This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
check ferror() only if read() returned 0
[perl5.git] / pp_sys.c
index 57e4099..f880719 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -54,7 +54,11 @@ extern "C" int syscall(unsigned long,...);
 #endif
 #endif
 
-#ifdef HOST_NOT_FOUND
+/* XXX Configure test needed.
+   h_errno might not be a simple 'int', especially for multi-threaded
+   applications.  HOST_NOT_FOUND is typically defined in <netdb.h>.
+*/
+#if defined(HOST_NOT_FOUND) && !defined(h_errno)
 extern int h_errno;
 #endif
 
@@ -65,7 +69,9 @@ extern int h_errno;
     struct passwd *getpwnam _((char *));
     struct passwd *getpwuid _((Uid_t));
 # endif
+# ifdef HAS_GETPWENT
   struct passwd *getpwent _((void));
+# endif
 #endif
 
 #ifdef HAS_GROUP
@@ -75,7 +81,9 @@ extern int h_errno;
     struct group *getgrnam _((char *));
     struct group *getgrgid _((Gid_t));
 # endif
+# ifdef HAS_GETGRENT
     struct group *getgrent _((void));
+# endif
 #endif
 
 #ifdef I_UTIME
@@ -203,7 +211,7 @@ PP(pp_backtick)
            SV *sv;
 
            for (;;) {
-               sv = NEWSV(56, 80);
+               sv = NEWSV(56, 79);
                if (sv_gets(sv, fp, 0) == Nullch) {
                    SvREFCNT_dec(sv);
                    break;
@@ -260,11 +268,13 @@ PP(pp_glob)
     return result;
 }
 
+#if 0          /* XXX never used! */
 PP(pp_indread)
 {
     last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*stack_sp--)), na), TRUE,SVt_PVIO);
     return do_readline();
 }
+#endif
 
 PP(pp_rcatline)
 {
@@ -286,10 +296,11 @@ PP(pp_warn)
        tmps = SvPV(TOPs, na);
     }
     if (!tmps || !*tmps) {
-       (void)SvUPGRADE(ERRSV, SVt_PV);
-       if (SvPOK(ERRSV) && SvCUR(ERRSV))
-           sv_catpv(ERRSV, "\t...caught");
-       tmps = SvPV(ERRSV, na);
+       SV *error = ERRSV;
+       (void)SvUPGRADE(error, SVt_PV);
+       if (SvPOK(error) && SvCUR(error))
+           sv_catpv(error, "\t...caught");
+       tmps = SvPV(error, na);
     }
     if (!tmps || !*tmps)
        tmps = "Warning: something's wrong";
@@ -301,6 +312,8 @@ PP(pp_die)
 {
     djSP; dMARK;
     char *tmps;
+    SV *tmpsv = Nullsv;
+    char *pat = "%s";
     if (SP - MARK != 1) {
        dTARGET;
        do_join(TARG, &sv_no, MARK, SP);
@@ -308,17 +321,43 @@ PP(pp_die)
        SP = MARK + 1;
     }
     else {
-       tmps = SvPV(TOPs, na);
+       tmpsv = TOPs;
+       tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, na);
     }
     if (!tmps || !*tmps) {
-       (void)SvUPGRADE(ERRSV, SVt_PV);
-       if (SvPOK(ERRSV) && SvCUR(ERRSV))
-           sv_catpv(ERRSV, "\t...propagated");
-       tmps = SvPV(ERRSV, na);
+       SV *error = ERRSV;
+       (void)SvUPGRADE(error, SVt_PV);
+       if(tmpsv ? SvROK(tmpsv) : SvROK(error)) {
+           if(tmpsv)
+               SvSetSV(error,tmpsv);
+           else if(sv_isobject(error)) {
+               HV *stash = SvSTASH(SvRV(error));
+               GV *gv = gv_fetchmethod(stash, "PROPAGATE");
+               if (gv) {
+                   SV *file = sv_2mortal(newSVsv(GvSV(curcop->cop_filegv)));
+                   SV *line = sv_2mortal(newSViv(curcop->cop_line));
+                   EXTEND(SP, 3);
+                   PUSHMARK(SP);
+                   PUSHs(error);
+                   PUSHs(file);
+                   PUSHs(line);
+                   PUTBACK;
+                   perl_call_sv((SV*)GvCV(gv),
+                                G_SCALAR|G_EVAL|G_KEEPERR);
+                   sv_setsv(error,*stack_sp--);
+               }
+           }
+           pat = Nullch;
+       }
+       else {
+           if (SvPOK(error) && SvCUR(error))
+               sv_catpv(error, "\t...propagated");
+           tmps = SvPV(error, na);
+       }
     }
     if (!tmps || !*tmps)
        tmps = "Died";
