diff options
author | Nick Ing-Simmons <nik@tiuk.ti.com> | 2002-06-19 15:57:16 +0000 |
---|---|---|
committer | Nick Ing-Simmons <nik@tiuk.ti.com> | 2002-06-19 15:57:16 +0000 |
commit | 277dad4e2320e5690f5933980b28aa5eb246f197 (patch) | |
tree | cd610ec3e3fa43eb2e682184723180ecc505663f | |
parent | 0226bbdb9567884ccd3573b0b35272e596fbceba (diff) | |
parent | 5fcb2458e2a089882f7916e0e5d93fae5aa2a607 (diff) | |
download | perl-277dad4e2320e5690f5933980b28aa5eb246f197.tar.gz |
Integrate mainline
p4raw-id: //depot/perlio@17304
-rw-r--r-- | Changes | 214 | ||||
-rw-r--r-- | MANIFEST | 4 | ||||
-rw-r--r-- | ext/POSIX/t/taint.t | 47 | ||||
-rw-r--r-- | lib/File/Spec/NW5.pm | 363 | ||||
-rw-r--r-- | lib/File/Spec/Win32.pm | 9 | ||||
-rw-r--r-- | patchlevel.h | 2 | ||||
-rw-r--r-- | pod/perltodo.pod | 14 | ||||
-rw-r--r-- | utils/perlbug.PL | 33 |
8 files changed, 299 insertions, 387 deletions
@@ -28,6 +28,220 @@ example from http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/ Version v5.7.X Development release working toward v5.8 -------------- ____________________________________________________________________________ +[ 17302] By: jhi on 2002/06/19 14:00:35 + Log: #17301 was only part of the story. + Branch: perl + ! MANIFEST +____________________________________________________________________________ +[ 17301] By: jhi on 2002/06/19 13:53:52 + Log: Make MANIFEST comply with #17297. + Branch: perl + ! MANIFEST +____________________________________________________________________________ +[ 17300] By: jhi on 2002/06/19 13:37:45 + Log: Subject: Re: perlbug mail loop? [PATCH] + From: Richard.Foley@t-online.de + Date: Wed, 19 Jun 2002 15:29:37 +0200 + Message-ID: <17KgXO-0dYZCiC@fwd08.sul.t-online.com> + Branch: perl + ! utils/perlbug.PL +____________________________________________________________________________ +[ 17299] By: jhi on 2002/06/19 13:18:42 + Log: opendir was missing for the list. + Branch: perl + ! pod/perltodo.pod +____________________________________________________________________________ +[ 17298] By: jhi on 2002/06/19 13:01:51 + Log: Integrate perlio: + + [ 17295] + Un-deprecate :raw after all - just define what it means + more precisely. (Pending approval). + Branch: perl + !> lib/PerlIO.pm pod/perldelta.pod pod/perlfunc.pod + !> pod/perlrun.pod +____________________________________________________________________________ +[ 17297] By: jhi on 2002/06/19 12:33:04 + Log: The only difference between NW5.pm and Win32.pm was that + NetWare preferred SYS:/temp over C:/temp for tmpdir(). + Branch: perl + - lib/File/Spec/NW5.pm + ! MANIFEST lib/File/Spec.pm lib/File/Spec/Win32.pm +____________________________________________________________________________ +[ 17296] By: jhi on 2002/06/19 12:20:54 + Log: Subject: [PATCH] POSIX taint tests + From: "Paul Marquess" <Paul.Marquess@btinternet.com> + Date: Wed, 19 Jun 2002 09:29:22 +0100 + Message-ID: <AIEAJICLCBDNAAOLLOKLMEFJEOAA.Paul.Marquess@btinternet.com> + Branch: perl + + ext/POSIX/t/taint.t + ! MANIFEST +____________________________________________________________________________ +[ 17295] By: nick on 2002/06/19 12:14:32 + Log: Un-deprecate :raw after all - just define what it means + more precisely. (Pending approval). + Branch: perlio + ! lib/PerlIO.pm pod/perldelta.pod pod/perlfunc.pod + ! pod/perlrun.pod +____________________________________________________________________________ +[ 17294] By: nick on 2002/06/19 06:09:49 + Log: Integrate mainline + Branch: perlio + !> configure.com ext/Digest/MD5/t/files.t lib/PerlIO.pm + !> lib/perl5db.pl lib/utf8.pm os2/os2_base.t pod/perldelta.pod + !> pod/perlfunc.pod pod/perlipc.pod pod/perlsyn.pod + !> pod/perltodo.pod pod/perlunicode.pod pod/perluniintro.pod + !> toke.c +____________________________________________________________________________ +[ 17293] By: jhi on 2002/06/19 02:00:05 + Log: Subject: [PATCH os2/os2_base.t] Re: Patch 14705 botched. (was Re: os2_base test failed) + From: Michael G Schwern <schwern@pobox.com> + Date: Tue, 18 Jun 2002 21:31:43 -0400 + Message-id: <20020619013143.GF3079@ool-18b93024.dyn.optonline.net> + Branch: perl + ! os2/os2_base.t +____________________________________________________________________________ +[ 17292] By: jhi on 2002/06/18 21:36:21 + Log: This is probably the reason for the GW failures. + Branch: perl + ! ext/Digest/MD5/t/files.t +____________________________________________________________________________ +[ 17291] By: jhi on 2002/06/18 21:28:33 + Log: Debugger tweak from from Peter Scott. + Branch: perl + ! lib/perl5db.pl +____________________________________________________________________________ +[ 17290] By: jhi on 2002/06/18 20:31:10 + Log: To mirror #17285. + Branch: perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 17289] By: jhi on 2002/06/18 20:29:25 + Log: Subject: [PATCH] configure.com: build Encode sub-extensions once and only once + From: "Craig A. Berry" <craigberry@mac.com> + Date: Tue, 18 Jun 2002 10:34:51 -0500 + Message-Id: <5.1.1.5.0.20020618103102.01b643e0@exchi01> + Branch: perl + ! configure.com +____________________________________________________________________________ +[ 17288] By: jhi on 2002/06/18 20:27:58 + Log: Tiny tweaks. + Branch: perl + ! lib/PerlIO.pm pod/perlfunc.pod +____________________________________________________________________________ +[ 17287] By: jhi on 2002/06/18 20:22:56 + Log: Integrate perlio: + + [ 17280] + Slight improvement to :win32 layer + + [ 17282] + More PerlIO doc tweaks - trying to make them document what + happens in current implementation while leaving way open + to "fixing" things. + Branch: perl + !> lib/PerlIO.pm pod/perlfunc.pod win32/win32io.c +____________________________________________________________________________ +[ 17286] By: jhi on 2002/06/18 20:19:25 + Log: Document the "Unicode in package/sub names" problem; + a microfix in toke.c towards the final goal (the fix + removes the need to have quotes around Unicode package + names when calling a method on them) + Branch: perl + ! lib/utf8.pm pod/perldelta.pod pod/perltodo.pod + ! pod/perlunicode.pod pod/perluniintro.pod toke.c +____________________________________________________________________________ +[ 17285] By: rgs on 2002/06/18 19:03:52 + Log: Further clarification about safe pipe opens. + Branch: perl + ! pod/perlipc.pod +____________________________________________________________________________ +[ 17284] By: rgs on 2002/06/18 18:42:49 + Log: perlsyn.pod tweak suggested by Larry. + Branch: perl + ! pod/perlsyn.pod +____________________________________________________________________________ +[ 17283] By: rgs on 2002/06/18 18:25:53 + Log: Subject: [DOC PATCH] perlsyn + From: Elizabeth Mattijsen <liz@dijkmat.nl> + Date: Tue, 18 Jun 2002 13:37:30 +0200 + Message-ID: <4.2.0.58.20020618133610.01956d30@mickey.dijkmat.nl> + + Subject: Re: [DOC PATCH] perlsyn (2) + From: Elizabeth Mattijsen <liz@dijkmat.nl> + Date: Tue, 18 Jun 2002 15:08:17 +0200 + Message-ID: <4.2.0.58.20020618150341.01798100@mickey.dijkmat.nl> + + (Plus tweak by Ronald J Kimball) + Branch: perl + ! pod/perlsyn.pod +____________________________________________________________________________ +[ 17282] By: nick on 2002/06/18 09:14:25 + Log: More PerlIO doc tweaks - trying to make them document what + happens in current implementation while leaving way open + to "fixing" things. + Branch: perlio + ! lib/PerlIO.pm pod/perlfunc.pod +____________________________________________________________________________ +[ 17281] By: nick on 2002/06/18 09:12:59 + Log: Integrate mainline + Branch: perlio + !> Changes Configure config_h.SH installperl patchlevel.h + !> pod/perldelta.pod pod/perlipc.pod +____________________________________________________________________________ +[ 17280] By: nick on 2002/06/18 07:03:08 + Log: Slight improvement to :win32 layer + Branch: perlio + ! win32/win32io.c +____________________________________________________________________________ +[ 17279] By: jhi on 2002/06/18 03:10:42 + Log: Do not install XS::{APItest,Typemap} + Branch: perl + ! installperl +____________________________________________________________________________ +[ 17278] By: jhi on 2002/06/18 02:46:43 + Log: Subject: Re: Do we want XS::APItest installed? + From: Andy Dougherty <doughera@lafayette.edu> + Date: Mon, 17 Jun 2002 16:59:52 -0400 (EDT) + Message-ID: <Pine.SOL.4.10.10206171658290.12935-100000@maxwell.phys.lafayette.edu> + + (rats, forgot to submit the metaconfig change separately) + Branch: metaconfig/U/perl + ! Extensions.U + Branch: perl + ! Configure config_h.SH +____________________________________________________________________________ +[ 17277] By: jhi on 2002/06/18 02:31:26 + Log: "Borrow" Rafael's multiarg open descripion to perldelta, + shuffle the highlights a bit (can't believe the perlio + mention was missing) + Branch: perl + ! pod/perldelta.pod +____________________________________________________________________________ +[ 17276] By: rgs on 2002/06/17 22:46:28 + Log: Document the '-|' open form in perlipc.pod + Branch: perl + ! pod/perlipc.pod +____________________________________________________________________________ +[ 17275] By: gsar on 2002/06/17 19:20:06 + Log: avoid AUTOLOAD() clobbering $! + Branch: maint-5.6/perl + ! ext/DB_File/DB_File.pm ext/Fcntl/Fcntl.pm + ! ext/File/Glob/Glob.pm ext/GDBM_File/GDBM_File.pm + ! ext/Socket/Socket.pm ext/Sys/Syslog/Syslog.pm + ! lib/AutoLoader.pm utils/h2xs.PL +____________________________________________________________________________ +[ 17274] By: nick on 2002/06/17 14:50:35 + Log: Integrate mainline + Branch: perlio + !> README.vms lib/File/Basename.pm lib/PerlIO.pm lib/open.pm + !> pod/perlfunc.pod pod/perlrun.pod +____________________________________________________________________________ +[ 17273] By: jhi on 2002/06/17 14:34:17 + Log: Update Changes. + Branch: perl + ! Changes patchlevel.h +____________________________________________________________________________ [ 17272] By: jhi on 2002/06/17 14:21:55 Log: :bytes is not the inverse of :crlf, either (from NI-S) Branch: perl @@ -557,6 +557,7 @@ ext/POSIX/POSIX.pod POSIX extension documentation ext/POSIX/POSIX.xs POSIX extension external subroutines ext/POSIX/t/posix.t See if POSIX works ext/POSIX/t/sigaction.t See if POSIX::sigaction works +ext/POSIX/t/taint.t See if POSIX works with taint ext/POSIX/t/waitpid.t See if waitpid works ext/POSIX/typemap POSIX extension interface types ext/re/hints/mpeix.pl Hints for re for named architecture @@ -1110,14 +1111,13 @@ lib/File/Spec/Cygwin.pm portable operations on Cygwin file names lib/File/Spec/Epoc.pm portable operations on EPOC file names lib/File/Spec/Functions.pm Function interface to File::Spec object methods lib/File/Spec/Mac.pm portable operations on Mac file names -lib/File/Spec/NW5.pm portable operations on NetWare5 file names lib/File/Spec/OS2.pm portable operations on OS2 file names lib/File/Spec/t/Functions.t See if File::Spec::Functions works lib/File/Spec/t/rel2abs2rel.t See if File::Spec->rel2abs/abs2rel works lib/File/Spec/t/Spec.t See if File::Spec works lib/File/Spec/Unix.pm portable operations on Unix file names lib/File/Spec/VMS.pm portable operations on VMS file names -lib/File/Spec/Win32.pm portable operations on Win32 file names +lib/File/Spec/Win32.pm portable operations on Win32 and NetWare file names lib/File/stat.pm By-name interface to Perl's builtin stat lib/File/stat.t See if File::stat works lib/File/Temp.pm create safe temporary files and file handles diff --git a/ext/POSIX/t/taint.t b/ext/POSIX/t/taint.t new file mode 100644 index 0000000000..2fc171b182 --- /dev/null +++ b/ext/POSIX/t/taint.t @@ -0,0 +1,47 @@ +#!./perl -Tw + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require Config; import Config; + if ($^O ne 'VMS' and $Config{'extensions'} !~ /\bPOSIX\b/) { + print "1..0\n"; + exit 0; + } +} + +require "./test.pl"; +use Scalar::Util qw/tainted/; +plan(tests => 5); + + +use POSIX qw(fcntl_h open read mkfifo); +use strict ; + +$| = 1; + +my $buffer; +my @buffer; +my $testfd; + +# Sources of taint: +# The empty tainted value, for tainting strings + +my $TAINT = substr($^X, 0, 0); + +eval { mkfifo($TAINT. "TEST", 0) }; +ok($@ =~ /^Insecure dependency/, 'mkfifo with tainted data'); + +eval { $testfd = open($TAINT. "TEST", O_WRONLY, 0) }; +ok($@ =~ /^Insecure dependency/, 'open with tainted data'); + +eval { $testfd = open("TEST", O_RDONLY, 0) }; +ok($@ eq "", 'open with untainted data'); + +read($testfd, $buffer, 2) if $testfd > 2; +is( $buffer, "#!", ' read' ); +ok(tainted($buffer), ' scalar tainted'); +read($testfd, $buffer[1], 2) if $testfd > 2; + +#is( $buffer[1], "./", ' read' ); +#ok(tainted($buffer[1]), ' array element tainted'); diff --git a/lib/File/Spec/NW5.pm b/lib/File/Spec/NW5.pm deleted file mode 100644 index 30cdd677f4..0000000000 --- a/lib/File/Spec/NW5.pm +++ /dev/null @@ -1,363 +0,0 @@ -package File::Spec::NW5; - - -use Cwd; -use vars qw(@ISA $VERSION); -require File::Spec::Unix; - -$VERSION = '1.3'; - -@ISA = qw(File::Spec::Unix); - -=head1 NAME - -File::Spec::NW5 - methods for NW5 file specs - -=head1 SYNOPSIS - - require File::Spec::NW5; # Done internally by File::Spec if needed - -=head1 DESCRIPTION - -See File::Spec::Unix for a documentation of the methods provided -there. This package overrides the implementation of these methods, not -the semantics. - -=over 4 - -=item devnull - -Returns a string representation of the null device. - -=cut - -sub devnull { - return "nul"; -} - -=item tmpdir - -Returns a string representation of the first existing directory -from the following list: - - $ENV{TMPDIR} - $ENV{TEMP} - $ENV{TMP} - SYS:/temp - /tmp - / - -Since perl 5.8.0, if running under taint mode, and if the environment -variables are tainted, they are not used. - -=cut - -my $tmpdir; -sub tmpdir { - return $tmpdir if defined $tmpdir; - my $self = shift; - my @dirlist = (@ENV{qw(TMPDIR TEMP TMP)}, qw(SYS:/temp /tmp /)); - { - no strict 'refs'; - if (${"\cTAINT"}) { # Check for taint mode on perl >= 5.8.0 - require Scalar::Util; - @dirlist = grep { ! Scalar::Util::tainted $_ } @dirlist; - } - } - foreach (@dirlist) { - next unless defined && -d; - $tmpdir = $_; - last; - } - $tmpdir = '' unless defined $tmpdir; - $tmpdir = $self->canonpath($tmpdir); - return $tmpdir; -} - -sub case_tolerant { - return 1; -} - -sub file_name_is_absolute { - my ($self,$file) = @_; - return scalar($file =~ m{^([a-z]:)?[\\/]}is); -} - -=item catfile - -Concatenate one or more directory names and a filename to form a -complete path ending with a filename - -=cut - -sub catfile { - my $self = shift; - my $file = pop @_; - return $file unless @_; - my $dir = $self->catdir(@_); - $dir .= "\\" unless substr($dir,-1) eq "\\"; - return $dir.$file; -} - -sub path { - my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'}; - my @path = split(';',$path); - foreach (@path) { $_ = '.' if $_ eq '' } - return @path; -} - -=item canonpath - -No physical check on the filesystem, but a logical cleanup of a -path. On UNIX eliminated successive slashes and successive "/.". - -=cut - -sub canonpath { - my ($self,$path) = @_; - $path =~ s/^([a-z]:)/\u$1/s; - $path =~ s|/|\\|g; - $path =~ s|([^\\])\\+|$1\\|g; # xx\\\\xx -> xx\xx - $path =~ s|(\\\.)+\\|\\|g; # xx\.\.\xx -> xx\xx - $path =~ s|^(\.\\)+||s unless $path eq ".\\"; # .\xx -> xx - $path =~ s|\\\Z(?!\n)|| - unless $path =~ m#^([A-Z]:)?\\\Z(?!\n)#s; # xx\ -> xx - return $path; -} - -=item splitpath - - ($volume,$directories,$file) = File::Spec->splitpath( $path ); - ($volume,$directories,$file) = File::Spec->splitpath( $path, $no_file ); - -Splits a path in to volume, directory, and filename portions. Assumes that -the last file is a path unless the path ends in '\\', '\\.', '\\..' -or $no_file is true. On NW5 this means that $no_file true makes this return -( $volume, $path, undef ). - -Separators accepted are \ and /. - -Volumes can be drive letters or UNC sharenames (\\server\share). - -The results can be passed to L</catpath> to get back a path equivalent to -(usually identical to) the original path. - -=cut - -sub splitpath { - my ($self,$path, $nofile) = @_; - my ($volume,$directory,$file) = ('','',''); - if ( $nofile ) { - $path =~ - m{^( (?:[a-zA-Z]:|(?:\\\\|//)[^\\/]+[\\/][^\\/]+)? ) - (.*) - }xs; - $volume = $1; - $directory = $2; - } - else { - $path =~ - m{^ ( (?: [a-zA-Z]: | - (?:\\\\|//)[^\\/]+[\\/][^\\/]+ - )? - ) - ( (?:.*[\\\\/](?:\.\.?\Z(?!\n))?)? ) - (.*) - }xs; - $volume = $1; - $directory = $2; - $file = $3; - } - - return ($volume,$directory,$file); -} - - -=item splitdir - -The opposite of L<catdir()|File::Spec/catdir()>. - - @dirs = File::Spec->splitdir( $directories ); - -$directories must be only the directory portion of the path on systems -that have the concept of a volume or that have path syntax that differentiates -files from directories. - -Unlike just splitting the directories on the separator, leading empty and -trailing directory entries can be returned, because these are significant -on some OSs. So, - - File::Spec->splitdir( "/a/b/c" ); - -Yields: - - ( '', 'a', 'b', '', 'c', '' ) - -=cut - -sub splitdir { - my ($self,$directories) = @_ ; - # - # split() likes to forget about trailing null fields, so here we - # check to be sure that there will not be any before handling the - # simple case. - # - if ( $directories !~ m|[\\/]\Z(?!\n)| ) { - return split( m|[\\/]|, $directories ); - } - else { - # - # since there was a trailing separator, add a file name to the end, - # then do the split, then replace it with ''. - # - my( @directories )= split( m|[\\/]|, "${directories}dummy" ) ; - $directories[ $#directories ]= '' ; - return @directories ; - } -} - - -=item catpath - -Takes volume, directory and file portions and returns an entire path. Under -Unix, $volume is ignored, and this is just like catfile(). On other OSs, -the $volume become significant. - -=cut - -sub catpath { - my ($self,$volume,$directory,$file) = @_; - - # If it's UNC, make sure the glue separator is there, reusing - # whatever separator is first in the $volume - $volume .= $1 - if ( $volume =~ m@^([\\/])[\\/][^\\/]+[\\/][^\\/]+\Z(?!\n)@s && - $directory =~ m@^[^\\/]@s - ) ; - - $volume .= $directory ; - - # If the volume is not just A:, make sure the glue separator is - # there, reusing whatever separator is first in the $volume if possible. - if ( $volume !~ m@^[a-zA-Z]:\Z(?!\n)@s && - $volume =~ m@[^\\/]\Z(?!\n)@ && - $file =~ m@[^\\/]@ - ) { - $volume =~ m@([\\/])@ ; - my $sep = $1 ? $1 : '\\' ; - $volume .= $sep ; - } - - $volume .= $file ; - - return $volume ; -} - - -sub abs2rel { - my($self,$path,$base) = @_; - - # Clean up $path - if ( ! $self->file_name_is_absolute( $path ) ) { - $path = $self->rel2abs( $path ) ; - } - else { - $path = $self->canonpath( $path ) ; - } - - # Figure out the effective $base and clean it up. - if ( !defined( $base ) || $base eq '' ) { - $base = cwd() ; - } - elsif ( ! $self->file_name_is_absolute( $base ) ) { - $base = $self->rel2abs( $base ) ; - } - else { - $base = $self->canonpath( $base ) ; - } - - # Split up paths - my ( undef, $path_directories, $path_file ) = - $self->splitpath( $path, 1 ) ; - - my $base_directories = ($self->splitpath( $base, 1 ))[1] ; - - # Now, remove all leading components that are the same - my @pathchunks = $self->splitdir( $path_directories ); - my @basechunks = $self->splitdir( $base_directories ); - - while ( @pathchunks && - @basechunks && - lc( $pathchunks[0] ) eq lc( $basechunks[0] ) - ) { - shift @pathchunks ; - shift @basechunks ; - } - - # No need to catdir, we know these are well formed. - $path_directories = CORE::join( '\\', @pathchunks ); - $base_directories = CORE::join( '\\', @basechunks ); - - # $base_directories now contains the directories the resulting relative - # path must ascend out of before it can descend to $path_directory. So, - # replace all names with $parentDir - - #FA Need to replace between backslashes... - $base_directories =~ s|[^\\]+|..|g ; - - # Glue the two together, using a separator if necessary, and preventing an - # empty result. - - #FA Must check that new directories are not empty. - if ( $path_directories ne '' && $base_directories ne '' ) { - $path_directories = "$base_directories\\$path_directories" ; - } else { - $path_directories = "$base_directories$path_directories" ; - } - - return $self->canonpath( - $self->catpath( "", $path_directories, $path_file ) - ) ; -} - - -sub rel2abs { - my ($self,$path,$base ) = @_; - - if ( ! $self->file_name_is_absolute( $path ) ) { - - if ( !defined( $base ) || $base eq '' ) { - $base = cwd() ; - } - elsif ( ! $self->file_name_is_absolute( $base ) ) { - $base = $self->rel2abs( $base ) ; - } - else { - $base = $self->canonpath( $base ) ; - } - - my ( $path_directories, $path_file ) = - ($self->splitpath( $path, 1 ))[1,2] ; - - my ( $base_volume, $base_directories ) = - $self->splitpath( $base, 1 ) ; - - $path = $self->catpath( - $base_volume, - $self->catdir( $base_directories, $path_directories ), - $path_file - ) ; - } - - return $self->canonpath( $path ) ; -} - -=back - -=head1 SEE ALSO - -L<File::Spec> - -=cut - -1; diff --git a/lib/File/Spec/Win32.pm b/lib/File/Spec/Win32.pm index ea9a62029e..186052bb4d 100644 --- a/lib/File/Spec/Win32.pm +++ b/lib/File/Spec/Win32.pm @@ -43,11 +43,14 @@ from the following list: $ENV{TMPDIR} $ENV{TEMP} $ENV{TMP} + SYS:/temp C:/temp /tmp / -Since perl 5.8.0, if running under taint mode, and if the environment +The SYS:/temp is preferred in Novell NetWare. + +Since Perl 5.8.0, if running under taint mode, and if the environment variables are tainted, they are not used. =cut @@ -354,6 +357,10 @@ sub rel2abs { =back +=head2 Note For File::Spec::Win32 Maintainers + +Novell NetWare inherits its File::Spec behaviour from File::Spec::Win32. + =head1 SEE ALSO L<File::Spec> diff --git a/patchlevel.h b/patchlevel.h index bee72b4218..3772b7a718 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -79,7 +79,7 @@ #if !defined(PERL_PATCHLEVEL_H_IMPLICIT) && !defined(LOCAL_PATCH_COUNT) static char *local_patches[] = { NULL - ,"DEVEL17272" + ,"DEVEL17302" ,NULL }; diff --git a/pod/perltodo.pod b/pod/perltodo.pod index 5f9a6cf2d0..a19dfd87ee 100644 --- a/pod/perltodo.pod +++ b/pod/perltodo.pod @@ -678,13 +678,13 @@ This emulation should also go near pp_sys.pp_truncate(). =head2 Unicode in Filenames -chdir, chmod, chown, chroot, exec, glob, link, lstat, mkdir, open, qx, -readdir, readlink, rename, rmdir, stat, symlink, sysopen, system, -truncate, unlink, utime. All these could potentially accept Unicode -filenames either as input or output (and in the case of system and qx -Unicode in general, as input or output to/from the shell). Whether a -filesystem - an operating system pair understands Unicode in filenames -varies. +chdir, chmod, chown, chroot, exec, glob, link, lstat, mkdir, open, +opendir, qx, readdir, readlink, rename, rmdir, stat, symlink, sysopen, +system, truncate, unlink, utime. All these could potentially accept +Unicode filenames either as input or output (and in the case of system +and qx Unicode in general, as input or output to/from the shell). +Whether a filesystem - an operating system pair understands Unicode in +filenames varies. Known combinations that have some level of understanding include Microsoft NTFS, Apple HFS+ (In Mac OS 9 and X) and Apple UFS (in Mac diff --git a/utils/perlbug.PL b/utils/perlbug.PL index 27fde11ac3..cf2103db78 100644 --- a/utils/perlbug.PL +++ b/utils/perlbug.PL @@ -91,7 +91,7 @@ BEGIN { $::HaveUtil = ($@ eq ""); }; -my $Version = "1.33"; +my $Version = "1.34"; # Changed in 1.06 to skip Mail::Send and Mail::Util if not available. # Changed in 1.07 to see more sendmail execs, and added pipe output. @@ -129,13 +129,14 @@ my $Version = "1.33"; # Changed in 1.31 Add checks on close().Fix my $var unless. TJENNESS 26-07-2000 # Changed in 1.32 Use File::Spec->tmpdir TJENNESS 20-08-2000 # Changed in 1.33 Don't require -t STDOUT for -ok. +# Changed in 1.34 Added Message-Id RFOLEY 18-06-2002 # TODO: - Allow the user to re-name the file on mail failure, and # make sure failure (transmission-wise) of Mail::Send is # accounted for. # - Test -b option -my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename, +my( $file, $usefile, $cc, $address, $perlbug, $testaddress, $filename, $messageid, $domain, $subject, $from, $verbose, $ed, $outfile, $Is_MacOS, $category, $severity, $fh, $me, $Is_MSWin32, $Is_Linux, $Is_VMS, $msg, $body, $andcc, %REP, $ok); @@ -252,7 +253,7 @@ sub Init { # Body of report $body = $::opt_b || ""; - + # Editor $ed = $::opt_e || $ENV{VISUAL} || $ENV{EDITOR} || $ENV{EDIT} || ($Is_VMS && "edit/tpu") @@ -314,6 +315,18 @@ EOF || $::Config{'cf_email'} || $::Config{'cf_by'} ); + if ($::HaveUtil) { + $domain = Mail::Util::maildomain(); + } elsif ($Is_MSWin32) { + $domain = $ENV{'USERDOMAIN'}; + } else { + require Sys::Hostname; + $domain = Sys::Hostname::hostname(); + } + + # Message-Id - rjsf + $messageid = "<$::Config{'version'}_${$}_".time."\@$domain>"; + # My username $me = $Is_MSWin32 ? $ENV{'USERNAME'} : $^O eq 'os2' ? $ENV{'USER'} || $ENV{'LOGNAME'} @@ -381,16 +394,8 @@ EOF } unless ($guess) { - my $domain; - if ($::HaveUtil) { - $domain = Mail::Util::maildomain(); - } elsif ($Is_MSWin32) { - $domain = $ENV{'USERDOMAIN'}; - } else { - require Sys::Hostname; - $domain = Sys::Hostname::hostname(); - } - if ($domain) { + # move $domain to where we can use it elsewhere + if ($domain) { if ($Is_VMS && !$::Config{'d_socket'}) { $guess = "$domain\:\:$me"; } else { @@ -750,6 +755,7 @@ EOF print FILE "To: $address\nSubject: $subject\n"; print FILE "Cc: $cc\n" if $cc; print FILE "Reply-To: $from\n" if $from; + print FILE "Message-Id: $messageid\n" if $messageid; print FILE "\n"; while (<REP>) { print FILE } close(REP) or die "Error closing report file `$filename': $!"; @@ -886,6 +892,7 @@ sendout: print SENDMAIL "Subject: $subject\n"; print SENDMAIL "Cc: $cc\n" if $cc; print SENDMAIL "Reply-To: $from\n" if $from; + print SENDMAIL "Message-Id: $messageid\n" if $messageid; print SENDMAIL "\n\n"; open(REP, "<$filename") or die "Couldn't open `$filename': $!\n"; while (<REP>) { print SENDMAIL $_ } |