From f4bc6091a243be2891148902d41e921e171e1a44 Mon Sep 17 00:00:00 2001 From: djk Date: Thu, 11 May 2000 16:00:30 +0000 Subject: [PATCH] made the communications between clients and server completely ascii (no length word at the fron anymore). added watchdbg (a cross between tail -f and grep) --- Changes | 5 ++++ perl/Msg.pm | 6 +++-- perl/cluster.pl | 10 +++++++- perl/watchdbg | 66 +++++++++++++++++++++++++++++++++++++++++++++++++ src/client.c | 21 +++++++++------- 5 files changed, 96 insertions(+), 12 deletions(-) create mode 100755 perl/watchdbg diff --git a/Changes b/Changes index acc45f67..979873b7 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,8 @@ +11May00======================================================================= +1. fixed looping in Msg.pm (at last) +10May00======================================================================= +1. wrote a cross between 'tail -f' and grepdbg so that you can watch the +debug files for particular strings and only have them print out. 05May00======================================================================= 1. rewrote parts of Msg.pm and client.c so that the messages no longer use a length word at the front of each one. They are simply strings of characters diff --git a/perl/Msg.pm b/perl/Msg.pm index d067f27e..b626e27c 100644 --- a/perl/Msg.pm +++ b/perl/Msg.pm @@ -128,6 +128,7 @@ sub _send { } else { # Uh, oh delete $conn->{send_offset}; $conn->handle_send_err($!); + $conn->disconnect; return 0; # fail. Message remains in queue .. } } @@ -231,9 +232,10 @@ sub _rcv { # Complement to _send } FINISH: - if (defined $bytes_read == 0) { - $conn->disconnect(); + if (defined $bytes_read && $bytes_read == 0) { +# $conn->disconnect(); &{$conn->{rcvd_notification_proc}}($conn, undef, $!); + @lines = (); } while (@lines){ diff --git a/perl/cluster.pl b/perl/cluster.pl index 3ea1d6a5..54295e4b 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -103,9 +103,11 @@ sub rec my ($conn, $msg, $err) = @_; my $dxchan = DXChannel->get_by_cnum($conn); # get the dxconnnect object for this message - if (defined $err && $err) { + if (!defined $msg || (defined $err && $err)) { if ($dxchan) { $dxchan->disconnect; + } elsif ($conn) { + $conn->disconnect; } return; } @@ -369,11 +371,17 @@ dbg('local', "Local::init error $@") if $@; # this, such as it is, is the main loop! print "orft we jolly well go ...\n"; dbg('chan', "DXSpider version $version started..."); + +open(DB::OUT, "|tee /tmp/aa"); + for (;;) { my $timenow; + $DB::trace = 1; + Msg->event_loop(1, 0.1); $timenow = time; process_inqueue(); # read in lines from the input queue and despatch them + $DB::trace = 0; # do timed stuff, ongoing processing happens one a second if ($timenow != $systime) { diff --git a/perl/watchdbg b/perl/watchdbg new file mode 100755 index 00000000..745d6983 --- /dev/null +++ b/perl/watchdbg @@ -0,0 +1,66 @@ +#!/usr/bin/perl +# +# watch the end of the current debug file (like tail -f) applying +# any regexes supplied on the command line. +# +# examples:- +# +# watchdbg g1tlh # watch everything g1tlh does +# watchdbg gb7baa gb7djk # watch the conversation between BAA and DJK +# + +require 5.004; + +# search local then perl directories +BEGIN { + # root of directory tree for this system + $root = "/spider"; + $root = $ENV{'DXSPIDER_ROOT'} if $ENV{'DXSPIDER_ROOT'}; + + unshift @INC, "$root/perl"; # this IS the right way round! + unshift @INC, "$root/local"; +} + +use IO::File; +use DXVars; +use DXUtil; +use DXLog; + +use strict; + +my $fp = DXLog::new('debug', 'dat', 'd'); +my @today = Julian::unixtoj(time()); +my $fh = $fp->open(@today) or die $!; +my $exp = join '|', @ARGV; + +# seek to end of file +$fh->seek(0, 2); +for (;;) { + my $line = <$fh>; + if ($line) { + if ($exp) { + printit($line) if $line =~ m{(?:$exp)}oi; + } else { + printit($line); + } + } else { + sleep(1); + + # check that the debug hasn't rolled over to next day + # open it if it has + my @now = Julian::unixtoj(time()); + if ($today[1] != $now[1]) { + $fp->close; + $fh = $fp->open(@now) or die $!; + } + } +} + +sub printit +{ + my $line = shift; + my @line = split '\^', $line; + my $t = shift @line; + print atime($t), ' ', join('^', @line); +} +exit(0); diff --git a/src/client.c b/src/client.c index 22e06f69..1f899c58 100644 --- a/src/client.c +++ b/src/client.c @@ -264,7 +264,7 @@ void send_msg(fcb_t *f, char let, unsigned char *s, int l) } else *mp->inp++ = *p; } - } + } *mp->inp++ = '\n'; *mp->inp = 0; cmsg_send(f->outq, mp, 0); @@ -295,14 +295,14 @@ int fcb_handler(sel_t *sp, int in, int out, int err) case EAGAIN: goto lout; default: - if (f->sort == MSG) - send_Z = 0; +/* if (f->sort == MSG) + send_Z = 0; */ ending++; return 0; } } else if (r == 0) { - if (f->sort == MSG) - send_Z = 0; +/* if (f->sort == MSG) + send_Z = 0; */ ending++; return 0; } @@ -473,8 +473,8 @@ lout:; case EAGAIN: goto lend; default: - if (f->sort == MSG) - send_Z = 0; +/* if (f->sort == MSG) + send_Z = 0; */ ending++; return; } @@ -597,6 +597,7 @@ void term_timeout(int i) if (in && in->t_set) tcsetattr(0, TCSANOW, &in->t); if (node) { + shutdown(node->cnum, 3); close(node->cnum); } exit(i); @@ -605,7 +606,7 @@ void term_timeout(int i) void terminate(int i) { if (node && send_Z && call) { - send_msg(node, 'Z', "", 0); + send_msg(node, 'Z', "bye", 3); } signal(SIGALRM, term_timeout); @@ -617,8 +618,10 @@ void terminate(int i) } if (in && in->t_set) tcsetattr(0, TCSADRAIN, &in->t); - if (node) + if (node) { + shutdown(node->cnum, 3); close(node->cnum); + } exit(i); } -- 2.34.1