projects
/
spider.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
started port of routing stuff
[spider.git]
/
perl
/
Aranea.pm
diff --git
a/perl/Aranea.pm
b/perl/Aranea.pm
index 3af3aee9432cd934f21f992cbd3006b3f36867a4..e90a2a4505e8f6e163df3b4248bc45034fb6702d 100644
(file)
--- a/
perl/Aranea.pm
+++ b/
perl/Aranea.pm
@@
-28,7
+28,7
@@
use Thingy;
use vars qw($VERSION $BRANCH);
$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
use vars qw($VERSION $BRANCH);
$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
-$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /
\d+\.\d+\.(\d+)\.(\d+)
/ || (0,0));
+$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /
^\d+\.\d+(?:\.(\d+)\.(\d+))?$
/ || (0,0));
$main::build += $VERSION;
$main::branch += $BRANCH;
$main::build += $VERSION;
$main::branch += $BRANCH;
@@
-55,7
+55,7
@@
sub new
# add this node to the table, the values get filled in later
my $pkg = shift;
my $call = shift;
# add this node to the table, the values get filled in later
my $pkg = shift;
my $call = shift;
- $main::routeroot->add($call, '5
000
', Route::here(1)) if $call ne $main::mycall;
+ $main::routeroot->add($call, '5
251
', Route::here(1)) if $call ne $main::mycall;
$self->{'sort'} = 'W';
return $self;
}
$self->{'sort'} = 'W';
return $self;
}
@@
-205,7
+205,8
@@
sub genheader
my $from = shift;
my $date = ((($dayno << 1) | $ntpflag) << 18) | ($main::systime % 86400);
my $from = shift;
my $date = ((($dayno << 1) | $ntpflag) << 18) | ($main::systime % 86400);
- my $r = "$mycall,$to," . sprintf('%6X%04X,0', $date, $seqno);
+ my $r = "$mycall," . sprintf('%6X%04X,0', $date, $seqno);
+ $r .= ",$to" if $to;
$r .= ",$from" if $from;
$seqno++;
$seqno = 0 if $seqno > 0x0ffff;
$r .= ",$from" if $from;
$seqno++;
$seqno = 0 if $seqno > 0x0ffff;
@@
-284,16
+285,20
@@
sub input
my ($head, $data) = split /\|/, $line, 2;
return unless $head && $data;
my ($head, $data) = split /\|/, $line, 2;
return unless $head && $data;
- my ($origin, $
group, $dts, $ho
p, $user) = split /,/, $head;
+ my ($origin, $
dts, $hop, $grou
p, $user) = split /,/, $head;
return if DXDupe::check("Ara,$origin,$dts", $dupeage);
my $err;
return if DXDupe::check("Ara,$origin,$dts", $dupeage);
my $err;
- $err .= "incomplete header," unless $origin &&
defined $group &&
$dts && defined $hop;
+ $err .= "incomplete header," unless $origin && $dts && defined $hop;
my ($cmd, $rdata) = split /,/, $data, 2;
# validate it further
$err .= "missing cmd or data," unless $cmd && $data;
$err .= "invalid command ($cmd)," unless $cmd =~ /^[A-Z][A-Z0-9]*$/;
my ($cmd, $rdata) = split /,/, $data, 2;
# validate it further
$err .= "missing cmd or data," unless $cmd && $data;
$err .= "invalid command ($cmd)," unless $cmd =~ /^[A-Z][A-Z0-9]*$/;
- $err .= "invalid group ($group)," unless $group =~ /^[-A-Z0-9\/:]{2,}$/;
+ my ($gp, $tus) = split /:/, $group, 2;
+
+ $err .= "invalid group ($gp)," unless $gp =~ /^[A-Z0-9]{2,}$/;
+ $err .= "invalid tocall ($tus)," if $tus && !is_callsign($tus);
+ $err .= "invalid fromcall ($user)," if $user && !is_callsign($user);
my $class = 'Thingy::' . ucfirst(lc $cmd);
my $thing;
my $class = 'Thingy::' . ucfirst(lc $cmd);
my $thing;
@@
-314,8
+319,9
@@
sub input
# store useful data
$thing->{origin} = $origin;
# store useful data
$thing->{origin} = $origin;
- ($thing->{group}, $thing->{touser}) = split /:/, $group, 2;
$thing->{time} = $t;
$thing->{time} = $t;
+ $thing->{group} = $gp if $gp;
+ $thing->{touser} = $tus if $tus;
$thing->{user} = $user if $user;
$thing->{hopsaway} = $hop;
$thing->{user} = $user if $user;
$thing->{hopsaway} = $hop;