-    DIE("%s", tmps);
+    DIE(pat, tmps);
 }
 
 /* I/O. */
@@ -460,7 +499,12 @@ PP(pp_umask)
     TAINT_PROPER("umask");
     XPUSHi(anum);
 #else
-    DIE(no_func, "Unsupported function umask");
+    /* Only DIE if trying to restrict permissions on `user' (self).
+     * Otherwise it's harmless and more useful to just return undef
+     * since 'group' and 'other' concepts probably don't exist here. */
+    if (MAXARG >= 1 && (POPi & 0700))
+       DIE("umask not implemented");
+    XPUSHs(&sv_undef);
 #endif
     RETURN;
 }
@@ -481,56 +525,27 @@ PP(pp_binmode)
     if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
        RETPUSHUNDEF;
 
-#ifdef DOSISH
-#ifdef atarist
-    if (!PerlIO_flush(fp) && (fp->_flag |= _IOBIN))
-       RETPUSHYES;
-    else
-       RETPUSHUNDEF;
-#else
-    if (PerlLIO_setmode(PerlIO_fileno(fp), OP_BINARY) != -1) {
-#if defined(WIN32) && defined(__BORLANDC__)
-       /* The translation mode of the stream is maintained independent
-        * of the translation mode of the fd in the Borland RTL (heavy
-        * digging through their runtime sources reveal).  User has to
-        * set the mode explicitly for the stream (though they don't
-        * document this anywhere). GSAR 97-5-24
-        */
-       PerlIO_seek(fp,0L,0);
-       fp->flags |= _F_BIN;
-#endif
+    if (do_binmode(fp,IoTYPE(io),TRUE)) 
        RETPUSHYES;
-    }
     else
        RETPUSHUNDEF;
-#endif
-#else
-#if defined(USEMYBINMODE)
-    if (my_binmode(fp,IoTYPE(io)) != NULL)
-       RETPUSHYES;
-       else
-       RETPUSHUNDEF;
-#else
-    RETPUSHYES;
-#endif
-#endif
-
 }
 
 
 PP(pp_tie)
 {
     djSP;
+    dMARK;
     SV *varsv;
     HV* stash;
     GV *gv;
     SV *sv;
-    SV **mark = stack_base + ++*markstack_ptr; /* reuse in entersub */
-    I32 markoff = mark - stack_base - 1;
+    I32 markoff = MARK - stack_base;
     char *methname;
     int how = 'P';
+    U32 items;
 
-    varsv = mark[0];  
+    varsv = *++MARK;
     switch(SvTYPE(varsv)) {
        case SVt_PVHV:
            methname = "TIEHASH";
@@ -547,26 +562,39 @@ PP(pp_tie)
            how = 'q';
            break;
     }
-
-    if (sv_isobject(mark[1])) {
+    items = SP - MARK++;
+    if (sv_isobject(*MARK)) {
        ENTER;
+       PUSHSTACKi(PERLSI_MAGIC);
+       PUSHMARK(SP);
+       EXTEND(SP,items);
+       while (items--)
+           PUSHs(*MARK++);
+       PUTBACK;
        perl_call_method(methname, G_SCALAR);
     } 
     else {
        /* Not clear why we don't call perl_call_method here too.
         * perhaps to get different error message ?
         */
-       stash = gv_stashsv(mark[1], FALSE);
+       stash = gv_stashsv(*MARK, FALSE);
        if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
            DIE("Can't locate object method \"%s\" via package \"%s\"",
-                methname, SvPV(mark[1],na));                   
+                methname, SvPV(*MARK,na));                   
        }
        ENTER;
+       PUSHSTACKi(PERLSI_MAGIC);
+       PUSHMARK(SP);
+       EXTEND(SP,items);
+       while (items--)
+           PUSHs(*MARK++);
+       PUTBACK;
        perl_call_sv((SV*)GvCV(gv), G_SCALAR);
     }
     SPAGAIN;
 
     sv = TOPs;
