From 678715c76fa49f08acb30df0760b34407f49675c Mon Sep 17 00:00:00 2001 From: djk Date: Mon, 18 Jan 1999 17:18:46 +0000 Subject: [PATCH] 1. added present(),presentish() and disconnect() to DXCron so that you can see (easily) if a station is on the cluster anywhere and also disconnect them locally. 2. added rcmd() to DXCron so you can send an rcmd to someone else from crontab. 3. Fixed create_sysop.pl so that longitude is spelt correctly there as well made the update work properly. NOTE create_sysop will only do what you expect if all cluster.pl and client.pl programs are stopped. 4. DXCron wasn't reading in reliably on startup, this is now (hopefully) fixed. the -M semantics are rather strange! 5. The -w switch is now standard on cluster.pl 6. Added last_connect() which gives the last connect time of a user (or now if connected). 7. Added present_on(call, node) and presentish_on(ditto) which returns true if the call is connected to the node. --- Changes | 16 +++++++++ perl/DXCron.pm | 77 ++++++++++++++++++++++++++++++++++++++++++-- perl/client.pl | 11 ++++--- perl/cluster.pl | 2 +- perl/create_sysop.pl | 12 ++++--- 5 files changed, 106 insertions(+), 12 deletions(-) diff --git a/Changes b/Changes index cb3bb254..7255322d 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,19 @@ +18Jan99======================================================================== +1. added present(),presentish() and disconnect() to DXCron so that you can see +(easily) if a station is on the cluster anywhere and also disconnect them +locally. +2. added rcmd() to DXCron so you can send an rcmd to someone else from crontab. +3. Fixed create_sysop.pl so that longitude is spelt correctly +there as well made the update work properly. NOTE create_sysop +will only do what you expect if all cluster.pl and client.pl programs are +stopped. +4. DXCron wasn't reading in reliably on startup, this is now (hopefully) fixed. +the -M semantics are rather strange! +5. The -w switch is now standard on cluster.pl +6. Added last_connect() which gives the last connect time of a user (or now +if connected). +7. Added present_on(call, node) and presentish_on(ditto) which returns true if +the call is connected to the node. 17Jan99======================================================================== 1. fixed some permission problems on DXLog. 2. There is a circumstance in DXMsg which caused the cluster to stop on an diff --git a/perl/DXCron.pm b/perl/DXCron.pm index 3c9c04fb..507a6a12 100644 --- a/perl/DXCron.pm +++ b/perl/DXCron.pm @@ -20,7 +20,7 @@ use strict; use vars qw{@crontab $mtime $lasttime $lastmin}; @crontab = (); -$mtime = 1; +$mtime = 0; $lasttime = 0; $lastmin = 0; @@ -41,7 +41,7 @@ sub init $t = -M $fn; cread($fn); - $mtime = $t if $t <= $mtime; + $mtime = $t if !$mtime || $t <= $mtime; } # then read in any local ones @@ -165,12 +165,70 @@ sub process # these are simple stub functions to make connecting easy in DXCron contexts # +# is it locally connected? sub connected { my $call = uc shift; return DXChannel->get($call); } +# is it remotely connected anywhere (with exact callsign)? +sub present +{ + my $call = uc shift; + return DXCluster->get_exact($call); +} + +# is it remotely connected anywhere (ignoring SSIDS)? +sub presentish +{ + my $call = uc shift; + return DXCluster->get($call); +} + +# is it remotely connected anywhere (with exact callsign) and on node? +sub present_on +{ + my $call = uc shift; + my $node = uc shift; + my $ref = DXCluster->get_exact($call); + return ($ref && $ref->mynode) ? $ref->mynode->call eq $node : undef; +} + +# is it remotely connected anywhere (ignoring SSIDS) and on node? +sub presentish_on +{ + my $call = uc shift; + my $node = uc shift; + my $ref = DXCluster->get($call); + return ($ref && $ref->mynode) ? $ref->mynode->call eq $node : undef; +} + +# last time this thing was connected +sub last_connect +{ + my $call = uc shift; + return $main::systime if DXChannel->get($call); + my $user = DXUser->get($call); + return $user ? $user->lastin : 0; +} + +# disconnect a locally connected thing +sub disconnect +{ + my $call = uc shift; + my $dxchan = DXChannel->get($call); + if ($dxchan) { + if ($dxchan->is_ak1a) { + $dxchan->send_now("D", DXProt::pc39($main::mycall, "$main::mycall DXCron")); + } else { + $dxchan->send_now('D', ""); + } + $dxchan->disconnect; + } +} + +# start a connect process off sub start_connect { my $call = uc shift; @@ -201,6 +259,7 @@ sub start_connect sleep(1); } +# spawn any old job off sub spawn { my $line = shift; @@ -226,5 +285,19 @@ sub spawn # coordinate sleep(1); } + +# do an rcmd to another cluster from the crontab +sub rcmd +{ + my $call = uc shift; + my $line = shift; + + # can we see it? Is it a node? + my $noderef = DXCluster->get_exact($call); + return if !$noderef || !$noderef->pcversion; + + # send it + DXProt::addrcmd($main::mycall, $call, $line); +} 1; __END__ diff --git a/perl/client.pl b/perl/client.pl index c39bda4c..6358d022 100755 --- a/perl/client.pl +++ b/perl/client.pl @@ -110,7 +110,7 @@ sub rec_socket $line =~ s/\n/\r/og if $mode == 1; #my $p = qq($line$snl); if ($buffered) { - if (length $outqueue >= 128) { + if (length $outqueue >= $client_buffer_lth) { print $stdout $outqueue; $outqueue = ""; } @@ -296,12 +296,12 @@ sub timeout $mode = 2; # 1 - \n = \r as EOL, 2 - \n = \n, 0 - transparent $call = ""; # the callsign being used -@stdoutq = (); # the queue of stuff to send out to the user $conn = 0; # the connection object for the cluster $lastbit = ""; # the last bit of an incomplete input line $mynl = "\n"; # standard terminator $lasttime = time; # lasttime something happened on the interface -$outqueue = ""; # the output queue length +$outqueue = ""; # the output queue +$client_buffer_lth = 200; # how many characters are buffered up on outqueue $buffered = 1; # buffer output $savenl = ""; # an NL that has been saved from last time $timeout = 60; # default timeout for connects @@ -317,6 +317,7 @@ $stdout = *STDOUT; $rfh = 0; $wfh = 0; +$waitedpid = 0; # # deal with args @@ -359,7 +360,7 @@ if ($loginreq) { close(I); $issue = s/\n/\r/og if $mode == 1; local $/ = $nl; - $stdout->print($issue) if issue; + $stdout->print($issue) if $issue; } @@ -442,7 +443,7 @@ if ($connsort eq "connect") { # close W; $stdin = $rfh; $stdout = $wfh; - $csort = 'telnet' if $sort eq 'prog'; + $csort = 'telnet' if $csort eq 'prog'; } elsif ($csort eq 'telnet') { # open(STDIN, "<&$sock"); # open(STDOUT, ">&$sock"); diff --git a/perl/cluster.pl b/perl/cluster.pl index 5341a919..8502cbab 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!/usr/bin/perl -w # # This is the DX cluster 'daemon'. It sits in the middle of its little # web of client routines sucking and blowing data where it may. diff --git a/perl/create_sysop.pl b/perl/create_sysop.pl index fbeca272..840ddef4 100755 --- a/perl/create_sysop.pl +++ b/perl/create_sysop.pl @@ -37,7 +37,7 @@ sub create_it $self->{qth} = $myqth; $self->{qra} = $mylocator; $self->{lat} = $mylatitude; - $self->{long} = $mylongtitude; + $self->{long} = $mylongitude; $self->{email} = $myemail; $self->{bbsaddr} = $mybbsaddr; $self->{homenode} = $mycall; @@ -59,7 +59,7 @@ sub create_it $self->{qth} = $myqth; $self->{qra} = $mylocator; $self->{lat} = $mylatitude; - $self->{long} = $mylongtitude; + $self->{long} = $mylongitude; $self->{email} = $myemail; $self->{bbsaddr} = $mybbsaddr; $self->{homenode} = $mycall; @@ -75,20 +75,24 @@ sub create_it } -DXUser->init($userfn); if (-e "$userfn") { print "Do you wish to destroy your user database (THINK!!!) [y/N]: "; $ans = ; if ($ans =~ /^[Yy]/) { delete_it(); + DXUser->init($userfn); create_it(); } else { print "Do you wish to reset your cluster and sysop information? [y/N]: "; $ans = ; - create_it() if $ans =~ /^[Yy]/; + if ($ans =~ /^[Yy]/) { + DXUser->init($userfn); + create_it(); + } } } else { + DXUser->init($userfn); create_it(); } DXUser->finish(); -- 2.34.1