nospawnify some of the commands
[spider.git] / perl / DXProt.pm
index 59deac9d13ead66155e7957b011bcbcfa246b733..8b9026c1f700e71945feda5329efcf9b2b431f95 100644 (file)
@@ -34,6 +34,9 @@ use Route::Node;
 use Script;
 use DXProtHandle;
 
+use Time::HiRes qw(gettimeofday tv_interval);
+use Mojo::IOLoop::Subprocess;
+
 use strict;
 
 use vars qw($pc11_max_age $pc23_max_age $last_pc50 $eph_restime $eph_info_restime $eph_pc34_restime
@@ -174,6 +177,8 @@ $pc92_find_timeout = 30;            # maximum time to wait for a reply
 sub check
 {
        my $n = shift;
+       my $pc = shift;
+       
        $n -= 10;
        return 0 if $n < 0 || $n > @checklist;
        my $ref = $checklist[$n];
@@ -183,30 +188,30 @@ sub check
        for ($i = 1; $i < @$ref; $i++) {
                my ($blank, $act) = $$ref[$i] =~ /^(b?)(\w)$/;
                return 0 unless $act;
-               next if $blank eq 'b' && $_[$i] =~ /^[ \*]$/;
-               next if $blank eq '*' && $_[$i] =~ /^\*$/;
+               next if $blank eq 'b' && $pc->[$i] =~ /^[ \*]$/;
+               next if $blank eq '*' && $pc->[$i] =~ /^\*$/;
                if ($act eq 'c') {
-                       return $i unless is_callsign($_[$i]);
+                       return $i unless is_callsign($pc->[$i]);
                } elsif ($act eq 'i') {
                        ;                                       # do nothing
                } elsif ($act eq 'm') {
-                       return $i unless is_pctext($_[$i]);
+                       return $i unless is_pctext($pc->[$i]);
                } elsif ($act eq 'p') {
-                       return $i unless is_pcflag($_[$i]);
+                       return $i unless is_pcflag($pc->[$i]);
                } elsif ($act eq 'f') {
-                       return $i unless is_freq($_[$i]);
+                       return $i unless is_freq($pc->[$i]);
                } elsif ($act eq 'n') {
-                       return $i unless $_[$i] =~ /^[\d ]+$/;
+                       return $i unless $pc->[$i] =~ /^[\d ]+$/;
                } elsif ($act eq 'h') {
-                       return $i unless $_[$i] =~ /^H\d\d?$/;
+                       return $i unless $pc->[$i] =~ /^H\d\d?$/;
                } elsif ($act eq 'd') {
-                       return $i unless $_[$i] =~ /^\s*\d+-\w\w\w-[12][90]\d\d$/;
+                       return $i unless $pc->[$i] =~ /^\s*\d+-\w\w\w-[12][90]\d\d$/;
                } elsif ($act eq 't') {
-                       return $i unless $_[$i] =~ /^[012]\d[012345]\dZ$/;
+                       return $i unless $pc->[$i] =~ /^[012]\d[012345]\dZ$/;
                } elsif ($act eq 'l') {
-                       return $i unless $_[$i] =~ /^[A-Z]$/;
+                       return $i unless $pc->[$i] =~ /^[A-Z]$/;
                } elsif ($act eq 'a') {
-                       return $i unless is_ipaddr($_[$i]);
+                       return $i unless is_ipaddr($pc->[$i]);
                }
        }
        return 0;
@@ -230,7 +235,8 @@ sub update_pc92_keepalive
 
 sub init
 {
-       do "$main::data/hop_table.pl" if -e "$main::data/hop_table.pl";
+       my $fn = localdata("hop_table.pl");
+       do $fn if -e $fn;
        confess $@ if $@;
 
        my $user = DXUser::get($main::mycall);
@@ -246,7 +252,7 @@ sub init
        $main::me->{pingave} = 0;
        $main::me->{registered} = 1;
        $main::me->{version} = $main::version;
-       $main::me->{build} = "$main::subversion.$main::build";
+       $main::me->{build} = $main::build;
        $main::me->{do_pc9x} = 1;
        $main::me->update_pc92_next($pc92_short_update_period);
        $main::me->update_pc92_keepalive;
@@ -289,6 +295,7 @@ sub start
        my $host = $self->{conn}->peerhost;
        $host ||= "AGW Port #$self->{conn}->{agwport}" if exists $self->{conn}->{agwport};
        $host ||= "unknown";
+       $self->{hostname} = $host if is_ipaddr($host);
 
        Log('DXProt', "$call connected from $host");
 
@@ -401,7 +408,7 @@ sub normal
        }
 
        # check for and dump bad protocol messages
-       my $n = check($pcno, @field);
+       my $n = check($pcno, \@field);
        if ($n) {
                dbg("PCPROT: bad field $n, dumped (" . parray($checklist[$pcno-10]) . ")") if isdbg('chanerr');
                return;
@@ -430,9 +437,9 @@ sub normal
        my $sub = "handle_$pcno";
 
        if ($self->can($sub)) {
-               $self->$sub($pcno, $line, $origin, @field);
+               $self->$sub($pcno, $line, $origin, \@field);
        } else {
-               $self->handle_default($pcno, $line, $origin, @field);
+               $self->handle_default($pcno, $line, $origin, \@field);
        }
 }
 
@@ -955,7 +962,8 @@ sub broadcast_pc92_update
 
        my $nref = Route::Node::get($call);
        unless ($nref) {
-               dbg("ERROR: broadcast_pc92_update - Route::Node $call disappeared");
+               cluck("ERROR: broadcast_pc92_update - Route::Node $call disappeared");
+               $self->update_pc92_next;
                return;
        }
        my $l = $nref->last_PC92C(gen_my_pc92_config($nref));
@@ -973,7 +981,8 @@ sub broadcast_pc92_keepalive
 
        my $nref = Route::Node::get($call);
        unless ($nref) {
-               dbg("ERROR: broadcast_pc92_keepalive - Route::Node $call disappeared");
+               cluck("ERROR: broadcast_pc92_keepalive - Route::Node $call disappeared");
+               $self->update_pc92_keepalive;
                return;
        }
        my $l = pc92k($nref);
@@ -1127,8 +1136,14 @@ sub process_rcmd
                        if ($ref->{priv}) {             # you have to have SOME privilege, the commands have further filtering
                                $self->{remotecmd} = 1; # for the benefit of any command that needs to know
                                my $oldpriv = $self->{priv};
-                               $self->{priv} = $ref->{priv}; # assume the user's privilege level
+                               $self->{priv} = 1; # set a maximum privilege 
+
+                               # park homenode and user for any spawned command that run_cmd may do.
+                               $self->{_rcmd_user} = $user;
+                               $self->{_rcmd_fromnode} = $fromnode;
                                my @in = (DXCommandmode::run_cmd($self, $cmd));
+                               delete $self->{_rcmd_fromnode};
+                               delete $self->{_rcmd_user};
                                $self->{priv} = $oldpriv;
                                $self->send_rcmd_reply($main::mycall, $fromnode, $user, @in);
                                delete $self->{remotecmd};
@@ -1148,6 +1163,108 @@ sub process_rcmd
        }
 }
 
+
+sub send_rcmd_reply
+{
+       my $self = shift;
+       my $tonode = shift;
+       my $fromnode = shift;
+       my $user = shift;
+       while (@_) {
+               my $line = shift;
+               $line =~ s/\s*$//;
+               Log('rcmd', 'out', $fromnode, $line);
+               if ($self->is_clx) {
+                       $self->send(pc85($main::mycall, $fromnode, $user, "$main::mycall:$line"));
+               } else {
+                       $self->send(pc35($main::mycall, $fromnode, "$main::mycall:$line"));
+               }
+       }
+}
+
+# Punt off a long running command into a separate process - this will be caused by an rcmd from outside
+#
+# This is called from commands to run some potentially long running
+# function. The process forks and then runs the function and returns
+# the result back to the cmd. 
+#
+# NOTE: this merely forks the current process and then runs the cmd in that (current) context.
+#       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($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 = @_;
+       my @out;
+       
+       my $cb = delete $args{cb};
+       my $prefix = delete $args{prefix};
+       my $progress = delete $args{progress};
+       my $args = delete $args{args} || [];
+       my $t0 = [gettimeofday];
+
+       # remembered from process_cmd when spawn_cmd was called thru DXCommandmode::run_cmd which was called by process_rcmd
+       my $fromnode = $self->{_rcmd_fromnode};
+       my $user = $self->{_rcmd_user};
+
+       no strict 'refs';
+               
+       my $fc = Mojo::IOLoop::Subprocess->new;
+
+       # just behave normally if something has set the "one-shot" _nospawn in the channel
+       return ($cmdref->(@$args)) if $self->{_nospawn};
+
+       #       $fc->serializer(\&encode_json);
+#      $fc->deserializer(\&decode_json);
+       $fc->run(
+                        sub {
+                                my $subpro = shift;
+                                if (isdbg('chan')) {
+                                        my $s = "line: $line";
+                                        $s .= ", args: " . join(', ', @$args) if $args && @$args;
+                                }
+
+                                my @res = $cmdref->(@$args);
+                                return @res;
+                        },
+#                       $args,
+                        sub {
+                                my ($fc, $err, @res) = @_; 
+                                my $self = DXChannel::get($call);
+                                return unless $self;
+
+                                if ($err) {
+                                        my $s = "DXCommand::spawn_cmd: call $call error $err";
+                                        dbg($s) if isdbg('chan');
+                                        if ($fromnode && $user) {
+                                                $self->send_rcmd_reply($main::mycall, $fromnode, $user, $s);
+                                        } else {
+                                                $self->send($s);
+                                        }
+                                        return;
+                                }
+                                if ($cb) {
+                                        # transform output if required
+                                        @res = $cb->($self, @res);
+                                }
+                                if (@res) {
+                                        if ($fromnode && $user) {
+                                                $self->send_rcmd_reply($main::mycall, $fromnode, $user, @res);
+                                        } else {
+                                                $self->send(@res);
+                                        }
+                                }
+                                DXCommandmode::_diffms($call, $line, $t0);
+                        });
+       
+       return @out;
+}
+
 sub process_rcmd_reply
 {
        my ($self, $tonode, $fromnode, $user, $line) = @_;
@@ -1173,23 +1290,7 @@ sub process_rcmd_reply
        }
 }
 
-sub send_rcmd_reply
-{
-       my $self = shift;
-       my $tonode = shift;
-       my $fromnode = shift;
-       my $user = shift;
-       while (@_) {
-               my $line = shift;
-               $line =~ s/\s*$//;
-               Log('rcmd', 'out', $fromnode, $line);
-               if ($self->is_clx) {
-                       $self->send(pc85($main::mycall, $fromnode, $user, "$main::mycall:$line"));
-               } else {
-                       $self->send(pc35($main::mycall, $fromnode, "$main::mycall:$line"));
-               }
-       }
-}
+
 
 # add a rcmd request to the rcmd queues
 sub addrcmd
@@ -1684,5 +1785,8 @@ sub clean_pc92_find
 {
 
 }
+
+
+
 1;
 __END__