From ee822fc8bbe6985f708cca37ce3953b83651e542 Mon Sep 17 00:00:00 2001 From: minima Date: Mon, 9 Jan 2006 20:46:47 +0000 Subject: [PATCH] fix a few Log/Dbg thingies. remove all references to QXProt.pm --- perl/DXCommandmode.pm | 20 ++-- perl/DXUser.pm | 9 +- perl/QXProt.pm | 246 ------------------------------------------ perl/QXProt/QXI.pm | 63 ----------- perl/QXProt/QXP.pm | 54 ---------- perl/QXProt/QXR.pm | 78 -------------- perl/cluster.pl | 11 +- 7 files changed, 15 insertions(+), 466 deletions(-) delete mode 100644 perl/QXProt.pm delete mode 100644 perl/QXProt/QXI.pm delete mode 100644 perl/QXProt/QXP.pm delete mode 100644 perl/QXProt/QXR.pm diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 89efeb4b..404a7391 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -93,7 +93,7 @@ sub start my $host = $self->{conn}->{peerhost}; $host ||= "AGW Port #$self->{conn}->{agwport}" if exists $self->{conn}->{agwport}; $host ||= "unknown"; - Log('DXCommand', "$call connected from $host"); + LogDbg('DXCommand', "$call connected from $host"); $self->{name} = $name ? $name : $call; $self->send($self->msg('l2',$self->{name})); @@ -562,7 +562,7 @@ sub disconnect # send info to all logged in thingies $self->tell_login('logoutu'); - Log('DXCommand', "$call disconnected"); + LogDbg('DXCommand', "$call disconnected"); $self->SUPER::disconnect; } @@ -1026,8 +1026,7 @@ sub import_cmd # are there any to do in this directory? return unless -d $cmdimportdir; unless (opendir(DIR, $cmdimportdir)) { - dbg("can\'t open $cmdimportdir $!"); - Log('err', "can\'t open $cmdimportdir $!"); + LogDbg('err', "can\'t open $cmdimportdir $!"); return; } @@ -1039,9 +1038,7 @@ sub import_cmd my $s = Script->new($name, $cmdimportdir); if ($s) { - - dbg("Run import cmd file $name"); - Log('DXCommand', "Run import cmd file $name"); + LogDbg('DXCommand', "Run import cmd file $name"); my @cat = split /[^A-Za-z0-9]+/, $name; my ($call) = grep {is_callsign(uc $_)} @cat; $call ||= $main::mycall; @@ -1072,19 +1069,16 @@ sub import_cmd $dxchan->{priv} = $priv; $dxchan->{user} = $user; } else { - Log('err', "Trying to run import cmd for non-existant user $call"); - dbg( "Trying to run import cmd for non-existant user $call"); + LogDbg('err', "Trying to run import cmd for non-existant user $call"); } } } $s->erase; for (@out) { - Log('DXCommand', "Import cmd $name/$call: $_"); - dbg("Import cmd $name/$call: $_"); + LogDbg('DXCommand', "Import cmd $name/$call: $_"); } } else { - Log("Failed to open $cmdimportdir/$name $!"); - dbg("Failed to open $cmdimportdir/$name $!"); + LogDbg('err', "Failed to open $cmdimportdir/$name $!"); unlink "$cmdimportdir/$name"; } } diff --git a/perl/DXUser.pm b/perl/DXUser.pm index adddce0a..6e2c014e 100644 --- a/perl/DXUser.pm +++ b/perl/DXUser.pm @@ -344,8 +344,7 @@ sub asc_decode my $ref; eval '$ref = ' . $s; if ($@) { - dbg($@); - Log('err', $@); + LogDbg('err', $@); $ref = undef; } return $ref; @@ -492,7 +491,7 @@ print "There are $count user records and $err errors\n"; my $ekey = $key; $eval =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; $ekey =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg; - Log('DXCommand', "Export Error1: $ekey\t$eval"); + LogDbg('DXCommand', "Export Error1: $ekey\t$eval"); eval {$dbm->del($key)}; dbg(carp("Export Error1: $ekey\t$eval\n$@")) if $@; ++$err; @@ -505,7 +504,7 @@ print "There are $count user records and $err errors\n"; unless ($ref->{lat} && $ref->{long} || $ref->{qth} || $ref->{qra}) { eval {$dbm->del($key)}; dbg(carp("Export Error2: $key\t$val\n$@")) if $@; - Log('DXCommand', "$ref->{call} deleted, too old"); + LogDbg('DXCommand', "$ref->{call} deleted, too old"); $del++; next; } @@ -514,7 +513,7 @@ print "There are $count user records and $err errors\n"; print $fh "$key\t" . $ref->asc_encode . "\n"; ++$count; } else { - Log('DXCommand', "Export Error3: $key\t$val"); + LogDbg('DXCommand', "Export Error3: $key\t$val"); eval {$dbm->del($key)}; dbg(carp("Export Error3: $key\t$val\n$@")) if $@; ++$err; diff --git a/perl/QXProt.pm b/perl/QXProt.pm deleted file mode 100644 index b9cf952c..00000000 --- a/perl/QXProt.pm +++ /dev/null @@ -1,246 +0,0 @@ -# -# This module impliments the new protocal mode for a dx cluster -# -# Copyright (c) 2001 Dirk Koopman G1TLH -# -# $Id$ -# - -package QXProt; - -@ISA = qw(DXChannel DXProt); - -use DXUtil; -use DXChannel; -use DXUser; -use DXM; -use DXLog; -use Spot; -use DXDebug; -use Filter; -use DXDb; -use AnnTalk; -use Geomag; -use WCY; -use Time::HiRes qw(gettimeofday tv_interval); -use BadWords; -use DXHash; -use Route; -use Route::Node; -use Script; -use DXProt; -use Verify; - -use strict; - -use vars qw($VERSION $BRANCH); -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); -$main::build += $VERSION; -$main::branch += $BRANCH; - -sub init -{ - my $user = DXUser->get($main::mycall); - $DXProt::myprot_version += $main::version*100; - $main::me = QXProt->new($main::mycall, 0, $user); - $main::me->{here} = 1; - $main::me->{state} = "indifferent"; - $main::me->{sort} = 'S'; # S for spider - $main::me->{priv} = 9; - $main::me->{metric} = 0; - $main::me->{pingave} = 0; - $main::me->{registered} = 1; - $main::me->{version} = $main::version; - $main::me->{build} = $main::build; - -# $Route::Node::me->adddxchan($main::me); -} - -sub start -{ - my $self = shift; - $self->SUPER::start(@_); -} - -sub sendinit -{ - my $self = shift; - - $self->send($self->genI); -} - -sub normal -{ - if ($_[1] =~ /^PC\d\d\^/) { - DXProt::normal(@_); - return; - } - my ($sort, $tonode, $fromnode, $msgid, $incs); - return unless ($sort, $tonode, $fromnode, $msgid, $incs) = $_[1] =~ /^QX([A-Z])\^(\*|[-A-Z0-9]+)\^([-A-Z0-9]+)\^([0-9A-F]{1,4})\^.*\^([0-9A-F]{2})$/; - - $msgid = hex $msgid; - my $noderef = Route::Node::get($fromnode); - $noderef = Route::Node::new($fromnode) unless $noderef; - - my $il = length $incs; - my $cs = sprintf("%02X", unpack("%32C*", substr($_[1], 0, length($_[1]) - ($il+1))) & 255); - if ($incs ne $cs) { - dbg("QXPROT: Checksum fail in: $incs ne calc: $cs" ) if isdbg('chanerr'); - return; - } - - return unless $noderef->newid($msgid); - - $_[0]->handle($sort, $tonode, $fromnode, $msgid, $_[1]); - return; -} - -sub handle -{ - no strict 'subs'; - my $self = shift; - my $sort = shift; - my $sub = "handle$sort"; - $self->$sub(@_) if $self->can($sub); - return; -} - -sub gen -{ - no strict 'subs'; - my $self = shift; - my $sort = shift; - my $sub = "gen$sort"; - $self->$sub(@_) if $self->can($sub); - return; -} - -my $last_node_update = 0; -my $node_update_interval = 60*15; - -sub process -{ - if ($main::systime >= $last_node_update+$node_update_interval) { -# sendallnodes(); -# sendallusers(); - $last_node_update = $main::systime; - } -} - -sub disconnect -{ - my $self = shift; - $self->DXProt::disconnect(@_); -} - -my $msgid = 1; - -sub frame -{ - my $sort = shift; - my $to = shift || "*"; - my $ht; - - $ht = sprintf "%X", $msgid; - my $line = join '^', "QX$sort", $to, $main::mycall, $ht, @_; - my $cs = sprintf "%02X", unpack("%32C*", $line) & 255; - $msgid = 1 if ++$msgid > 0xffff; - return "$line^$cs"; -} - -sub handleI -{ - my $self = shift; - - my @f = split /\^/, $_[3]; - if ($self->passphrase && $f[7] && $f[8]) { - my $inv = Verify->new($f[7]); - unless ($inv->verify($f[8], $main::me->user->passphrase, $main::mycall, $self->call)) { - $self->sendnow('D','Sorry...'); - $self->disconnect; - } - $self->{verified} = 1; - } else { - $self->{verified} = 0; - } - if ($self->{outbound}) { - $self->send($self->genI); - } - if ($self->{sort} ne 'S' && $f[4] eq 'DXSpider') { - $self->{user}->{sort} = $self->{sort} = 'S'; - $self->{user}->{priv} = $self->{priv} = 1 unless $self->{priv}; - } - $self->{version} = $f[5]; - $self->{build} = $f[6]; - $self->state('init1'); - $self->{lastping} = 0; -} - -sub genI -{ - my $self = shift; - my @out = ('I', $self->call, "DXSpider", ($main::version + 53) * 100, $main::build); - if (my $pass = $self->user->passphrase) { - my $inp = Verify->new; - push @out, $inp->challenge, $inp->response($pass, $self->call, $main::mycall); - } - return frame(@out); -} - -sub handleR -{ - -} - -sub genR -{ - -} - -sub handleP -{ - -} - -sub genP -{ - -} - -sub gen2 -{ - my $self = shift; - - my $node = shift; - my $sort = shift; - my @out; - my $dxchan; - - while (@_) { - my $str = ''; - for (; @_ && length $str <= 230;) { - my $ref = shift; - my $call = $ref->call; - my $flag = 0; - - $flag += 1 if $ref->here; - $flag += 2 if $ref->conf; - if ($ref->is_node) { - my $ping = int($ref->pingave * 10); - $str .= "^N$flag$call,$ping"; - my $v = $ref->build || $ref->version; - $str .= ",$v" if defined $v; - } else { - $str .= "^U$flag$call"; - } - } - push @out, $str if $str; - } - my $n = @out; - my $h = get_hops(90); - @out = map { sprintf "PC90^%s^%X^%s%d%s^%s^", $node->call, $main::systime, $sort, --$n, $_, $h } @out; - return @out; -} - -1; diff --git a/perl/QXProt/QXI.pm b/perl/QXProt/QXI.pm deleted file mode 100644 index aacfae68..00000000 --- a/perl/QXProt/QXI.pm +++ /dev/null @@ -1,63 +0,0 @@ -# -# This module is part of the new protocal mode for a dx cluster -# -# This module handles the initialisation between two nodes -# -# Copyright (c) 2003 Dirk Koopman G1TLH -# -# $Id$ -# - -package QXI; - -use strict; - -use vars qw(@ISA $VERSION $BRANCH); -@ISA = qw(QXProt); - -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); -$main::build += $VERSION; -$main::branch += $BRANCH; - - -sub handle -{ - my ($self, $to, $from, $msgid, $line) = @_; - - my @f = split /\^/, $line; - if ($self->user->passphrase && @f > 3) { - my $inv = Verify->new($f[3]); - unless ($inv->verify($f[4], $main::me->user->passphrase, $main::mycall, $self->call)) { - $self->sendnow('D','Sorry...'); - $self->disconnect; - } - $self->{verified} = 1; - } else { - $self->{verified} = 0; - } - if ($self->{outbound}) { - $self->send($self->QXI::gen); - } - if ($self->{sort} ne 'S' && $f[0] eq 'DXSpider') { - $self->{user}->{sort} = $self->{sort} = 'S'; - $self->{user}->{priv} = $self->{priv} = 1 unless $self->{priv}; - } - $self->{version} = $f[1]; - $self->{build} = $f[2]; - $self->state('init1'); - $self->{lastping} = 0; -} - -sub gen -{ - my $self = shift; - my @out = ('I', $self->call, "DXSpider", ($main::version + 53) * 100, $main::build); - if (my $pass = $self->user->passphrase) { - my $inp = Verify->new; - push @out, $inp->challenge, $inp->response($pass, $self->call, $main::mycall); - } - return $self->frame(@out); -} - -1; diff --git a/perl/QXProt/QXP.pm b/perl/QXProt/QXP.pm deleted file mode 100644 index ec9f96dc..00000000 --- a/perl/QXProt/QXP.pm +++ /dev/null @@ -1,54 +0,0 @@ -# -# This module is part of the new protocal mode for a dx cluster -# -# This module handles ping requests -# -# Copyright (c) 2003 Dirk Koopman G1TLH -# -# $Id$ -# - -package QXP; - -use strict; - -use vars qw(@ISA $VERSION $BRANCH); -@ISA = qw(QXProt); - -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); -$main::build += $VERSION; -$main::branch += $BRANCH; - -sub handle -{ - my ($self, $to, $from, $msgid, $line) = @_; - - my @f = split /\^/, $line; - - # is it for us? - if ($to eq $main::mycall) { - if ($f[0] == 1) { - $self->send(gen($self, $from, '0', $f[1], $f[2], $f[3])); - } else { - # it's a reply, look in the ping list for this one - $self->handlepingreply($from); - } - } else { - - # route down an appropriate thingy - $self->route($to, $line); - } -} - -sub gen -{ - my ($self, $to, $flag, $user, $secs, $usecs) = @_; - my @out = ('P', $to, $flag); - push @out, $user if defined $user; - push @out, $secs if defined $secs; - push @out, $usecs if defined $usecs; - return $self->frame(@out); -} - -1; diff --git a/perl/QXProt/QXR.pm b/perl/QXProt/QXR.pm deleted file mode 100644 index ad23e2b8..00000000 --- a/perl/QXProt/QXR.pm +++ /dev/null @@ -1,78 +0,0 @@ - -# -# This module is part of the new protocal mode for a dx cluster -# -# This module handles the Routing message between nodes -# -# Copyright (c) 2003 Dirk Koopman G1TLH -# -# $Id$ -# - -package QXR; - -use strict; - -use vars qw(@ISA $VERSION $BRANCH); -@ISA = qw(QXProt); - -$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); -$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ || (0,0)); -$main::build += $VERSION; -$main::branch += $BRANCH; - -sub handle -{ - my ($self, $to, $from, $msgid, $line) = @_; - - my @f = split /\^/, $line; - -} - -sub gen -{ - my $self = shift; - my @out = ('R', $self->call, "DXSpider", ($main::version + 53) * 100, $main::build); - if (my $pass = $self->user->passphrase) { - my $inp = Verify->new; - push @out, $inp->challenge, $inp->response($pass, $self->call, $main::mycall); - } - return $self->frame(@out); -} - -1; - -sub gen2 -{ - my $self = shift; - - my $node = shift; - my $sort = shift; - my @out; - my $dxchan; - - while (@_) { - my $str = ''; - for (; @_ && length $str <= 230;) { - my $ref = shift; - my $call = $ref->call; - my $flag = 0; - - $flag += 1 if $ref->here; - $flag += 2 if $ref->conf; - if ($ref->is_node) { - my $ping = int($ref->pingave * 10); - $str .= "^N$flag$call,$ping"; - my $v = $ref->build || $ref->version; - $str .= ",$v" if defined $v; - } else { - $str .= "^U$flag$call"; - } - } - push @out, $str if $str; - } - my $n = @out; - my $h = get_hops(90); - @out = map { sprintf "PC90^%s^%X^%s%d%s^%s^", $node->call, $main::systime, $sort, --$n, $_, $h } @out; - return @out; -} diff --git a/perl/cluster.pl b/perl/cluster.pl index 5d5a824a..80c4a057 100755 --- a/perl/cluster.pl +++ b/perl/cluster.pl @@ -182,8 +182,7 @@ sub new_channel if ($bumpexisting) { my $ip = $conn->{peerhost} || 'unknown'; $dxchan->send_now('D', DXM::msg($lang, 'conbump', $call, $ip)); - Log('DXCommand', "$call bumped off by $ip, disconnected"); - dbg("$call bumped off by $ip, disconnected"); + LogDbg('DXCommand', "$call bumped off by $ip, disconnected"); $dxchan->disconnect; } else { already_conn($conn, $call, DXM::msg($lang, 'conother', $call, $main::mycall)); @@ -199,7 +198,7 @@ sub new_channel if ($baseuser && $baseuser->lockout || $lock) { if (!$user || !defined $lock || $lock) { my $host = $conn->{peerhost} || "unknown"; - Log('DXCommand', "$call on $host is locked out, disconnected"); + LogDbg('DXCommand', "$call on $host is locked out, disconnected"); $conn->disconnect; return; } @@ -284,8 +283,7 @@ sub cease $l->close_server; } - dbg("DXSpider version $version, build $build ended") if isdbg('chan'); - Log('cluster', "DXSpider V$version, build $build ended"); + LogDbg('cluster', "DXSpider V$version, build $build ended"); dbgclose(); Logclose(); @@ -351,13 +349,12 @@ STDOUT->autoflush(1); $build += $main::version; $build = "$build.$branch" if $branch; -Log('cluster', "DXSpider V$version, build $build started"); +LogDbg('cluster', "DXSpider V$version, build $build started"); # banner my ($year) = (gmtime)[5]; $year += 1900; dbg("Copyright (c) 1998-$year Dirk Koopman G1TLH"); -dbg("DXSpider Version $version, build $build started"); # try to load the database if ($dsn && -e "$root/perl/DXSql.pm") { -- 2.43.0