X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;ds=sidebyside;f=perl%2FDXCommandmode.pm;h=12c84c009d7310d1ac7b57f163caca3f62153aaa;hb=6f9f47b53d1b6c2a52722b525695fa1c03ab1ed7;hp=bce0255fd4750002963821575ccd462f5173ddda;hpb=8942c27356acc5d5f5a20134461bcf7e6bd6a044;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index bce0255f..12c84c00 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -9,6 +9,9 @@ package DXCommandmode; +use POSIX; +use IO::File; + @ISA = qw(DXChannel); use DXUtil; @@ -21,9 +24,9 @@ use DXLog; use DXLogPrint; use DXBearing; use CmdAlias; -use FileHandle; use Filter; use Carp; +use Minimuf; use strict; use vars qw(%Cache %cmd_cache $errstr %aliases); @@ -77,7 +80,9 @@ sub start # 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 @@ -87,10 +92,8 @@ 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('msgnew')) if DXMsg::for_me($call); + $self->send($self->msg('m9')) if DXMsg::for_me($call); - # get the filters - $self->{spotfilter} = Filter::read_in('spots', $call); $self->send($self->msg('pr', $call)); } @@ -133,6 +136,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; @@ -176,7 +195,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 { @@ -213,31 +232,25 @@ 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}; + @ans = &{$c}($self, $args); } } 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); } @@ -288,7 +301,7 @@ sub finish # 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); Log('DXCommand', "$call disconnected"); $ref->del() if $ref; @@ -424,22 +437,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 @@ -483,15 +481,14 @@ 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; + my $fh = new IO::File; if (!open $fh, $filename) { $errstr = "Syserr: can't open '$filename' $!"; return undef; @@ -501,7 +498,7 @@ sub find_cmd_name { 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; @@ -511,25 +508,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; }