pp_open() could pass an uninitialized filename down to do_open9().
[p5sagit/p5-mst-13.2.git] / pp_sys.c
index 9ea67e1..a95c43c 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
 #ifdef I_SHADOW
 /* Shadow password support for solaris - pdo@cs.umd.edu
  * Not just Solaris: at least HP-UX, IRIX, Linux.
- * the API is from SysV. --jhi */
-#ifdef __hpux__
+ * The API is from SysV.
+ *
+ * There are at least two more shadow interfaces,
+ * see the comments in pp_gpwent().
+ *
+ * --jhi */
+#   ifdef __hpux__
 /* There is a MAXINT coming from <shadow.h> <- <hpsecurity.h> <- <values.h>
  * and another MAXINT from "perl.h" <- <sys/param.h>. */ 
-#undef MAXINT
-#endif
-#include <shadow.h>
+#       undef MAXINT
+#   endif
+#   include <shadow.h>
 #endif
 
 /* XXX If this causes problems, set i_unistd=undef in the hint file.  */
@@ -195,7 +200,7 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true";
 #endif
 
 #if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_EACCESS)
-#   if defined(I_SYS_SECURITY)
+#   ifdef I_SYS_SECURITY
 #       include <sys/security.h>
 #   endif
 #   ifdef ACC_SELF
@@ -503,7 +508,7 @@ PP(pp_open)
     djSP; dTARGET;
     GV *gv;
     SV *sv;
-    SV *name;
+    SV *name = Nullsv;
     I32 have_name = 0;
     char *tmps;
     STRLEN len;
@@ -607,8 +612,8 @@ PP(pp_pipe_op)
     IoIFP(rstio) = PerlIO_fdopen(fd[0], "r");
     IoOFP(wstio) = PerlIO_fdopen(fd[1], "w");
     IoIFP(wstio) = IoOFP(wstio);
-    IoTYPE(rstio) = '<';
-    IoTYPE(wstio) = '>';
+    IoTYPE(rstio) = IoTYPE_RDONLY;
+    IoTYPE(wstio) = IoTYPE_WRONLY;
 
     if (!IoIFP(rstio) || !IoOFP(wstio)) {
        if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio));
