[aprssig] Field station
Arne Stahre
sm6vyf at gatugarden.com
Sat Dec 20 00:28:02 EST 2008
This is how I did KISS in Perl (Linux). Maybe it still works...
73 de SM6VYF/Arne
#!/usr/bin/perl -w
# SM6VYF 26-28.X.02
# From C to Common Lisp to Perl...
use strict;
#### - - - - - BEGIN AX.25 code - - - - -
####AX.25 constants
my $FEND = 0xC0;
my $FESC = 0xDB;
my $TFEND = 0xDC;
my $TFESC = 0xDD;
my $KISS_DATA = 0x00;
my $AXALEN = 7;
my $SSID = 0x1E; #Bitmask
my $CONTROL = 0x03; #UI
my $PID = 0xF0; #No layer three
my @rx_buffer = ();
my $index = 0;
my $state = 'SYNCH';
sub change_state {
my ($new_state) = @_;
$state = $new_state;
}
sub clear_buffer {
@rx_buffer = ();
$index = 0;
}
sub select_buffer {
}
sub to_buffer {
my ($byte) = @_;
$rx_buffer[$index++] = $byte;
}
sub reset_kiss {
clear_buffer();
change_state('SYNCH');
}
sub call_char {
my ($str_ref, $index) = @_;
my $c = chr(($$str_ref[$index] >> 1) & 0x7F);
return $c ne ' ' ? $c : '';
}
sub pull_call {
my ($str_ref, $offset) = @_;
my $ssid_byte = $$str_ref[$offset + ($AXALEN - 1)];
my $ssid = ($ssid_byte & $SSID) >> 1;
return (sprintf("%s%s%s%s%s%s%s",
call_char($str_ref, $offset + 0),
call_char($str_ref, $offset + 1),
call_char($str_ref, $offset + 2),
call_char($str_ref, $offset + 3),
call_char($str_ref, $offset + 4),
call_char($str_ref, $offset + 5),
$ssid ? "-$ssid" : ''),
$ssid_byte & 0x80, #digid or C bit
! ($ssid_byte & 0x1)); #more
}
sub pull_digis {
my ($str_ref, $offset) = @_;
my ($call, $more, $n, $digid, @digi_list);
$more = 1;
$n = 0;
while ($more) {
($call, $digid, $more) = pull_call($str_ref, $offset);
push(@digi_list, $digid ? "$call*" : $call);
$n += 1 if ($digid);
$offset += $AXALEN;
}
return (@digi_list);
}
sub disp_digis {
my ($list_ref) = @_;
return join('', map sprintf(",%s", $_), (@$list_ref));
}
sub extract_frame {
my ($dest, $source, $digid, $more, @digi_list, $n);
($dest, $digid, $more) = pull_call(\@rx_buffer, 0);
($source, $digid, $more) = pull_call(\@rx_buffer, $AXALEN);
if ($more) {
@digi_list = pull_digis(\@rx_buffer, $AXALEN * 2);
}
my $control_byte_index = ($#digi_list + 3) * $AXALEN;
if (($rx_buffer[$control_byte_index] & 0xCF) == 3) {
return sprintf("%s>%s%s:%s",
$source,
$dest,
disp_digis(\@digi_list),
join('',
map(chr($_),
splice(@rx_buffer, $control_byte_index + 2))));
} else {
return 'OTHER FRAME';
}
}
sub build_kiss_frame {
my ($byte) = @_;
my $ret = 'NO FRAME';
if ($state eq 'SYNCH') {
if ($byte eq $FEND) { #beginning of frame
change_state('COMMAND');
}
} elsif ($state eq 'COMMAND') {
if ($byte eq $FEND) { #new beginning of frame
} elsif (($byte & 0xF) == $KISS_DATA) {
select_buffer(($byte & 0xF0) >> 4);
clear_buffer();
change_state('NORMAL'); #clear buffer
} else {
change_state('SYNCH');
}
} elsif ($state eq 'NORMAL') {
if ($byte eq $FEND) { #end of frame
$ret = extract_frame();
change_state('SYNCH');
} elsif ($byte eq $FESC) {
change_state('ESCAPED');
} else {
to_buffer($byte);
}
} elsif ($state eq 'ESCAPED') {
if ($byte eq $FEND) { #end of frame
$ret = extract_frame();
change_state('SYNCH');
} elsif ($byte eq $TFEND) {
to_buffer($FEND);
change_state('NORMAL');
} elsif ($byte eq $TFESC) {
to_buffer($FESC);
change_state('NORMAL');
} else {
to_buffer($byte);
}
}
return $ret;
}
###Below is the code needed to send KISS-data
sub send_kiss {
my (@s) = @_;
write_byte($FEND);
write_byte($KISS_DATA);
foreach my $byte (@s) {
if ($byte eq $FEND) {
write_byte($FESC);
write_byte($TFEND);
} elsif ($byte eq $FESC) {
write_byte($FESC);
write_byte($TFESC);
} else {
write_byte($byte);
}
}
write_byte($FEND);
}
sub make_call {
my ($call, $ssid, $more) = @_;
my @str = split(//, uc($call . ' ')); # ???
return (ord($str[0]) << 1,
ord($str[1]) << 1,
ord($str[2]) << 1,
ord($str[3]) << 1,
ord($str[4]) << 1,
ord($str[5]) << 1,
($ssid << 1) | ($more ? 0x0 : 0x1));
}
sub ax25_addr {
my ($call, $more) = @_;
if ($call =~ /([A-Z0-9]+)\-(\d+)/) {
return make_call($1, $2, $more);
} else {
return make_call($call, 0, $more);
}
}
sub write_kiss_frame {
my ($dest, $source, $path_ref, $message) = @_;
my @tx_buffer;
##Destination
push(@tx_buffer, ax25_addr($dest, 1));
##Source
push(@tx_buffer, ax25_addr($source, $#$path_ref >= 0));
##Digipeaters
foreach my $i (0 .. $#$path_ref) {
push(@tx_buffer, ax25_addr($$path_ref[$i], $i != $#$path_ref));
}
##Control & PID
push(@tx_buffer, $CONTROL);
push(@tx_buffer, $PID);
##Message
push(@tx_buffer, map(ord($_), split(//, $message)));
##TX
send_kiss(@tx_buffer);
}
#### - - - - - END AX.25 code - - - - -
sub write_byte {
my ($byte) = @_;
syswrite(TNC, chr($byte), 1);
}
sub disp_frame {
my ($str) = @_;
my $oldfh = select(STDOUT);
$| = 1;
print "$str\n";
select($oldfh);
$| = 1;
}
my $tty = '/dev/ttyS0';
my ($rin, $rout) = ('', '');
my ($win, $wout) = ('', '');
my ($byte, $c) = ('', '');
reset_kiss();
system("stty 19200 -echo -cstopb raw < $tty");
open(TNC, "+<$tty") or die("Open error: $1");
binmode(TNC);
select(TNC);
$|=1;
vec($rin, fileno(TNC), 1) = 1;
vec($win, fileno(STDIN), 1) = 1;
while (select(undef, $wout=$win, undef, 1)) {
# write_kiss_frame('APRS', 'SM6VYF-13', ['WIDE2-2'],
# '!5743.60N/01146.43E.Perl KISS interface test');
while (select($rout=$rin, undef, undef, 1)) { # $wout=$win
sysread(TNC, $byte, 1);
$c = build_kiss_frame(ord($byte));
last if ($c ne 'NO FRAME');
}
disp_frame($c);# if ($c ne 'OTHER FRAME');
}
close(TNC);
More information about the aprssig
mailing list