my \@pagers = ();
push \@pagers, "$Config{'pager'}" if -x "$Config{'pager'}";
+my \$bindir = "$Config{installscript}";
!GROK!THIS!
use Fcntl; # for sysopen
use Getopt::Std;
use Config '%Config';
+use File::Spec::Functions qw(catfile splitdir);
#
# Perldoc revision #1 -- look up a piece of documentation in .pod format that
my $Is_MSWin32 = $^O eq 'MSWin32';
my $Is_Dos = $^O eq 'dos';
-# refuse to run if we should be tainting and aren't
-# (but regular users deserve protection too, though!)
-if (!($Is_VMS || $Is_MSWin32 || $Is_Dos) && ($> == 0 || $< == 0)
- && !am_taint_checking())
-{
- die "Superuser must not run $0 without security audit and taint checks.\n";
-}
-
sub usage{
warn "@_\n" if @_;
# Erase evidence of previous errors (if any), so exit status is simple.
-v Verbosely describe what's going on
-X use index if present (looks for pod.idx at $Config{archlib})
-q Search the text of questions (not answers) in perlfaq[1-9]
+ -U Run in insecure mode (superuser only)
PageName|ModuleName...
is the name of a piece of documentation that you want to look at. You
}
!NO!SUBS!
-my $getopts = "mhtluvriFf:Xq:n:";
+my $getopts = "mhtluvriFf:Xq:n:U";
print OUT <<"!GET!OPTS!";
use vars qw( @{[map "\$opt_$_", ($getopts =~ /\w/g)]} );
print OUT <<'!NO!SUBS!';
usage if $opt_h;
+
+# refuse to run if we should be tainting and aren't
+# (but regular users deserve protection too, though!)
+if (!($Is_VMS || $Is_MSWin32 || $Is_Dos) && ($> == 0 || $< == 0)
+ && !am_taint_checking())
+{{
+ if ($opt_U) {
+ my $id = eval { getpwnam("nobody") };
+ $id = eval { getpwnam("nouser") } unless defined $id;
+ $id = -2 unless defined $id;
+ eval {
+ $> = $id; # must do this one first!
+ $< = $id;
+ };
+ last if !$@ && $< && $>;
+ }
+ die "Superuser must not run $0 without security audit and taint checks.\n";
+}}
+
$opt_n = "nroff" if !$opt_n;
my $podidx;
eval q{ use lib qw(. lib); 1; } or die;
# don't add if superuser
- if ($< && $>) { # don't be looking too hard now!
- eval q{ use blib; 1 } or die;
+ if ($< && $> && -f "blib") { # don't be looking too hard now!
+ eval q{ use blib; 1 };
+ warn $@ if $@ && $opt_v;
}
}
sub minus_f_nocase {
my($dir,$file) = @_;
- my $path = join('/',$dir,$file); # XXX: dirseps
+ my $path = catfile($dir,$file);
return $path if -f $path and -r _;
if (!$opt_i or $Is_VMS or $Is_MSWin32 or $Is_Dos or $^O eq 'os2') {
# on a case-forgiving file system or if case is important
local($")="/";
my @p = ($dir);
my($p,$cip);
- foreach $p (split(m!/!, $file)){ # XXX: dirseps
- my $try = "@p/$p";
+ foreach $p (splitdir $file){
+ my $try = catfile @p, $p;
stat $try;
if (-d _) {
push @p, $p;
if ( $p eq $global_target) {
- my $tmp_path = join ('/', @p); # XXX: dirseps
+ my $tmp_path = catfile @p;
my $path_f = 0;
for (@global_found) {
$path_f = 1 if $_ eq $tmp_path;
my $ret;
my $i;
my $dir;
- $global_target = (split(m!/!, $s))[-1]; # XXX: dirseps
+ $global_target = (splitdir $s)[-1]; # XXX: why not use File::Basename?
for ($i=0; $i<@dirs; $i++) {
$dir = $dirs[$i];
($dir = VMS::Filespec::unixpath($dir)) =~ s!/\z!! if $Is_VMS;
if ($recurse) {
opendir(D,$dir) or die "Can't opendir $dir: $!";
- my @newdirs = map "$dir/$_", grep { # XXX: dirseps
+ my @newdirs = map catfile($dir, $_), grep {
not /^\.\.?\z/s and
not /^auto\z/s and # save time! don't search auto dirs
- -d "$dir/$_" # XXX: dirseps
+ -d catfile($dir, $_)
} readdir D;
closedir(D) or die "Can't closedir $dir: $!";
next unless @newdirs;
close OUT or die "can't close $tmp: $!";
}
elsif (not $opt_u) {
- my $cmd = "pod2man --lax $file | $opt_n -man";
+ my $cmd = catfile($bindir, 'pod2man') . " --lax $file | $opt_n -man";
$cmd .= " | col -x" if $^O =~ /hpux/;
my $rslt = `$cmd`;
$rslt = filter_nroff($rslt) if $filter;
}
else {
foreach my $pager (@pagers) {
- last if system("$pager $tmp") == 0;
+ if ($Is_VMS) {
+ last if system("$pager $tmp") == 0; # quoting prevents logical expansion
+ } else {
+ last if system("$pager \"$tmp\"") == 0;
+ }
}
}
}
my @found;
foreach (@pages) {
if ($podidx && open(PODIDX, $podidx)) {
- my $searchfor = $_;
- $searchfor =~ s,::,/,g; # XXX: dirseps
+ my $searchfor = catfile split '::';
print STDERR "Searching for '$searchfor' in $podidx\n" if $opt_v;
local $_;
while (<PODIDX>) {
next;
}
print STDERR "Searching for $_\n" if $opt_v;
- # We must look both in @INC for library modules and in PATH
+ # We must look both in @INC for library modules and in $bindir
# for executables, like h2xs or perldoc itself.
- my @searchdirs = @INC;
+ my @searchdirs = ($bindir, @INC);
if ($opt_F) {
next unless -r;
push @found, $_ if $opt_m or containspod($_);
command line in the file C<$Config{archlib}/pod.idx>. The pod.idx file should
contain fully qualified filenames, one per line.
+=item B<-U> run insecurely
+
+Because B<perldoc> does not run properly tainted, and is known to
+have security issues, it will not normally execute as the superuser.
+If you use the B<-U> flag, it will do so, but only after setting
+the effective and real IDs to nobody's or nouser's account, or -2
+if unavailable. If it cannot relinguish its privileges, it will not
+run.
+
=item B<PageName|ModuleName|ProgramName>
The item you want to look up. Nested modules (such as C<File::Basename>)
=head1 VERSION
-This is perldoc v2.01.
+This is perldoc v2.03.
=head1 AUTHOR
=cut
#
+# Version 2.03: Sun Apr 23 16:56:34 BST 2000
+# Hugo van der Sanden <hv@crypt0.demon.co.uk>
+# don't die when 'use blib' fails
+# Version 2.02: Mon Mar 13 18:03:04 MST 2000
+# Tom Christiansen <tchrist@perl.com>
+# Added -U insecurity option
# Version 2.01: Sat Mar 11 15:22:33 MST 2000
# Tom Christiansen <tchrist@perl.com>, querulously.
# Security and correctness patches.
projects / p5sagit/p5-mst-13.2.git / blobdiff