From af378e74088394d9c70a9a01d67a311cf4774d96 Mon Sep 17 00:00:00 2001 From: minima Date: Tue, 10 Jan 2006 22:22:21 +0000 Subject: [PATCH] get some basic XML routines up and running. --- perl/DXProt.pm | 104 ++++++++++++++++++++++++++------------------- perl/DXXml.pm | 88 ++++++++++++++++++++++++++++++++++++-- perl/DXXml/Dx.pm | 32 ++++++++++++++ perl/DXXml/Ping.pm | 32 ++++++++++++++ perl/IsoTime.pm | 89 ++++++++++++++++++++++++++++++++++++++ perl/Route/Node.pm | 22 ++-------- perl/cluster.pl | 5 ++- 7 files changed, 305 insertions(+), 67 deletions(-) create mode 100644 perl/DXXml/Dx.pm create mode 100644 perl/DXXml/Ping.pm create mode 100644 perl/IsoTime.pm diff --git a/perl/DXProt.pm b/perl/DXProt.pm index 352a4f6a..d51b9f1a 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -301,7 +301,7 @@ sub start $self->{pingave} = 999; $self->{metric} ||= 100; $self->{lastping} = $main::systime; - + # send initialisation string unless ($self->{outbound}) { $self->sendinit; @@ -335,6 +335,11 @@ sub normal { my ($self, $line) = @_; + if ($line =~ '^<\w+\s') { + DXXml::normal($self, $line); + return; + } + my @field = split /\^/, $line; return unless @field; @@ -1545,48 +1550,7 @@ sub handle_51 if ($flag == 1) { $self->send(pc51($from, $to, '0')); } else { - # it's a reply, look in the ping list for this one - my $ref = $pings{$from}; - if ($ref) { - my $tochan = DXChannel::get($from); - while (@$ref) { - my $r = shift @$ref; - my $dxchan = DXChannel::get($r->{call}); - next unless $dxchan; - my $t = tv_interval($r->{t}, [ gettimeofday ]); - if ($dxchan->is_user) { - my $s = sprintf "%.2f", $t; - my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t; - $dxchan->send($dxchan->msg('pingi', $from, $s, $ave)) - } elsif ($dxchan->is_node) { - if ($tochan) { - my $nopings = $tochan->user->nopings || $obscount; - push @{$tochan->{pingtime}}, $t; - shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6; - - # cope with a missed ping, this means you must set the pingint large enough - if ($t > $tochan->{pingint} && $t < 2 * $tochan->{pingint} ) { - $t -= $tochan->{pingint}; - } - - # calc smoothed RTT a la TCP - if (@{$tochan->{pingtime}} == 1) { - $tochan->{pingave} = $t; - } else { - $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6); - } - $tochan->{nopings} = $nopings; # pump up the timer - if (my $ivp = Investigate::get($from, $self->{call})) { - $ivp->handle_ping; - } - } elsif (my $rref = Route::Node::get($r->{call})) { - if (my $ivp = Investigate::get($from, $self->{call})) { - $ivp->handle_ping; - } - } - } - } - } + $self->handle_ping_reply($from); } } else { @@ -1601,6 +1565,56 @@ sub handle_51 } } +sub handle_ping_reply +{ + my $self = shift; + my $from = shift; + my $id = shift; + + # it's a reply, look in the ping list for this one + my $ref = $pings{$from}; + return unless $ref; + + my $tochan = DXChannel::get($from); + while (@$ref) { + my $r = shift @$ref; + my $dxchan = DXChannel::get($r->{call}); + next unless $dxchan; + my $t = tv_interval($r->{t}, [ gettimeofday ]); + if ($dxchan->is_user) { + my $s = sprintf "%.2f", $t; + my $ave = sprintf "%.2f", $tochan ? ($tochan->{pingave} || $t) : $t; + $dxchan->send($dxchan->msg('pingi', $from, $s, $ave)) + } elsif ($dxchan->is_node) { + if ($tochan) { + my $nopings = $tochan->user->nopings || $obscount; + push @{$tochan->{pingtime}}, $t; + shift @{$tochan->{pingtime}} if @{$tochan->{pingtime}} > 6; + + # cope with a missed ping, this means you must set the pingint large enough + if ($t > $tochan->{pingint} && $t < 2 * $tochan->{pingint} ) { + $t -= $tochan->{pingint}; + } + + # calc smoothed RTT a la TCP + if (@{$tochan->{pingtime}} == 1) { + $tochan->{pingave} = $t; + } else { + $tochan->{pingave} = $tochan->{pingave} + (($t - $tochan->{pingave}) / 6); + } + $tochan->{nopings} = $nopings; # pump up the timer + if (my $ivp = Investigate::get($from, $self->{call})) { + $ivp->handle_ping; + } + } elsif (my $rref = Route::Node::get($r->{call})) { + if (my $ivp = Investigate::get($from, $self->{call})) { + $ivp->handle_ping; + } + } + } + } +} + # dunno but route it sub handle_75 { @@ -1711,7 +1725,8 @@ sub process } foreach $dxchan (@dxchan) { - next unless $dxchan->is_node(); + next unless $dxchan->is_node; + next if $dxchan->handle_xml; next if $dxchan == $main::me; # send the pc50 @@ -1725,6 +1740,7 @@ sub process addping($main::mycall, $dxchan->call); $dxchan->{nopings} -= 1; $dxchan->{lastping} = $t; + $dxchan->{lastping} += $dxchan->{pingint} / 2 unless @{$dxchan->{pingtime}}; } } } diff --git a/perl/DXXml.pm b/perl/DXXml.pm index c6c8ee69..968b6148 100644 --- a/perl/DXXml.pm +++ b/perl/DXXml.pm @@ -9,18 +9,34 @@ use strict; package DXXml; +use IsoTime; -use DXChannel; use DXProt; +use DXDebug; +use DXLog; +use DXXml::Ping; +use DXXml::Dx; -use vars qw($VERSION $BRANCH $xs); +use vars qw($VERSION $BRANCH $xs $id); $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); $main::build += $VERSION; $main::branch += $BRANCH; -$xs = undef; # the XML::Simple parser instance +$xs = undef; # the XML::Simple parser instance +$id = 0; # the next ID to be used +# generate a new XML sentence structure +sub new +{ + my $pkg = shift; + my $class = ref $pkg || $pkg; + return bless{@_}, $class; +} + +# +# note that this a function not a method +# sub init { return unless $main::do_xml; @@ -34,13 +50,79 @@ sub init undef $@; } +# +# note that this a function not a method +# sub normal { + my $dxchan = shift; + my $line = shift; + + unless ($main::do_xml) { + dbg("xml not enabled, IGNORED") if isdbg('chanerr'); + return; + } + + my ($rootname) = $line =~ '<(\w+) '; + my $pkg = "DXXml::" . ucfirst lc "$rootname"; + + unless (defined *{"${pkg}::"} && $pkg->can('handle_input')) { + dbg("xml sentence $rootname not recognised, IGNORED") if isdbg('chanerr'); + return; + } + + my $xref; + unless ($xref = $pkg->decode_xml($dxchan, $line)) { + dbg("invalid XML ($@), IGNORED") if isdbg('chanerr'); + undef $@; + return; + } + + # mark the handle as accepting xml (but only if they + # have at least one right) + $dxchan->handle_xml(1); + $xref = bless $xref, $pkg; + $xref->{'-xml'} = $line; + $xref->handle_input($dxchan); } +# +# note that this a function not a method +# sub process { } + +sub decode_xml +{ + my $pkg = shift; + my $dxchan = shift; + my $line = shift; + + my $xref; + eval {$xref = $xs->XMLin($line)}; + return $xref; +} + +sub nextid +{ + my $r = $id++; + $id = 0 if $id > 999; + return $r; +} + +sub toxml +{ + my $self = shift; + + $self->{o} ||= $main::mycall; + $self->{t} ||= IsoTime::dayms(); + $self->{id} ||= nextid(); + + my ($name) = ref $self =~ /::(\w+)$/; + my $s = $xs->XMLout($self, RootName =>$name, NumericEscape=>1); + return $self->{'-xml'} = $s; +} 1; diff --git a/perl/DXXml/Dx.pm b/perl/DXXml/Dx.pm new file mode 100644 index 00000000..d8bba23b --- /dev/null +++ b/perl/DXXml/Dx.pm @@ -0,0 +1,32 @@ +# +# XML DX Spot handler +# +# $Id$ +# +# Copyright (c) Dirk Koopman, G1TLH +# + +use strict; + +package DXXml::Dx; + +use DXDebug; +use DXProt; +use IsoTime; + +use vars qw($VERSION $BRANCH @ISA); +$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); +$main::build += $VERSION; +$main::branch += $BRANCH; + +@ISA = qw(DXXml); + +sub handle_input +{ + my $self = shift; + my $dxchan = shift; + +} + +1; diff --git a/perl/DXXml/Ping.pm b/perl/DXXml/Ping.pm new file mode 100644 index 00000000..26dd864e --- /dev/null +++ b/perl/DXXml/Ping.pm @@ -0,0 +1,32 @@ +# +# XML Ping handler +# +# $Id$ +# +# Copyright (c) Dirk Koopman, G1TLH +# + +use strict; + +package DXXml::Ping; + +use DXDebug; +use DXProt; +use IsoTime; + +use vars qw($VERSION $BRANCH @ISA); +$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); +$main::build += $VERSION; +$main::branch += $BRANCH; + +@ISA = qw(DXXml); + +sub handle_input +{ + my $self = shift; + my $dxchan = shift; + +} + +1; diff --git a/perl/IsoTime.pm b/perl/IsoTime.pm new file mode 100644 index 00000000..422f9912 --- /dev/null +++ b/perl/IsoTime.pm @@ -0,0 +1,89 @@ +# +# Utility routines for handling Iso 8601 date time groups +# +# $Id$ +# +# Copyright (c) Dirk Koopman, G1TLH +# + +use strict; + +package IsoTime; + +use Date::Parse; + +use vars qw($VERSION $BRANCH $year $month $day $hour $min $sec @days @ldays); +$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); +$main::build += $VERSION; +$main::branch += $BRANCH; + +@days = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); +@ldays = (31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); + +# is it a leap year? +sub _isleap +{ + my $year = shift; + return ($year % 4 == 0 && ($year % 100 != 0 || $year % 400 == 0)) ? 1 : 0; +} + +sub full +{ + return sprintf "%04d%02d%02dT%02d%02d%02d", $year, $month, $day, $hour, $min, $sec; +} + +sub dayminsec +{ + return sprintf "%02dT%02d%02d%02d", $day, $hour, $min, $sec; +} + +sub daymin +{ + return sprintf "%02dT%02d%02d", $day, $hour, $min; +} + +sub update +{ + my $t = shift || time; + ($sec,$min,$hour,$day,$month,$year) = gmtime($t); + $month++; + $year += 1900; +} + +sub unixtime +{ + my $iso = shift; + + # get the correct month and year if it is a short date + if (my ($d) = $iso =~ /^(\d\d)T\d\d\d\d/) { + if ($d == $day) { + $iso = sprintf("%04d%02d", $year, $month) . $iso; + } else { + my $days = _isleap($year) ? $ldays[$month-1] : $days[$month-1]; + my ($y, $m) = ($year, $month); + if ($d < $day) { + if ($day - $d > $days / 2) { + if ($month == 1) { + $y = $year - 1; + $m = 12; + } else { + $m = $month - 1; + } + } + } else { + if ($d - $day > $days / 2) { + if ($month == 12) { + $y = $year + 1; + $m = 1; + } else { + $m = $month + 1; + } + } + } + $iso = sprintf("%04d%02d", $y, $m) . $iso; + } + } + return str2time($iso); +} +1; diff --git a/perl/Route/Node.pm b/perl/Route/Node.pm index 3c4addd0..d3b1e955 100644 --- a/perl/Route/Node.pm +++ b/perl/Route/Node.pm @@ -29,8 +29,9 @@ use vars qw(%list %valid @ISA $max $filterdef); users => '0,Users,parray', usercount => '0,User Count', version => '0,Version', - np => '0,Using New Prot,yesno', - lid => '0,Last Msgid', + handle_xml => '0,Using XML,yesno', + lastmsg => '0,Last Route Msg,atime', + lastid => '0,Last Route MsgID', ); $filterdef = $Route::filterdef; @@ -224,7 +225,6 @@ sub new $self->{flags} = shift; $self->{users} = []; $self->{nodes} = []; - $self->{lid} = 0; $list{$call} = $self; @@ -245,22 +245,6 @@ sub get_all return values %list; } -sub newid -{ - my $self = shift; - my $id = shift; - - return 0 if $id == $self->{lid}; - if ($id > $self->{lid}) { - $self->{lid} = $id; - return 1; - } elsif ($self->{lid} - $id > 500) { - $self->{id} = $id; - return 1; - } - return 0; -} - sub _addparent { my $self = shift; diff --git a/perl/cluster.pl b/perl/cluster.pl index e28011ab..0ad54f31 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -101,6 +101,7 @@ use QSL; use RouteDB; use DXXml; use DXSql; +use IsoTime; use Data::Dumper; use IO::File; @@ -134,7 +135,7 @@ $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); $main::build += $VERSION; $main::branch += $BRANCH; -$main::build += 3; # fudge (put back for now) +#$main::build += 2; # fudge (put back for now) @@ -511,8 +512,10 @@ for (;;) { if ($timenow != $systime) { reap if $zombies; $systime = $timenow; + IsoTime::update($systime); DXCron::process(); # do cron jobs DXCommandmode::process(); # process ongoing command mode stuff + DXXml::process(); DXProt::process(); # process ongoing ak1a pcxx stuff DXConnect::process(); DXMsg::process(); -- 2.34.1