]> dxcluster.net Git - spider.git/blob - perl/DXProtout.pm
Timeout PC92 nodes at the correct rate
[spider.git] / perl / DXProtout.pm
1 #!/usr/bin/perl
2 #
3 # This module impliments the outgoing PCxx generation routines
4 #
5 # These are all the namespace of DXProt and are separated for "clarity"
6 #
7 # Copyright (c) 1998 Dirk Koopman G1TLH
8 #
9 #
10 #
11
12 package DXProt;
13
14 @ISA = qw(DXProt DXChannel);
15
16 use DXUtil;
17 use DXM;
18 use DXDebug;
19
20 use strict;
21
22 use vars qw($sentencelth $pc19_version);
23
24 $sentencelth = 180;
25
26 #
27 # All the PCxx generation routines
28 #
29
30 # create a talk string ($from, $to, $via, $text)
31 sub pc10
32 {
33         my ($from, $to, $via, $text, $origin) = @_;
34         my ($user1, $user2);
35         if ($via && $via ne $to && $via ne '*') {
36                 $user1 = $via;
37                 $user2 = $to;
38         } else {
39                 $user2 = ' ';
40                 $user1 = $to;
41         }
42         $origin ||= $main::mycall;
43         $text = unpad($text);
44         $text = ' ' unless $text && length $text > 0;
45         $text =~ s/\^/%5E/g;
46         return "PC10^$from^$user1^$text^*^$user2^$origin^~";
47 }
48
49 # create a dx message (call, freq, dxcall, text)
50 sub pc11
51 {
52         my ($mycall, $freq, $dxcall, $text) = @_;
53         my $hops = get_hops(11);
54         my $t = time;
55         $text = ' ' if !$text;
56         $text =~ s/\^/%5E/g;
57         return sprintf "PC11^%.1f^$dxcall^%s^%s^$text^$mycall^$main::mycall^$hops^~", $freq, cldate($t), ztime($t);
58 }
59
60 # create an announce message
61 sub pc12
62 {
63         my ($call, $text, $tonode, $sysop, $wx, $origin) = @_;
64         my $hops = get_hops(12);
65         $text ||= ' ';
66         $text =~ s/\^/%5E/g;
67         $tonode ||= '*';
68         $sysop ||= ' ';
69         $wx ||= '0';
70         $origin ||= $main::mycall;
71         return "PC12^$call^$tonode^$text^$sysop^$origin^$wx^$hops^~";
72 }
73
74 #
75 # add one or more users (I am expecting references that have 'call',
76 # 'conf' & 'here' method)
77 #
78 # this will create a list of PC16 with up pc16_max_users in each
79 # called $self->pc16(..)
80 #
81 sub pc16
82 {
83         my $node = shift;
84         my $ncall = $node->call;
85         my @out;
86
87         my $s = "";
88         for (@_) {
89                 next unless $_;
90                 my $ref = $_;
91                 my $str = sprintf "^%s %s %d", $ref->call, $ref->conf ? '*' : '-', $ref->here;
92                 if (length($s) + length($str) > $sentencelth) {
93                         push @out, "PC16^$ncall" . $s . sprintf "^%s^", get_hops(16);
94                         $s = "";
95                 }
96                 $s .= $str;
97         }
98         push @out, "PC16^$ncall" . $s . sprintf "^%s^", get_hops(16);
99         return @out;
100 }
101
102 # remove a local user
103 sub pc17
104 {
105         my @out;
106         while (@_) {
107                 my $node = shift;
108                 my $ref = shift;
109                 my $hops = get_hops(17);
110                 my $ncall = $node->call;
111                 my $ucall = $ref->call;
112                 push @out, "PC17^$ucall^$ncall^$hops^";
113         }
114         return @out;
115 }
116
117 # Request init string
118 sub pc18
119 {
120         my $flags = shift;
121         return "PC18^DXSpider Version: $main::version Build: $main::subversion.$main::build$flags^$DXProt::myprot_version^";
122 }
123
124 #
125 # add one or more nodes
126 #
127 sub pc19
128 {
129         my @out;
130         my @in;
131
132         my $s = "";
133         for (@_) {
134                 next unless $_;
135                 my $ref = $_;
136                 my $call = $ref->call;
137                 my $here = $ref->here;
138                 my $conf = $ref->conf;
139                 my $version = $ref->version;
140                 $version = $pc19_version unless $version =~ /^\d\d\d\d$/;
141
142                 my $str = "^$here^$call^$conf^$version";
143                 if (length($s) + length($str) > $sentencelth) {
144                         push @out, "PC19" . $s . sprintf "^%s^", get_hops(19);
145                         $s = "";
146                 }
147                 $s .= $str;
148         }
149         push @out, "PC19" . $s . sprintf "^%s^", get_hops(19);
150         return @out;
151 }
152
153 # end of Rinit phase
154 sub pc20
155 {
156         return 'PC20^';
157 }
158
159 # delete a node
160 sub pc21
161 {
162         my @out;
163         while (@_) {
164                 my $node = shift;
165                 my $hops = get_hops(21);
166                 my $call = $node->call;
167                 push @out, "PC21^$call^Gone^$hops^";
168         }
169         return @out;
170 }
171
172 # end of init phase
173 sub pc22
174 {
175         return 'PC22^';
176 }
177
178 # here status
179 sub pc24
180 {
181         my $self = shift;
182         my $call = $self->call;
183         my $flag = $self->here ? '1' : '0';
184         my $hops = shift || get_hops(24);
185
186         return "PC24^$call^$flag^$hops^";
187 }
188
189
190 # create a merged dx message (freq, dxcall, t, text, spotter, orig-node)
191 sub pc26
192 {
193         my ($freq, $dxcall, $t, $text, $spotter, $orignode) = @_;
194         $text = ' ' unless $text;
195         $orignode = $main::mycall unless $orignode;
196         return sprintf "PC26^%.1f^$dxcall^%s^%s^$text^$spotter^$orignode^ ^~", $freq, cldate($t), ztime($t);
197 }
198
199 # create a merged WWV spot (logger, t, sfi, a, k, forecast, orig-node)
200 sub pc27
201 {
202         my ($logger, $t, $sfi, $a, $k, $forecast, $orignode) = @_;
203         return sprintf "PC27^%s^%-2.2s^$sfi^$a^$k^$forecast^$logger^$orignode^ ^~", cldate($t), ztime($t);
204 }
205
206 # message start (fromnode, tonode, to, from, t, private, subject, origin)
207 sub pc28
208 {
209         my ($tonode, $fromnode, $to, $from, $t, $private, $subject, $origin, $rr) = @_;
210         my $date = cldate($t);
211         my $time = ztime($t);
212         $private = $private ? '1' : '0';
213         $rr = $rr ? '1' : '0';
214         $subject ||= ' ';
215         return "PC28^$tonode^$fromnode^$to^$from^$date^$time^$private^$subject^ ^5^$rr^ ^$origin^~";
216 }
217
218 # message text (from and to node same way round as pc29)
219 sub pc29
220 {
221         my ($fromnode, $tonode, $stream, $text) = @_;
222         $text = ' ' unless defined $text && length $text > 0;
223         $text =~ s/\^/%5E/og;                   # remove ^
224         return "PC29^$fromnode^$tonode^$stream^$text^~";
225 }
226
227 # subject acknowledge (will have to and from node reversed to pc28)
228 sub pc30
229 {
230         my ($fromnode, $tonode, $stream) = @_;
231         return "PC30^$fromnode^$tonode^$stream^";
232 }
233
234 # acknowledge this tranche of lines (to and from nodes reversed to pc29 and pc28
235 sub pc31
236 {
237         my ($fromnode, $tonode, $stream) = @_;
238         return "PC31^$fromnode^$tonode^$stream^";
239 }
240
241 #  end of message from the sending end (pc28 node order)
242 sub pc32
243 {
244         my ($fromnode, $tonode, $stream) = @_;
245         return "PC32^$fromnode^$tonode^$stream^";
246 }
247
248 # acknowledge end of message from receiving end (opposite pc28 node order)
249 sub pc33
250 {
251         my ($fromnode, $tonode, $stream) = @_;
252         return "PC33^$fromnode^$tonode^$stream^";
253 }
254
255 # remote cmd send
256 sub pc34
257 {
258         my($fromnode, $tonode, $msg) = @_;
259         return "PC34^$tonode^$fromnode^$msg^~";
260 }
261
262 # remote cmd reply
263 sub pc35
264 {
265         my($fromnode, $tonode, $msg) = @_;
266         return "PC35^$tonode^$fromnode^$msg^~";
267 }
268
269 # send all the DX clusters I reckon are connected
270 sub pc38
271 {
272         return join '^', "PC38", map {$_->call} Route::Node::get_all();
273 }
274
275 # tell the local node to discconnect
276 sub pc39
277 {
278         my ($call, $reason) = @_;
279         my $hops = get_hops(39);
280         $reason = "Gone." if !$reason;
281         return "PC39^$call^$reason^$hops^";
282 }
283
284 # cue up bulletin or file for transfer
285 sub pc40
286 {
287         my ($to, $from, $fn, $bull) = @_;
288         $bull = $bull ? '1' : '0';
289         return "PC40^$to^$from^$fn^$bull^5^";
290 }
291
292 # user info
293 sub pc41
294 {
295         my $call = shift;
296         $call = shift if ref $call;
297
298         my $sort = shift || '0';
299         my $info = shift || ' ';
300         my $hops = shift || get_hops(41);
301         return "PC41^$call^$sort^$info^$hops^~";
302 }
303
304 # abort message
305 sub pc42
306 {
307         my ($fromnode, $tonode, $stream) = @_;
308         return "PC42^$fromnode^$tonode^$stream^";
309 }
310
311 # remote db request
312 sub pc44
313 {
314         my ($fromnode, $tonode, $stream, $db, $req, $call) = @_;
315         $db = uc $db;
316         return "PC44^$tonode^$fromnode^$stream^$db^$req^$call^";
317 }
318
319 # remote db data
320 sub pc45
321 {
322         my ($fromnode, $tonode, $stream, $data) = @_;
323         return "PC45^$tonode^$fromnode^$stream^$data^";
324 }
325
326 # remote db data complete
327 sub pc46
328 {
329         my ($fromnode, $tonode, $stream) = @_;
330         return "PC46^$tonode^$fromnode^$stream^";
331 }
332
333 # bull delete
334 sub pc49
335 {
336         my ($from, $subject) = @_;
337         my $hops = get_hops(49);
338         return "PC49^$from^$subject^$hops^~";
339 }
340
341 # periodic update of users, plus keep link alive device (always H99)
342 sub pc50
343 {
344         my $self = shift;
345         my $call = $self->call;
346         my $n = shift || '0';
347         my $hops = shift || 'H99';
348         return "PC50^$call^$n^$hops^";
349 }
350
351 # generate pings
352 sub pc51
353 {
354         my ($to, $from, $val) = @_;
355         return "PC51^$to^$from^$val^";
356 }
357
358 # clx remote cmd send
359 sub pc84
360 {
361         my($fromnode, $tonode, $call, $msg) = @_;
362         return "PC84^$tonode^$fromnode^$call^$msg^~";
363 }
364
365 # clx remote cmd reply
366 sub pc85
367 {
368         my($fromnode, $tonode, $call, $msg) = @_;
369         return "PC85^$tonode^$fromnode^$call^$msg^~";
370 }
371
372 # spider route broadcasts
373 #
374
375
376 sub _gen_pc92
377 {
378         my $sort = shift;
379         my $ext = shift;
380         my $s = "PC92^$main::mycall^" . gen_pc9x_t() . "^$sort";
381         for (@_) {
382                 $s .= "^" . _encode_pc92_call($_, $ext);
383                 $ext = 0;                               # only the first slot has an ext.
384         }
385         return $s . '^H99^';
386 }
387
388 sub gen_pc92_with_time
389 {
390         my $call = shift;
391         my $sort = shift;
392         my $t = shift;
393         my $ext = 1;
394         my $s = "PC92^$call^$t^$sort";
395         for (@_) {
396                 $s .= "^" . _encode_pc92_call($_, $ext);
397         }
398         return $s . '^H99^';
399 }
400
401 # add a local one
402 sub pc92a
403 {
404         return _gen_pc92('A', 0, @_);
405 }
406
407 # delete a local one
408 sub pc92d
409 {
410         return _gen_pc92('D', 0, @_);
411 }
412
413 # send a config
414 sub pc92c
415 {
416         return _gen_pc92('C', 1, @_);
417 }
418
419 # send a keep alive
420 sub pc92k
421 {
422         my $nref = shift;
423         my $s = "PC92^$main::mycall^" . gen_pc9x_t() . "^K";
424         $s .= "^" . _encode_pc92_call($nref, 1);
425         $s .= "^" . scalar $nref->nodes;
426         $s .= "^" . scalar $nref->users;
427         return $s . '^H99^';
428 }
429
430 # send a 'find' message
431 sub pc92f
432 {
433         my $target = shift;
434         my $from = shift;
435         return "PC92^$main::mycall^" . gen_pc9x_t() . "^F^$from^$target^H99^"
436 }
437
438 # send a 'reply' message
439 sub pc92r
440 {
441         my $to = shift;
442         my $target = shift;
443         my $flag = shift;
444         my $ms = shift;
445         return "PC92^$main::mycall^" . gen_pc9x_t() . "^R^$to^$target^$flag^$ms^H99^"
446 }
447
448 sub pc93
449 {
450         my $to = shift;                         # *, callsign, chat group name, sysop
451         my $from = shift;                       # from user callsign
452         my $via = shift || '*';                 # *, node call
453         my $line = shift;                       # the text
454         my $origin = shift;                     # this will be present on proxying from PC10
455
456         $line = unpad($line);
457         $line =~ s/\^/\\5E/g;           # remove any ^ characters
458         my $s = "PC93^$main::mycall^" . gen_pc9x_t() . "^$to^$from^$via^$line";
459         $s .= "^$origin" if $origin;
460         $s .= "^H99^";
461         return $s;
462 }
463
464 1;
465 __END__
466
467
468