@@ -1065,7 +1070,7 @@ PP(pp_select)
     else {
        GV **gvp = (GV**)hv_fetch(hv, GvNAME(egv), GvNAMELEN(egv), FALSE);
        if (gvp && *gvp == egv) {
-           gv_efullname3(TARG, PL_defoutgv, Nullch);
+           gv_efullname4(TARG, PL_defoutgv, Nullch, FALSE);
            XPUSHTARG;
        }
        else {
@@ -1169,11 +1174,14 @@ PP(pp_enterwrite)
 
     cv = GvFORM(fgv);
     if (!cv) {
+        char *name = NULL;
        if (fgv) {
            SV *tmpsv = sv_newmortal();
-           gv_efullname3(tmpsv, fgv, Nullch);
-           DIE(aTHX_ "Undefined format \"%s\" called",SvPVX(tmpsv));
+           gv_efullname4(tmpsv, fgv, Nullch, FALSE);
+           name = SvPV_nolen(tmpsv);
        }
+       if (name && *name)
+           DIE(aTHX_ "Undefined format \"%s\" called", name);
        DIE(aTHX_ "Not a format reference");
     }
     if (CvCLONE(cv))
@@ -1250,10 +1258,19 @@ PP(pp_leavewrite)
        if (!fgv)
            DIE(aTHX_ "bad top format reference");
        cv = GvFORM(fgv);
-       if (!cv) {
-           SV *tmpsv = sv_newmortal();
-           gv_efullname3(tmpsv, fgv, Nullch);
-           DIE(aTHX_ "Undefined top format \"%s\" called",SvPVX(tmpsv));
+       {
+           char *name = NULL;
+           if (!cv) {
+               SV *sv = sv_newmortal();
+               gv_efullname4(sv, fgv, Nullch, FALSE);
+               name = SvPV_nolen(sv);
+           }
+           if (name && *name)
+               DIE(aTHX_ "Undefined top format \"%s\" called",name);
+           /* why no:
+           else
+               DIE(aTHX_ "Undefined top format called");
+           ?*/
        }
        if (CvCLONE(cv))
            cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
@@ -1269,14 +1286,22 @@ PP(pp_leavewrite)
     if (!fp) {
        if (ckWARN2(WARN_CLOSED,WARN_IO)) {
            if (IoIFP(io)) {
-               SV* sv = sv_newmortal();
-               gv_efullname3(sv, gv, Nullch);
-               Perl_warner(aTHX_ WARN_IO,
-                           "Filehandle %s opened only for input",
-                           SvPV_nolen(sv));
+               /* integrate with report_evil_fh()? */
+               char *name = NULL;
+               if (isGV(gv)) {
+                   SV* sv = sv_newmortal();
+                   gv_efullname4(sv, gv, Nullch, FALSE);
+                   name = SvPV_nolen(sv);
+               }
+               if (name && *name)
+                   Perl_warner(aTHX_ WARN_IO,
+                               "Filehandle %s opened only for input", name);
+               else
+                   Perl_warner(aTHX_ WARN_IO,
+                               "Filehandle opened only for input");
            }
            else if (ckWARN(WARN_CLOSED))
-               report_closed_fh(gv, io, "write", "filehandle");
+               report_evil_fh(gv, io, PL_op->op_type);
        }
        PUSHs(&PL_sv_no);
     }
@@ -1339,24 +1364,30 @@ PP(pp_prtf)
 
     sv = NEWSV(0,0);
     if (!(io = GvIO(gv))) {
-       if (ckWARN(WARN_UNOPENED)) {
-           gv_efullname3(sv, gv, Nullch);
-           Perl_warner(aTHX_ WARN_UNOPENED,
-                       "Filehandle %s never opened", SvPV(sv,n_a));
-       }
+        dTHR;
+       if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+           report_evil_fh(gv, io, PL_op->op_type);
        SETERRNO(EBADF,RMS$_IFI);
        goto just_say_no;
     }
     else if (!(fp = IoOFP(io))) {
        if (ckWARN2(WARN_CLOSED,WARN_IO))  {
+           /* integrate with report_evil_fh()? */
            if (IoIFP(io)) {
-               gv_efullname3(sv, gv, Nullch);
-               Perl_warner(aTHX_ WARN_IO,
-                           "Filehandle %s opened only for input",
-                           SvPV(sv,n_a));
+               char *name = NULL;
+               if (isGV(gv)) {
+                   gv_efullname4(sv, gv, Nullch, FALSE);
+                   name = SvPV_nolen(sv);
+               }
+               if (name && *name)
+                   Perl_warner(aTHX_ WARN_IO,
+                               "Filehandle %s opened only for input", name);
+               else
+                   Perl_warner(aTHX_ WARN_IO,
+                               "Filehandle opened only for input");
            }
            else if (ckWARN(WARN_CLOSED))
-               report_closed_fh(gv, io, "printf", "filehandle");
+               report_evil_fh(gv, io, PL_op->op_type);
        }
        SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
        goto just_say_no;
@@ -1510,7 +1541,7 @@ PP(pp_sysread)
     }
     if (PL_op->op_type == OP_SYSREAD) {
 #ifdef PERL_SOCK_SYSREAD_IS_RECV
-       if (IoTYPE(io) == 's') {
+       if (IoTYPE(io) == IoTYPE_SOCKET) {
            length = PerlSock_recv(PerlIO_fileno(IoIFP(io)),
                                   buffer+offset, length, 0);
        }
@@ -1523,7 +1554,7 @@ PP(pp_sysread)
     }
     else
 #ifdef HAS_SOCKET__bad_code_maybe
-    if (IoTYPE(io) == 's') {
+    if (IoTYPE(io) == IoTYPE_SOCKET) {
        char namebuf[MAXPATHLEN];
 #if defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)
        bufsize = sizeof (struct sockaddr_in);
@@ -1542,13 +1573,22 @@ PP(pp_sysread)
            length = -1;
     }
     if (length < 0) {
-       if ((IoTYPE(io) == '>' || IoIFP(io) == PerlIO_stdout()
+       if ((IoTYPE(io) == IoTYPE_WRONLY || IoIFP(io) == PerlIO_stdout()
            || IoIFP(io) == PerlIO_stderr()) && ckWARN(WARN_IO))
        {
-           SV* sv = sv_newmortal();
-           gv_efullname3(sv, gv, Nullch);
-           Perl_warner(aTHX_ WARN_IO, "Filehandle %s opened only for output",
-                       SvPV_nolen(sv));
+           /* integrate with report_evil_fh()? */
+           char *name = NULL;
+           if (isGV(gv)) {
+               SV* sv = sv_newmortal();
+               gv_efullname4(sv, gv, Nullch, FALSE);
+               name = SvPV_nolen(sv);
+           }
+           if (name && *name)
+               Perl_warner(aTHX_ WARN_IO,
+                           "Filehandle %s opened only for output", name);
+           else
+               Perl_warner(aTHX_ WARN_IO,
+                           "Filehandle opened only for output");
        }
        goto say_undef;
     }
@@ -1625,12 +1665,8 @@ PP(pp_send)
     io = GvIO(gv);
     if (!io || !IoIFP(io)) {
        retval = -1;
-       if (ckWARN(WARN_CLOSED)) {
-           if (PL_op->op_type == OP_SYSWRITE)
-               report_closed_fh(gv, io, "syswrite", "filehandle");
-           else
-               report_closed_fh(gv, io, "send", "socket");
-       }
+       if (ckWARN(WARN_CLOSED))
+           report_evil_fh(gv, io, PL_op->op_type);
     }
     else if (PL_op->op_type == OP_SYSWRITE) {
        if (MARK < SP) {
@@ -1646,7 +1682,7 @@ PP(pp_send)
        if (length > blen - offset)
            length = blen - offset;
 #ifdef PERL_SOCK_SYSWRITE_IS_SEND
-       if (IoTYPE(io) == 's') {
+       if (IoTYPE(io) == IoTYPE_SOCKET) {
            retval = PerlSock_send(PerlIO_fileno(IoIFP(io)),
                                   buffer+offset, length, 0);
        }
@@ -1987,6 +2023,7 @@ PP(pp_flock)
     I32 value;
     int argtype;
     GV *gv;
+    IO *io = NULL;
     PerlIO *fp;
 
 #ifdef FLOCK
@@ -1995,19 +2032,21 @@ PP(pp_flock)
        gv = PL_last_in_gv;
     else
        gv = (GV*)POPs;
-    if (gv && GvIO(gv))
-       fp = IoIFP(GvIOp(gv));
-    else
+    if (gv && (io = GvIO(gv)))
+       fp = IoIFP(io);
+    else {
        fp = Nullfp;
+       io = NULL;
+    }
     if (fp) {
        (void)PerlIO_flush(fp);
        value = (I32)(PerlLIO_flock(PerlIO_fileno(fp), argtype) >= 0);
     }
     else {
+       if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+           report_evil_fh(gv, io, PL_op->op_type);
        value = 0;
        SETERRNO(EBADF,RMS$_IFI);
-       if (ckWARN(WARN_CLOSED))
-           report_closed_fh(gv, GvIO(gv), "flock", "filehandle");
     }
     PUSHi(value);
     RETURN;
@@ -2046,7 +2085,7 @@ PP(pp_socket)
        RETPUSHUNDEF;
     IoIFP(io) = PerlIO_fdopen(fd, "r");        /* stdio gets confused about sockets */
     IoOFP(io) = PerlIO_fdopen(fd, "w");
-    IoTYPE(io) = 's';
+    IoTYPE(io) = IoTYPE_SOCKET;
     if (!IoIFP(io) || !IoOFP(io)) {
        if (IoIFP(io)) PerlIO_close(IoIFP(io));
        if (IoOFP(io)) PerlIO_close(IoOFP(io));
@@ -2093,10 +2132,10 @@ PP(pp_sockpair)
        RETPUSHUNDEF;
     IoIFP(io1) = PerlIO_fdopen(fd[0], "r");
     IoOFP(io1) = PerlIO_fdopen(fd[0], "w");
-    IoTYPE(io1) = 's';
+    IoTYPE(io1) = IoTYPE_SOCKET;
     IoIFP(io2) = PerlIO_fdopen(fd[1], "r");
     IoOFP(io2) = PerlIO_fdopen(fd[1], "w");
-    IoTYPE(io2) = 's';
+    IoTYPE(io2) = IoTYPE_SOCKET;
     if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
        if (IoIFP(io1)) PerlIO_close(IoIFP(io1));
        if (IoOFP(io1)) PerlIO_close(IoOFP(io1));
@@ -2168,7 +2207,7 @@ PP(pp_bind)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-       report_closed_fh(gv, io, "bind", "socket");
+       report_evil_fh(gv, io, PL_op->op_type);
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -2198,7 +2237,7 @@ PP(pp_connect)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-       report_closed_fh(gv, io, "connect", "socket");
+       report_evil_fh(gv, io, PL_op->op_type);
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -2224,7 +2263,7 @@ PP(pp_listen)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-       report_closed_fh(gv, io, "listen", "socket");
+       report_evil_fh(gv, io, PL_op->op_type);
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -2265,7 +2304,7 @@ PP(pp_accept)
        goto badexit;
     IoIFP(nstio) = PerlIO_fdopen(fd, "r");
     IoOFP(nstio) = PerlIO_fdopen(fd, "w");
-    IoTYPE(nstio) = 's';
+    IoTYPE(nstio) = IoTYPE_SOCKET;
     if (!IoIFP(nstio) || !IoOFP(nstio)) {
        if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio));
        if (IoOFP(nstio)) PerlIO_close(IoOFP(nstio));
@@ -2281,7 +2320,7 @@ PP(pp_accept)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-       report_closed_fh(ggv, ggv ? GvIO(ggv) : 0, "accept", "socket");
+       report_evil_fh(ggv, ggv ? GvIO(ggv) : 0, PL_op->op_type);
     SETERRNO(EBADF,SS$_IVCHAN);
 
 badexit:
@@ -2308,7 +2347,7 @@ PP(pp_shutdown)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-       report_closed_fh(gv, io, "shutdown", "socket");
+       report_evil_fh(gv, io, PL_op->op_type);
     SETERRNO(EBADF,SS$_IVCHAN);
     RETPUSHUNDEF;
 #else
@@ -2387,9 +2426,7 @@ PP(pp_ssockopt)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-       report_closed_fh(gv, io,
-                        optype == OP_GSOCKOPT ? "getsockopt" : "setsockopt",
-                        "socket");
+       report_evil_fh(gv, io, optype);
     SETERRNO(EBADF,SS$_IVCHAN);
 nuts2:
     RETPUSHUNDEF;
@@ -2462,10 +2499,7 @@ PP(pp_getpeername)
 
 nuts:
     if (ckWARN(WARN_CLOSED))
-       report_closed_fh(gv, io,
-                        optype == OP_GETSOCKNAME ? "getsockname"
-                                                 : "getpeername",
-                        "socket");
+       report_evil_fh(gv, io, optype);
     SETERRNO(EBADF,SS$_IVCHAN);
 nuts2:
     RETPUSHUNDEF;
@@ -2485,32 +2519,39 @@ PP(pp_lstat)
 PP(pp_stat)
 {
     djSP;
-    GV *tmpgv;
+    GV *gv;
     I32 gimme;
     I32 max = 13;
     STRLEN n_a;
 
     if (PL_op->op_flags & OPf_REF) {
-       tmpgv = cGVOP_gv;
+       gv = cGVOP_gv;
+       if (PL_op->op_type == OP_LSTAT && ckWARN(WARN_IO))
+           Perl_warner(aTHX_ WARN_IO,
+                       "lstat() on filehandle %s", GvENAME(gv));
       do_fstat:
-       if (tmpgv != PL_defgv) {
+       if (gv != PL_defgv) {
            PL_laststype = OP_STAT;
-           PL_statgv = tmpgv;
+           PL_statgv = gv;
            sv_setpv(PL_statname, "");
-           PL_laststatval = (GvIO(tmpgv) && IoIFP(GvIOp(tmpgv))
-               ? PerlLIO_fstat(PerlIO_fileno(IoIFP(GvIOn(tmpgv))), &PL_statcache) : -1);
+           PL_laststatval = (GvIO(gv) && IoIFP(GvIOp(gv))
+               ? PerlLIO_fstat(PerlIO_fileno(IoIFP(GvIOn(gv))), &PL_statcache) : -1);
        }
-       if (PL_laststatval < 0)
+       if (PL_laststatval < 0) {
+           dTHR;
+           if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
+               report_evil_fh(gv, GvIO(gv), PL_op->op_type);
            max = 0;
+       }
     }
     else {
        SV* sv = POPs;
        if (SvTYPE(sv) == SVt_PVGV) {
-           tmpgv = (GV*)sv;
+           gv = (GV*)sv;
            goto do_fstat;
        }
        else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
-           tmpgv = (GV*)SvRV(sv);
+           gv = (GV*)SvRV(sv);
            goto do_fstat;
        }
        sv_setpv(PL_statname, SvPV(sv,n_a));
@@ -3052,10 +3093,10 @@ PP(pp_fttext)
                len = 512;
        }
        else {
-           if (ckWARN(WARN_UNOPENED)) {
+           dTHR;
+           if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) {
                gv = cGVOP_gv;
-               Perl_warner(aTHX_ WARN_UNOPENED, "Test on unopened file <%s>",
-                           GvENAME(gv));
+               report_evil_fh(gv, GvIO(gv), PL_op->op_type);
            }
            SETERRNO(EBADF,RMS$_IFI);
            RETPUSHUNDEF;
@@ -3697,7 +3738,12 @@ PP(pp_wait)
     int argflags;
 
     childpid = wait4pid(-1, &argflags, 0);
+#  if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
+    /* 0 and -1 are both error returns (the former applies to WNOHANG case) */
+    STATUS_NATIVE_SET((childpid && childpid != -1) ? argflags : -1);
+#  else
     STATUS_NATIVE_SET((childpid > 0) ? argflags : -1);
+#  endif
     XPUSHi(childpid);
     RETURN;
 #else
@@ -3716,7 +3762,12 @@ PP(pp_waitpid)
     optype = POPi;
     childpid = TOPi;
     childpid = wait4pid(childpid, &argflags, optype);
+#  if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
+    /* 0 and -1 are both error returns (the former applies to WNOHANG case) */
+    STATUS_NATIVE_SET((childpid && childpid != -1) ? argflags : -1);
+#  else
     STATUS_NATIVE_SET((childpid > 0) ? argflags : -1);
+#  endif
     SETi(childpid);
     RETURN;
 #else
@@ -3744,7 +3795,7 @@ PP(pp_system)
        }
     }
     PERL_FLUSHALL_FOR_CHILD;
-#if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2) && !defined(__CYGWIN__)
+#if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2) && !defined(__CYGWIN__) || defined(PERL_MICRO)
     if (PerlProc_pipe(pp) >= 0)
        did_pipes = 1;
     while ((childpid = vfork()) == -1) {
@@ -3763,13 +3814,17 @@ PP(pp_system)
     if (childpid > 0) {
        if (did_pipes)
            PerlLIO_close(pp[1]);
+#ifndef PERL_MICRO
        rsignal_save(SIGINT, SIG_IGN, &ihand);
        rsignal_save(SIGQUIT, SIG_IGN, &qhand);
+#endif
        do {
            result = wait4pid(childpid, &status, 0);
        } while (result == -1 && errno == EINTR);
+#ifndef PERL_MICRO
        (void)rsignal_restore(SIGINT, &ihand);
        (void)rsignal_restore(SIGQUIT, &qhand);
+#endif
        STATUS_NATIVE_SET(result == -1 ? -1 : status);
        do_execfree();  /* free any memory child malloced on vfork */
        SP = ORIGMARK;
@@ -3813,6 +3868,8 @@ PP(pp_system)
     }
     PerlProc__exit(-1);
 #else /* ! FORK or VMS or OS/2 */
+    PL_statusvalue = 0;
+    result = 0;
     if (PL_op->op_flags & OPf_STACKED) {
        SV *really = *++MARK;
        value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
@@ -3822,10 +3879,12 @@ PP(pp_system)
     else {
        value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), n_a));
     }
+    if (PL_statusvalue == -1)  /* hint that value must be returned as is */
+       result = 1;
     STATUS_NATIVE_SET(value);
     do_execfree();
     SP = ORIGMARK;
-    PUSHi(STATUS_CURRENT);
+    PUSHi(result ? value : STATUS_CURRENT);
 #endif /* !FORK or VMS */
     RETURN;
 }
@@ -4773,11 +4832,59 @@ PP(pp_gpwent)
     register SV *sv;
     STRLEN n_a;
     struct passwd *pwent  = NULL;
-/* We do not use HAS_GETSPENT in pp_gpwent() but leave it here in the case
- * somebody wants to write an XS to access the shadow passwords. --jhi */
-#   ifdef HAS_GETSPNAM
-    struct spwd   *spwent = NULL;
-#   endif
+    /* 
+     * We currently support only the SysV getsp* shadow password interface.
+     * The interface is declared in <shadow.h> and often one needs to link
+     * with -lsecurity or some such.
+     * This interface is used at least by Solaris, HP-UX, IRIX, and Linux.
+     * (and SCO?)
+     *
+     * AIX getpwnam() is clever enough to return the encrypted password
+     * only if the caller (euid?) is root.
+     *
+     * There are at least two other shadow password APIs.  Many platforms
+     * seem to contain more than one interface for accessing the shadow
+     * password databases, possibly for compatibility reasons.
+     * The getsp*() is by far he simplest one, the other two interfaces
+     * are much more complicated, but also very similar to each other.
+     *
+     * <sys/types.h>
+     * <sys/security.h>
+     * <prot.h>
+     * struct pr_passwd *getprpw*();
+     * The password is in
+     * char getprpw*(...).ufld.fd_encrypt[]
+     * Mention HAS_GETPRPWNAM here so that Configure probes for it.
+     *
+     * <sys/types.h>
+     * <sys/security.h>
+     * <prot.h>
+     * struct es_passwd *getespw*();
+     * The password is in
+     * char *(getespw*(...).ufld.fd_encrypt)
+     * Mention HAS_GETESPWNAM here so that Configure probes for it.
+     *
+     * Mention I_PROT here so that Configure probes for it.
+     *
+     * In HP-UX for getprpw*() the manual page claims that one should include
+     * <hpsecurity.h> instead of <sys/security.h>, but that is not needed
+     * if one includes <shadow.h> as that includes <hpsecurity.h>,
+     * and pp_sys.c already includes <shadow.h> if there is such.
+     *
+     * Note that <sys/security.h> is already probed for, but currently
+     * it is only included in special cases.
+     * 
+     * In Digital UNIX/Tru64 if using the getespw*() (which seems to be
+     * be preferred interface, even though also the getprpw*() interface
+     * is available) one needs to link with -lsecurity -ldb -laud -lm.
+     * One also needs to call set_auth_parameters() in main() before
+     * doing anything else, whether one is using getespw*() or getprpw*().
+     *
+     * Note that accessing the shadow databases can be magnitudes
+     * slower than accessing the standard databases.
+     *
+     * --jhi
+     */
 
     switch (which) {
     case OP_GPWNAM:
@@ -4816,17 +4923,44 @@ PP(pp_gpwent)
        sv_setpv(sv, pwent->pw_name);
 
        PUSHs(sv = sv_mortalcopy(&PL_sv_no));
+       SvPOK_off(sv);
+       /* If we have getspnam(), we try to dig up the shadow
+        * password.  If we are underprivileged, the shadow
+        * interface will set the errno to EACCES or similar,
+        * and return a null pointer.  If this happens, we will
+        * use the dummy password (usually "*" or "x") from the
+        * standard password database.
+        *
+        * In theory we could skip the shadow call completely
+        * if euid != 0 but in practice we cannot know which
+        * security measures are guarding the shadow databases
+        * on a random platform.
+        *
+        * Resist the urge to use additional shadow interfaces.
+        * Divert the urge to writing an extension instead.
+        *
+        * --jhi */
 #   ifdef HAS_GETSPNAM
-       spwent = getspnam(pwent->pw_name);
-       if (spwent)
-           sv_setpv(sv, spwent->sp_pwdp);
-       else
-           sv_setpv(sv, pwent->pw_passwd);
-#   else
-       sv_setpv(sv, pwent->pw_passwd);
+       {
+           struct spwd *spwent;
+           int saverrno; /* Save and restore errno so that
+                          * underprivileged attempts seem
+                          * to have never made the unsccessful
+                          * attempt to retrieve the shadow password. */
+
+           saverrno = errno;
+           spwent = getspnam(pwent->pw_name);
+           errno = saverrno;
+           if (spwent && spwent->sp_pwdp)
+               sv_setpv(sv, spwent->sp_pwdp);
+       }
 #   endif
+       if (!SvPOK(sv)) /* Use the standard password, then. */
+           sv_setpv(sv, pwent->pw_passwd);
+
 #   ifndef INCOMPLETE_TAINTS
-       /* passwd is tainted because user himself can diddle with it. */
+       /* passwd is tainted because user himself can diddle with it.
+        * admittedly not much and in a very limited way, but nevertheless. */
        SvTAINTED_on(sv);
 #   endif
 
@@ -4843,7 +4977,11 @@ PP(pp_gpwent)
 #   else
        sv_setuv(sv, (UV)pwent->pw_gid);
 #   endif
-       /* pw_change, pw_quota, and pw_age are mutually exclusive. */
+       /* pw_change, pw_quota, and pw_age are mutually exclusive--
+        * because of the poor interface of the Perl getpw*(),
+        * not because there's some standard/convention saying so.
+        * A better interface would have been to return a hash,
+        * but we are accursed by our history, alas. --jhi.  */
        PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 #   ifdef PWCHANGE
        sv_setiv(sv, (IV)pwent->pw_change);
@@ -4857,7 +4995,8 @@ PP(pp_gpwent)
 #       endif
 #   endif
 
-       /* pw_class and pw_comment are mutually exclusive. */
+       /* pw_class and pw_comment are mutually exclusive--.
+        * see the above note for pw_change, pw_quota, and pw_age. */
        PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 #   ifdef PWCLASS
        sv_setpv(sv, pwent->pw_class);
@@ -4902,9 +5041,6 @@ PP(pp_spwent)
     djSP;
 #if defined(HAS_PASSWD) && defined(HAS_SETPWENT)
     setpwent();
-#   ifdef HAS_SETSPENT
-    setspent();
-#   endif
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_func, "setpwent");
@@ -4916,9 +5052,6 @@ PP(pp_epwent)
     djSP;
 #if defined(HAS_PASSWD) && defined(HAS_ENDPWENT)
     endpwent();
-#   ifdef HAS_ENDSPENT
-    endspent();
-#   endif
     RETPUSHYES;
 #else
     DIE(aTHX_ PL_no_func, "endpwent");