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