+    POPSTACK;
     if (sv_isobject(sv)) {
        sv_unmagic(varsv, how);            
        sv_magic(varsv, sv, how, Nullch, 0);
@@ -581,7 +609,8 @@ PP(pp_untie)
 {
     djSP;
     SV * sv ;
-    sv = POPs;          
+
+    sv = POPs;
 
     if (dowarn) {
         MAGIC * mg ;
@@ -648,9 +677,9 @@ PP(pp_dbmopen)
     }
 
     ENTER;
-    PUSHMARK(sp);
+    PUSHMARK(SP);
 
-    EXTEND(sp, 5);
+    EXTEND(SP, 5);
     PUSHs(sv);
     PUSHs(left);
     if (SvIV(right))
@@ -663,8 +692,8 @@ PP(pp_dbmopen)
     SPAGAIN;
 
     if (!sv_isobject(TOPs)) {
-       sp--;
-       PUSHMARK(sp);
+       SP--;
+       PUSHMARK(SP);
        PUSHs(sv);
        PUSHs(left);
        PUSHs(sv_2mortal(newSViv(O_RDONLY)));
@@ -906,7 +935,7 @@ PP(pp_read)
     return pp_sysread(ARGS);
 }
 
-static OP *
+STATIC OP *
 doform(CV *cv, GV *gv, OP *retop)
 {
     dTHR;
@@ -1243,7 +1272,7 @@ PP(pp_sysread)
 #ifdef HAS_SOCKET
     if (op->op_type == OP_RECV) {
        char namebuf[MAXPATHLEN];
-#if defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)
+#if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(MPE)
        bufsize = sizeof (struct sockaddr_in);
 #else
        bufsize = sizeof namebuf;
@@ -1297,7 +1326,12 @@ PP(pp_sysread)
     }
     else
 #endif
+    {
        length = PerlIO_read(IoIFP(io), buffer+offset, length);
+       /* fread() returns 0 on both error and EOF */
+       if (length == 0 && PerlIO_error(IoIFP(io)))
+           length = -1;
+    }
     if (length < 0)
        goto say_undef;
     SvCUR_set(bufsv, length+offset);
@@ -1569,7 +1603,7 @@ PP(pp_ioctl)
 
     if (optype == OP_IOCTL)
 #ifdef HAS_IOCTL
-       retval = ioctl(PerlIO_fileno(IoIFP(io)), func, s);
+       retval = PerlLIO_ioctl(PerlIO_fileno(IoIFP(io)), func, s);
 #else
        DIE("ioctl is not implemented");
 #endif
@@ -1623,7 +1657,7 @@ PP(pp_flock)
        fp = Nullfp;
     if (fp) {
        (void)PerlIO_flush(fp);
-       value = (I32)(FLOCK(PerlIO_fileno(fp), argtype) >= 0);
+       value = (I32)(PerlLIO_flock(PerlIO_fileno(fp), argtype) >= 0);
     }
     else
        value = 0;
@@ -1732,18 +1766,47 @@ PP(pp_bind)
 {
     djSP;
 #ifdef HAS_SOCKET
+#ifdef MPE /* Requires PRIV mode to bind() to ports < 1024 */
+    extern GETPRIVMODE();
+    extern GETUSERMODE();
+#endif
     SV *addrsv = POPs;
     char *addr;
     GV *gv = (GV*)POPs;
     register IO *io = GvIOn(gv);
     STRLEN len;
+    int bind_ok = 0;
+#ifdef MPE
+    int mpeprivmode = 0;
+#endif
 
     if (!io || !IoIFP(io))
        goto nuts;
 
     addr = SvPV(addrsv, len);
     TAINT_PROPER("bind");
-    if (PerlSock_bind(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
+#ifdef MPE /* Deal with MPE bind() peculiarities */
+    if (((struct sockaddr *)addr)->sa_family == AF_INET) {
+        /* The address *MUST* stupidly be zero. */
+        ((struct sockaddr_in *)addr)->sin_addr.s_addr = INADDR_ANY;
+        /* PRIV mode is required to bind() to ports < 1024. */
+        if (((struct sockaddr_in *)addr)->sin_port < 1024 &&
+            ((struct sockaddr_in *)addr)->sin_port > 0) {
+            GETPRIVMODE(); /* If this fails, we are aborted by MPE/iX. */
+           mpeprivmode = 1;
+       }
+    }
+#endif /* MPE */
+    if (PerlSock_bind(PerlIO_fileno(IoIFP(io)),
+                     (struct sockaddr *)addr, len) >= 0)
+       bind_ok = 1;
+
+#ifdef MPE /* Switch back to USER mode */
+    if (mpeprivmode)
+       GETUSERMODE();
+#endif /* MPE */
+
+    if (bind_ok)
        RETPUSHYES;
     else
        RETPUSHUNDEF;
@@ -1950,7 +2013,7 @@ PP(pp_ssockopt)
                buf = SvPV(sv, na);
                len = na;
            }
-           else if (SvOK(sv)) {
+           else {
                aint = (int)SvIV(sv);
                buf = (char*)&aint;
                len = sizeof(int);
@@ -2093,7 +2156,7 @@ PP(pp_stat)
            laststatval = PerlLIO_lstat(SvPV(statname, na), &statcache);
        else
 #endif
-           laststatval = Stat(SvPV(statname, na), &statcache);
+           laststatval = PerlLIO_stat(SvPV(statname, na), &statcache);
        if (laststatval < 0) {
            if (dowarn && strchr(SvPV(statname, na), '\n'))
                warn(warn_nl, "stat");
@@ -2585,6 +2648,13 @@ PP(pp_chdir)
        if (svp)
            tmps = SvPV(*svp, na);
     }
+#ifdef VMS
+    if (!tmps || !*tmps) {
+       svp = hv_fetch(GvHVn(envgv), "SYS$LOGIN", 9, FALSE);
+       if (svp)
+           tmps = SvPV(*svp, na);
+    }
+#endif
     TAINT_PROPER("chdir");
     PUSHi( PerlDir_chdir(tmps) >= 0 );
 #ifdef VMS
@@ -2662,13 +2732,13 @@ PP(pp_rename)
     char *tmps = SvPV(TOPs, na);
     TAINT_PROPER("rename");
 #ifdef HAS_RENAME
-    anum = rename(tmps, tmps2);
+    anum = PerlLIO_rename(tmps, tmps2);
 #else
-    if (!(anum = Stat(tmps, &statbuf))) {
+    if (!(anum = PerlLIO_stat(tmps, &statbuf))) {
        if (same_dirent(tmps2, tmps))   /* can always rename to same name */
            anum = 1;
        else {
-           if (euid || Stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
+           if (euid || PerlLIO_stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
                (void)UNLINK(tmps2);
            if (!(anum = link(tmps, tmps2)))
                anum = UNLINK(tmps);
@@ -2805,7 +2875,7 @@ char *filename;
            return 0;
        }
        else {  /* some mkdirs return no failure indication */
-           anum = (Stat(save_filename, &statbuf) >= 0);
+           anum = (PerlLIO_stat(save_filename, &statbuf) >= 0);
            if (op->op_type == OP_RMDIR)
                anum = !anum;
            if (anum)
@@ -3350,11 +3420,11 @@ PP(pp_tms)
     EXTEND(SP, 4);
 
 #ifndef VMS
-    (void)times(&timesbuf);
+    (void)PerlProc_times(&timesbuf);
 #else
-    (void)times((tbuffer_t *)&timesbuf);  /* time.h uses different name for */
-                                          /* struct tms, though same data   */
-                                          /* is returned.                   */
+    (void)PerlProc_times((tbuffer_t *)&timesbuf);  /* time.h uses different name for */
+                                                   /* struct tms, though same data   */
+                                                   /* is returned.                   */
 #endif
 
     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_utime)/HZ)));
@@ -3452,10 +3522,10 @@ PP(pp_sleep)
 
     (void)time(&lasttime);
     if (MAXARG < 1)
-       Pause();
+       PerlProc_pause();
     else {
        duration = POPi;
-       sleep((unsigned int)duration);
+       PerlProc_sleep((unsigned int)duration);
     }
     (void)time(&when);
     XPUSHi(when - lasttime);
@@ -3607,33 +3677,38 @@ PP(pp_ghostent)
     I32 which = op->op_type;
     register char **elem;
     register SV *sv;
-#if defined(HAS_GETHOSTENT) && !defined(DONT_DECLARE_STD)
+#ifndef HAS_GETHOST_PROTOS /* XXX Do we need individual probes? */
     struct hostent *PerlSock_gethostbyaddr(Netdb_host_t, Netdb_hlen_t, int);
     struct hostent *PerlSock_gethostbyname(Netdb_name_t);
-#ifndef PerlSock_gethostent
     struct hostent *PerlSock_gethostent(void);
 #endif
-#endif
     struct hostent *hent;
     unsigned long len;
 
     EXTEND(SP, 10);
-    if (which == OP_GHBYNAME) {
+    if (which == OP_GHBYNAME)
+#ifdef HAS_GETHOSTBYNAME
        hent = PerlSock_gethostbyname(POPp);
-    }
+#else
+       DIE(no_sock_func, "gethostbyname");
+#endif
     else if (which == OP_GHBYADDR) {
+#ifdef HAS_GETHOSTBYADDR
        int addrtype = POPi;
        SV *addrsv = POPs;
        STRLEN addrlen;
        Netdb_host_t addr = (Netdb_host_t) SvPV(addrsv, addrlen);
 
        hent = PerlSock_gethostbyaddr(addr, (Netdb_hlen_t) addrlen, addrtype);
+#else
+       DIE(no_sock_func, "gethostbyaddr");
+#endif
     }
     else
 #ifdef HAS_GETHOSTENT
        hent = PerlSock_gethostent();
 #else
-       DIE("gethostent not implemented");
+       DIE(no_sock_func, "gethostent");
 #endif
 
 #ifdef HOST_NOT_FOUND
@@ -3710,22 +3785,34 @@ PP(pp_gnetent)
     I32 which = op->op_type;
     register char **elem;
     register SV *sv;
-#ifdef NETDB_H_OMITS_GETNET
-    struct netent *getnetbyaddr(Netdb_net_t, int);
-    struct netent *getnetbyname(Netdb_name_t);
-    struct netent *getnetent(void);
+#ifndef HAS_GETNET_PROTOS /* XXX Do we need individual probes? */
+    struct netent *PerlSock_getnetbyaddr(Netdb_net_t, int);
+    struct netent *PerlSock_getnetbyname(Netdb_name_t);
+    struct netent *PerlSock_getnetent(void);
 #endif
     struct netent *nent;
 
     if (which == OP_GNBYNAME)
-       nent = getnetbyname(POPp);
+#ifdef HAS_GETNETBYNAME
+       nent = PerlSock_getnetbyname(POPp);
+#else
+        DIE(no_sock_func, "getnetbyname");
+#endif
     else if (which == OP_GNBYADDR) {
+#ifdef HAS_GETNETBYADDR
        int addrtype = POPi;
        Netdb_net_t addr = (Netdb_net_t) U_L(POPn);
-       nent = getnetbyaddr(addr, addrtype);
+       nent = PerlSock_getnetbyaddr(addr, addrtype);
+#else
+       DIE(no_sock_func, "getnetbyaddr");
+#endif
     }
     else
-       nent = getnetent();
+#ifdef HAS_GETNETENT
+       nent = PerlSock_getnetent();
+#else
+        DIE(no_sock_func, "getnetent");
+#endif
 
     EXTEND(SP, 4);
     if (GIMME != G_ARRAY) {
@@ -3785,13 +3872,11 @@ PP(pp_gprotoent)
     I32 which = op->op_type;
     register char **elem;
     register SV *sv;  
-#ifndef DONT_DECLARE_STD
+#ifndef HAS_GETPROTO_PROTOS /* XXX Do we need individual probes? */
     struct protoent *PerlSock_getprotobyname(Netdb_name_t);
     struct protoent *PerlSock_getprotobynumber(int);
-#ifndef PerlSock_getprotoent
     struct protoent *PerlSock_getprotoent(void);
 #endif
-#endif
     struct protoent *pent;
 
     if (which == OP_GPBYNAME)
@@ -3869,16 +3954,15 @@ PP(pp_gservent)
     I32 which = op->op_type;
     register char **elem;
     register SV *sv;
-#ifndef DONT_DECLARE_STD
+#ifndef HAS_GETSERV_PROTOS /* XXX Do we need individual probes? */
     struct servent *PerlSock_getservbyname(Netdb_name_t, Netdb_name_t);
     struct servent *PerlSock_getservbyport(int, Netdb_name_t);
-#ifndef PerlSock_getservent
     struct servent *PerlSock_getservent(void);
 #endif
-#endif
     struct servent *sent;
 
     if (which == OP_GSBYNAME) {
+#ifdef HAS_GETSERVBYNAME
        char *proto = POPp;
        char *name = POPp;
 
@@ -3886,8 +3970,12 @@ PP(pp_gservent)
            proto = Nullch;
 
        sent = PerlSock_getservbyname(name, proto);
+#else
+       DIE(no_sock_func, "getservbyname");
+#endif
     }
     else if (which == OP_GSBYPORT) {
+#ifdef HAS_GETSERVBYPORT
        char *proto = POPp;
        unsigned short port = POPu;
 
@@ -3895,6 +3983,9 @@ PP(pp_gservent)
        port = PerlSock_htons(port);
 #endif
        sent = PerlSock_getservbyport(port, proto);
+#else
+       DIE(no_sock_func, "getservbyport");
+#endif
     }
     else
 #ifdef HAS_GETSERVENT
@@ -3931,7 +4022,7 @@ PP(pp_gservent)
        }
        PUSHs(sv = sv_mortalcopy(&sv_no));
 #ifdef HAS_NTOHS
-       sv_setiv(sv, (IV)ntohs(sent->s_port));
+       sv_setiv(sv, (IV)PerlSock_ntohs(sent->s_port));
 #else
        sv_setiv(sv, (IV)(sent->s_port));
 #endif
@@ -3949,7 +4040,7 @@ PP(pp_shostent)
 {
     djSP;
 #ifdef HAS_SETHOSTENT
-    sethostent(TOPi);
+    PerlSock_sethostent(TOPi);
     RETSETYES;
 #else
     DIE(no_sock_func, "sethostent");
@@ -3960,7 +4051,7 @@ PP(pp_snetent)
 {
     djSP;
 #ifdef HAS_SETNETENT
-    setnetent(TOPi);
+    PerlSock_setnetent(TOPi);
     RETSETYES;
 #else
     DIE(no_sock_func, "setnetent");
@@ -3971,7 +4062,7 @@ PP(pp_sprotoent)
 {
     djSP;
 #ifdef HAS_SETPROTOENT
-    setprotoent(TOPi);
+    PerlSock_setprotoent(TOPi);
     RETSETYES;
 #else
     DIE(no_sock_func, "setprotoent");
@@ -3982,7 +4073,7 @@ PP(pp_sservent)
 {
     djSP;
 #ifdef HAS_SETSERVENT
-    setservent(TOPi);
+    PerlSock_setservent(TOPi);
     RETSETYES;
 #else
     DIE(no_sock_func, "setservent");
@@ -3993,8 +4084,8 @@ PP(pp_ehostent)
 {
     djSP;
 #ifdef HAS_ENDHOSTENT
-    endhostent();
-    EXTEND(sp,1);
+    PerlSock_endhostent();
+    EXTEND(SP,1);
     RETPUSHYES;
 #else
     DIE(no_sock_func, "endhostent");
@@ -4005,8 +4096,8 @@ PP(pp_enetent)
 {
     djSP;
 #ifdef HAS_ENDNETENT
-    endnetent();
-    EXTEND(sp,1);
+    PerlSock_endnetent();
+    EXTEND(SP,1);
     RETPUSHYES;
 #else
     DIE(no_sock_func, "endnetent");
@@ -4017,8 +4108,8 @@ PP(pp_eprotoent)
 {
     djSP;
 #ifdef HAS_ENDPROTOENT
-    endprotoent();
-    EXTEND(sp,1);
+    PerlSock_endprotoent();
+    EXTEND(SP,1);
     RETPUSHYES;
 #else
     DIE(no_sock_func, "endprotoent");
@@ -4029,8 +4120,8 @@ PP(pp_eservent)
 {
     djSP;
 #ifdef HAS_ENDSERVENT
-    endservent();
-    EXTEND(sp,1);
+    PerlSock_endservent();
+    EXTEND(SP,1);
     RETPUSHYES;
 #else
     DIE(no_sock_func, "endservent");
@@ -4058,7 +4149,7 @@ PP(pp_gpwuid)
 PP(pp_gpwent)
 {
     djSP;
-#ifdef HAS_PASSWD
+#if defined(HAS_PASSWD) && defined(HAS_GETPWENT)
     I32 which = op->op_type;
     register SV *sv;
     struct passwd *pwent;
@@ -4085,41 +4176,57 @@ PP(pp_gpwent)
     if (pwent) {
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setpv(sv, pwent->pw_name);
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
+#ifdef PWPASSWD
        sv_setpv(sv, pwent->pw_passwd);
+#endif
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setiv(sv, (IV)pwent->pw_uid);
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setiv(sv, (IV)pwent->pw_gid);
+
+       /* pw_change, pw_quota, and pw_age are mutually exclusive. */
        PUSHs(sv = sv_mortalcopy(&sv_no));
 #ifdef PWCHANGE
        sv_setiv(sv, (IV)pwent->pw_change);
 #else
-#ifdef PWQUOTA
+#   ifdef PWQUOTA
        sv_setiv(sv, (IV)pwent->pw_quota);
-#else
-#ifdef PWAGE
+#   else
+#       ifdef PWAGE
        sv_setpv(sv, pwent->pw_age);
+#       endif
+#   endif
 #endif
-#endif
-#endif
+
+       /* pw_class and pw_comment are mutually exclusive. */
        PUSHs(sv = sv_mortalcopy(&sv_no));
 #ifdef PWCLASS
        sv_setpv(sv, pwent->pw_class);
 #else
-#ifdef PWCOMMENT
+#   ifdef PWCOMMENT
        sv_setpv(sv, pwent->pw_comment);
+#   endif
 #endif
-#endif
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
+#ifdef PWGECOS
        sv_setpv(sv, pwent->pw_gecos);
+#endif
 #ifndef INCOMPLETE_TAINTS
+       /* pw_gecos is tainted because user himself can diddle with it. */
        SvTAINTED_on(sv);
 #endif
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setpv(sv, pwent->pw_dir);
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setpv(sv, pwent->pw_shell);
+
 #ifdef PWEXPIRE
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setiv(sv, (IV)pwent->pw_expire);
@@ -4134,7 +4241,7 @@ PP(pp_gpwent)
 PP(pp_spwent)
 {
     djSP;
-#if defined(HAS_PASSWD) && !defined(CYGWIN32)
+#if defined(HAS_PASSWD) && defined(HAS_SETPWENT) && !defined(CYGWIN32)
     setpwent();
     RETPUSHYES;
 #else
@@ -4145,7 +4252,7 @@ PP(pp_spwent)
 PP(pp_epwent)
 {
     djSP;
-#ifdef HAS_PASSWD
+#if defined(HAS_PASSWD) && defined(HAS_ENDPWENT)
     endpwent();
     RETPUSHYES;
 #else
@@ -4174,7 +4281,7 @@ PP(pp_ggrgid)
 PP(pp_ggrent)
 {
     djSP;
-#ifdef HAS_GROUP
+#if defined(HAS_GROUP) && defined(HAS_GETGRENT)
     I32 which = op->op_type;
     register char **elem;
     register SV *sv;
@@ -4202,10 +4309,15 @@ PP(pp_ggrent)
     if (grent) {
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setpv(sv, grent->gr_name);
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
+#ifdef GRPASSWD
        sv_setpv(sv, grent->gr_passwd);
+#endif
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setiv(sv, (IV)grent->gr_gid);
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
        for (elem = grent->gr_mem; elem && *elem; elem++) {
            sv_catpv(sv, *elem);
@@ -4223,7 +4335,7 @@ PP(pp_ggrent)
 PP(pp_sgrent)
 {
     djSP;
-#ifdef HAS_GROUP
+#if defined(HAS_GROUP) && defined(HAS_SETGRENT)
     setgrent();
     RETPUSHYES;
 #else
@@ -4234,7 +4346,7 @@ PP(pp_sgrent)
 PP(pp_egrent)
 {
     djSP;
-#ifdef HAS_GROUP
+#if defined(HAS_GROUP) && defined(HAS_ENDGRENT)
     endgrent();
     RETPUSHYES;
 #else
@@ -4248,7 +4360,7 @@ PP(pp_getlogin)
 #ifdef HAS_GETLOGIN
     char *tmps;
     EXTEND(SP, 1);
-    if (!(tmps = getlogin()))
+    if (!(tmps = PerlProc_getlogin()))
        RETPUSHUNDEF;
     PUSHp(tmps, strlen(tmps));
     RETURN;
@@ -4261,7 +4373,7 @@ PP(pp_getlogin)
 
 PP(pp_syscall)
 {
-#ifdef HAS_SYSCALL   
+#ifdef HAS_SYSCALL
     djSP; dMARK; dORIGMARK; dTARGET;
     register I32 items = SP - MARK;
     unsigned long a[20];
@@ -4475,4 +4587,3 @@ int operation;
 }
 
 #endif /* LOCKF_EMULATE_FLOCK */
-