X-Git-Url: http://www.dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=4f0566f9ebc2f5f4f322d5db6d4d9b8e566cd1b6;hb=b473fa8950fc9a6b747be44434569dec254b0897;hp=5348212d620ceb7c09626f5c9d7f56ef3d5690a8;hpb=6a0068ec3df1dca0c6ae2714af3c0a4a62998dcf;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 5348212d..4f0566f9 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -17,6 +17,8 @@ use DXUser; use DXVars; use DXDebug; use DXM; +use DXLog; +use DXLogPrint; use CmdAlias; use FileHandle; use Carp; @@ -46,18 +48,18 @@ sub new sub start { - my ($self, $line) = @_; + my ($self, $line, $sort) = @_; my $user = $self->{user}; my $call = $self->{call}; my $name = $user->{name}; - + $self->{name} = $name ? $name : $call; $self->send($self->msg('l2',$self->{name})); $self->send_file($main::motd) if (-e $main::motd); - $self->send($self->msg('pr', $call)); $self->state('prompt'); # a bit of room for further expansion, passwords etc $self->{priv} = $user->priv; $self->{lang} = $user->lang; + $self->{pagelth} = 20; $self->{priv} = 0 if $line =~ /^(ax|te)/; # set the connection priv to 0 - can be upgraded later $self->{consort} = $line; # save the connection type @@ -74,85 +76,142 @@ sub start my $nchan = DXChannel->get($main::mycall); my @pc16 = DXProt::pc16($nchan, $cuser); DXProt::broadcast_ak1a(@pc16); + Log('DXCommand', "$call connected"); + + # send prompts and things + my $info = DXCluster::cluster(); + $self->send("Cluster:$info"); + $self->send($self->msg('pr', $call)); } # # This is the normal command prompt driver # + sub normal { - my $self = shift; - my $user = $self->{user}; - my $call = $self->{call}; - my $cmdline = shift; - my @ans; - - # are we in stored state? - if ($self->{func}) { - my $c = qq{ \@ans = $self->{func}(\$self, \$cmdline) }; - dbg('eval', "stored func cmd = $c\n"); - eval $c; - if ($@) { - return (1, "Syserr: Eval err $errstr on stored func $self->{func}"); - } - } else { + my $self = shift; + my $cmdline = shift; + my @ans; + + # remove leading and trailing spaces + $cmdline =~ s/^\s*(.*)\s*$/$1/; + + if ($self->{func}) { + my $c = qq{ \@ans = $self->{func}(\$self, \$cmdline) }; + dbg('eval', "stored func cmd = $c\n"); + eval $c; + if ($@) { + return (1, "Syserr: Eval err $errstr on stored func $self->{func}"); + } + } elsif ($self->{state} eq 'prompt') { + @ans = run_cmd($self, $cmdline) if length $cmdline; + + if ($self->{pagelth} && @ans > $self->{pagelth}) { + my $i; + for ($i = $self->{pagelth}; $i-- > 0; ) { + my $line = shift @ans; + $line =~ s/\s+$//o; # why am having to do this? + $self->send($line); + } + $self->{pagedata} = \@ans; + $self->state('page'); + $self->send($self->msg('page', scalar @ans)); + } else { + for (@ans) { + s/\s+$//o; # why ????????? + $self->send($_); + } + } + } elsif ($self->{state} eq 'page') { + my $i = $self->{pagelth}; + my $ref = $self->{pagedata}; + my $tot = @$ref; + + # abort if we get a line starting in with a + if ($cmdline =~ /^a/io) { + undef $ref; + $i = 0; + } + + # send a tranche of data + while ($i-- > 0 && @$ref) { + my $line = shift @$ref; + $line =~ s/\s+$//o; # why am having to do this? + $self->send($line); + } - # special case only \n input => " " - if ($cmdline eq " ") { - $self->prompt(); - return; - } + # reset state if none or else chuck out an intermediate prompt + if ($ref && @$ref) { + $tot -= $self->{pagelth}; + $self->send($self->msg('page', $tot)); + } else { + $self->state('prompt'); + } + } + + # send a prompt only if we are in a prompt state + $self->prompt() if $self->{state} =~ /^prompt/o; +} + +# +# this is the thing that runs the command, it is done like this for the +# benefit of remote command execution +# + +sub run_cmd +{ + my $self = shift; + my $user = $self->{user}; + my $call = $self->{call}; + my $cmdline = shift; + my @ans; + # strip out // $cmdline =~ s|//|/|og; - + # split the command line up into parts, the first part is the command my ($cmd, $args) = $cmdline =~ /^([\w\/]+)\s*(.*)/o; - + if ($cmd) { - - my ($path, $fcmd); - - # alias it if possible - my $acmd = CmdAlias::get_cmd($cmd); - if ($acmd) { - ($cmd, $args) = "$acmd $args" =~ /^([\w\/]+)\s*(.*)/o; - } - - # first expand out the entry to a command - ($path, $fcmd) = search($main::localcmd, $cmd, "pl"); - ($path, $fcmd) = search($main::cmd, $cmd, "pl") if !$path || !$fcmd; - - my $package = find_cmd_name($path, $fcmd); - @ans = (0, "Syserr: compile err on $package\n$@$errstr") if !$package ; - - if ($package) { - my $c = qq{ \@ans = $package(\$self, \$args) }; - dbg('eval', "cluster cmd = $c\n"); - eval $c; - if ($@) { - @ans = (0, "Syserr: Eval err cached $package\n$@"); - } - } + + my ($path, $fcmd); + + # alias it if possible + my $acmd = CmdAlias::get_cmd($cmd); + if ($acmd) { + ($cmd, $args) = "$acmd $args" =~ /^([\w\/]+)\s*(.*)/o; + } + + # first expand out the entry to a command + ($path, $fcmd) = search($main::localcmd, $cmd, "pl"); + ($path, $fcmd) = search($main::cmd, $cmd, "pl") if !$path || !$fcmd; + + my $package = find_cmd_name($path, $fcmd); + @ans = (0) if !$package ; + + if ($package) { + my $c = qq{ \@ans = $package(\$self, \$args) }; + dbg('eval', "cluster cmd = $c\n"); + eval $c; + if ($@) { + @ans = (0, "Syserr: Eval err cached $package\n$@"); + } + } } - } - -# my @ans = $self->eval_file($path, $fcmd, $args) if $path && $fcmd; -# @ans = $self->eval_file($main::cmd, $cmd, $args) if !$ans[0]; - if ($ans[0]) { - shift @ans; - $self->send(@ans) if @ans > 0; - } else { - shift @ans; - if (@ans > 0) { - $self->send($self->msg('e2', @ans)); + + if ($ans[0]) { + shift @ans; } else { - $self->send($self->msg('e1')); + shift @ans; + if (@ans > 0) { + unshift @ans, $self->msg('e2'); + } else { + @ans = $self->msg('e1'); + } } - } - - # send a prompt only if we are in a prompt state - $self->prompt() if $self->{state} =~ /^prompt/o; + return (@ans); } # @@ -194,7 +253,8 @@ sub finish my $nchan = DXChannel->get($main::mycall); my $pc17 = $nchan->pc17($self); DXProt::broadcast_ak1a($pc17); - + + Log('DXCommand', "$call disconnected"); $ref->del() if $ref; } @@ -394,6 +454,7 @@ sub find_cmd_name { my $fh = new FileHandle; if (!open $fh, $filename) { $errstr = "Syserr: can't open '$filename' $!"; + return undef; }; local $/ = undef; my $sub = <$fh>; @@ -424,7 +485,6 @@ sub find_cmd_name { print "\$\@ = $@"; $errstr = $@; delete_package($package); - $package = undef; } else { #cache it unless we're cleaning out each time $Cache{$package}{mtime} = $mtime; @@ -433,6 +493,7 @@ sub find_cmd_name { #print Devel::Symdump->rnew($package)->as_string, $/; $package = "DXCommandmode::$package" if $package; + $package = undef if $errstr; return $package; }