part of making rcmd work again for async cmds

[spider.git] / perl / DXCommandmode.pm

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 14e0dd2c9b8e599a856ddbb76410755d1efa5d48..4212d968b236aaf408288bd09a55930d0a102b8b 100644 (file)
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -13,6 +13,8 @@ package DXCommandmode;
 
 @ISA = qw(DXChannel);
 
+require 5.10.1;
+
 use POSIX qw(:math_h);
 use DXUtil;
 use DXChannel;
@@ -71,7 +73,7 @@ sub new
        my $pkg = shift;
        my $call = shift;
 #      my @rout = $main::routeroot->add_user($call, Route::here(1));
-       DXProt::_add_thingy($main::routeroot, [$call, 0, 0, 1, undef, undef, $self->{conn}->peerhost], );
+       DXProt::_add_thingy($main::routeroot, [$call, 0, 0, 1, undef, undef, $self->hostname], );
 
        # ALWAYS output the user
        my $ref = Route::User::get($call);
@@ -98,7 +100,7 @@ sub start
        my $host = $self->{conn}->peerhost;
        $host ||= "AGW Port #$self->{conn}->{agwport}" if exists $self->{conn}->{agwport};
        $host ||= "unknown";
-       LogDbg('DXCommand', "$call connected from $host");
+       $self->{hostname} = $host;
 
        $self->{name} = $name ? $name : $call;
        $self->send($self->msg('l2',$self->{name}));
@@ -109,9 +111,20 @@ sub start
        $pagelth = $default_pagelth unless defined $pagelth;
        $self->{pagelth} = $pagelth;
        ($self->{width}) = $line =~ /width=(\d+)/; $line =~ s/\s*width=\d+\s*//;
+       if ($line =~ /host=/) {
+               my ($h) = $line =~ /host=(\d+\.\d+\.\d+\.\d+)/;
+               $line =~ s/\s*host=\d+\.\d+\.\d+\.\d+// if $h;
+               unless ($h) {
+                       ($h) = $line =~ /host=([\da..fA..F:]+)/;
+                       $line =~ s/\s*host=[\da..fA..F:]+// if $h;
+               }
+               $self->{hostname} = $h if $h;
+       }
        $self->{width} = 80 unless $self->{width} && $self->{width} > 80;
        $self->{consort} = $line;       # save the connection type
-       
+
+       LogDbg('DXCommand', "$call connected from $self->{hostname}");
+
        # set some necessary flags on the user if they are connecting
        $self->{beep} = $user->wantbeep;
        $self->{ann} = $user->wantann;
@@ -144,7 +157,7 @@ sub start
        $self->send_motd;
 
        # sort out privilege reduction
-       $self->{priv} = 0 if $line =~ /^(ax|te)/ && !$self->conn->{usedpasswd};
+       $self->{priv} = 0 unless $self->{hostname} eq '127.0.0.1' || $self->{hostname} eq '::1' || $self->conn->{usedpasswd};
 
        # get the filters
        my $nossid = $call;
@@ -567,7 +580,7 @@ sub process
        my $dxchan;
        
        foreach $dxchan (@dxchan) {
-               next unless $dxchan->{sort} eq 'U';  
+               next unless $dxchan->is_user;  
        
                # send a outstanding message prompt if required
                if ($t >= $dxchan->lastmsgpoll + $msgpolltime) {
@@ -661,7 +674,7 @@ sub broadcast
        my $s = shift;                          # the line to be rebroadcast
        
     foreach my $dxchan (DXChannel::get_all()) {
-               next unless $dxchan->{sort} eq 'U'; # only interested in user channels  
+               next unless $dxchan->is_user; # only interested in user channels  
                next if grep $dxchan == $_, @_;
                $dxchan->send($s);                      # send it
        }
@@ -670,7 +683,7 @@ sub broadcast
 # gimme all the users
 sub get_all
 {
-       return grep {$_->{sort} eq 'U'} DXChannel::get_all();
+       return grep {$_->is_user} DXChannel::get_all();
 }
 
 # run a script for this user
@@ -1256,16 +1269,15 @@ sub _diffms
 {
        return unless isdbg('chan');
        my $call = shift;
-       my $a = shift;
-       my $b = shift || [gettimeofday];
-       my $prefix = shift;
+       my $line = shift;
+       my $ta = shift;
+       my $tb = shift || [gettimeofday];
 
-       my $secs = $b->[0] - $a->[0];
-       my $msecs = int(($b->[1] - $a->[1]) / 1000);
+       my $a = int($ta->[0] * 1000) + int($ta->[1] / 1000); 
+       my $b = int($tb->[0] * 1000) + int($tb->[1] / 1000);
+       my $msecs = $b - $a;
 
-       my $s = "forkcall stats: $call ";
-       $s .= "$prefix " if $prefix;
-       $s .= "${secs}S" if $secs;
+       my $s = "forkcall stats: $call '$line' ";
        $s .= "${msecs}mS";
        dbg($s);
 }
@@ -1280,10 +1292,11 @@ sub _diffms
 #       IT DOES NOT START UP SOME NEW PROGRAM AND RELIES ON THE FACT THAT IT IS RUNNING DXSPIDER 
 #       THE CURRENT CONTEXT!!
 # 
-# call: $self->spawn_cmd(\<function>, [cb => sub{...}], [prefix => "cmd> "], [progress => 0|1], [args => [...]]);
+# call: $self->spawn_cmd($original_cmd_line, \<function>, [cb => sub{...}], [prefix => "cmd> "], [progress => 0|1], [args => [...]]);
 sub spawn_cmd
 {
        my $self = shift;
+       my $line = shift;
        my $cmdref = shift;
        my $call = $self->{call};
        my %args = @_;
@@ -1315,16 +1328,17 @@ sub spawn_cmd
                                         return;
                                 }
                                 if ($cb) {
-                                        $cb->($dxchan, @res);
-                                } else {
-                                        return unless @res;
+                                        # transform output if required
+                                        @res = $cb->($dxchan, @res);
+                                }
+                                if (@res) {
                                         if (defined $prefix) {
                                                 $dxchan->send(map {"$prefix$_"} @res);
                                         } else {
                                                 $dxchan->send(@res);
                                         }
                                 }
-                                _diffms($call, $t0, [gettimeofday], $prefix);
+                                _diffms($call, $line, $t0);
                         });
        
        return @out;