]> gb7djk.dxcluster.net Git - spider.git/blob - perl/DXXml.pm
get the xml checking correct!
[spider.git] / perl / DXXml.pm
1 #
2 # XML handler
3 #
4 # $Id$
5 #
6 # Copyright (c) Dirk Koopman, G1TLH
7 #
8
9 use strict;
10
11 package DXXml;
12 use IsoTime;
13
14 use DXProt;
15 use DXDebug;
16 use DXLog;
17 use DXUtil;
18 use DXXml::Ping;
19 use DXXml::Dx;
20 use DXXml::IM;
21
22 use vars qw($VERSION $BRANCH $xs $id $max_old_age $max_future_age $dupeage);
23 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
24 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
25 $main::build += $VERSION;
26 $main::branch += $BRANCH;
27
28 $xs = undef;                                    # the XML::Simple parser instance
29 $id = 0;                                                # the next ID to be used
30 $max_old_age = 3600;                    # how old a sentence we will accept
31 $max_future_age = 900;                  # how far into the future we will accept
32 $dupeage = 12*60*60;                    # duplicates stored half a day 
33
34
35 # generate a new XML sentence structure 
36 sub new
37 {
38         my $pkg = shift;
39         my $class = ref $pkg || $pkg;
40         return bless{@_}, $class;
41 }
42
43 #
44 # note that this a function not a method
45 #
46 sub init
47 {
48         return unless $main::do_xml;
49         
50         eval { require XML::Simple };
51         eval { require XML::Parser } unless $@;
52         if ($@) {
53                 LogDbg('err', "do_xml was set to 1 and the XML routines failed to load ($@)");
54                 $main::do_xml = 0;
55         } else {
56                 $XML::Simple::PREFERRED_PARSER = 'XML::Parser';
57                 import XML::Simple;
58                 $DXProt::handle_xml = 1;
59                 $xs = new XML::Simple(Cache=>[]);
60         }
61         undef $@;
62 }
63
64 #
65 # note that this a function not a method
66 #
67 sub normal
68 {
69         my $dxchan = shift;
70         my $line = shift;
71
72         unless ($main::do_xml) {
73                 dbg("xml not enabled, IGNORED") if isdbg('chanerr');
74                 return;
75         }
76         
77         my ($rootname) = $line =~ '<(\w+) ';
78         my $pkg = "DXXml::" . ucfirst lc "$rootname";
79
80         unless (defined *{"${pkg}::"} && $pkg->can('handle_input')) {
81                 dbg("xml sentence $rootname not recognised, IGNORED") if isdbg('chanerr');
82                 return;
83         }
84                 
85         my $xref;
86         unless ($xref = $pkg->decode_xml($dxchan, $line))  {
87                 dbg("invalid XML ($@), IGNORED") if isdbg('chanerr');
88                 undef $@;
89                 return;
90         }
91
92         # do some basic checks
93         my ($o, $t, $id);
94         unless (exists $xref->{o} && is_callsign($o = $xref->{o})) {
95                 dbg("Invalid origin, not a callsign") if isdbg('chanerr');
96                 return;
97         }
98         unless (exists $xref->{t} && ($t = IsoTime::unixtime($xref->{t}))) {
99                 dbg("Invalid, non-existant or zero time") if isdbg('chanerr');
100                 return;
101         }
102         unless ($t > $main::systime - $max_old_age && $t < $main::systime + $max_future_age) {
103                 dbg("Too old or too far in the future") if isdbg('chanerr');
104                 return;
105         }
106         unless (exists $xref->{id} && ($id = $xref->{id}) >= 0 && $id <= 999) {
107                 dbg("Invalid or non-existant id") if isdbg('chanerr');
108                 return;
109         }
110
111         # mark the handle as accepting xml (but only if they 
112         # have at least one right)
113         $dxchan->handle_xml(1);
114
115         # now check that we have not seen this before 
116         # this is based on the tuple (o (origin), t (time, normalised to time_t), id)
117         $xref->{'-timet'} = $t;
118         return if DXDupe::check("xml,$o,$t,$id", $dupeage);
119                 
120         $xref = bless $xref, $pkg;
121         $xref->{'-xml'} = $line; 
122         $xref->handle_input($dxchan);
123 }
124
125 #
126 # note that this a function not a method
127 #
128
129 my $last10;
130 my $last_hour;
131
132 sub process
133 {
134         my $t = time;
135         my @dxchan = DXChannel::get_all();
136         my $dxchan;
137
138         foreach $dxchan (@dxchan) {
139                 next unless $dxchan->is_node;
140                 next unless $dxchan->handle_xml;
141                 next if $dxchan == $main::me;
142
143                 # send a ping out on this channel
144                 if ($dxchan->{pingint} && $t >= $dxchan->{pingint} + $dxchan->{lastping}) {
145                         if ($dxchan->{nopings} <= 0) {
146                                 $dxchan->disconnect;
147                         } else {
148                                 DXXml::Ping::add($main::me, $dxchan->call);
149                                 $dxchan->{nopings} -= 1;
150                                 $dxchan->{lastping} = $t;
151                                 $dxchan->{lastping} += $dxchan->{pingint} / 2 unless @{$dxchan->{pingtime}};
152                         }
153                 }
154         }
155
156
157         # every ten seconds
158         if (!$last10 || $t - $last10 >= 10) {   
159                 $last10 = $t;
160         }
161
162         # every hour
163         if (!$last_hour || $main::systime - 3600 > $last_hour) {
164                 $last_hour = $main::systime;
165         }
166
167 }
168
169 sub decode_xml
170 {
171         my $pkg = shift;
172         my $dxchan = shift;
173         my $line = shift;
174
175         my $xref;
176         eval {$xref = $xs->XMLin($line)};
177         return $xref;
178 }
179
180 sub nextid
181 {
182         my $r = $id++;
183         $id = 0 if $id > 999;
184         return $r;
185 }
186
187 sub toxml
188 {
189         my $self = shift;
190
191         unless (exists $self->{'-xml'}) {
192                 $self->{o} ||= $main::mycall;
193                 $self->{t} ||= IsoTime::dayminsec();
194                 $self->{id} ||= nextid();
195                 
196                 my ($name) = (ref $self) =~ /::(\w+)$/;
197                 $self->{'-xml'} = $xs->XMLout($self, RootName =>lc $name, NumericEscape=>1);
198         }
199         return $self->{'-xml'};
200 }
201
202 sub route
203 {
204         my $self = shift;
205         my $fromdxchan = shift;
206         my $to = shift;
207         my $via = $to || $self->{'-via'} || $self->{to};
208
209         unless ($via) {
210                 dbg("XML: no route specified (" . $self->toxml . ")") if isdbg('chanerr');
211                 return;
212         }
213         if (ref $fromdxchan && $via && $fromdxchan->call eq $via) {
214                 dbg("XML: Trying to route back to source (" . $self->toxml . ")") if isdbg('chanerr');
215                 return;
216         }
217
218         # always send it down the local interface if available
219         my $dxchan = DXChannel::get($via);
220         if ($dxchan) {
221                 dbg("route: $via -> $dxchan->{call} direct" ) if isdbg('route');
222         } else {
223                 my $cl = Route::get($via);
224                 $dxchan = $cl->dxchan if $cl;
225                 dbg("route: $via -> $dxchan->{call} using normal route" ) if isdbg('route');
226         }
227
228         # try the backstop method
229         unless ($dxchan) {
230                 my $rcall = RouteDB::get($via);
231                 if ($rcall) {
232                         $dxchan = DXChannel::get($rcall);
233                         dbg("route: $via -> $rcall using RouteDB" ) if isdbg('route') && $dxchan;
234                 }
235         }
236         
237         unless ($dxchan) {
238                 dbg("XML: no route available to $via") if isdbg('chanerr');
239                 return;
240         }
241
242         if ($fromdxchan->call eq $via) {
243                 dbg("XML: Trying to route back to source (" . $self->toxml . ")") if isdbg('chanerr');
244                 return;
245         }
246
247         if ($dxchan == $main::me) {
248                 dbg("XML: Trying to route to me (" . $self->toxml . ")") if isdbg('chanerr');
249                 return;
250         }
251
252         if ($dxchan->handle_xml) {
253                 $dxchan->send($self->toxml);
254         } else {
255                 $self->{o} ||= $main::mycall;
256                 $self->{id} ||= nextid();
257                 $self->{'-timet'} ||= $main::systime;
258                 $dxchan->send($self->topcxx);
259         }
260 }
261
262 sub has_xml
263 {
264         return exists $_[0]->{'-xml'};
265 }
266
267 sub has_pcxx
268 {
269         return exists $_[0]->{'-pcxx'};
270 }
271
272 sub has_cmd
273 {
274         return exists $_[0]->{'-cmd'};
275 }
276
277 1;