X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=c2cab9f9bb619dc02ed6831ae9a1401b85f006af;hb=1cc51a6696899a05d1b9ca40dab497cfdc39294b;hp=eef342bc7dbd718b40ad203f80c5e0f61d6883ee;hpb=6624dcdf07d628e8d6a16fc6549edf40be25b7b2;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index eef342bc..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"); @@ -125,6 +138,17 @@ sub start $self->tell_login('loginu'); + # do we need to send a forward/opernam? + my $lastoper = $user->lastoper || 0; + my $homenode = $user->homenode || ""; + 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; } # @@ -410,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; @@ -649,7 +682,7 @@ sub talk { my ($self, $from, $to, $via, $line) = @_; $line =~ s/\\5E/\^/g; - $self->send_later('T', "$to de $from: $line") if $self->{talk}; + $self->local_send('T', "$to de $from: $line") if $self->{talk}; Log('talk', $to, $from, $main::mycall, $line); # send a 'not here' message if required unless ($self->{here} && $from ne $to) { @@ -677,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;