X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXCommandmode.pm;h=79ba03b0b8f63ac3f189534677f9d4d55cb7c5e2;hb=d3004b59ca0171c0afe6d9898c84830c809721af;hp=6eee5d457cc00aca7b0ea6143a96dca280df4d0b;hpb=dce19df96e5dab964cd89cab9c33af470d824109;p=spider.git diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm index 6eee5d45..79ba03b0 100644 --- a/perl/DXCommandmode.pm +++ b/perl/DXCommandmode.pm @@ -37,7 +37,8 @@ use DB_File; use VE7CC; use strict; -use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug $maxbadcount $msgpolltime); +use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase $maxerrors %nothereslug + $maxbadcount $msgpolltime $default_pagelth); %Cache = (); # cache of dynamically loaded routine's mod times %cmd_cache = (); # cache of short names @@ -87,7 +88,9 @@ sub start my $name = $user->{name}; # log it - my $host = $self->{conn}->{peerhost} || "unknown"; + my $host = $self->{conn}->{peerhost}; + $host ||= "AGW Port #$self->{conn}->{agwport}" if exists $self->{conn}->{agwport}; + $host ||= "unknown"; Log('DXCommand', "$call connected from $host"); $self->{name} = $name ? $name : $call; @@ -95,7 +98,9 @@ sub start $self->state('prompt'); # a bit of room for further expansion, passwords etc $self->{priv} = $user->priv || 0; $self->{lang} = $user->lang || $main::lang || 'en'; - $self->{pagelth} = $user->pagelth || 20; + my $pagelth = $user->pagelth; + $pagelth = $default_pagelth unless defined $pagelth; + $self->{pagelth} = $pagelth; ($self->{width}) = $line =~ /width=(\d+)/; $line =~ s/\s*width=\d+\s*//; $self->{width} = 80 unless $self->{width} && $self->{width} > 80; $self->{consort} = $line; # save the connection type @@ -433,6 +438,8 @@ sub run_cmd if ($cmd) { # strip out // on command only $cmd =~ s|//|/|g; + $cmd =~ s|^/||g; # no leading / either + $cmd =~ s|[^-?\w/]||g; # and no funny characters either my ($path, $fcmd); @@ -448,7 +455,7 @@ sub run_cmd # 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; + ($path, $fcmd) = search($main::cmd, $cmd, "pl") unless $path && $fcmd; if ($path && $cmd) { dbg("path: $cmd cmd: $fcmd") if isdbg('command'); @@ -630,40 +637,42 @@ sub search my @parts = split '/', $short_cmd; my $dirfn; my $curdir = $path; - my $p; - my $i; - my @lparts; - for ($i = 0; $i < @parts; $i++) { - my $p = $parts[$i]; - opendir(D, $curdir) or confess "can't open $curdir $!"; - my @ls = readdir D; - closedir D; - my $l; - foreach $l (sort @ls) { - next if $l =~ /^\./; - if ($i < $#parts) { # we are dealing with directories - if ((-d "$curdir/$l") && $p eq substr($l, 0, length $p)) { - dbg("got dir: $curdir/$l\n") if isdbg('command'); - $dirfn .= "$l/"; - $curdir .= "/$l"; - last; - } - } else { # we are dealing with commands - @lparts = split /\./, $l; - next if $lparts[$#lparts] ne $suffix; # only look for .$suffix files - if ($p eq substr($l, 0, length $p)) { - pop @lparts; # remove the suffix - $l = join '.', @lparts; - # chop $dirfn; # remove trailing / - $dirfn = "" unless $dirfn; - $cmd_cache{$short_cmd} = join(',', ($path, "$dirfn$l")); # cache it - dbg("got path: $path cmd: $dirfn$l\n") if isdbg('command'); - return ($path, "$dirfn$l"); - } - } - } - } + while (my $p = shift @parts) { + opendir(D, $curdir) or confess "can't open $curdir $!"; + my @ls = readdir D; + closedir D; + + # if this isn't the last part + if (@parts) { + my $found; + foreach my $l (sort @ls) { + next if $l =~ /^\./; + if ((-d "$curdir/$l") && $p eq substr($l, 0, length $p)) { + dbg("got dir: $curdir/$l\n") if isdbg('command'); + $dirfn .= "$l/"; + $curdir .= "/$l"; + $found++; + last; + } + } + # only proceed if we find the directory asked for + return () unless $found; + } else { + foreach my $l (sort @ls) { + next if $l =~ /^\./; + next unless $l =~ /\.$suffix$/; + if ($p eq substr($l, 0, length $p)) { + $l =~ s/\.$suffix$//; + $dirfn = "" unless $dirfn; + $cmd_cache{$short_cmd} = join(',', ($path, "$dirfn$l")); # cache it + dbg("got path: $path cmd: $dirfn$l\n") if isdbg('command'); + return ($path, "$dirfn$l"); + } + } + } + } + return (); } @@ -914,7 +923,7 @@ sub wwv return unless $self->{wwv}; if ($self->{wwvfilter}) { - ($filter, $hops) = $self->{wwvfilter}->it(@_ ); + ($filter, $hops) = $self->{wwvfilter}->it(@_[7..$#_] ); return unless $filter; }