X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXXml.pm;h=6bf1fa5967a5bbb4bc248312355899a2b9407e59;hb=0791dd94e297b6c14167f4252b91f06e84fbcf6f;hp=fe4cb2b8af8efc6affdc47079922e6f56f25e3c5;hpb=9cc26cc7a73efb7679d3e8e819ba0019307f8607;p=spider.git diff --git a/perl/DXXml.pm b/perl/DXXml.pm index fe4cb2b8..6bf1fa59 100644 --- a/perl/DXXml.pm +++ b/perl/DXXml.pm @@ -14,10 +14,14 @@ use IsoTime; use DXProt; use DXDebug; use DXLog; +use DXUtil; use DXXml::Ping; use DXXml::Dx; +use DXXml::IM; +use DXXml::Text; +use DXXml::Cmd; -use vars qw($VERSION $BRANCH $xs $id); +use vars qw($VERSION $BRANCH $xs $id $max_old_age $max_future_age $dupeage); $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); $main::build += $VERSION; @@ -25,13 +29,23 @@ $main::branch += $BRANCH; $xs = undef; # the XML::Simple parser instance $id = 0; # the next ID to be used +$max_old_age = 3600; # how old a sentence we will accept +$max_future_age = 900; # how far into the future we will accept +$dupeage = 12*60*60; # duplicates stored half a day + # generate a new XML sentence structure sub new { my $pkg = shift; my $class = ref $pkg || $pkg; - return bless{@_}, $class; + my $self = bless{}, $class; + while (@_) { + my $key = shift; + my $val = shift; + $self->{$key} = $val if defined $val; + } + return $self; } # @@ -42,20 +56,24 @@ sub init return unless $main::do_xml; eval { require XML::Simple }; - eval { require XML::SAX } unless $@; - eval { require XML::SAX::Expat } unless $@; + eval { require XML::Parser } unless $@; if ($@) { LogDbg('err', "do_xml was set to 1 and the XML routines failed to load ($@)"); - $main::do_xml = 0; + $main::do_xml = $xs = 0; } else { - $XML::Simple::PREFERRED_PARSER = 'XML::SAX::Expat'; + $XML::Simple::PREFERRED_PARSER = 'XML::Parser'; import XML::Simple; - $DXProt::handle_xml = 1; - $xs = new XML::Simple(Cache=>[]); + $xs = new XML::Simple(ContentKey=>'content', ForceArray=>1); } undef $@; } +# is XML avaiable and active +sub available +{ + return $main::do_xml && $xs; +} + # # note that this a function not a method # @@ -64,7 +82,7 @@ sub normal my $dxchan = shift; my $line = shift; - unless ($main::do_xml) { + unless (available()) { dbg("xml not enabled, IGNORED") if isdbg('chanerr'); return; } @@ -83,14 +101,38 @@ sub normal undef $@; return; } - + + # do some basic checks + my ($o, $t, $id); + unless (exists $xref->{o} && is_callsign($o = $xref->{o})) { + dbg("Invalid origin, not a callsign") if isdbg('chanerr'); + return; + } + unless (exists $xref->{t} && ($t = IsoTime::unixtime($xref->{t}))) { + dbg("Invalid, non-existant or zero time") if isdbg('chanerr'); + return; + } + unless ($t > $main::systime - $max_old_age && $t < $main::systime + $max_future_age) { + dbg("Too old or too far in the future") if isdbg('chanerr'); + return; + } + unless (exists $xref->{id} && ($id = $xref->{id}) >= 0 && $id <= 999) { + dbg("Invalid or non-existant id") if isdbg('chanerr'); + 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); + # now check that we have not seen this before + # this is based on the tuple (o (origin), t (time, normalised to time_t), id) + $xref->{'-timet'} = $t; + return if DXDupe::check("xml,$o,$t,$id", $dupeage); + + my $r = bless $xref, $pkg; + $r->{'-xml'} = $line; + $r->handle_input($dxchan); } # @@ -119,7 +161,6 @@ sub process DXXml::Ping::add($main::me, $dxchan->call); $dxchan->{nopings} -= 1; $dxchan->{lastping} = $t; - $dxchan->{lastping} += $dxchan->{pingint} / 2 unless @{$dxchan->{pingtime}}; } } } @@ -161,7 +202,7 @@ sub toxml unless (exists $self->{'-xml'}) { $self->{o} ||= $main::mycall; - $self->{t} ||= IsoTime::dayminsec(); + $self->{t} ||= IsoTime::hourminsec(); $self->{id} ||= nextid(); my ($name) = (ref $self) =~ /::(\w+)$/; @@ -175,19 +216,25 @@ sub route my $self = shift; my $fromdxchan = shift; my $to = shift; - my $via = $to || $self->{'-via'} || $self->{to}; + my $via = $to; + my $dxchan; + + if (my $u = $self->{u} && $self->{to} eq $main::mycall) { + $via ||= $u if ($dxchan = DXChannel::get($u)); + } + $via ||= $self->{'-via'} || $self->{to}; unless ($via) { - dbg("XML: no route specified (" . $self->toxml . ")") if isdbg('chanerr'); + dbg("XML: no route specified (" . dd($self) . ")") if isdbg('chanerr'); return; } if (ref $fromdxchan && $via && $fromdxchan->call eq $via) { - dbg("XML: Trying to route back to source (" . $self->toxml . ")") if isdbg('chanerr'); + dbg("XML: Trying to route back to source (" . dd($self) . ")") if isdbg('chanerr'); return; } # always send it down the local interface if available - my $dxchan = DXChannel::get($via); + $dxchan ||= DXChannel::get($via); if ($dxchan) { dbg("route: $via -> $dxchan->{call} direct" ) if isdbg('route'); } else { @@ -211,22 +258,27 @@ sub route } if ($fromdxchan->call eq $via) { - dbg("XML: Trying to route back to source (" . $self->toxml . ")") if isdbg('chanerr'); + dbg("XML: Trying to route back to source (" . dd($self) . ")") if isdbg('chanerr'); return; } if ($dxchan == $main::me) { - dbg("XML: Trying to route to me (" . $self->toxml . ")") if isdbg('chanerr'); + dbg("XML: Trying to route to me (" . dd($self) . ")") if isdbg('chanerr'); return; } + $self->{o} ||= $main::mycall; + $self->{id} ||= nextid(); + $self->{'-timet'} ||= $main::systime; + if ($dxchan->handle_xml) { $dxchan->send($self->toxml); + } elsif ($dxchan->is_node) { + my $ref = $self->topcxx($dxchan); + $dxchan->send($ref); } else { - $self->{o} ||= $main::mycall; - $self->{id} ||= nextid(); - $self->{'-timet'} ||= $main::systime; - $dxchan->send($self->topcxx); + my $ref = $self->tocmd($dxchan); + $dxchan->send($ref); } }