]> gb7djk.dxcluster.net Git - spider.git/blob - perl/console.pl
make sure DXCron::spawn records output
[spider.git] / perl / console.pl
1 #!/usr/bin/env perl
2 #
3 # this is the operators console.
4 #
5 # Calling syntax is:-
6 #
7 # console.pl [callsign] 
8 #
9 # if the callsign isn't given then the sysop callsign in DXVars.pm is assumed
10 #
11 # Copyright (c) 1999 Dirk Koopman G1TLH
12 #
13 #
14
15
16 require 5.004;
17 use warnings;
18
19 # search local then perl directories
20 BEGIN {
21         # root of directory tree for this system
22         $root = "/spider"; 
23         $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'};
24         
25         unshift @INC, "$root/perl";     # this IS the right way round!
26         unshift @INC, "$root/local";
27         $is_win = ($^O =~ /^MS/ || $^O =~ /^OS-2/) ? 1 : 0; # is it Windows?
28 }
29
30 use Mojo::IOLoop;
31
32 use Msg;
33 use IntMsg;
34 use DXVars;
35 use DXDebug;
36 use DXUtil;
37 use DXDebug;
38 use IO::File;
39 use Time::HiRes qw(gettimeofday tv_interval);
40 use Curses 1.06;
41 use Text::Wrap;
42
43 use Console;
44
45 #
46 # initialisation
47 #
48
49 $call = "";                     # the callsign being used
50 $conn = 0;                      # the connection object for the cluster
51 $lasttime = time;               # lasttime something happened on the interface
52
53 $connsort = "local";
54 @khistory = ();
55 @shistory = ();
56 $khistpos = 0;
57 $spos = $pos = $lth = 0;
58 $inbuf = "";
59 @time = ();
60 $lastmin = 0;
61 $idle = 0;
62
63
64 #$SIG{WINCH} = sub {@time = gettimeofday};
65
66 sub mydbg
67 {
68         local *STDOUT = undef;
69         dbg(@_);
70 }
71
72 # do the screen initialisation
73 sub do_initscr
74 {
75         $scr = new Curses;
76         if ($has_colors) {
77                 start_color();
78                 init_pair("0", $foreground, $background);
79 #               init_pair(0, $background, $foreground);
80                 init_pair(1, COLOR_RED, $background);
81                 init_pair(2, COLOR_YELLOW, $background);
82                 init_pair(3, COLOR_GREEN, $background);
83                 init_pair(4, COLOR_CYAN, $background);
84                 init_pair(5, COLOR_BLUE, $background);
85                 init_pair(6, COLOR_MAGENTA, $background);
86                 init_pair(7, COLOR_RED, COLOR_BLUE);
87                 init_pair(8, COLOR_YELLOW, COLOR_BLUE);
88                 init_pair(9, COLOR_GREEN, COLOR_BLUE);
89                 init_pair(10, COLOR_CYAN, COLOR_BLUE);
90                 init_pair(11, COLOR_BLUE, COLOR_RED);
91                 init_pair(12, COLOR_MAGENTA, COLOR_BLUE);
92                 init_pair(13, COLOR_YELLOW, COLOR_GREEN);
93                 init_pair(14, COLOR_RED, COLOR_GREEN);
94                 eval { assume_default_colors($foreground, $background) } unless $is_win;
95         }
96
97         $top = $scr->subwin($lines-4, $cols, 0, 0);
98         $top->intrflush(0);
99         $top->scrollok(1);
100         $top->idlok(1);
101         $top->meta(1);
102 #       $scr->addstr($lines-4, 0, '-' x $cols);
103         $bot = $scr->subwin(3, $cols, $lines-3, 0);
104         $bot->intrflush(0);
105         $bot->scrollok(1);
106         $top->idlok(1);
107         $bot->keypad(1);
108         $bot->move(1,0);
109         $bot->meta(1);
110         $bot->nodelay(1);
111         $scr->refresh();
112         
113         $pagel = $lines-4;
114         $mycallcolor = COLOR_PAIR(1) unless $mycallcolor;
115 }
116
117 sub do_resize
118 {
119         endwin() if $scr;
120         initscr();
121         raw();
122         noecho();
123         nonl();
124         $lines = LINES;
125         $cols = COLS;
126         $has_colors = has_colors();
127         do_initscr();
128
129         show_screen();
130 }
131
132 # cease communications
133 sub cease
134 {
135         my $sendz = shift;
136         $conn->disconnect if $conn;
137         endwin();
138         dbgclose();
139         print @_ if @_;
140         exit(0);        
141 }
142
143 # terminate program from signal
144 sub sig_term
145 {
146         cease(1, @_);
147 }
148
149 # determine the colour of the line
150 sub setattr
151 {
152         if ($has_colors) {
153                 foreach my $ref (@colors) {
154                         if ($_[0] =~ m{$$ref[0]}) {
155                                 $top->attrset($$ref[1]);
156                                 last;
157                         }
158                 }
159         }
160 }
161
162 # measure the no of screen lines a line will take
163 sub measure
164 {
165         my $line = shift;
166         return 0 unless $line;
167
168         my $l = length $line;
169         my $lines = int ($l / $cols);
170         $lines++ if $l / $cols > $lines;
171         return $lines;
172 }
173
174 # display the top screen
175 sub show_screen
176 {
177         if ($spos == @shistory - 1) {
178
179                 # if we really are scrolling thru at the end of the history
180                 my $line = $shistory[$spos];
181                 $top->addstr("\n") if $spos > 0;
182                 setattr($line);
183                 $top->addstr($line);
184 #               $top->addstr("\n");
185                 $top->attrset(COLOR_PAIR(0)) if $has_colors;
186                 $spos = @shistory;
187                 
188         } else {
189                 
190                 # anywhere else
191                 my ($i, $l);
192                 my $p = $spos-1;
193                 for ($i = 0; $i < $pagel && $p >= 0; ) {
194                         $l = measure($shistory[$p]);
195                         $i += $l;
196                         $p-- if $i < $pagel;
197                 }
198                 $p = 0 if $p < 0;
199                 
200                 $top->move(0, 0);
201                 $top->attrset(COLOR_PAIR(0)) if $has_colors;
202                 $top->clrtobot();
203                 for ($i = 0; $i < $pagel && $p < @shistory; $p++) {
204                         my $line = $shistory[$p];
205                         my $lines = measure($line);
206                         last if $i + $lines > $pagel;
207                         $top->addstr("\n") if $i;
208                         setattr($line);
209                         $top->addstr($line);
210                         $top->attrset(COLOR_PAIR(0)) if $has_colors;
211                         $i += $lines;
212                 }
213                 $spos = $p;
214                 $spos = @shistory if $spos > @shistory;
215         }
216     my $shl = @shistory;
217         my $size = $lines . 'x' . $cols . '-'; 
218         my $add = "-$spos-$shl";
219     my $time = ztime(time);
220         my $str =  "-" . $time . '-' x ($cols - (length($size) + length($call) + length($add) + length($time) + 1));
221         $scr->addstr($lines-4, 0, $str);
222         
223         $scr->addstr($size);
224         $scr->attrset($mycallcolor) if $has_colors;
225         $scr->addstr($call);
226         $scr->attrset(COLOR_PAIR(0)) if $has_colors;
227     $scr->addstr($add);
228         $scr->refresh();
229 #       $top->refresh();
230 }
231
232 # add a line to the end of the top screen
233 sub addtotop
234 {
235         while (@_) {
236                 my $inbuf = shift;
237                 if ($inbuf =~ s/\x07+$//) {
238                         beep();
239                 }
240                 if (length $inbuf >= $cols) {
241                         $Text::Wrap::Columns = $cols;
242                         push @shistory, wrap('',"\t", $inbuf);
243                 } else {
244                         push @shistory, $inbuf;
245                 }
246                 shift @shistory while @shistory > $maxshist;
247         }
248         show_screen();
249 }
250
251 # handle incoming messages
252 sub rec_socket
253 {
254         my ($con, $msg, $err) = @_;
255         if (defined $err && $err) {
256                 cease(1);
257         }
258         if (defined $msg) {
259                 my ($sort, $call, $line) = $msg =~ /^(\w)([^\|]+)\|(.*)$/;
260                 
261                 $line =~ s/[\x00-\x06\x08\x0a-\x19\x1b-\x1f\x80-\x9f]/./g;         # immutable CSI sequence + control characters
262                 if ($sort && $sort eq 'D') {
263                         $line = " " unless length($line);
264                         addtotop($line);
265                 } elsif ($sort && $sort eq 'Z') { # end, disconnect, go, away .....
266                         cease(0);
267                 }         
268                 # ******************************************************
269                 # ******************************************************
270                 # any other sorts that might happen are silently ignored.
271                 # ******************************************************
272                 # ******************************************************
273         } else {
274                 cease(0);
275         }
276         $top->refresh();
277         $lasttime = time; 
278 }
279
280 sub rec_stdin
281 {
282         my $r = shift;;
283         
284         #  my $prbuf;
285         #  $prbuf = $buf;
286         #  $prbuf =~ s/\r/\\r/;
287         #  $prbuf =~ s/\n/\\n/;
288         #  print "sys: $r ($prbuf)\n";
289         if (defined $r) {
290
291                 $r = '0' if !$r;
292                 
293                 if ($r eq KEY_ENTER || $r eq "\n" || $r eq "\r") {
294                         
295                         # save the lines
296                         $inbuf = " " unless length $inbuf;
297
298                         # check for a pling and do a search back for a command
299                         if ($inbuf =~ /^!/o) {
300                                 my $i;
301                                 $inbuf =~ s/^!//o;
302                                 for ($i = $#khistory; $i >= 0; $i--) {
303                                         if ($khistory[$i] =~ /^$inbuf/) {
304                                                 $inbuf = $khistory[$i];
305                                                 last;
306                                         }
307                                 }
308                                 if ($i < 0) {
309                                         beep();
310                                         return;
311                                 }
312                         }
313                         push @khistory, $inbuf if length $inbuf;
314                         shift @khistory if @khistory > $maxkhist;
315                         $khistpos = @khistory;
316                         $bot->move(0,0);
317                         $bot->clrtoeol();
318                         $bot->addstr(substr($inbuf, 0, $cols));
319
320                         # add it to the monitor window
321                         unless ($spos == @shistory) {
322                                 $spos = @shistory;
323                                 show_screen();
324                         };
325                         addtotop($inbuf);
326                 
327                         # send it to the cluster
328                         $conn->send_later("I$call|$inbuf");
329                         $inbuf = "";
330                         $pos = $lth = 0;
331                 } elsif ($r eq KEY_UP || $r eq "\020") {
332                         if ($khistpos > 0) {
333                                 --$khistpos;
334                                 $inbuf = $khistory[$khistpos];
335                                 $pos = $lth = length $inbuf;
336                         } else {
337                                 beep();
338                         }
339                 } elsif ($r eq KEY_DOWN || $r eq "\016") {
340                         if ($khistpos < @khistory - 1) {
341                                 ++$khistpos;
342                                 $inbuf = $khistory[$khistpos];
343                                 $pos = $lth = length $inbuf;
344                         } else {
345                                 beep();
346                         }
347                 } elsif ($r eq KEY_PPAGE || $r eq "\032") {
348                         if ($spos > 0) {
349                                 my ($i, $l);
350                                 for ($i = 0; $i < $pagel-1 && $spos >= 0; ) {
351                                         $l = measure($shistory[$spos]);
352                                         $i += $l;
353                                         $spos-- if $i <= $pagel;
354                                 }
355                                 $spos = 0 if $spos < 0;
356                                 show_screen();
357                         } else {
358                                 beep();
359                         }
360                 } elsif ($r eq KEY_NPAGE || $r eq "\026") {
361                         if ($spos < @shistory - 1) {
362                                 my ($i, $l);
363                                 for ($i = 0; $i <= $pagel && $spos <= @shistory; ) {
364                                         $l = measure($shistory[$spos]);
365                                         $i += $l;
366                                         $spos++ if $i <= $pagel;
367                                 }
368                                 $spos = @shistory if $spos >= @shistory - 1;
369                                 show_screen();
370                         } else {
371                                 beep();
372                         }
373                 } elsif ($r eq KEY_LEFT || $r eq "\002") {
374                         if ($pos > 0) {
375                                 --$pos;
376                         } else {
377                                 beep();
378                         }
379                 } elsif ($r eq KEY_RIGHT || $r eq "\006") {
380                         if ($pos < $lth) {
381                                 ++$pos;
382                         } else {
383                                 beep();
384                         }
385                 } elsif ($r eq KEY_HOME || $r eq "\001") {
386                         $pos = 0;
387                 } elsif ($r eq KEY_END || $r eq "\005") {
388                         $pos = $lth;
389                 } elsif ($r eq KEY_BACKSPACE || $r eq "\010" || $r eq "\x7f") {
390                         if ($pos > 0) {
391                                 my $a = substr($inbuf, 0, $pos-1);
392                                 my $b = substr($inbuf, $pos) if $pos < $lth;
393                                 $b = "" unless $b;
394                                 
395                                 $inbuf = $a . $b;
396                                 --$lth;
397                                 --$pos;
398                         } else {
399                                 beep();
400                         }
401                 } elsif ($r eq KEY_DC || $r eq "\004") {
402                         if ($pos < $lth) {
403                                 my $a = substr($inbuf, 0, $pos);
404                                 my $b = substr($inbuf, $pos+1) if $pos < $lth;
405                                 $b = "" unless $b;
406                                 
407                                 $inbuf = $a . $b;
408                                 --$lth;
409                         } else {
410                                 beep();
411                         }
412                 } elsif ($r eq KEY_RESIZE || $r eq "\0632") {
413                         do_resize();
414                         return;
415                 } elsif (defined $r && is_pctext($r)) {
416                         # move the top screen back to the bottom if you type something
417                         if ($spos < @shistory) {
418                                 $spos = @shistory;
419                                 show_screen();
420                         }
421
422                 #       $r = ($r lt ' ' || $r gt "\x7e") ? sprintf("'%x", ord $r) : $r;
423                         
424                         # insert the character into the keyboard buffer
425                         if ($pos < $lth) {
426                                 my $a = substr($inbuf, 0, $pos);
427                                 my $b = substr($inbuf, $pos);
428                                 $inbuf = $a . $r . $b;
429                         } else {
430                                 $inbuf .= $r;
431                         }
432                         $pos++;
433                         $lth++;
434                 } elsif ($r eq "\014" || $r eq "\022") {
435                         touchwin(curscr, 1);
436                         refresh(curscr);
437                         return;
438                 } elsif ($r eq "\013") {
439                         $inbuf = substr($inbuf, 0, $pos);
440                         $lth = length $inbuf;
441                 } else {
442                         beep();
443                 }
444                 $bot->move(1, 0);
445                 $bot->clrtobot();
446                 $bot->addstr($inbuf);
447         } 
448         $bot->move(1, $pos);
449         $bot->refresh();
450 }
451
452 sub idle_loop
453 {
454         my $t;
455         
456         $t = time;
457         if ($t > $lasttime) {
458                 my ($min)= (gmtime($t))[1];
459                 if ($min != $lastmin) {
460                         show_screen();
461                         $lastmin = $min;
462                 }
463                 $lasttime = $t;
464         }
465         my $ch = $bot->getch();
466         if (@time && tv_interval(\@time, [gettimeofday]) >= 1) {
467                 next;
468         }
469         if (defined $ch) {
470                 if ($ch ne '-1') {
471                         rec_stdin($ch);
472                 }
473         }
474         $top->refresh() if $top->is_wintouched;
475         $bot->refresh();
476 }
477
478 sub on_connect
479 {
480         my $conn = shift;
481         $conn->send_later("A$call|$connsort width=$cols");
482         $conn->send_later("I$call|set/page $maxshist");
483         #$conn->send_later("I$call|set/nobeep");
484 }
485
486 sub on_disconnect
487 {
488         $conn = shift;
489         Mojo::IOLoop->remove($idle);
490         Mojo::IOLoop->stop;
491 }
492
493 #
494 # deal with args
495 #
496
497 $call = uc shift @ARGV if @ARGV;
498 $call = uc $myalias if !$call;
499 my ($scall, $ssid) = split /-/, $call;
500 $ssid = undef unless $ssid && $ssid =~ /^\d+$/;  
501 if ($ssid) {
502         $ssid = 15 if $ssid > 15;
503         $call = "$scall-$ssid";
504 }
505
506 if ($call eq $mycall) {
507         print "You cannot connect as your cluster callsign ($mycall)\n";
508         exit(0);
509 }
510
511 dbginit();
512
513 unless ($DB::VERSION) {
514         $SIG{'INT'} = \&sig_term;
515         $SIG{'TERM'} = \&sig_term;
516 }
517
518 $SIG{'HUP'} = \&sig_term;
519
520 # start up
521 do_resize();
522
523 $SIG{__DIE__} = \&sig_term;
524
525 $Text::Wrap::Columns = $cols;
526
527 my $lastmin = 0;
528
529
530 $conn = IntMsg->connect($clusteraddr, $clusterport, rproc => \&rec_socket);
531 $conn->{on_connect} = \&on_connect;
532 $conn->{on_disconnect} = \&on_disconnect;
533
534 $idle = Mojo::IOLoop->recurring(0.100 => \&idle_loop);
535 Mojo::IOLoop->start;
536
537
538 cease(0);