X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=c2cab9f9bb619dc02ed6831ae9a1401b85f006af;hb=1cc51a6696899a05d1b9ca40dab497cfdc39294b;hp=8dcb9b6cf9b0b07451199d825fddee6ce451205c;hpb=53899d74634af9db8d0b842d68b099972dd849b6;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 8dcb9b6c..c2cab9f9 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -30,6 +30,8 @@ use AnnTalk; use WCY; use Sun; use Internet; +use Script; + use strict; use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug); @@ -41,6 +43,12 @@ $errstr = (); # error string from eval $scriptbase = "$main::root/scripts"; # the place where all users start scripts go $maxerrors = 20; # the maximum number of concurrent errors allowed before disconnection +use vars qw($VERSION $BRANCH); +$VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ ); +$BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/ ) || 0; +$main::build += $VERSION; +$main::branch += $BRANCH; + # # obtain a new connection this is derived from dxchannel # @@ -69,6 +77,10 @@ sub start my $call = $self->{call}; my $name = $user->{name}; + # log it + my $host = $self->{conn}->{peerhost} || "unknown"; + Log('DXCommand', "$call connected from $host"); + $self->{name} = $name ? $name : $call; $self->send($self->msg('l2',$self->{name})); $self->send_file($main::motd) if (-e $main::motd); @@ -77,6 +89,8 @@ sub start $self->{lang} = $user->lang || $main::lang || 'en'; $self->{pagelth} = $user->pagelth || 20; $self->{priv} = 0 if $line =~ /^(ax|te)/; # set the connection priv to 0 - can be upgraded later + ($self->{width}) = $line =~ /width=(\d+)/; + $self->{width} = 80 unless $self->{width} && $self->{width} > 80; $self->{consort} = $line; # save the connection type # set some necessary flags on the user if they are connecting @@ -88,6 +102,7 @@ sub start $self->{wx} = $user->wantwx; $self->{dx} = $user->wantdx; $self->{logininfo} = $user->wantlogininfo; + $self->{ann_talk} = $user->wantann_talk; $self->{here} = 1; # get the filters @@ -105,8 +120,6 @@ sub start $user->qra(DXBearing::lltoqra($lat, $long)) if (defined $lat && defined $long); } - Log('DXCommand', "$call connected"); - # send prompts and things my $info = Route::cluster(); $self->send("Cluster:$info"); @@ -128,10 +141,14 @@ sub start # do we need to send a forward/opernam? my $lastoper = $user->lastoper || 0; my $homenode = $user->homenode || ""; - if ($homenode eq $main::mycall && $lastoper < $main::systime + $DXUser::lastoperinterval) { + if ($homenode eq $main::mycall && $lastoper + $DXUser::lastoperinterval < $main::systime) { run_cmd($DXProt::me, "forward/opernam $call"); $user->lastoper($main::systime); } + + # run a script send the output to the punter + my $script = new Script(lc $call) || new Script('user_default'); + $script->run($self) if $script; } # @@ -417,10 +434,19 @@ sub disconnect { my $self = shift; my $call = $self->call; + + return if $self->{disconnecting}++; + delete $self->{senddbg}; - my @rout = $main::routeroot->del_user($call); - dbg("B/C PC17 on $main::mycall for: $call") if isdbg('route'); + my $uref = Route::User::get($call); + my @rout; + if ($uref) { + @rout = $main::routeroot->del_user($uref); + dbg("B/C PC17 on $main::mycall for: $call") if isdbg('route'); + } else { + confess "trying to disconnect a non existant user $call"; + } # issue a pc17 to everybody interested DXProt::route_pc17($DXProt::me, $main::routeroot, @rout) if @rout; @@ -684,6 +710,11 @@ sub announce my $text = shift; my ($filter, $hops); + if (!$self->{ann_talk} && $to ne $self->{call}) { + my $call = AnnTalk::is_talk_candidate($_[0], $text); + return if $call; + } + if ($self->{annfilter}) { ($filter, $hops) = $self->{annfilter}->it(@_ ); return unless $filter;