X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=39153ea4b40ae8120c756d83bba9d762a7d8be6f;hb=7de34899527cbc4dfacdcc6452926b3d2d73792c;hp=b9d8e6cfc7d3b4e9f7eafadb2767cfc420f5df33;hpb=61cdf7dc2b72c1898850a4d2aa403d712f22f8ee;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index b9d8e6cf..39153ea4 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -9,6 +9,8 @@ package DXCommandmode; +use POSIX; + @ISA = qw(DXChannel); use DXUtil; @@ -21,16 +23,20 @@ use DXLog; use DXLogPrint; use DXBearing; use CmdAlias; -use FileHandle; +use Filter; use Carp; +use Minimuf; +use DXDb; +use Sun; use strict; -use vars qw(%Cache %cmd_cache $errstr %aliases); +use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase); %Cache = (); # cache of dynamically loaded routine's mod times %cmd_cache = (); # cache of short names $errstr = (); # error string from eval %aliases = (); # aliases for (parts of) commands +$scriptbase = "$main::root/scripts"; # the place where all users start scripts go # # obtain a new connection this is derived from dxchannel @@ -65,20 +71,28 @@ sub start $self->{consort} = $line; # save the connection type # set some necessary flags on the user if they are connecting - $self->{beep} = $self->{wwv} = $self->{talk} = $self->{ann} = $self->{here} = $self->{dx} = 1; - # $self->prompt() if $self->{state} =~ /^prompt/o; + $self->{beep} = $user->wantbeep; + $self->{ann} = $user->wantann; + $self->{wwv} = $user->wantwwv; + $self->{talk} = $user->wanttalk; + $self->{wx} = $user->wantwx; + $self->{dx} = $user->wantdx; + $self->{logininfo} = $user->wantlogininfo; + $self->{here} = 1; # add yourself to the database my $node = DXNode->get($main::mycall) or die "$main::mycall not allocated in DXNode database"; my $cuser = DXNodeuser->new($self, $node, $call, 0, 1); $node->dxchan($self) if $call eq $main::myalias; # send all output for mycall to myalias - + # issue a pc16 to everybody interested my $nchan = DXChannel->get($main::mycall); my @pc16 = DXProt::pc16($nchan, $cuser); - DXProt::broadcast_ak1a(@pc16); + for (@pc16) { + DXProt::broadcast_all_ak1a($_); + } Log('DXCommand', "$call connected"); - + # send prompts and things my $info = DXCluster::cluster(); $self->send("Cluster:$info"); @@ -86,9 +100,11 @@ sub start $self->send($self->msg('qthe1')) if !$user->qth; $self->send($self->msg('qll')) if !$user->qra || (!$user->lat && !$user->long); $self->send($self->msg('hnodee1')) if !$user->qth; - - + $self->send($self->msg('m9')) if DXMsg::for_me($call); $self->send($self->msg('pr', $call)); + + $self->tell_login('loginu'); + } # @@ -129,6 +145,22 @@ sub normal } else { $self->state('prompt'); } + } elsif ($self->{state} eq 'sysop') { + my $passwd = $self->{user}->passwd; + my @pw = split / */, $passwd; + if ($passwd) { + my @l = @{$self->{passwd}}; + my $str = "$pw[$l[0]].*$pw[$l[1]].*$pw[$l[2]].*$pw[$l[3]].*$pw[$l[4]]"; + if ($cmdline =~ /$str/) { + $self->{priv} = $self->{user}->priv; + } else { + $self->send($self->msg('sorry')); + } + } else { + $self->send($self->msg('sorry')); + } + delete $self->{passwd}; + $self->state('prompt'); } else { @ans = run_cmd($self, $cmdline); # if length $cmdline; @@ -144,8 +176,7 @@ sub normal $self->send($self->msg('page', scalar @ans)); } else { for (@ans) { - s/\s+$//o; # why ????????? - $self->send($_); + $self->send($_) if $_; } } } @@ -172,7 +203,7 @@ sub run_cmd dbg('eval', "stored func cmd = $c\n"); eval $c; if ($@) { - return (1, "Syserr: Eval err $errstr on stored func $self->{func}"); + return ("Syserr: Eval err $errstr on stored func $self->{func}", $@); } } else { @@ -182,7 +213,8 @@ sub run_cmd $cmdline =~ s|//|/|og; # split the command line up into parts, the first part is the command - my ($cmd, $args) = $cmdline =~ /^([\S\/]+)\s*(.*)/o; + my ($cmd, $args) = split /\s+/, $cmdline, 2; + $args = "" unless $args; if ($cmd) { @@ -193,7 +225,8 @@ sub run_cmd # alias it if possible my $acmd = CmdAlias::get_cmd($cmd); if ($acmd) { - ($cmd, $args) = "$acmd $args" =~ /^([\w\/]+)\s*(.*)/o; + ($cmd, $args) = split /\s+/, "$acmd $args", 2; + $args = "" unless $args; dbg('command', "aliased cmd: $cmd $args"); } @@ -209,31 +242,29 @@ sub run_cmd if ($package) { dbg('command', "package: $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 $c; + unless (exists $Cache{$package}->{'sub'}) { + $c = eval $Cache{$package}->{'eval'}; + if ($@) { + return ("Syserr: Syntax error in $package", $@); + } + $Cache{$package}->{'sub'} = $c; } + $c = $Cache{$package}->{'sub'}; + eval { + @ans = &{$c}($self, $args); + }; + + return ($@) if $@; } } else { dbg('command', "cmd: $cmd not found"); - @ans = (0); + return ($self->msg('e1')); } } } - if ($ans[0]) { - shift @ans; - } else { - shift @ans; - if (@ans > 0) { - unshift @ans, $self->msg('e2'); - } else { - @ans = $self->msg('e1'); - } - } + shift @ans; return (@ans); } @@ -266,6 +297,9 @@ sub finish my $self = shift; my $call = $self->call; + # I was the last node visited + $self->user->node($main::mycall); + # log out text if (-e "$main::data/logout") { open(I, "$main::data/logout") or confess; @@ -279,14 +313,17 @@ sub finish my $node = DXNode->get($main::mycall); $node->{dxchan} = 0; } - my $ref = DXCluster->get_exact($call); # issue a pc17 to everybody interested my $nchan = DXChannel->get($main::mycall); my $pc17 = $nchan->pc17($self); - DXProt::broadcast_ak1a($pc17); - + DXProt::broadcast_all_ak1a($pc17); + + # send info to all logged in thingies + $self->tell_login('logoutu'); + Log('DXCommand', "$call disconnected"); + my $ref = DXCluster->get_exact($call); $ref->del() if $ref; } @@ -330,6 +367,14 @@ sub get_all return @out; } +# run a script for this user +sub run_script +{ + my $self = shift; + my $silent = shift || 0; + +} + # # search for the command in the cache of short->long form commands # @@ -420,22 +465,7 @@ sub valid_package_name { #Dress it up as a real package name $string =~ s/\//_/og; - return "Emb_" . $string; -} - -#borrowed from Safe.pm -sub delete_package { - my $pkg = shift; - my ($stem, $leaf); - - no strict 'refs'; - $pkg = "DXCommandmode::$pkg\::"; # expand to full symbol table name - ($stem, $leaf) = $pkg =~ m/(.*::)(\w+::)$/; - - if ($stem && $leaf) { - my $stem_symtab = *{$stem}{HASH}; - delete $stem_symtab->{$leaf}; - } + return $string; } # find a cmd reference @@ -479,25 +509,21 @@ sub find_cmd_name { return undef; } - if(defined $Cache{$package}{mtime} && $Cache{$package}{mtime } <= $mtime) { + if(defined $Cache{$package}->{mtime} &&$Cache{$package}->{mtime} <= $mtime) { #we have compiled this subroutine already, #it has not been updated on disk, nothing left to do #print STDERR "already compiled $package->handler\n"; ; } else { - delete_package($package) if defined $Cache{$package}{mtime}; - - my $fh = new FileHandle; - if (!open $fh, $filename) { + + my $sub = readfilestr($filename); + unless ($sub) { $errstr = "Syserr: can't open '$filename' $!"; return undef; }; - local $/ = undef; - my $sub = <$fh>; - close $fh; #wrap the code into a subroutine inside our unique package - my $eval = qq{ sub $package { $sub } }; + my $eval = qq( sub { $sub } ); if (isdbg('eval')) { my @list = split /\n/, $eval; @@ -507,25 +533,9 @@ sub find_cmd_name { } } - { - #hide our variables within this block - my($filename,$mtime,$package,$sub); - eval $eval; - } - - if ($@) { - print "\$\@ = $@"; - $errstr = $@; - delete_package($package); - } else { - #cache it unless we're cleaning out each time - $Cache{$package}{'mtime'} = $mtime; - } + $Cache{$package} = {mtime => $mtime, 'eval' => $eval }; } - - #print Devel::Symdump->rnew($package)->as_string, $/; - $package = "DXCommandmode::$package" if $package; - $package = undef if $errstr; + return $package; }