Change 22258 by [EMAIL PROTECTED] on 2004/02/01 17:40:02

        Subject: Re: [perl #15063] /tmp issues
        From: Solar Designer <[EMAIL PROTECTED]> 
        Date: Mon, 26 Jan 2004 01:22:18 +0300
        Message-ID: <[EMAIL PROTECTED]>
        
        Remove insecure usage of /tmp from code and documentation

Affected files ...

... //depot/perl/ext/DB_File/DB_File.pm#48 edit
... //depot/perl/ext/DB_File/t/db-recno.t#27 edit
... //depot/perl/ext/Devel/PPPort/PPPort.pm#30 edit
... //depot/perl/ext/IO/t/io_unix.t#2 edit
... //depot/perl/ext/ODBM_File/ODBM_File.xs#24 edit
... //depot/perl/ext/POSIX/POSIX.pod#38 edit
... //depot/perl/ext/Socket/Socket.pm#27 edit
... //depot/perl/ext/Storable/Storable.pm#48 edit
... //depot/perl/ext/Time/HiRes/Makefile.PL#23 edit
... //depot/perl/lib/CGI/Cookie.pm#16 edit
... //depot/perl/lib/ExtUtils/MakeMaker.pm#117 edit
... //depot/perl/lib/ExtUtils/instmodsh#4 edit
... //depot/perl/lib/Memoize/t/tie.t#8 edit
... //depot/perl/lib/Memoize/t/tie_gdbm.t#5 edit
... //depot/perl/lib/Memoize/t/tie_ndbm.t#8 edit
... //depot/perl/lib/Memoize/t/tie_sdbm.t#11 edit
... //depot/perl/lib/Memoize/t/tie_storable.t#6 edit
... //depot/perl/lib/Shell.pm#18 edit
... //depot/perl/lib/dotsh.pl#9 edit
... //depot/perl/lib/perl5db.pl#104 edit
... //depot/perl/mpeix/nm#4 edit
... //depot/perl/mpeix/relink#7 edit
... //depot/perl/perly.fixer#14 edit
... //depot/perl/pod/perl571delta.pod#18 edit
... //depot/perl/pod/perl58delta.pod#10 edit
... //depot/perl/pod/perldbmfilter.pod#7 edit
... //depot/perl/pod/perldebug.pod#52 edit
... //depot/perl/pod/perlfaq5.pod#56 edit
... //depot/perl/pod/perlfaq8.pod#41 edit
... //depot/perl/pod/perlfunc.pod#426 edit
... //depot/perl/pod/perlipc.pod#53 edit
... //depot/perl/pod/perllexwarn.pod#25 edit
... //depot/perl/pod/perlobj.pod#27 edit
... //depot/perl/pod/perlop.pod#117 edit
... //depot/perl/pod/perlopentut.pod#20 edit
... //depot/perl/utils/c2ph.PL#12 edit

Differences ...

==== //depot/perl/ext/DB_File/DB_File.pm#48 (text) ====
Index: perl/ext/DB_File/DB_File.pm
--- perl/ext/DB_File/DB_File.pm#47~21981~       Sat Dec 27 12:14:09 2003
+++ perl/ext/DB_File/DB_File.pm Sun Feb  1 09:40:02 2004
@@ -1821,7 +1821,7 @@
     use DB_File ;
 
     my %hash ;
-    my $filename = "/tmp/filt" ;
+    my $filename = "filt" ;
     unlink $filename ;
 
     my $db = tie %hash, 'DB_File', $filename, O_CREAT|O_RDWR, 0666, $DB_HASH 
@@ -1863,7 +1863,7 @@
     use strict ;
     use DB_File ;
     my %hash ;
-    my $filename = "/tmp/filt" ;
+    my $filename = "filt" ;
     unlink $filename ;
 
 
@@ -1894,8 +1894,8 @@
 
 The locking technique went like this. 
 
-    $db = tie(%db, 'DB_File', '/tmp/foo.db', O_CREAT|O_RDWR, 0666)
-        || die "dbcreat /tmp/foo.db $!";
+    $db = tie(%db, 'DB_File', 'foo.db', O_CREAT|O_RDWR, 0644)
+        || die "dbcreat foo.db $!";
     $fd = $db->fd;
     open(DB_FH, "+<&=$fd") || die "dup $!";
     flock (DB_FH, LOCK_EX) || die "flock: $!";

==== //depot/perl/ext/DB_File/t/db-recno.t#27 (xtext) ====
Index: perl/ext/DB_File/t/db-recno.t
--- perl/ext/DB_File/t/db-recno.t#26~21981~     Sat Dec 27 12:14:09 2003
+++ perl/ext/DB_File/t/db-recno.t       Sun Feb  1 09:40:02 2004
@@ -1198,7 +1198,7 @@
 
 my $testnum = 181;
 my $failed = 0;
-require POSIX; my $tmp = POSIX::tmpnam();
+my $tmp = "dbr$$";
 foreach my $test (@tests) {
     my $err = test_splice(@$test);
     if (defined $err) {

==== //depot/perl/ext/Devel/PPPort/PPPort.pm#30 (text) ====
Index: perl/ext/Devel/PPPort/PPPort.pm
--- perl/ext/Devel/PPPort/PPPort.pm#29~21915~   Sun Dec 14 23:43:50 2003
+++ perl/ext/Devel/PPPort/PPPort.pm     Sun Feb  1 09:40:02 2004
@@ -349,13 +349,13 @@
        }
        
        if ($changes) {
-               open(OUT,">/tmp/ppport.h.$$");
+               open(OUT,"ppport.h.$$");
                print OUT $c;
                close(OUT);
-               open(DIFF, "diff -u $filename /tmp/ppport.h.$$|");
-               while (<DIFF>) { s!/tmp/ppport\.h\.$$!$filename.patched!; print 
STDOUT; }
+               open(DIFF, "diff -u $filename ppport.h.$$|");
+               while (<DIFF>) { s!ppport\.h\.$$!$filename.patched!; print STDOUT; }
                close(DIFF);
-               unlink("/tmp/ppport.h.$$");
+               unlink("ppport.h.$$");
        } else {
                print "Looks OK\n";
        }

==== //depot/perl/ext/IO/t/io_unix.t#2 (text) ====
Index: perl/ext/IO/t/io_unix.t
--- perl/ext/IO/t/io_unix.t#1~20268~    Mon Jul 28 07:31:17 2003
+++ perl/ext/IO/t/io_unix.t     Sun Feb  1 09:40:02 2004
@@ -24,7 +24,7 @@
        elsif ($^O eq 'os2') {
            require IO::Socket;
 
-           eval {IO::Socket::pack_sockaddr_un('/tmp/foo') || 1}
+           eval {IO::Socket::pack_sockaddr_un('/foo/bar') || 1}
              or $@ !~ /not implemented/ or
                $reason = 'compiled without TCP/IP stack v4';
        } elsif ($^O =~ m/^(?:qnx|nto|vos)$/ ) {
@@ -37,7 +37,7 @@
     }
 }
 
-$PATH = "/tmp/sock-$$";
+$PATH = "sock-$$";
 
 # Test if we can create the file within the tmp directory
 if (-e $PATH or not open(TEST, ">$PATH") and $^O ne 'os2') {

==== //depot/perl/ext/ODBM_File/ODBM_File.xs#24 (text) ====
Index: perl/ext/ODBM_File/ODBM_File.xs
--- perl/ext/ODBM_File/ODBM_File.xs#23~17761~   Thu Aug 22 19:54:09 2002
+++ perl/ext/ODBM_File/ODBM_File.xs     Sun Feb  1 09:40:02 2004
@@ -32,7 +32,7 @@
  * Set DBM_BUG_DUPLICATE_FREE in the extension hint file.
  */
 /* Close the previous dbm, and fail to open a new dbm */
-#define dbmclose()     ((void) dbminit("/tmp/x/y/z/z/y"))
+#define dbmclose()     ((void) dbminit("/non/exist/ent"))
 #endif
 
 #include <fcntl.h>

==== //depot/perl/ext/POSIX/POSIX.pod#38 (text) ====
Index: perl/ext/POSIX/POSIX.pod
--- perl/ext/POSIX/POSIX.pod#37~20081~  Tue Jul  8 22:53:56 2003
+++ perl/ext/POSIX/POSIX.pod    Sun Feb  1 09:40:02 2004
@@ -417,9 +417,9 @@
 uses file descriptors such as those obtained by calling C<POSIX::open>.
 
 The following will determine the maximum length of the longest allowable
-pathname on the filesystem which holds C</tmp/foo>.
+pathname on the filesystem which holds C</var/foo>.
 
-       $fd = POSIX::open( "/tmp/foo", &POSIX::O_RDONLY );
+       $fd = POSIX::open( "/var/foo", &POSIX::O_RDONLY );
        $path_max = POSIX::fpathconf( $fd, &POSIX::_PC_PATH_MAX );
 
 Returns C<undef> on failure.
@@ -919,7 +919,7 @@
 
 Open a directory for reading.
 
-       $dir = POSIX::opendir( "/tmp" );
+       $dir = POSIX::opendir( "/var" );
        @files = POSIX::readdir( $dir );
        POSIX::closedir( $dir );
 
@@ -930,9 +930,9 @@
 Retrieves the value of a configurable limit on a file or directory.
 
 The following will determine the maximum length of the longest allowable
-pathname on the filesystem which holds C</tmp>.
+pathname on the filesystem which holds C</var>.
 
-       $path_max = POSIX::pathconf( "/tmp", &POSIX::_PC_PATH_MAX );
+       $path_max = POSIX::pathconf( "/var", &POSIX::_PC_PATH_MAX );
 
 Returns C<undef> on failure.
 

==== //depot/perl/ext/Socket/Socket.pm#27 (text) ====
Index: perl/ext/Socket/Socket.pm
--- perl/ext/Socket/Socket.pm#26~20704~ Thu Aug 14 07:36:45 2003
+++ perl/ext/Socket/Socket.pm   Sun Feb  1 09:40:02 2004
@@ -32,8 +32,8 @@
 
     $proto = getprotobyname('tcp');
     socket(Socket_Handle, PF_UNIX, SOCK_STREAM, $proto);
-    unlink('/tmp/usock');
-    $sun = sockaddr_un('/tmp/usock');
+    unlink('/var/run/usock');
+    $sun = sockaddr_un('/var/run/usock');
     connect(Socket_Handle,$sun);
 
 =head1 DESCRIPTION

==== //depot/perl/ext/Storable/Storable.pm#48 (text) ====
Index: perl/ext/Storable/Storable.pm
--- perl/ext/Storable/Storable.pm#47~22205~     Sat Jan 24 03:03:36 2004
+++ perl/ext/Storable/Storable.pm       Sun Feb  1 09:40:02 2004
@@ -791,10 +791,10 @@
 
        %color = ('Blue' => 0.1, 'Red' => 0.8, 'Black' => 0, 'White' => 1);
 
-       store(\%color, '/tmp/colors') or die "Can't store %a in /tmp/colors!\n";
+       store(\%color, 'mycolors') or die "Can't store %a in mycolors!\n";
 
-       $colref = retrieve('/tmp/colors');
-       die "Unable to retrieve from /tmp/colors!\n" unless defined $colref;
+       $colref = retrieve('mycolors');
+       die "Unable to retrieve from mycolors!\n" unless defined $colref;
        printf "Blue is still %lf\n", $colref->{'Blue'};
 
        $colref2 = dclone(\%color);

==== //depot/perl/ext/Time/HiRes/Makefile.PL#23 (text) ====
Index: perl/ext/Time/HiRes/Makefile.PL
--- perl/ext/Time/HiRes/Makefile.PL#22~21567~   Tue Oct 28 00:48:06 2003
+++ perl/ext/Time/HiRes/Makefile.PL     Sun Feb  1 09:40:02 2004
@@ -71,19 +71,11 @@
 # without changing it, and then I'd always forget to change it before a
 # release. Sorry, Edward :)
 
-sub TMPDIR {
-    my $TMPDIR =
-       (grep(defined $_ && -d $_ && -w _,
-             ((defined $ENV{'TMPDIR'} ? $ENV{'TMPDIR'} : undef),
-              qw(/var/tmp /usr/tmp /tmp c:/temp))))[0];
-    $TMPDIR || die "Cannot find writable temporary directory.\n";
-}
-
 sub try_compile_and_link {
     my ($c, %args) = @_;
 
     my ($ok) = 0;
-    my ($tmp) = (($^O eq 'VMS') ? "sys\$scratch:tmp$$" : TMPDIR() . '/' . "tmp$$");
+    my ($tmp) = "tmp$$";
     local(*TMPC);
 
     my $obj_ext = $Config{obj_ext} || ".o";

==== //depot/perl/lib/CGI/Cookie.pm#16 (text) ====
Index: perl/lib/CGI/Cookie.pm
--- perl/lib/CGI/Cookie.pm#15~21928~    Fri Dec 19 00:36:11 2003
+++ perl/lib/CGI/Cookie.pm      Sun Feb  1 09:40:02 2004
@@ -407,7 +407,7 @@
 You may also retrieve cookies that were stored in some external
 form using the parse() class method:
 
-       $COOKIES = `cat /usr/tmp/Cookie_stash`;
+       $COOKIES = `cat /some/path/Cookie_stash`;
        %cookies = parse CGI::Cookie($COOKIES);
 
 If you are in a mod_perl environment, you can save some overhead by

==== //depot/perl/lib/ExtUtils/MakeMaker.pm#117 (text) ====
Index: perl/lib/ExtUtils/MakeMaker.pm
--- perl/lib/ExtUtils/MakeMaker.pm#116~21918~   Tue Dec 16 14:00:39 2003
+++ perl/lib/ExtUtils/MakeMaker.pm      Sun Feb  1 09:40:02 2004
@@ -1018,7 +1018,7 @@
 The Makefile to be produced may be altered by adding arguments of the
 form C<KEY=VALUE>. E.g.
 
-  perl Makefile.PL PREFIX=/tmp/myperl5
+  perl Makefile.PL PREFIX=~/myperl5
 
 Other interesting targets in the generated Makefile are
 
@@ -1369,13 +1369,13 @@
 
 This is the root directory into which the code will be installed.  It
 I<prepends itself to the normal prefix>.  For example, if your code
-would normally go into /usr/local/lib/perl you could set DESTDIR=/tmp/
-and installation would go into /tmp/usr/local/lib/perl.
+would normally go into /usr/local/lib/perl you could set DESTDIR=/other/
+and installation would go into /other/usr/local/lib/perl.
 
 This is primarily of use for people who repackage Perl modules.
 
 NOTE: Due to the nature of make, it is important that you put the trailing
-slash on your DESTDIR.  "/tmp/" not "/tmp".
+slash on your DESTDIR.  "/other/" not "/other".
 
 =item DIR
 

==== //depot/perl/lib/ExtUtils/instmodsh#4 (text) ====
Index: perl/lib/ExtUtils/instmodsh
--- perl/lib/ExtUtils/instmodsh#3~21918~        Tue Dec 16 14:00:39 2003
+++ perl/lib/ExtUtils/instmodsh Sun Feb  1 09:40:02 2004
@@ -105,7 +105,6 @@
     my($reply, $module) = @_;
 
     my $file = (split(' ', $reply))[1];
-    my $tmp = "/tmp/inst.$$";
 
     if( !(defined $file and length $file) ) {
         print "No tar file specified\n";

==== //depot/perl/lib/Memoize/t/tie.t#8 (xtext) ====
Index: perl/lib/Memoize/t/tie.t
--- perl/lib/Memoize/t/tie.t#7~17508~   Fri Jul 12 13:06:23 2002
+++ perl/lib/Memoize/t/tie.t    Sun Feb  1 09:40:02 2004
@@ -29,14 +29,7 @@
   $_[0]+1;
 }
 
-if (eval {require File::Spec::Functions}) {
-  File::Spec::Functions->import('tmpdir', 'catfile');
-  $tmpdir = tmpdir();
-} else {
-  *catfile = sub { join '/', @_ };
-  $tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
-}
-$file = catfile($tmpdir, "md$$");
+$file = "md$$";
 @files = ($file, "$file.db", "$file.dir", "$file.pag");
 1 while unlink @files;
 

==== //depot/perl/lib/Memoize/t/tie_gdbm.t#5 (xtext) ====
Index: perl/lib/Memoize/t/tie_gdbm.t
--- perl/lib/Memoize/t/tie_gdbm.t#4~17508~      Fri Jul 12 13:06:23 2002
+++ perl/lib/Memoize/t/tie_gdbm.t       Sun Feb  1 09:40:02 2004
@@ -26,13 +26,7 @@
 
 print "1..4\n";
 
-if (eval {require File::Spec::Functions}) {
- File::Spec::Functions->import();
-} else {
-  *catfile = sub { join '/', @_ };
-}
-$tmpdir = $ENV{TMP} || $ENV{TMPDIR} ||  '/tmp';  
-$file = catfile($tmpdir, "md$$");
+$file = "md$$";
 1 while unlink $file, "$file.dir", "$file.pag";
 tryout('GDBM_File', $file, 1);  # Test 1..4
 1 while unlink $file, "$file.dir", "$file.pag";

==== //depot/perl/lib/Memoize/t/tie_ndbm.t#8 (text) ====
Index: perl/lib/Memoize/t/tie_ndbm.t
--- perl/lib/Memoize/t/tie_ndbm.t#7~17508~      Fri Jul 12 13:06:23 2002
+++ perl/lib/Memoize/t/tie_ndbm.t       Sun Feb  1 09:40:02 2004
@@ -28,14 +28,7 @@
 
 print "1..4\n";
 
-
-if (eval {require File::Spec::Functions}) {
- File::Spec::Functions->import();
-} else {
-  *catfile = sub { join '/', @_ };
-}
-$tmpdir = $ENV{TMP} || $ENV{TMPDIR} ||  '/tmp';  
-$file = catfile($tmpdir, "md$$");
+$file = "md$$";
 1 while unlink $file, "$file.dir", "$file.pag";
 tryout('Memoize::NDBM_File', $file, 1);  # Test 1..4
 1 while unlink $file, "$file.dir", "$file.pag";

==== //depot/perl/lib/Memoize/t/tie_sdbm.t#11 (text) ====
Index: perl/lib/Memoize/t/tie_sdbm.t
--- perl/lib/Memoize/t/tie_sdbm.t#10~21234~     Mon Sep 15 12:17:03 2003
+++ perl/lib/Memoize/t/tie_sdbm.t       Sun Feb  1 09:40:02 2004
@@ -28,14 +28,7 @@
 
 print "1..4\n";
 
-if (eval {require File::Spec::Functions}) {
- File::Spec::Functions->import('tmpdir', 'catfile');
- $tmpdir = tmpdir();
-} else {
- *catfile = sub { join '/', @_ };
-  $tmpdir = $ENV{TMP} || $ENV{TMPDIR} || '/tmp';
-}
-$file = catfile($tmpdir, "md$$");
+$file = "md$$";
 1 while unlink $file, "$file.dir", "$file.pag";
 if ( $^O eq 'VMS' ) {
     1 while unlink "$file.sdbm_dir";

==== //depot/perl/lib/Memoize/t/tie_storable.t#6 (text) ====
Index: perl/lib/Memoize/t/tie_storable.t
--- perl/lib/Memoize/t/tie_storable.t#5~17508~  Fri Jul 12 13:06:23 2002
+++ perl/lib/Memoize/t/tie_storable.t   Sun Feb  1 09:40:02 2004
@@ -33,14 +33,7 @@
 
 print "1..4\n";
 
-
-if (eval {require File::Spec::Functions}) {
- File::Spec::Functions->import();
-} else {
-  *catfile = sub { join '/', @_ };
-}
-$tmpdir = $ENV{TMP} || $ENV{TMPDIR} ||  '/tmp';  
-$file = catfile($tmpdir, "storable$$");
+$file = "storable$$";
 1 while unlink $file;
 tryout('Memoize::Storable', $file, 1);  # Test 1..4
 1 while unlink $file;

==== //depot/perl/lib/Shell.pm#18 (text) ====
Index: perl/lib/Shell.pm
--- perl/lib/Shell.pm#17~22254~ Sun Feb  1 05:11:00 2004
+++ perl/lib/Shell.pm   Sun Feb  1 09:40:02 2004
@@ -144,7 +144,7 @@
     sub ps;
     print ps -ww;
 
-    cp("/etc/passwd", "/tmp/passwd");
+    cp("/etc/passwd", "/etc/passwd.orig");
 
 That's maybe too gonzo.  It actually exports an AUTOLOAD to the current
 package (and uncovered a bug in Beta 3, by the way).  Maybe the usual

==== //depot/perl/lib/dotsh.pl#9 (text) ====
Index: perl/lib/dotsh.pl
--- perl/lib/dotsh.pl#8~3759~   Sun Jul 25 22:12:24 1999
+++ perl/lib/dotsh.pl   Sun Feb  1 09:40:02 2004
@@ -27,9 +27,9 @@
 #         dependent upon. These variables MUST be defined using shell syntax.
 #
 #   Example:
-#      &dotsh ('/tmp/foo', 'arg1');
-#      &dotsh ('/tmp/foo');
-#      &dotsh ('/tmp/foo arg1 ... argN');
+#      &dotsh ('/foo/bar', 'arg1');
+#      &dotsh ('/foo/bar');
+#      &dotsh ('/foo/bar arg1 ... argN');
 #
 sub dotsh {
    local(@sh) = @_;
@@ -54,19 +54,17 @@
       }
    }
    if (length($vars) > 0) {
-      system "$shell \"$vars;. $command $args; set > /tmp/_sh_env$$\"";
+      open (_SH_ENV, "$shell \"$vars && . $command $args && set \" |") || die;
    } else {
-      system "$shell \". $command $args; set > /tmp/_sh_env$$\"";
+      open (_SH_ENV, "$shell \". $command $args && set \" |") || die;
    }
 
-   open (_SH_ENV, "/tmp/_sh_env$$") || die "Could not open /tmp/_sh_env$$!\n";
    while (<_SH_ENV>) {
        chop;
        m/^([^=]*)=(.*)/s;
        $ENV{$1} = $2;
    }
    close (_SH_ENV);
-   system "rm -f /tmp/_sh_env$$";
 
    foreach $key (keys(%ENV)) {
        $tmp .= "\$$key = \$ENV{'$key'};" if $key =~ /^[A-Za-z]\w*$/;

==== //depot/perl/lib/perl5db.pl#104 (text) ====
Index: perl/lib/perl5db.pl
--- perl/lib/perl5db.pl#103~22041~      Thu Jan  1 16:38:00 2004
+++ perl/lib/perl5db.pl Sun Feb  1 09:40:02 2004
@@ -95,7 +95,7 @@
 # TTY  - the TTY to use for debugging i/o.
 #
 # noTTY - if set, goes in NonStop mode.  On interrupt if TTY is not set
-# uses the value of noTTY or "/tmp/perldbtty$$" to find TTY using
+# uses the value of noTTY or ".perldbtty$$" to find TTY using
 # Term::Rendezvous.  Current variant is to have the name of TTY in this
 # file.
 #
@@ -2227,7 +2227,7 @@
            select($sel);
        } else {
            eval "require Term::Rendezvous;" or die;
-           my $rv = $ENV{PERLDB_NOTTY} || "/tmp/perldbtty$$";
+           my $rv = $ENV{PERLDB_NOTTY} || ".perldbtty$$";
            my $term_rv = new Term::Rendezvous $rv;
            $IN = $term_rv->IN;
            $OUT = $term_rv->OUT;

==== //depot/perl/mpeix/nm#4 (xtext) ====
Index: perl/mpeix/nm
--- perl/mpeix/nm#3~17582~      Tue Jul 16 13:18:32 2002
+++ perl/mpeix/nm       Sun Feb  1 09:40:02 2004
@@ -22,12 +22,12 @@
 # I wanted to pipe this into awk, but it fell victim to a known pipe/streams
 # bug on my multiprocessor machine.
 
-callci xeq linkedit.pub.sys \"$LIST\" >/tmp/nm.$$
+callci xeq linkedit.pub.sys \"$LIST\" >nm.$$
 
 /bin/awk '\
     / data  univ / { printf "%-20s|%10s|%-6s|%-7s|%s\n",$1,$5,"extern","data","?"} \
-    / entry univ / { printf "%-20s|%10s|%-6s|%-7s|%s\n",$1,$7,"extern","entry","?"}' 
/tmp/nm.$$
+    / entry univ / { printf "%-20s|%10s|%-6s|%-7s|%s\n",$1,$7,"extern","entry","?"}' 
nm.$$
 
-rm -f /tmp/nm.$$
+rm -f nm.$$
 
 exit 0

==== //depot/perl/mpeix/relink#7 (xtext) ====
Index: perl/mpeix/relink
--- perl/mpeix/relink#6~15590~  Thu Mar 28 18:59:03 2002
+++ perl/mpeix/relink   Sun Feb  1 09:40:02 2004
@@ -14,7 +14,7 @@
 
 echo "Creating $RAND.sl...\n"
 
-TEMP=/tmp/perlmpe.$$
+TEMP=perlmpe.$$
 
 rm -f $TEMP $RAND.a $RAND.sl
 

==== //depot/perl/perly.fixer#14 (xtext) ====
Index: perl/perly.fixer
--- perl/perly.fixer#13~18282~  Wed Dec 11 02:16:05 2002
+++ perl/perly.fixer    Sun Feb  1 09:40:02 2004
@@ -23,7 +23,7 @@
 
 input=$1
 output=$2
-tmp=/tmp/f$$
+tmp=perly$$
 
 inputh=`echo $input|sed 's:\.c$:.h:'`
 if grep '^#ifdef PERL_CORE' $inputh; then

==== //depot/perl/pod/perl571delta.pod#18 (text) ====
Index: perl/pod/perl571delta.pod
--- perl/pod/perl571delta.pod#17~17055~ Fri Jun  7 06:01:19 2002
+++ perl/pod/perl571delta.pod   Sun Feb  1 09:40:02 2004
@@ -771,17 +771,17 @@
 If your file system supports symbolic links you can build Perl outside
 of the source directory by
 
-       mkdir /tmp/perl/build/directory
-       cd /tmp/perl/build/directory
+       mkdir perl/build/directory
+       cd perl/build/directory
        sh /path/to/perl/source/Configure -Dmksymlinks ...
 
-This will create in /tmp/perl/build/directory a tree of symbolic links
+This will create in perl/build/directory a tree of symbolic links
 pointing to files in /path/to/perl/source.  The original files are left
 unaffected.  After Configure has finished you can just say
 
        make all test
 
-and Perl will be built and tested, all in /tmp/perl/build/directory.
+and Perl will be built and tested, all in perl/build/directory.
 
 =back
 

==== //depot/perl/pod/perl58delta.pod#10 (text) ====
Index: perl/pod/perl58delta.pod
--- perl/pod/perl58delta.pod#9~22100~   Thu Jan  8 09:35:27 2004
+++ perl/pod/perl58delta.pod    Sun Feb  1 09:40:02 2004
@@ -1905,17 +1905,17 @@
 If your file system supports symbolic links, you can build Perl outside
 of the source directory by
 
-       mkdir /tmp/perl/build/directory
-       cd /tmp/perl/build/directory
+       mkdir perl/build/directory
+       cd perl/build/directory
        sh /path/to/perl/source/Configure -Dmksymlinks ...
 
-This will create in /tmp/perl/build/directory a tree of symbolic links
+This will create in perl/build/directory a tree of symbolic links
 pointing to files in /path/to/perl/source.  The original files are left
 unaffected.  After Configure has finished, you can just say
 
        make all test
 
-and Perl will be built and tested, all in /tmp/perl/build/directory.
+and Perl will be built and tested, all in perl/build/directory.
 [561]
 
 =item *

==== //depot/perl/pod/perldbmfilter.pod#7 (text) ====
Index: perl/pod/perldbmfilter.pod
--- perl/pod/perldbmfilter.pod#6~12338~ Thu Oct  4 15:54:06 2001
+++ perl/pod/perldbmfilter.pod  Sun Feb  1 09:40:02 2004
@@ -91,7 +91,7 @@
     use Fcntl ;
 
     my %hash ;
-    my $filename = "/tmp/filt" ;
+    my $filename = "filt" ;
     unlink $filename ;
 
     my $db = tie(%hash, 'SDBM_File', $filename, O_RDWR|O_CREAT, 0640)
@@ -137,7 +137,7 @@
     use warnings ;
     use DB_File ;
     my %hash ;
-    my $filename = "/tmp/filt" ;
+    my $filename = "filt" ;
     unlink $filename ;
 
 

==== //depot/perl/pod/perldebug.pod#52 (text) ====
Index: perl/pod/perldebug.pod
--- perl/pod/perldebug.pod#51~20202~    Thu Jul 24 06:12:08 2003
+++ perl/pod/perldebug.pod      Sun Feb  1 09:40:02 2004
@@ -700,7 +700,7 @@
 with two methods: C<IN> and C<OUT>.  These should return filehandles to use
 for debugging input and output correspondingly.  The C<new> method should
 inspect an argument containing the value of C<$ENV{PERLDB_NOTTY}> at
-startup, or C<"/tmp/perldbtty$$"> otherwise.  This file is not 
+startup, or C<".perldbtty$$"> otherwise.  This file is not 
 inspected for proper ownership, so security hazards are theoretically
 possible.
 

==== //depot/perl/pod/perlfaq5.pod#56 (text) ====
Index: perl/pod/perlfaq5.pod
--- perl/pod/perlfaq5.pod#55~21835~     Tue Dec  2 14:18:05 2003
+++ perl/pod/perlfaq5.pod       Sun Feb  1 09:40:02 2004
@@ -141,6 +141,7 @@
            my $count = 0;
            until (defined(fileno(FH)) || $count++ > 100) {
                $base_name =~ s/-(\d+)$/"-" . (1 + $1)/e;
+               # O_EXCL is required for security reasons.
                sysopen(FH, $base_name, O_WRONLY|O_EXCL|O_CREAT);
            }
            if (defined(fileno(FH))
@@ -427,8 +428,8 @@
 
 To open a file without blocking, creating if necessary:
 
-    sysopen(FH, "/tmp/somefile", O_WRONLY|O_NDELAY|O_CREAT)
-           or die "can't open /tmp/somefile: $!":
+    sysopen(FH, "/foo/somefile", O_WRONLY|O_NDELAY|O_CREAT)
+           or die "can't open /foo/somefile: $!":
 
 Be warned that neither creation nor deletion of files is guaranteed to
 be an atomic operation over NFS.  That is, two processes might both
@@ -924,7 +925,7 @@
 If you check L<perlfunc/open>, you'll see that several of the ways
 to call open() should do the trick.  For example:
 
-    open(LOG, ">>/tmp/logfile");
+    open(LOG, ">>/foo/logfile");
     open(STDERR, ">&LOG");
 
 Or even with a literal numeric descriptor:

==== //depot/perl/pod/perlfaq8.pod#41 (text) ====
Index: perl/pod/perlfaq8.pod
--- perl/pod/perlfaq8.pod#40~21283~     Thu Sep 18 14:29:23 2003
+++ perl/pod/perlfaq8.pod       Sun Feb  1 09:40:02 2004
@@ -749,10 +749,10 @@
     while (<PH>) { }                            #    plus a read
 
 To read both a command's STDOUT and its STDERR separately, it's easiest
-and safest to redirect them separately to files, and then read from those
-files when the program is done:
+to redirect them separately to files, and then read from those files
+when the program is done:
 
-    system("program args 1>/tmp/program.stdout 2>/tmp/program.stderr");
+    system("program args 1>program.stdout 2>program.stderr");
 
 Ordering is important in all these examples.  That's because the shell
 processes file descriptor redirections in strictly left to right order.
@@ -1063,8 +1063,8 @@
 sysopen():
 
     use Fcntl;
-    sysopen(FH, "/tmp/somefile", O_WRONLY|O_NDELAY|O_CREAT, 0644)
-        or die "can't open /tmp/somefile: $!":
+    sysopen(FH, "/foo/somefile", O_WRONLY|O_NDELAY|O_CREAT, 0644)
+        or die "can't open /foo/somefile: $!":
 
 =head2 How do I install a module from CPAN?
 

==== //depot/perl/pod/perlfunc.pod#426 (text) ====
Index: perl/pod/perlfunc.pod
--- perl/pod/perlfunc.pod#425~22252~    Sat Jan 31 09:29:05 2004
+++ perl/pod/perlfunc.pod       Sun Feb  1 09:40:02 2004
@@ -2929,7 +2929,7 @@
     open(ARTICLE, "caesar <$article |")                # ditto
        or die "Can't start caesar: $!";
 
-    open(EXTRACT, "|sort >/tmp/Tmp$$")         # $$ is our process id
+    open(EXTRACT, "|sort >Tmp$$")              # $$ is our process id
        or die "Can't start sort: $!";
 
     # in memory files

==== //depot/perl/pod/perlipc.pod#53 (text) ====
Index: perl/pod/perlipc.pod
--- perl/pod/perlipc.pod#52~20813~      Thu Aug 21 21:57:12 2003
+++ perl/pod/perlipc.pod        Sun Feb  1 09:40:02 2004
@@ -1030,7 +1030,7 @@
     use strict;
     my ($rendezvous, $line);
 
-    $rendezvous = shift || '/tmp/catsock';
+    $rendezvous = shift || 'catsock';
     socket(SOCK, PF_UNIX, SOCK_STREAM, 0)      || die "socket: $!";
     connect(SOCK, sockaddr_un($rendezvous))    || die "connect: $!";
     while (defined($line = <SOCK>)) {
@@ -1051,7 +1051,7 @@
     sub spawn;  # forward declaration
     sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
 
-    my $NAME = '/tmp/catsock';
+    my $NAME = 'catsock';
     my $uaddr = sockaddr_un($NAME);
     my $proto = getprotobyname('tcp');
 

==== //depot/perl/pod/perllexwarn.pod#25 (text) ====
Index: perl/pod/perllexwarn.pod
--- perl/pod/perllexwarn.pod#24~19808~  Tue Jun 17 14:10:06 2003
+++ perl/pod/perllexwarn.pod    Sun Feb  1 09:40:02 2004
@@ -383,9 +383,9 @@
     sub open {
         my $path = shift ;
         if ($path !~ m#^/#) {
-            warnings::warn("changing relative path to /tmp/")
+            warnings::warn("changing relative path to /var/abc")
                 if warnings::enabled();
-            $path = "/tmp/$path" ; 
+            $path = "/var/abc/$path";
         }
     }
 

==== //depot/perl/pod/perlobj.pod#27 (text) ====
Index: perl/pod/perlobj.pod
--- perl/pod/perlobj.pod#26~22037~      Thu Jan  1 15:22:10 2004
+++ perl/pod/perlobj.pod        Sun Feb  1 09:40:02 2004
@@ -535,15 +535,15 @@
     warn "time to die...";
     exit;
 
-When run as F</tmp/test>, the following output is produced:
+When run as F</foo/test>, the following output is produced:
 
-    starting program at /tmp/test line 18.
-    CREATING SCALAR(0x8e5b8) at /tmp/test line 7.
-    CREATING SCALAR(0x8e57c) at /tmp/test line 7.
-    leaving block at /tmp/test line 23.
-    DESTROYING Subtle=SCALAR(0x8e5b8) at /tmp/test line 13.
-    just exited block at /tmp/test line 26.
-    time to die... at /tmp/test line 27.
+    starting program at /foo/test line 18.
+    CREATING SCALAR(0x8e5b8) at /foo/test line 7.
+    CREATING SCALAR(0x8e57c) at /foo/test line 7.
+    leaving block at /foo/test line 23.
+    DESTROYING Subtle=SCALAR(0x8e5b8) at /foo/test line 13.
+    just exited block at /foo/test line 26.
+    time to die... at /foo/test line 27.
     DESTROYING Subtle=SCALAR(0x8e57c) during global destruction.
 
 Notice that "global destruction" bit there?  That's the thread

==== //depot/perl/pod/perlop.pod#117 (text) ====
Index: perl/pod/perlop.pod
--- perl/pod/perlop.pod#116~22108~      Sat Jan 10 13:33:59 2004
+++ perl/pod/perlop.pod Sun Feb  1 09:40:02 2004
@@ -1185,10 +1185,10 @@
     $output = `cmd 3>&1 1>&2 2>&3 3>&-`;
 
 To read both a command's STDOUT and its STDERR separately, it's easiest
-and safest to redirect them separately to files, and then read from those
-files when the program is done:
+to redirect them separately to files, and then read from those files
+when the program is done:
 
-    system("program args 1>/tmp/program.stdout 2>/tmp/program.stderr");
+    system("program args 1>program.stdout 2>program.stderr");
 
 Using single-quote as a delimiter protects the command from Perl's
 double-quote interpolation, passing it on to the shell instead:

==== //depot/perl/pod/perlopentut.pod#20 (text) ====
Index: perl/pod/perlopentut.pod
--- perl/pod/perlopentut.pod#19~21040~  Thu Sep  4 21:36:48 2003
+++ perl/pod/perlopentut.pod    Sun Feb  1 09:40:02 2004
@@ -192,11 +192,11 @@
     open(WTMP, "+< /usr/adm/wtmp") 
         || die "can't open /usr/adm/wtmp: $!";
 
-    open(SCREEN, "+> /tmp/lkscreen")
-        || die "can't open /tmp/lkscreen: $!";
+    open(SCREEN, "+> lkscreen")
+        || die "can't open lkscreen: $!";
 
-    open(LOGFILE, "+>> /tmp/applog"
-        || die "can't open /tmp/applog: $!";
+    open(LOGFILE, "+>> /var/log/applog"
+        || die "can't open /var/log/applog: $!";
 
 The first one won't create a new file, and the second one will always
 clobber an old one.  The third one will create a new file if necessary

==== //depot/perl/utils/c2ph.PL#12 (text) ====
Index: perl/utils/c2ph.PL
--- perl/utils/c2ph.PL#11~19837~        Sun Jun 22 08:56:45 2003
+++ perl/utils/c2ph.PL  Sun Feb  1 09:40:02 2004
@@ -280,6 +280,7 @@
 
 $RCSID = '$Id: c2ph,v 1.7 95/10/28 10:41:47 tchrist Exp Locker: tchrist $';
 
+use File::Temp;
 
 ######################################################################
 
@@ -480,6 +481,13 @@
     printf "%-16s%-15s  %s\n", $var, eval "\$$var", $msg;
 }
 
+sub safedir {
+    $SAFEDIR = File::Temp::tempdir("c2ph.XXXXXX", TMPDIR => 1, CLEANUP => 1)
+      unless (defined($SAFEDIR));
+}
+
+undef $SAFEDIR;
+
 $recurse = 1;
 
 if (@ARGV) {
@@ -495,15 +503,15 @@
     }
     elsif (@ARGV == 1 && $ARGV[0] =~ /\.c$/) {
        local($dir, $file) = $ARGV[0] =~ m#(.*/)?(.*)$#;
-       $chdir = "cd $dir; " if $dir;
+       $chdir = "cd $dir && " if $dir;
        &system("$chdir$CC $CFLAGS $DEFINES $file") && exit 1;
        $ARGV[0] =~ s/\.c$/.s/;
     }
     else {
-       $TMPDIR = tempdir(CLEANUP => 1);
-       $TMP = "$TMPDIR/c2ph.$$.c";
+       &safedir;
+       $TMP = "$SAFEDIR/c2ph.$$.c";
        &system("cat @ARGV > $TMP") && exit 1;
-       &system("cd $TMPDIR; $CC $CFLAGS $DEFINES $TMP") && exit 1;
+       &system("cd $SAFEDIR && $CC $CFLAGS $DEFINES $TMP") && exit 1;
        unlink $TMP;
        $TMP =~ s/\.c$/.s/;
        @ARGV = ($TMP);
@@ -1274,8 +1282,8 @@
 }
 
 sub compute_intrinsics {
-    $TMPDIR ||= tempdir(CLEANUP => 1);
-    local($TMP) = "$TMPDIR/c2ph-i.$$.c";
+    &safedir;
+    local($TMP) = "$SAFEDIR/c2ph-i.$$.c";
     open (TMP, ">$TMP") || die "can't open $TMP: $!";
     select(TMP);
 
@@ -1303,7 +1311,7 @@
     close TMP;
 
     select(STDOUT);
-    open(PIPE, "cd $TMPDIR && $CC $TMP && $TMPDIR/a.out|");
+    open(PIPE, "cd $SAFEDIR && $CC $TMP && $SAFEDIR/a.out|");
     while (<PIPE>) {
        chop;
        split(' ',$_,2);;
@@ -1312,7 +1320,7 @@
        $intrinsics{$_[1]} = $template{$_[0]};
     }
     close(PIPE) || die "couldn't read intrinsics!";
-    unlink($TMP, '$TMPDIR/a.out');
+    unlink($TMP, '$SAFEDIR/a.out');
     print STDERR "done\n" if $trace;
 }
 
End of Patch.

Reply via email to