In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/9c6681cc159f89641fc077464b7f7b3fcf64e6f1?hp=3ff4feb5bd226622062600b4127bb8c276c9d5ec>
- Log -----------------------------------------------------------------
commit 9c6681cc159f89641fc077464b7f7b3fcf64e6f1
Merge: 3ff4feb5bd 1b4d0d79ac
Author: Tony Cook <t...@develop-help.com>
Date: Mon Sep 11 14:48:21 2017 +1000
[perl #127663] safer in-place editing
-----------------------------------------------------------------------
Summary of changes:
Configure | 26 +++
Cross/config.sh-arm-linux | 5 +
INSTALL | 6 +
NetWare/config.wc | 5 +
Porting/Glossary | 20 ++
Porting/config.sh | 5 +
config_h.SH | 25 +++
configure.com | 5 +
doio.c | 482 ++++++++++++++++++++++++++++++++++++++--------
embed.fnc | 5 +
embed.h | 1 +
embedvar.h | 1 +
intrpvar.h | 8 +
mg.c | 36 ++++
perl.c | 37 +++-
plan9/config_sh.sample | 5 +
pod/perldiag.pod | 16 +-
pod/perlrun.pod | 12 ++
pp_sort.c | 2 +-
proto.h | 8 +
symbian/config.sh | 5 +
t/io/fs.t | 27 +--
t/io/nargv.t | 24 ++-
t/run/switches.t | 221 ++++++++++++++++++++-
uconfig.h | 29 ++-
uconfig.sh | 5 +
uconfig64.sh | 5 +
util.c | 38 +++-
util.h | 10 +
win32/config.ce | 5 +
win32/config.gc | 5 +
win32/config.vc | 5 +
32 files changed, 978 insertions(+), 111 deletions(-)
diff --git a/Configure b/Configure
index bdcfaf17ef..3736fae165 100755
--- a/Configure
+++ b/Configure
@@ -383,6 +383,11 @@ d_alarm=''
asctime_r_proto=''
d_asctime_r=''
d_asinh=''
+d_openat=''
+d_unlinkat=''
+d_renameat=''
+d_linkat=''
+d_fchmodat=''
d_atanh=''
d_attribute_deprecated=''
d_attribute_format=''
@@ -19769,6 +19774,22 @@ esac
set strxfrm d_strxfrm
eval $inlibc
+: check for openat, unlinkat, renameat, linkat, fchmodat
+set openat d_openat
+eval $inlibc
+
+set unlinkat d_unlinkat
+eval $inlibc
+
+set renameat d_renameat
+eval $inlibc
+
+set linkat d_linkat
+eval $inlibc
+
+set fchmodat d_fchmodat
+eval $inlibc
+
: see if symlink exists
set symlink d_symlink
eval $inlibc
@@ -24445,6 +24466,11 @@ d_asctime64='$d_asctime64'
d_asctime_r='$d_asctime_r'
d_asinh='$d_asinh'
d_atanh='$d_atanh'
+d_openat='$d_openat'
+d_unlinkat='$d_unlinkat'
+d_renameat='$d_renameat'
+d_linkat='$d_linkat'
+d_fchmodat='$d_fchmodat'
d_atolf='$d_atolf'
d_atoll='$d_atoll'
d_attribute_deprecated='$d_attribute_deprecated'
diff --git a/Cross/config.sh-arm-linux b/Cross/config.sh-arm-linux
index 1477fb7405..96a408de31 100644
--- a/Cross/config.sh-arm-linux
+++ b/Cross/config.sh-arm-linux
@@ -202,6 +202,7 @@ d_expm1='undef'
d_faststdio='define'
d_fchdir='define'
d_fchmod='define'
+d_fchmodat='undef'
d_fchown='define'
d_fcntl='define'
d_fcntl_can_lock='define'
@@ -342,6 +343,7 @@ d_lgamma='undef'
d_lgamma_r='undef'
d_libm_lib_version='define'
d_link='define'
+d_linkat='undef'
d_llrint='undef'
d_llrintl='undef'
d_llround='undef'
@@ -420,6 +422,7 @@ d_old_pthread_create_joinable='undef'
d_oldpthreads='undef'
d_oldsock='undef'
d_open3='define'
+d_openat='undef'
d_pathconf='define'
d_pause='define'
d_perl_otherlibdirs='undef'
@@ -458,6 +461,7 @@ d_regcomp='undef'
d_remainder='undef'
d_remquo='undef'
d_rename='define'
+d_renameat='undef'
d_rewinddir='define'
d_rint='undef'
d_rmdir='define'
@@ -606,6 +610,7 @@ d_ualarm='define'
d_umask='define'
d_uname='define'
d_union_semun='undef'
+d_unlinkat='undef'
d_unordered='undef'
d_unsetenv='define'
d_uselocale='undef'
diff --git a/INSTALL b/INSTALL
index 5a88ded723..fbce4f5469 100644
--- a/INSTALL
+++ b/INSTALL
@@ -2721,6 +2721,12 @@ F<mathoms.c> will not be compiled in. Those functions
are no longer used
by perl itself; for source compatibility reasons, though, they weren't
completely removed.
+=head2 C<-DNO_PERL_INTERNAL_RAND_SEED>
+X<PERL_INTERNAL_RAND_SEED>
+
+If you configure perl with C<-Accflags=-DNO_PERL_INTERNAL_RAND_SEED>,
+perl will ignore the C<PERL_INTERNAL_RAND_SEED> enviroment variable.
+
=head1 DOCUMENTATION
Read the manual entries before running perl. The main documentation
diff --git a/NetWare/config.wc b/NetWare/config.wc
index 3150bcbf17..b4e501b9bd 100644
--- a/NetWare/config.wc
+++ b/NetWare/config.wc
@@ -190,6 +190,7 @@ d_expm1='undef'
d_faststdio='undef'
d_fchdir='undef'
d_fchmod='undef'
+d_fchmodat='undef'
d_fchown='undef'
d_fcntl='undef'
d_fcntl_can_lock='undef'
@@ -331,6 +332,7 @@ d_lgamma='undef'
d_lgamma_r='undef'
d_libm_lib_version='undef'
d_link='define'
+d_linkat='undef'
d_llrint='undef'
d_llrintl='undef'
d_llround='undef'
@@ -409,6 +411,7 @@ d_old_pthread_create_joinable='undef'
d_oldpthreads='undef'
d_oldsock='undef'
d_open3='undef'
+d_openat='undef'
d_pathconf='undef'
d_pause='undef'
d_perl_otherlibdirs='undef'
@@ -447,6 +450,7 @@ d_regcomp='undef'
d_remainder='undef'
d_remquo='undef'
d_rename='define'
+d_renameat='undef'
d_rewinddir='define'
d_rint='undef'
d_rmdir='define'
@@ -596,6 +600,7 @@ d_ualarm='undef'
d_umask='define'
d_uname='define'
d_union_semun='define'
+d_unlinkat='undef'
d_unordered='undef'
d_unsetenv='undef'
d_uselocale='undef'
diff --git a/Porting/Glossary b/Porting/Glossary
index a94eaabe8a..cabf016f8e 100644
--- a/Porting/Glossary
+++ b/Porting/Glossary
@@ -849,6 +849,10 @@ d_fchmod (d_fchmod.U):
indicates to the C program that the fchmod() routine is available
to change mode of opened files.
+d_fchmodat (d_fchmodat.U):
+ This variable conditionally defines the HAS_FCHMODAT symbol, which
+ indicates the POSIX fchmodat() function is available.
+
d_fchown (d_fchown.U):
This variable conditionally defines the HAS_FCHOWN symbol, which
indicates to the C program that the fchown() routine is available
@@ -1525,6 +1529,10 @@ d_link (d_link.U):
This variable conditionally defines HAS_LINK if link() is
available to create hard links.
+d_linkat (d_linkat.U):
+ This variable conditionally defines the HAS_LINKAT symbol, which
+ indicates the POSIX linkat() function is available.
+
d_llrint (d_llrint.U):
This variable conditionally defines the HAS_LLRINT symbol, which
indicates to the C program that the llrint() routine is available
@@ -1897,6 +1905,10 @@ d_open3 (d_open3.U):
which indicates to the C program that the 3 argument version of
the open(2) function is available.
+d_openat (d_openat.U):
+ This variable conditionally defines the HAS_OPENAT symbol, which
+ indicates the POSIX openat() function is available.
+
d_pathconf (d_pathconf.U):
This variable conditionally defines the HAS_PATHCONF symbol, which
indicates to the C program that the pathconf() routine is available
@@ -2137,6 +2149,10 @@ d_rename (d_rename.U):
indicates to the C program that the rename() routine is available
to rename files.
+d_renameat (d_renameat.U):
+ This variable conditionally defines the HAS_RENAMEAT symbol, which
+ indicates the POSIX renameat() function is available.
+
d_rewinddir (d_readdir.U):
This variable conditionally defines HAS_REWINDDIR if rewinddir() is
available.
@@ -2821,6 +2837,10 @@ d_union_semun (d_union_semun.U):
This variable conditionally defines HAS_UNION_SEMUN if the
union semun is defined by including <sys/sem.h>.
+d_unlinkat (d_unlinkat.U):
+ This variable conditionally defines the HAS_UNLINKAT symbol, which
+ indicates the POSIX unlinkat() function isavailable.
+
d_unordered (d_unordered.U):
This variable conditionally defines the HAS_UNORDERED symbol, which
indicates to the C program that the unordered() routine is available.
diff --git a/Porting/config.sh b/Porting/config.sh
index 52a3b5a8d2..178db06c21 100644
--- a/Porting/config.sh
+++ b/Porting/config.sh
@@ -211,6 +211,7 @@ d_expm1='define'
d_faststdio='define'
d_fchdir='define'
d_fchmod='define'
+d_fchmodat='undef'
d_fchown='define'
d_fcntl='define'
d_fcntl_can_lock='define'
@@ -352,6 +353,7 @@ d_lgamma_r='define'
d_libm_lib_version='undef'
d_libname_unique='undef'
d_link='define'
+d_linkat='undef'
d_llrint='define'
d_llrintl='define'
d_llround='define'
@@ -430,6 +432,7 @@ d_old_pthread_create_joinable='undef'
d_oldpthreads='undef'
d_oldsock='undef'
d_open3='define'
+d_openat='undef'
d_pathconf='define'
d_pause='define'
d_perl_otherlibdirs='undef'
@@ -470,6 +473,7 @@ d_regcomp='define'
d_remainder='define'
d_remquo='define'
d_rename='define'
+d_renameat='undef'
d_rewinddir='define'
d_rint='define'
d_rmdir='define'
@@ -619,6 +623,7 @@ d_ualarm='define'
d_umask='define'
d_uname='define'
d_union_semun='define'
+d_unlinkat='undef'
d_unordered='undef'
d_unsetenv='define'
d_uselocale='define'
diff --git a/config_h.SH b/config_h.SH
index e9b144f02b..da1a1f3627 100755
--- a/config_h.SH
+++ b/config_h.SH
@@ -63,6 +63,31 @@ sed <<!GROK!THIS! >$CONFIG_H -e
's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un
*/
#$d_alarm HAS_ALARM /**/
+/* HAS_OPENAT:
+ * This symbol is defined if the openat() routine is available.
+ */
+#$d_openat HAS_OPENAT /**/
+
+/* HAS_UNLINKAT:
+ * This symbol is defined if the unlinkat() routine is available.
+ */
+#$d_unlinkat HAS_UNLINKAT /**/
+
+/* HAS_RENAMEAT:
+ * This symbol is defined if the renameat() routine is available.
+ */
+#$d_renameat HAS_RENAMEAT /**/
+
+/* HAS_LINKAT:
+ * This symbol is defined if the linkat() routine is available.
+ */
+#$d_linkat HAS_LINKAT /**/
+
+/* HAS_FCHMODAT:
+ * This symbol is defined if the fchmodat() routine is available.
+ */
+#$d_fchmodat HAS_FCHMODAT /**/
+
/* HAS_BCMP:
* This symbol is defined if the bcmp() routine is available to
* compare blocks of memory.
diff --git a/configure.com b/configure.com
index f54722eab8..f76d8f752c 100644
--- a/configure.com
+++ b/configure.com
@@ -6246,6 +6246,11 @@ $ WC "d_oldarchlib='define'"
$ WC "d_oldpthreads='" + d_oldpthreads + "'"
$ WC "d_oldsock='undef'"
$ WC "d_open3='define'"
+$ WC "d_openat='undef'"
+$ WC "d_unlinkat='undef'"
+$ WC "d_renameat='undef'"
+$ WC "d_linkat='undef'"
+$ WC "d_fchmodat='undef'"
$ WC "d_pathconf='" + d_pathconf + "'"
$ WC "d_pause='define'"
$ WC "d_perl_otherlibdirs='undef'"
diff --git a/doio.c b/doio.c
index 6f4cd84f8c..8c08455eda 100644
--- a/doio.c
+++ b/doio.c
@@ -813,6 +813,172 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char
*mode, const char *oname,
return FALSE;
}
+/* Open a temp file in the same directory as an original name.
+*/
+
+static bool
+S_openindirtemp(pTHX_ GV *gv, SV *orig_name, SV *temp_out_name) {
+ int fd;
+ PerlIO *fp;
+ const char *p = SvPV_nolen(orig_name);
+ const char *sep;
+
+ /* look for the last directory separator */
+ sep = strrchr(p, '/');
+
+#ifdef DOSISH
+ {
+ const char *sep2;
+ if ((sep2 = strrchr(sep ? sep : p, '\\')))
+ sep = sep2;
+ }
+#endif
+#ifdef VMS
+ if (!sep) {
+ const char *openp = strchr(p, '[');
+ if (openp)
+ sep = strchr(openp, ']');
+ else {
+ sep = strchr(p, ':');
+ }
+ }
+#endif
+ if (sep) {
+ sv_setpvn(temp_out_name, p, sep - p + 1);
+ sv_catpvs(temp_out_name, "XXXXXXXX");
+ }
+ else
+ sv_setpvs(temp_out_name, "XXXXXXXX");
+
+ fd = Perl_my_mkstemp(SvPVX(temp_out_name));
+
+ if (fd < 0)
+ return FALSE;
+
+ fp = PerlIO_fdopen(fd, "w+");
+ if (!fp)
+ return FALSE;
+
+ return do_openn(gv, "+>&", 3, 0, 0, 0, fp, NULL, 0);
+}
+
+#if defined(HAS_UNLINKAT) && defined(HAS_RENAMEAT) && defined(HAS_FCHMODAT) &&
\
+ (defined(HAS_DIRFD) || defined(HAS_DIR_DD_FD)) &&
!defined(NO_USE_ATFUNCTIONS)
+# define ARGV_USE_ATFUNCTIONS
+#endif
+
+/* Win32 doesn't necessarily return useful information
+ * in st_dev, st_ino.
+ */
+#ifndef ARGV_USE_ATFUNCTIONS
+# ifndef DOSISH
+# define ARGV_USE_STAT_INO
+# endif
+#endif
+
+#define ARGVMG_BACKUP_NAME 0
+#define ARGVMG_TEMP_NAME 1
+#define ARGVMG_ORIG_NAME 2
+#define ARGVMG_ORIG_MODE 3
+#define ARGVMG_ORIG_PID 4
+
+#if defined(ARGV_USE_ATFUNCTIONS)
+#define ARGVMG_ORIG_DIRP 5
+#elif defined(ARGV_USE_STAT_INO)
+/* we store the entire stat_t since the ino_t and dev_t values might
+ not fit in an IV. I could have created a new structure and
+ transferred them across, but this seemed too much effort for very
+ little win.
+ */
+#define ARGVMG_ORIG_CWD_STAT 5
+#endif
+
+static int
+S_argvout_free(pTHX_ SV *io, MAGIC *mg) {
+ SV **temp_psv;
+
+ PERL_UNUSED_ARG(io);
+
+ /* note this can be entered once the file has been
+ successfully deleted too */
+ assert(IoTYPE(io) != IoTYPE_PIPE);
+
+ /* mg_obj can be NULL if a thread is created with the handle open, in which
+ case we leave any clean up to the parent thread */
+ if (mg->mg_obj && IoIFP(io)) {
+ SV **pid_psv;
+#ifdef ARGV_USE_ATFUNCTIONS
+ SV **dir_psv;
+ DIR *dir;
+#endif
+ PerlIO *iop = IoIFP(io);
+
+ assert(SvTYPE(mg->mg_obj) == SVt_PVAV);
+
+ pid_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_PID, FALSE);
+
+ assert(pid_psv && *pid_psv);
+
+ if (SvIV(*pid_psv) == (IV)PerlProc_getpid()) {
+ /* if we get here the file hasn't been closed explicitly by the
+ user and hadn't been closed implicitly by nextargv(), so
+ abandon the edit */
+ (void)PerlIO_close(iop);
+ IoIFP(io) = IoOFP(io) = NULL;
+ temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE);
+ assert(temp_psv && *temp_psv && SvPOK(*temp_psv));
+#ifdef ARGV_USE_ATFUNCTIONS
+ dir_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_DIRP, FALSE);
+ assert(dir_psv && *dir_psv && SvIOK(*dir_psv));
+ dir = INT2PTR(DIR *, SvIV(*dir_psv));
+ if (dir) {
+ (void)unlinkat(my_dirfd(dir), SvPVX(*temp_psv), 0);
+ closedir(dir);
+ }
+#else
+ (void)UNLINK(SvPVX(*temp_psv));
+#endif
+ }
+ }
+
+ return 0;
+}
+
+static int
+S_argvout_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *param) {
+ PERL_UNUSED_ARG(param);
+
+ /* ideally we could just remove the magic from the SV but we don't get the
SV here */
+ SvREFCNT_dec(mg->mg_obj);
+ mg->mg_obj = NULL;
+
+ return 0;
+}
+
+/* Magic of this type has an AV containing the following:
+ 0: name of the backup file (if any)
+ 1: name of the temp output file
+ 2: name of the original file
+ 3: file mode of the original file
+ 4: pid of the process we opened at, to prevent doing the renaming
+ etc in both the child and the parent after a fork
+
+If we have unlinkat(), renameat(), fchmodat(), dirfd() we also keep:
+ 5: the DIR * for the current directory when we open the file, stored as an
IV
+ */
+
+static const MGVTBL argvout_vtbl =
+ {
+ NULL, /* svt_get */
+ NULL, /* svt_set */
+ NULL, /* svt_len */
+ NULL, /* svt_clear */
+ S_argvout_free, /* svt_free */
+ NULL, /* svt_copy */
+ S_argvout_dup, /* svt_dup */
+ NULL /* svt_local */
+ };
+
PerlIO *
Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
{
@@ -834,15 +1000,14 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
SvREFCNT_inc_simple_NN(PL_defoutgv));
}
}
- if (PL_filemode & (S_ISUID|S_ISGID)) {
- PerlIO_flush(IoIFP(GvIOn(PL_argvoutgv))); /* chmod must follow last
write */
-#ifdef HAS_FCHMOD
- if (PL_lastfd != -1)
- (void)fchmod(PL_lastfd,PL_filemode);
-#else
- (void)PerlLIO_chmod(PL_oldname,PL_filemode);
-#endif
+
+ {
+ IO * const io = GvIOp(PL_argvoutgv);
+ if (io && IoIFP(io) && old_out_name) {
+ do_close(PL_argvoutgv, FALSE);
+ }
}
+
PL_lastfd = -1;
PL_filemode = 0;
if (!GvAV(gv))
@@ -865,13 +1030,6 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
}
else {
Stat_t statbuf;
- {
- IO * const io = GvIOp(PL_argvoutgv);
- if (io && IoIFP(io) && old_out_name && !io_close(io,
PL_argvoutgv, FALSE, FALSE)) {
- Perl_croak(aTHX_ "Failed to close in-place edit file %"
- SVf ": %s\n", old_out_name, Strerror(errno));
- }
- }
/* This very long block ends with return IoIFP(GvIOp(gv));
Both this block and the block above fall through on open
failure to the warning code, and then the while loop above tries
@@ -880,9 +1038,15 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
#ifndef FLEXFILENAMES
int filedev;
int fileino;
+#endif
+#ifdef ARGV_USE_ATFUNCTIONS
+ DIR *curdir;
#endif
Uid_t fileuid;
Gid_t filegid;
+ AV *magic_av = NULL;
+ SV *temp_name_sv = NULL;
+ MAGIC *mg;
TAINT_PROPER("inplace open");
if (oldlen == 1 && *PL_oldname == '-') {
@@ -904,6 +1068,7 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
do_close(gv,FALSE);
continue;
}
+ magic_av = newAV();
if (*PL_inplace && strNE(PL_inplace, "*")) {
const char *star = strchr(PL_inplace, '*');
if (star) {
@@ -933,71 +1098,45 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
"Can't do inplace edit: %"
SVf " would not be unique",
SVfARG(sv));
- do_close(gv,FALSE);
- continue;
- }
-#endif
-#ifdef HAS_RENAME
-#if !defined(DOSISH) && !defined(__CYGWIN__)
- if (PerlLIO_rename(PL_oldname,SvPVX_const(sv)) < 0) {
- Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE),
- "Can't rename %s to %" SVf
- ": %s, skipping file",
- PL_oldname, SVfARG(sv),
- Strerror(errno));
- do_close(gv,FALSE);
- continue;
- }
-#else
- do_close(gv,FALSE);
- (void)PerlLIO_unlink(SvPVX_const(sv));
- (void)PerlLIO_rename(PL_oldname,SvPVX_const(sv));
- do_open_raw(gv, SvPVX_const(sv), SvCUR(sv), O_RDONLY, 0,
NULL);
-#endif /* DOSISH */
-#else
- (void)UNLINK(SvPVX_const(sv));
- if (link(PL_oldname,SvPVX_const(sv)) < 0) {
- Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE),
- "Can't rename %s to %" SVf ": %s,
skipping file",
- PL_oldname, SVfARG(sv),
Strerror(errno) );
- do_close(gv,FALSE);
- continue;
- }
- (void)UNLINK(PL_oldname);
-#endif
- }
- else {
-#if !defined(DOSISH) && !defined(__amigaos4__)
-# ifndef VMS /* Don't delete; use automatic file versioning */
- if (UNLINK(PL_oldname) < 0) {
- Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE),
- "Can't remove %s: %s, skipping file",
- PL_oldname, Strerror(errno) );
- do_close(gv,FALSE);
- continue;
+ goto cleanup_argv;
}
-# endif
-#else
- Perl_croak(aTHX_ "Can't do inplace edit without backup");
#endif
+ av_store(magic_av, ARGVMG_BACKUP_NAME, newSVsv(sv));
}
sv_setpvn(sv,PL_oldname,oldlen);
SETERRNO(0,0); /* in case sprintf set errno */
- if (!Perl_do_open_raw(aTHX_ PL_argvoutgv, SvPVX_const(sv),
- SvCUR(sv),
-#ifdef VMS
- O_WRONLY|O_CREAT|O_TRUNC, 0,
-#else
- O_WRONLY|O_CREAT|OPEN_EXCL, 0600,
-#endif
- NULL)) {
- Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), "Can't do
inplace edit on %s: %s",
+ temp_name_sv = newSV(0);
+ if (!S_openindirtemp(aTHX_ PL_argvoutgv, GvSV(gv),
temp_name_sv)) {
+ SvREFCNT_dec(temp_name_sv);
+ /* diag_listed_as: Can't do inplace edit on %s: %s */
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), "Can't do
inplace edit on %s: Cannot make temp name: %s",
PL_oldname, Strerror(errno) );
- do_close(gv,FALSE);
- continue;
+#ifndef FLEXFILENAMES
+ cleanup_argv:
+#endif
+ do_close(gv,FALSE);
+ SvREFCNT_dec(magic_av);
+ continue;
}
+ av_store(magic_av, ARGVMG_TEMP_NAME, temp_name_sv);
+ av_store(magic_av, ARGVMG_ORIG_NAME, newSVsv(sv));
+ av_store(magic_av, ARGVMG_ORIG_MODE, newSVuv(PL_filemode));
+ av_store(magic_av, ARGVMG_ORIG_PID,
newSViv((IV)PerlProc_getpid()));
+#if defined(ARGV_USE_ATFUNCTIONS)
+ curdir = opendir(".");
+ av_store(magic_av, ARGVMG_ORIG_DIRP, newSViv(PTR2IV(curdir)));
+#elif defined(ARGV_USE_STAT_INO)
+ if (PerlLIO_stat(".", &statbuf) >= 0) {
+ av_store(magic_av, ARGVMG_ORIG_CWD_STAT,
+ newSVpvn((char *)&statbuf, sizeof(statbuf)));
+ }
+#endif
setdefout(PL_argvoutgv);
+ sv_setsv(GvSVn(PL_argvoutgv), temp_name_sv);
+ mg = sv_magicext((SV*)GvIOp(PL_argvoutgv), (SV*)magic_av,
PERL_MAGIC_uvar, &argvout_vtbl, NULL, 0);
+ mg->mg_flags |= MGf_DUP;
+ SvREFCNT_dec(magic_av);
PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv)));
if (PL_lastfd >= 0) {
(void)PerlLIO_fstat(PL_lastfd,&statbuf);
@@ -1039,17 +1178,6 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen)
if (io && (IoFLAGS(io) & IOf_ARGV))
IoFLAGS(io) |= IOf_START;
if (PL_inplace) {
- if (old_out_name) {
- IO * const io = GvIOp(PL_argvoutgv);
- if (io && IoIFP(io) && !io_close(io, PL_argvoutgv, FALSE, FALSE)) {
- Perl_croak(aTHX_ "Failed to close in-place edit file %" SVf ":
%s\n",
- old_out_name, Strerror(errno));
- }
- }
- else {
- /* maybe this is no longer wanted */
- (void)do_close(PL_argvoutgv,FALSE);
- }
if (io && (IoFLAGS(io) & IOf_ARGV)
&& PL_argvout_stack && AvFILLp(PL_argvout_stack) >= 0)
{
@@ -1069,6 +1197,7 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
{
bool retval;
IO *io;
+ MAGIC *mg;
if (!gv)
gv = PL_argvgv;
@@ -1085,7 +1214,194 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit)
}
return FALSE;
}
- retval = io_close(io, NULL, not_implicit, FALSE);
+ if ((mg = mg_findext((SV*)io, PERL_MAGIC_uvar, &argvout_vtbl))
+ && mg->mg_obj) {
+ /* handle to an in-place edit work file */
+ SV **back_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_BACKUP_NAME, FALSE);
+ SV **temp_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_TEMP_NAME, FALSE);
+ /* PL_oldname may have been modified by a nested ARGV use at this
point */
+ SV **orig_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_NAME, FALSE);
+ SV **mode_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_MODE, FALSE);
+ SV **pid_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_PID, FALSE);
+#if defined(ARGV_USE_ATFUNCTIONS)
+ SV **dir_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_DIRP, FALSE);
+ DIR *dir;
+ int dfd;
+#elif defined(ARGV_USE_STAT_INO)
+ SV **stat_psv = av_fetch((AV*)mg->mg_obj, ARGVMG_ORIG_CWD_STAT, FALSE);
+ Stat_t *orig_cwd_stat = stat_psv && *stat_psv ? (Stat_t
*)SvPVX(*stat_psv) : NULL;
+#endif
+#ifndef ARGV_USE_ATFUNCTIONS
+ Stat_t statbuf;
+#endif
+ UV mode;
+ int fd;
+
+ const char *orig_pv;
+
+ assert(temp_psv && *temp_psv);
+ assert(orig_psv && *orig_psv);
+ assert(mode_psv && *mode_psv);
+ assert(pid_psv && *pid_psv);
+#ifdef ARGV_USE_ATFUNCTIONS
+ assert(dir_psv && *dir_psv);
+ dir = INT2PTR(DIR *, SvIVX(*dir_psv));
+ dfd = my_dirfd(dir);
+#endif
+
+ orig_pv = SvPVX(*orig_psv);
+ mode = SvUV(*mode_psv);
+
+ if ((mode & (S_ISUID|S_ISGID)) != 0
+ && (fd = PerlIO_fileno(IoIFP(io))) >= 0) {
+ (void)PerlIO_flush(IoIFP(io));
+#ifdef HAS_FCHMOD
+ (void)fchmod(fd, mode);
+#else
+ (void)PerlLIO_chmod(orig_pv, mode);
+#endif
+ }
+
+ retval = io_close(io, NULL, not_implicit, FALSE);
+
+ if (SvIV(*pid_psv) != (IV)PerlProc_getpid()) {
+ /* this is a child process, don't duplicate our rename() etc
+ processing below */
+ goto freext;
+ }
+
+ if (retval) {
+#ifdef ARGV_USE_STAT_INO
+ /* if the path is absolute the possible moving of cwd (which the
file
+ might be in) isn't our problem.
+ This code tries to be reasonably balanced about detecting a
changed
+ CWD, if we have the information needed to check that curdir has
changed, we
+ check it
+ */
+ if (!PERL_FILE_IS_ABSOLUTE(SvPVX(*orig_psv))
+ && orig_cwd_stat
+ && PerlLIO_stat(".", &statbuf) >= 0
+ && ( statbuf.st_dev != orig_cwd_stat->st_dev
+ || statbuf.st_ino != orig_cwd_stat->st_ino)) {
+ Perl_croak(aTHX_ "Cannot complete in-place edit of %" SVf ":
%s",
+ *orig_psv, "Current directory has changed");
+ }
+#endif
+#if !defined(ARGV_USE_ATFUNCTIONS) && !defined(ARGV_USE_STAT_INO)
+ /* Some platforms don't have useful st_ino etc, so just
+ check we can see the work file.
+ */
+ if (!PERL_FILE_IS_ABSOLUTE(SvPVX(*orig_psv))
+ && PerlLIO_stat(SvPVX(*temp_psv), &statbuf) < 0) {
+ Perl_croak(aTHX_ "Cannot complete in-place edit of %" SVf ":
%s",
+ *orig_psv,
+ "Work file is missing - did you change directory?");
+ }
+#endif
+
+#if defined(DOSISH) || defined(__CYGWIN__)
+ if (PL_argvgv && GvIOp(PL_argvgv)
+ && IoIFP(GvIOp(PL_argvgv))
+ && (IoFLAGS(GvIOp(PL_argvgv)) & (IOf_ARGV|IOf_START)) ==
IOf_ARGV) {
+ do_close(PL_argvgv, FALSE);
+ }
+#endif
+ if (back_psv && *back_psv) {
+#if defined(HAS_LINK) && !defined(DOSISH) && !defined(__CYGWIN__) &&
defined(HAS_RENAME)
+ if (
+# ifdef ARGV_USE_ATFUNCTIONS
+ linkat(dfd, orig_pv, dfd, SvPVX(*back_psv), 0) < 0
+# else
+ link(orig_pv, SvPVX(*back_psv)) < 0
+# endif
+ )
+#endif
+ {
+#ifdef HAS_RENAME
+ if (
+# ifdef ARGV_USE_ATFUNCTIONS
+ renameat(dfd, orig_pv, dfd, SvPVX(*back_psv)) < 0
+# else
+ PerlLIO_rename(orig_pv, SvPVX(*back_psv)) < 0
+# endif
+ ) {
+ if (!not_implicit) {
+# ifdef ARGV_USE_ATFUNCTIONS
+ (void)unlinkat(dfd, SvPVX_const(*temp_psv), 0);
+# else
+ UNLINK(SvPVX(*temp_psv));
+# endif
+ Perl_croak(aTHX_ "Can't rename %s to %s: %s,
skipping file",
+ SvPVX(*orig_psv), SvPVX(*back_psv),
Strerror(errno));
+ }
+ /* should we warn here? */
+ goto abort_inplace;
+ }
+#else
+ (void)UNLINK(SvPVX(*back_psv));
+ if (link(orig_pv, SvPVX(*back_psv))) {
+ if (!not_implicit) {
+ Perl_croak(aTHX_ "Can't rename %s to %s: %s,
skipping file",
+ SvPVX(*orig_psv), SvPVX(*back_psv),
Strerror(errno));
+ }
+ goto abort_inplace;
+ }
+ /* we need to use link() to get the temp into place too,
and linK()
+ fails if the new link name exists */
+ (void)UNLINK(orig_pv);
+#endif
+ }
+ }
+#if defined(DOSISH) || defined(__CYGWIN__) || !defined(HAS_RENAME)
+ else {
+ UNLINK(orig_pv);
+ }
+#endif
+ if (
+#ifdef HAS_RENAME
+# ifdef ARGV_USE_ATFUNCTIONS
+ renameat(dfd, SvPVX(*temp_psv), dfd, orig_pv) < 0
+# else
+ PerlLIO_rename(SvPVX(*temp_psv), orig_pv) < 0
+# endif
+#else
+ link(SvPVX(*temp_psv), orig_pv) < 0
+#endif
+ ) {
+ if (!not_implicit) {
+#ifdef ARGV_USE_ATFUNCTIONS
+ (void)unlinkat(dfd, SvPVX_const(*temp_psv), 0);
+#else
+ UNLINK(SvPVX(*temp_psv));
+#endif
+ Perl_croak(aTHX_ "Can't rename in-place work file '%s' to
'%s': %s\n",
+ SvPVX(*temp_psv), SvPVX(*orig_psv),
Strerror(errno));
+ }
+ abort_inplace:
+ UNLINK(SvPVX_const(*temp_psv));
+ retval = FALSE;
+ }
+#ifndef HAS_RENAME
+ UNLINK(SvPVX(*temp_psv));
+#endif
+ }
+ else {
+#ifdef ARGV_USE_ATFUNCTIONS
+ unlinkat(dfd, SvPVX_const(*temp_psv), 0);
+#else
+ UNLINK(SvPVX_const(*temp_psv));
+#endif
+ if (!not_implicit) {
+ Perl_croak(aTHX_ "Failed to close in-place work file %s: %s",
+ SvPVX(*temp_psv), Strerror(errno));
+ }
+ }
+ freext:
+ mg_freeext((SV*)io, PERL_MAGIC_uvar, &argvout_vtbl);
+ }
+ else {
+ retval = io_close(io, NULL, not_implicit, FALSE);
+ }
if (not_implicit) {
IoLINES(io) = 0;
IoPAGE(io) = 0;
diff --git a/embed.fnc b/embed.fnc
index 44d8d40adf..bcef22ad2e 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1036,6 +1036,7 @@ ApdRn |MAGIC* |mg_findext |NULLOK const SV*
sv|int type|NULLOK const MGVTBL *vtb
EXpR |MAGIC* |mg_find_mglob |NN SV* sv
Apd |int |mg_free |NN SV* sv
Apd |void |mg_free_type |NN SV* sv|int how
+Apd |void |mg_freeext |NN SV* sv|int how|NULLOK const MGVTBL *vtbl
Apd |int |mg_get |NN SV* sv
ApdD |U32 |mg_length |NN SV* sv
Apdn |void |mg_magical |NN SV* sv
@@ -3053,6 +3054,10 @@ Apnod |Size_t |my_strlcat |NULLOK char
*dst|NULLOK const char *src|Size_t size
Apnod |Size_t |my_strlcpy |NULLOK char *dst|NULLOK const char *src|Size_t
size
#endif
+#ifndef HAS_MKSTEMP
+pno |int |my_mkstemp |NN char *templte
+#endif
+
APpdn |bool |isinfnan |NV nv
p |bool |isinfnansv |NN SV *sv
diff --git a/embed.h b/embed.h
index 6d2fa1ccb7..0f491afd77 100644
--- a/embed.h
+++ b/embed.h
@@ -345,6 +345,7 @@
#define mg_findext Perl_mg_findext
#define mg_free(a) Perl_mg_free(aTHX_ a)
#define mg_free_type(a,b) Perl_mg_free_type(aTHX_ a,b)
+#define mg_freeext(a,b,c) Perl_mg_freeext(aTHX_ a,b,c)
#define mg_get(a) Perl_mg_get(aTHX_ a)
#define mg_length(a) Perl_mg_length(aTHX_ a)
#define mg_magical Perl_mg_magical
diff --git a/embedvar.h b/embedvar.h
index 8b9842f9cc..76efb9104b 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -174,6 +174,7 @@
#define PL_incgv (vTHX->Iincgv)
#define PL_initav (vTHX->Iinitav)
#define PL_inplace (vTHX->Iinplace)
+#define PL_internal_random_state (vTHX->Iinternal_random_state)
#define PL_isarev (vTHX->Iisarev)
#define PL_known_layers (vTHX->Iknown_layers)
#define PL_langinfo_buf (vTHX->Ilanginfo_buf)
diff --git a/intrpvar.h b/intrpvar.h
index b6b20bcad9..766e552aed 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -830,6 +830,14 @@ PERLVAR(I, random_state, PL_RANDOM_STATE_TYPE)
PERLVARI(I, dump_re_max_len, STRLEN, 0)
+/* For internal uses of randomness, this ensures the sequence of
+ * random numbers returned by rand() isn't modified by perl's internal
+ * use of randomness.
+ * This is important if the user has called srand() with a seed.
+ */
+
+PERLVAR(I, internal_random_state, PL_RANDOM_STATE_TYPE)
+
/* If you are adding a U8 or U16, check to see if there are 'Space' comments
* above on where there are gaps which currently will be structure padding. */
diff --git a/mg.c b/mg.c
index 971fceed2b..fe4f8a5935 100644
--- a/mg.c
+++ b/mg.c
@@ -626,6 +626,42 @@ Perl_mg_free_type(pTHX_ SV *sv, int how)
mg_magical(sv);
}
+/*
+=for apidoc mg_freeext
+
+Remove any magic of type C<how> using virtual table C<vtbl> from the
+SV C<sv>. See L</sv_magic>.
+
+C<mg_freeext(sv, how, NULL)> is equivalent to C<mg_free_type(sv, how)>.
+
+=cut
+*/
+
+void
+Perl_mg_freeext(pTHX_ SV *sv, int how, const MGVTBL *vtbl)
+{
+ MAGIC *mg, *prevmg, *moremg;
+ PERL_ARGS_ASSERT_MG_FREEEXT;
+ for (prevmg = NULL, mg = SvMAGIC(sv); mg; prevmg = mg, mg = moremg) {
+ MAGIC *newhead;
+ moremg = mg->mg_moremagic;
+ if (mg->mg_type == how && (vtbl == NULL || mg->mg_virtual == vtbl)) {
+ /* temporarily move to the head of the magic chain, in case
+ custom free code relies on this historical aspect of mg_free */
+ if (prevmg) {
+ prevmg->mg_moremagic = moremg;
+ mg->mg_moremagic = SvMAGIC(sv);
+ SvMAGIC_set(sv, mg);
+ }
+ newhead = mg->mg_moremagic;
+ mg_free_struct(sv, mg);
+ SvMAGIC_set(sv, newhead);
+ mg = prevmg;
+ }
+ }
+ mg_magical(sv);
+}
+
#include <signal.h>
U32
diff --git a/perl.c b/perl.c
index a3f8ac367d..fd100cc64a 100644
--- a/perl.c
+++ b/perl.c
@@ -261,6 +261,22 @@ perl_construct(pTHXx)
init_constants();
+#ifdef NO_PERL_INTERNAL_RAND_SEED
+ Perl_drand48_init_r(&PL_internal_random_state, seed());
+#else
+ {
+ UV seed;
+ const char *env_pv;
+ if (PerlProc_getuid() != PerlProc_geteuid() ||
+ PerlProc_getgid() != PerlProc_getegid() ||
+ !(env_pv = PerlEnv_getenv("PERL_INTERNAL_RAND_SEED")) ||
+ grok_number(env_pv, strlen(env_pv), &seed) != IS_NUMBER_IN_UV) {
+ seed = seed();
+ }
+ Perl_drand48_init_r(&PL_internal_random_state, (U32)seed);
+ }
+#endif
+
SvREADONLY_on(&PL_sv_placeholder);
SvREFCNT(&PL_sv_placeholder) = SvREFCNT_IMMORTAL;
@@ -2202,6 +2218,21 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
}
}
+#ifndef NO_PERL_INTERNAL_RAND_SEED
+ /* If we're not set[ug]id, we might have honored
+ PERL_INTERNAL_RAND_SEED in perl_construct().
+ At this point command-line options have been parsed, so if
+ we're now tainting and not set[ug]id re-seed.
+ This could possibly be wasteful if PERL_INTERNAL_RAND_SEED is invalid,
+ but avoids duplicating the logic from perl_construct().
+ */
+ if (PL_tainting &&
+ PerlProc_getuid() == PerlProc_geteuid() &&
+ PerlProc_getgid() == PerlProc_getegid()) {
+ Perl_drand48_init_r(&PL_internal_random_state, seed());
+ }
+#endif
+
/* Set $^X early so that it can be used for relocatable paths in @INC */
/* and for SITELIB_EXP in USE_SITECUSTOMIZE */
assert (!TAINT_get);
@@ -3376,12 +3407,6 @@ Perl_moreswitches(pTHX_ const char *s)
case 'i':
Safefree(PL_inplace);
-#if defined(__CYGWIN__) /* do backup extension automagically */
- if (*(s+1) == '\0') {
- PL_inplace = savepvs(".bak");
- return s+1;
- }
-#endif /* __CYGWIN__ */
{
const char * const start = ++s;
while (*s && !isSPACE(*s))
diff --git a/plan9/config_sh.sample b/plan9/config_sh.sample
index 49a42ff13d..9ca482d5b2 100644
--- a/plan9/config_sh.sample
+++ b/plan9/config_sh.sample
@@ -202,6 +202,7 @@ d_expm1='undef'
d_faststdio='undef'
d_fchdir='undef'
d_fchmod='define'
+d_fchmodat='undef'
d_fchown='undef'
d_fcntl='define'
d_fcntl_can_lock='undef'
@@ -342,6 +343,7 @@ d_lgamma='undef'
d_lgamma_r='undef'
d_libm_lib_version='0'
d_link='define'
+d_linkat='undef'
d_llrint='undef'
d_llrintl='undef'
d_llround='undef'
@@ -420,6 +422,7 @@ d_old_pthread_create_joinable='undef'
d_oldpthreads='undef'
d_oldsock='undef'
d_open3='define'
+d_openat='undef'
d_pathconf='define'
d_pause='define'
d_perl_otherlibdirs='undef'
@@ -458,6 +461,7 @@ d_regcomp='undef'
d_remainder='undef'
d_remquo='undef'
d_rename='define'
+d_renameat='undef'
d_rewinddir='define'
d_rint='undef'
d_rmdir='define'
@@ -606,6 +610,7 @@ d_ualarm='undef'
d_umask='define'
d_uname='define'
d_union_semun='undef'
+d_unlinkat='undef'
d_unordered='undef'
d_unsetenv='undef'
d_uselocale='undef'
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 7a7b220747..689e9609bc 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -656,6 +656,13 @@ the warning. See L<perlsub>.
(F) You passed an invalid number (like an infinity or not-a-number) to C<chr>.
+=item Cannot complete in-place edit of %s: %s
+
+(F) Your perl script appears to have changed directory while
+performing an in-place edit of a file specified by a relative path,
+and your system doesn't include the directory relative POSIX functions
+needed to handle that.
+
=item Cannot compress %f in pack
(F) You tried compressing an infinity or not-a-number as an unsigned
@@ -1311,9 +1318,14 @@ the modified file. The file was left unmodified.
=item Can't rename %s to %s: %s, skipping file
-(S inplace) The rename done by the B<-i> switch failed for some reason,
+(F) The rename done by the B<-i> switch failed for some reason,
probably because you don't have write permission to the directory.
+=item Can't rename in-place work file '%s' to '%s': %s
+
+(F) When closed implicitly, the temporary file for in-place editing
+couldn't be renamed to the original filename.
+
=item Can't reopen input pipe (name: %s) in binary mode
(P) An error peculiar to VMS. Perl thought stdin was a pipe, and tried
@@ -2311,7 +2323,7 @@ Check the #! line, or manually feed your script into Perl
yourself.
CHECK, INIT, or END subroutine. Processing of the remainder of the
queue of such routines has been prematurely ended.
-=item Failed to close in-place edit file %s: %s
+=item Failed to close in-place work file %s: %s
(F) Closing an output file from in-place editing, as with the C<-i>
command-line switch, failed.
diff --git a/pod/perlrun.pod b/pod/perlrun.pod
index f32c8edc98..b5e4c06517 100644
--- a/pod/perlrun.pod
+++ b/pod/perlrun.pod
@@ -1392,6 +1392,18 @@ X<SYS$LOGIN>
Used if chdir has no argument and HOME and LOGDIR are not set.
+=item PERL_INTERNAL_RAND_SEED
+X<PERL_INTERNAL_RAND_SEED>
+
+Set to a non-negative integer to seed the random number generator used
+internally by perl for a variety of purposes.
+
+Ignored if perl is run setuid or setgid. Used only for some limited
+startup randomization (hash keys) if C<-T> or C<-t> perl is started
+with tainting enabled.
+
+Perl may be built to ignore this variable.
+
=back
Perl also has environment variables that control how Perl handles data
diff --git a/pp_sort.c b/pp_sort.c
index 5f39dba40e..604950910a 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -788,7 +788,7 @@ S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t
compare)
size_t n;
SV ** const q = array;
for (n = num_elts; n > 1; ) {
- const size_t j = (size_t)(n-- * Drand01());
+ const size_t j = (size_t)(n-- * Perl_internal_drand48());
temp = q[j];
q[j] = q[n];
q[n] = temp;
diff --git a/proto.h b/proto.h
index 637b3c913b..b02c677f32 100644
--- a/proto.h
+++ b/proto.h
@@ -2006,6 +2006,9 @@ PERL_CALLCONV int Perl_mg_free(pTHX_ SV* sv);
PERL_CALLCONV void Perl_mg_free_type(pTHX_ SV* sv, int how);
#define PERL_ARGS_ASSERT_MG_FREE_TYPE \
assert(sv)
+PERL_CALLCONV void Perl_mg_freeext(pTHX_ SV* sv, int how, const MGVTBL
*vtbl);
+#define PERL_ARGS_ASSERT_MG_FREEEXT \
+ assert(sv)
PERL_CALLCONV int Perl_mg_get(pTHX_ SV* sv);
#define PERL_ARGS_ASSERT_MG_GET \
assert(sv)
@@ -3856,6 +3859,11 @@ STATIC int S_dooneliner(pTHX_ const char *cmd,
const char *filename)
# endif
#endif
+#if !defined(HAS_MKSTEMP)
+PERL_CALLCONV int Perl_my_mkstemp(char *templte);
+#define PERL_ARGS_ASSERT_MY_MKSTEMP \
+ assert(templte)
+#endif
#if !defined(HAS_RENAME)
PERL_CALLCONV I32 Perl_same_dirent(pTHX_ const char* a, const char* b);
#define PERL_ARGS_ASSERT_SAME_DIRENT \
diff --git a/symbian/config.sh b/symbian/config.sh
index dc4ad64b7e..7ed6bb3de3 100644
--- a/symbian/config.sh
+++ b/symbian/config.sh
@@ -146,6 +146,7 @@ d_expm1='undef'
d_faststdio='undef'
d_fchdir='undef'
d_fchmod='undef'
+d_fchmodat='undef'
d_fchown='undef'
d_fcntl='undef'
d_fcntl_can_lock='undef'
@@ -288,6 +289,7 @@ d_lgamma='undef'
d_lgamma_r='undef'
d_libm_lib_version='undef'
d_link='undef'
+d_linkat='undef'
d_llrint='undef'
d_llrintl='undef'
d_llround='undef'
@@ -366,6 +368,7 @@ d_old_pthread_create_joinable='undef'
d_oldpthreads='undef'
d_oldsock='undef'
d_open3='undef'
+d_openat='undef'
d_pathconf='undef'
d_pause='undef'
d_perl_otherlibdirs='undef'
@@ -404,6 +407,7 @@ d_regcomp='undef'
d_remainder='undef'
d_remquo='undef'
d_rename='define'
+d_renameat='undef'
d_rewinddir='define'
d_rint='undef'
d_rmdir='define'
@@ -554,6 +558,7 @@ d_ualarm='undef'
d_umask='undef'
d_uname='undef'
d_union_semun='undef'
+d_unlinkat='undef'
d_unordered='undef'
d_unsetenv='undef'
d_uselocale='undef'
diff --git a/t/io/fs.t b/t/io/fs.t
index b6754d6568..09eede1e44 100644
--- a/t/io/fs.t
+++ b/t/io/fs.t
@@ -468,18 +468,23 @@ SKIP: {
chdir $wd || die "Can't cd back to $wd";
}
-# check if rename() works on directories
-if ($^O eq 'VMS') {
- # must have delete access to rename a directory
- `set file $tmpdir.dir/protection=o:d`;
- ok(rename("$tmpdir.dir", "$tmpdir1.dir"), "rename on directories") ||
- print "# errno: $!\n";
-}
-else {
- ok(rename($tmpdir, $tmpdir1), "rename on directories");
-}
+SKIP:
+{
+ $Config{d_rename}
+ or skip "Cannot rename directories with link()", 2;
+ # check if rename() works on directories
+ if ($^O eq 'VMS') {
+ # must have delete access to rename a directory
+ `set file $tmpdir.dir/protection=o:d`;
+ ok(rename("$tmpdir.dir", "$tmpdir1.dir"), "rename on directories") ||
+ print "# errno: $!\n";
+ }
+ else {
+ ok(rename($tmpdir, $tmpdir1), "rename on directories");
+ }
-ok(-d $tmpdir1, "rename on directories working");
+ ok(-d $tmpdir1, "rename on directories working");
+}
{
# Change 26011: Re: A surprising segfault
diff --git a/t/io/nargv.t b/t/io/nargv.t
index f0eee30c59..598ceed617 100644
--- a/t/io/nargv.t
+++ b/t/io/nargv.t
@@ -6,7 +6,7 @@ BEGIN {
set_up_inc('../lib');
}
-print "1..5\n";
+print "1..6\n";
my $j = 1;
for $i ( 1,2,5,4,3 ) {
@@ -43,6 +43,28 @@ while (<>) {
show();
}
+# test setuid is preserved (and hopefully setgid)
+#
+# With nested in-place editing PL_oldname and PL_filemode would
+# be overwritten by the values for the last file in the nested
+# loop. This is now all stored as magic in *ARGVOUT{IO}
+$^I = "";
+@ARGV = mkfiles(1..3);
+my $sidfile = $ARGV[1];
+chmod(04600, $sidfile);
+my $mode = (stat $ARGV[1])[2];
+$n = 0;
+while (<>) {
+ print STDOUT "#final \@ARGV: [@ARGV]\n";
+ if ($n++ == 1) {
+ other();
+ }
+ print;
+}
+my $newmode = (stat $sidfile)[2];
+printf "# before %#o after %#o\n", $mode, $newmode;
+print +($mode == $newmode ? "" : "not "). "ok 6 # check setuid mode
preserved\n";
+
sub show {
#warn "$ARGV: $_";
s/^not //;
diff --git a/t/run/switches.t b/t/run/switches.t
index b61be56834..6725f8fd35 100644
--- a/t/run/switches.t
+++ b/t/run/switches.t
@@ -12,7 +12,7 @@ BEGIN {
BEGIN { require "./test.pl"; require "./loc_tools.pl"; }
-plan(tests => 115);
+plan(tests => 136);
use Config;
@@ -355,11 +355,12 @@ for (qw( e f x E S V )) {
sub do_i_unlink { unlink_all("file", "file.bak") }
open(FILE, ">file") or die "$0: Failed to create 'file': $!";
- print FILE <<__EOF__;
+ my $yada = <<__EOF__;
foo yada dada
bada foo bing
king kong foo
__EOF__
+ print FILE $yada;
close FILE;
END { do_i_unlink() }
@@ -400,6 +401,222 @@ __EOF__
args => ['file'],
);
is($out2, "", "no warning when files given");
+
+ open my $f, ">", "file" or die "$0: failed to create 'file': $!";
+ print $f "foo\nbar\n";
+ close $f;
+
+ # a backup extension is no longer required on any platform
+ my $out3 = runperl(
+ switches => [ '-i', '-p' ],
+ prog => 's/foo/quux/',
+ stderr => 1,
+ args => [ 'file' ],
+ );
+ is($out3, "", "no warnings/errors without backup extension");
+ open $f, "<", "file" or die "$0: cannot open 'file': $!";
+ chomp(my @out4 = <$f>);
+ close $f;
+ is(join(":", @out4), "quux:bar", "correct output without backup
extension");
+
+ -d "inplacetmp" or mkdir("inplacetmp")
+ or die "Cannot mkdir 'inplacetmp': $!";
+ require File::Spec;
+ my $work = File::Spec->catfile("inplacetmp", "foo");
+
+ # exit or die should leave original content in file
+ for my $inplace (qw/-i -i.bak/) {
+ for my $prog (qw/die exit/) {
+ open my $fh, ">", $work or die "$0: failed to open '$work': $!";
+ print $fh $yada;
+ close $fh or die "Failed to close: $!";
+ my $out = runperl (
+ switches => [ $inplace, '-n' ],
+ prog => "print q(foo\n); $prog",
+ stderr => 1,
+ args => [ $work ],
+ );
+ open my $in, "<", $work or die "$0: failed to open '$work': $!";
+ my $data = do { local $/; <$in> };
+ close $in;
+ is ($data, $yada, "check original content still in file");
+ unlink $work;
+ }
+ }
+
+ # test that path parsing is correct
+ open $f, ">", $work or die "Cannot create $work: $!";
+ print $f "foo\nbar\n";
+ close $f;
+
+ my $out4 = runperl
+ (
+ switches => [ "-i", "-p" ],
+ prog => 's/foo/bar/',
+ stderr => 1,
+ args => [ $work ],
+ );
+ is ($out4, "", "no errors or warnings");
+ open $f, "<", $work or die "Cannot open $work: $!";
+ chomp(my @file4 = <$f>);
+ close $f;
+ is(join(":", @file4), "bar:bar", "check output");
+
+ SKIP:
+ {
+ # this needs to match how ARGV_USE_ATFUNCTIONS is defined in doio.c
+ skip "Not enough *at functions", 3
+ unless $Config{d_unlinkat} && $Config{d_renameat} &&
$Config{d_fchmodat}
+ && ($Config{d_dirfd} || $Config{d_dir_dd_fd})
+ && $Config{ccflags} !~ /-DNO_USE_ATFUNCTIONS\b/;
+ fresh_perl_is(<<'CODE', "ok\n", { },
+@ARGV = ("inplacetmp/foo");
+$^I = "";
+while (<>) {
+ chdir "..";
+ print "xx\n";
+}
+print "ok\n";
+CODE
+ "chdir while in-place editing");
+ ok(open(my $fh, "<", $work), "open out file");
+ is(scalar <$fh>, "xx\n", "file successfully saved after chdir");
+ close $fh;
+ }
+
+ SKIP:
+ {
+ skip "Need threads and full perl", 3
+ if !$Config{useithreads} || is_miniperl();
+ fresh_perl_is(<<'CODE', "ok\n", { stderr => 1 },
+use threads;
+use strict;
+@ARGV = ("inplacetmp/foo");
+$^I = "";
+while (<>) {
+ threads->create(sub { })->join;
+ print "yy\n";
+}
+print "ok\n";
+CODE
+ "threads while in-place editing");
+ ok(open(my $fh, "<", $work), "open out file");
+ is(scalar <$fh>, "yy\n", "file successfully saved after chdir");
+ close $fh;
+ }
+
+ SKIP:
+ {
+ skip "Need fork", 3 if !$Config{d_fork};
+ open my $fh, ">", $work
+ or die "Cannot open $work: $!";
+ # we want only a single line for this test, otherwise
+ # it attempts to close the file twice
+ print $fh "foo\n";
+ close $fh or die "Cannot close $work: $!";
+ fresh_perl_is(<<'CODE', "ok\n", { stderr => 1 },
+use strict;
+@ARGV = ("inplacetmp/foo");
+$^I = "";
+while (<>) {
+ my $pid = fork;
+ if (defined $pid && !$pid) {
+ # child
+ close ARGVOUT or die "Cannot close in child\n"; # this shouldn't do
ARGVOUT magic
+ exit 0;
+ }
+ wait;
+ print "yy\n";
+ close ARGVOUT or die "Cannot close in parent\n"; # this should
+}
+print "ok\n";
+CODE
+ "fork while in-place editing");
+ ok(open($fh, "<", $work), "open out file");
+ is(scalar <$fh>, "yy\n", "file successfully saved after chdir");
+ close $fh;
+ }
+
+ {
+ # test we handle the rename to the backup failing
+ # make it fail by creating a directory of the backup name
+ mkdir "$work.bak" or die "Cannot make mask backup directory: $!";
+ fresh_perl_like(<<'CODE', qr/Can't rename/, { stderr => 1 }, "fail
backup rename");
+@ARGV = ("inplacetmp/foo");
+$^I = ".bak";
+while (<>) {
+ print;
+}
+print "ok\n";
+CODE
+ rmdir "$work.bak" or die "Cannot remove mask backup directory: $!";
+ }
+
+ # we now use temp files for in-place editing, make sure we didn't leave
+ # any behind in the above test
+ opendir my $d, "inplacetmp" or die "Cannot opendir inplacetmp: $!";
+ my @names = grep !/^\.\.?$/ && $_ ne 'foo', readdir $d;
+ closedir $d;
+ is(scalar(@names), 0, "no extra files")
+ or diag "Found @names, expected none";
+
+ # the following tests might leave work files behind
+
+ # this test can leave the work file in the directory, since making
+ # the directory non-writable also prevents removing the work file
+ SKIP:
+ {
+ # test we handle the rename of the work to the original failing
+ # make it fail by removing write perms from the directory
+ # but first check that doesn't prevent writing
+ chmod 0500, "inplacetmp";
+ my $check = File::Spec->catfile("inplacetmp", "check");
+ my $canwrite = open my $fh, ">", $check;
+ unlink $check;
+ chmod 0700, "inplacetmp" or die "Cannot make inplacetmp writable
again: $!";
+ skip "Cannot make inplacetmp read only", 1
+ if $canwrite;
+ fresh_perl_like(<<'CODE', qr/Can't rename/, { stderr => 1 }, "fail
final rename");
+@ARGV = ("inplacetmp/foo");
+$^I = "";
+while (<>) {
+ chmod 0500, "inplacetmp";
+ print;
+}
+print "ok\n";
+CODE
+ chmod 0700, "inplacetmp" or die "Cannot make inplacetmp writable
again: $!";
+ }
+
+ SKIP:
+ {
+ # this needs to reverse match how ARGV_USE_ATFUNCTIONS is defined in
doio.c
+ skip "Testing without *at functions", 1
+ if $Config{d_unlinkat} && $Config{d_renameat} && $Config{d_fchmodat}
+ && ($Config{d_dirfd} || $Config{d_dir_dd_fd})
+ && $Config{ccflags} !~ /-DNO_USE_ATFUNCTIONS\b/;
+ fresh_perl_like(<<'CODE', qr/^Cannot complete in-place edit of
inplacetmp\/foo: .* - line 5, <> line \d+\./, { },
+@ARGV = ("inplacetmp/foo");
+$^I = "";
+while (<>) {
+ chdir "..";
+ print "xx\n";
+}
+print "ok\n";
+CODE
+ "chdir while in-place editing (no at-functions)");
+ }
+
+ unlink $work;
+
+ opendir $d, "inplacetmp" or die "Cannot opendir inplacetmp: $!";
+ @names = grep !/^\.\.?$/ && !/foo$/aai, readdir $d;
+ closedir $d;
+
+ # clean up in case the above failed
+ unlink map File::Spec->catfile("inplacetmp", $_), @names;
+
+ rmdir "inplacetmp";
}
# Tests for -E
diff --git a/uconfig.h b/uconfig.h
index b663e7edc7..e3646d27b2 100644
--- a/uconfig.h
+++ b/uconfig.h
@@ -28,6 +28,31 @@
*/
/*#define HAS_ALARM / **/
+/* HAS_OPENAT:
+ * This symbol is defined if the openat() routine is available.
+ */
+/*#define HAS_OPENAT / **/
+
+/* HAS_UNLINKAT:
+ * This symbol is defined if the unlinkat() routine is available.
+ */
+/*#define HAS_UNLINKAT / **/
+
+/* HAS_RENAMEAT:
+ * This symbol is defined if the renameat() routine is available.
+ */
+/*#define HAS_RENAMEAT / **/
+
+/* HAS_LINKAT:
+ * This symbol is defined if the linkat() routine is available.
+ */
+/*#define HAS_LINKAT / **/
+
+/* HAS_FCHMODAT:
+ * This symbol is defined if the fchmodat() routine is available.
+ */
+/*#define HAS_FCHMODAT / **/
+
/* HAS_BCMP:
* This symbol is defined if the bcmp() routine is available to
* compare blocks of memory.
@@ -5354,6 +5379,6 @@
#endif
/* Generated from:
- * a0cea6273c16c1c5d8625665c84bda01926ce960c26873d4e5596b5b02a53e92 config_h.SH
- * 58f9d541683fff4dcacfd3cb2d9e1f444fd3c8e3f120ef92c21eb47e880ba924 uconfig.sh
+ * e192beb070dfc2b1167cdec538893718edff9a3659073ef7ad4a47a7fed9f082 config_h.SH
+ * a088a21b0ddb63b48c794da959469ddb98da178e5b2d4ec568331a988d59e146 uconfig.sh
* ex: set ro: */
diff --git a/uconfig.sh b/uconfig.sh
index 0da4e46f5e..9ebda12bdc 100644
--- a/uconfig.sh
+++ b/uconfig.sh
@@ -140,6 +140,7 @@ d_expm1='undef'
d_faststdio='undef'
d_fchdir='undef'
d_fchmod='undef'
+d_fchmodat='undef'
d_fchown='undef'
d_fcntl='undef'
d_fcntl_can_lock='undef'
@@ -281,6 +282,7 @@ d_lgamma='undef'
d_lgamma_r='undef'
d_libm_lib_version='undef'
d_link='undef'
+d_linkat='undef'
d_llrint='undef'
d_llrintl='undef'
d_llround='undef'
@@ -359,6 +361,7 @@ d_old_pthread_create_joinable='undef'
d_oldpthreads='undef'
d_oldsock='undef'
d_open3='undef'
+d_openat='undef'
d_pathconf='undef'
d_pause='undef'
d_perl_otherlibdirs='undef'
@@ -397,6 +400,7 @@ d_regcomp='define'
d_remainder='undef'
d_remquo='undef'
d_rename='define'
+d_renameat='undef'
d_rewinddir='undef'
d_rint='undef'
d_rmdir='undef'
@@ -545,6 +549,7 @@ d_ualarm='undef'
d_umask='undef'
d_uname='undef'
d_union_semun='undef'
+d_unlinkat='undef'
d_unordered='undef'
d_unsetenv='undef'
d_uselocale='undef'
diff --git a/uconfig64.sh b/uconfig64.sh
index 7ec0017b20..40caa1907a 100644
--- a/uconfig64.sh
+++ b/uconfig64.sh
@@ -141,6 +141,7 @@ d_expm1='undef'
d_faststdio='undef'
d_fchdir='undef'
d_fchmod='undef'
+d_fchmodat='undef'
d_fchown='undef'
d_fcntl='undef'
d_fcntl_can_lock='undef'
@@ -282,6 +283,7 @@ d_lgamma='undef'
d_lgamma_r='undef'
d_libm_lib_version='undef'
d_link='undef'
+d_linkat='undef'
d_llrint='undef'
d_llrintl='undef'
d_llround='undef'
@@ -360,6 +362,7 @@ d_old_pthread_create_joinable='undef'
d_oldpthreads='undef'
d_oldsock='undef'
d_open3='undef'
+d_openat='undef'
d_pathconf='undef'
d_pause='undef'
d_perl_otherlibdirs='undef'
@@ -398,6 +401,7 @@ d_regcomp='undef'
d_remainder='undef'
d_remquo='undef'
d_rename='define'
+d_renameat='undef'
d_rewinddir='undef'
d_rint='undef'
d_rmdir='undef'
@@ -546,6 +550,7 @@ d_ualarm='undef'
d_umask='undef'
d_uname='undef'
d_union_semun='undef'
+d_unlinkat='undef'
d_unordered='undef'
d_unsetenv='undef'
d_uselocale='undef'
diff --git a/util.c b/util.c
index b470681bdd..e2feb7f473 100644
--- a/util.c
+++ b/util.c
@@ -4677,10 +4677,8 @@ Perl_get_hash_seed(pTHX_ unsigned char * const
seed_buffer)
else
#endif /* NO_PERL_HASH_ENV */
{
- (void)seedDrand01((Rand_seed_t)seed());
-
for( i = 0; i < PERL_HASH_SEED_BYTES; i++ ) {
- seed_buffer[i] = (unsigned char)(Drand01() * (U8_MAX+1));
+ seed_buffer[i] = (unsigned char)(Perl_internal_drand48() *
(U8_MAX+1));
}
}
#ifdef USE_PERL_PERTURB_KEYS
@@ -5791,6 +5789,40 @@ Perl_my_dirfd(DIR * dir) {
#endif
}
+#ifndef HAS_MKSTEMP
+
+#define TEMP_FILE_CH
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvxyz0123456789"
+#define TEMP_FILE_CH_COUNT (sizeof(TEMP_FILE_CH)-1)
+
+int
+Perl_my_mkstemp(char *templte) {
+ dTHX;
+ STRLEN len = strlen(templte);
+ int fd;
+ int attempts = 0;
+
+ PERL_ARGS_ASSERT_MY_MKSTEMP;
+
+ if (len < 6 ||
+ templte[len-1] != 'X' || templte[len-2] != 'X' || templte[len-3] !=
'X' ||
+ templte[len-4] != 'X' || templte[len-5] != 'X' || templte[len-6] !=
'X') {
+ errno = EINVAL;
+ return -1;
+ }
+
+ do {
+ int i;
+ for (i = 1; i <= 6; ++i) {
+ templte[len-i] = TEMP_FILE_CH[(int)(Perl_internal_drand48() *
TEMP_FILE_CH_COUNT)];
+ }
+ fd = PerlLIO_open3(templte, O_RDWR | O_CREAT | O_EXCL, 0600);
+ } while (fd == -1 && errno == EEXIST && ++attempts <= 100);
+
+ return fd;
+}
+
+#endif
+
REGEXP *
Perl_get_re_arg(pTHX_ SV *sv) {
diff --git a/util.h b/util.h
index 12a1c470ee..6b63d90e4f 100644
--- a/util.h
+++ b/util.h
@@ -89,6 +89,12 @@ typedef struct PERL_DRAND48_T perl_drand48_t;
#define Perl_drand48_init(seed) (Perl_drand48_init_r(&PL_random_state, (seed)))
#define Perl_drand48() (Perl_drand48_r(&PL_random_state))
+#ifdef PERL_CORE
+/* uses a different source of randomness to avoid interfering with the results
+ * of rand() */
+#define Perl_internal_drand48() (Perl_drand48_r(&PL_internal_random_state))
+#endif
+
#ifdef USE_C_BACKTRACE
typedef struct {
@@ -240,6 +246,10 @@ means arg not present, 1 is empty string/null byte */
((char *) memmem(big, bigend - big, little, lend - little))
#endif
+#if defined(HAS_MKSTEMP) && defined(PERL_CORE)
+# define Perl_my_mkstemp(templte) mkstemp(templte)
+#endif
+
#endif /* PERL_UTIL_H_ */
/*
diff --git a/win32/config.ce b/win32/config.ce
index d73b16672c..9325e57cd6 100644
--- a/win32/config.ce
+++ b/win32/config.ce
@@ -188,6 +188,7 @@ d_expm1='undef'
d_faststdio='undef'
d_fchdir='undef'
d_fchmod='undef'
+d_fchmodat='undef'
d_fchown='undef'
d_fcntl='undef'
d_fcntl_can_lock='undef'
@@ -329,6 +330,7 @@ d_lgamma='undef'
d_lgamma_r='undef'
d_libm_lib_version='undef'
d_link='define'
+d_linkat='undef'
d_llrint='undef'
d_llrintl='undef'
d_llround='undef'
@@ -407,6 +409,7 @@ d_old_pthread_create_joinable='undef'
d_oldpthreads='undef'
d_oldsock='undef'
d_open3='undef'
+d_openat='undef'
d_pathconf='undef'
d_pause='define'
d_perl_otherlibdirs='undef'
@@ -445,6 +448,7 @@ d_regcomp='undef'
d_remainder='undef'
d_remquo='undef'
d_rename='define'
+d_renameat='undef'
d_rewinddir='define'
d_rint='undef'
d_rmdir='define'
@@ -594,6 +598,7 @@ d_ualarm='undef'
d_umask='define'
d_uname='define'
d_union_semun='define'
+d_unlinkat='undef'
d_unordered='undef'
d_unsetenv='undef'
d_uselocale='undef'
diff --git a/win32/config.gc b/win32/config.gc
index 8a50293705..3ad6aa3ecf 100644
--- a/win32/config.gc
+++ b/win32/config.gc
@@ -189,6 +189,7 @@ d_expm1='undef'
d_faststdio='define'
d_fchdir='undef'
d_fchmod='undef'
+d_fchmodat='undef'
d_fchown='undef'
d_fcntl='undef'
d_fcntl_can_lock='undef'
@@ -329,6 +330,7 @@ d_lgamma='undef'
d_lgamma_r='undef'
d_libm_lib_version='undef'
d_link='define'
+d_linkat='undef'
d_llrint='undef'
d_llrintl='undef'
d_llround='undef'
@@ -408,6 +410,7 @@ d_old_pthread_create_joinable='undef'
d_oldpthreads='undef'
d_oldsock='undef'
d_open3='undef'
+d_openat='undef'
d_pathconf='undef'
d_pause='define'
d_perl_otherlibdirs='undef'
@@ -446,6 +449,7 @@ d_regcomp='undef'
d_remainder='undef'
d_remquo='undef'
d_rename='define'
+d_renameat='undef'
d_rewinddir='define'
d_rint='undef'
d_rmdir='define'
@@ -594,6 +598,7 @@ d_ualarm='undef'
d_umask='define'
d_uname='define'
d_union_semun='define'
+d_unlinkat='undef'
d_unordered='undef'
d_unsetenv='undef'
d_uselocale='undef'
diff --git a/win32/config.vc b/win32/config.vc
index ff6ea8780b..baa210d140 100644
--- a/win32/config.vc
+++ b/win32/config.vc
@@ -189,6 +189,7 @@ d_expm1='undef'
d_faststdio='define'
d_fchdir='undef'
d_fchmod='undef'
+d_fchmodat='undef'
d_fchown='undef'
d_fcntl='undef'
d_fcntl_can_lock='undef'
@@ -329,6 +330,7 @@ d_lgamma='undef'
d_lgamma_r='undef'
d_libm_lib_version='undef'
d_link='define'
+d_linkat='undef'
d_llrint='undef'
d_llrintl='undef'
d_llround='undef'
@@ -408,6 +410,7 @@ d_old_pthread_create_joinable='undef'
d_oldpthreads='undef'
d_oldsock='undef'
d_open3='undef'
+d_openat='undef'
d_pathconf='undef'
d_pause='define'
d_perl_otherlibdirs='undef'
@@ -446,6 +449,7 @@ d_regcomp='undef'
d_remainder='undef'
d_remquo='undef'
d_rename='define'
+d_renameat='undef'
d_rewinddir='define'
d_rint='undef'
d_rmdir='define'
@@ -594,6 +598,7 @@ d_ualarm='undef'
d_umask='define'
d_uname='define'
d_union_semun='define'
+d_unlinkat='undef'
d_unordered='undef'
d_unsetenv='undef'
d_uselocale='undef'
--
Perl5 Master Repository
