X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_sys.c;h=fe75220d38ea9f5efd5a4b26ed1664cc01416653;hb=b83ac84c2fbc01a334f3e39ae42527298ccd0b11;hp=c273c8c5b29f82d0f1b016801e7795fc863b55f8;hpb=1d603a678689f1e74cf73914a432b2a8d38be470;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_sys.c b/pp_sys.c
index c273c8c..fe75220 100644
--- 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 (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);
@@ -3584,7 +3654,7 @@ PP(pp_semop)
 
 PP(pp_ghbyname)
 {
-#ifdef HAS_SOCKET
+#ifdef HAS_GETHOSTBYNAME
     return pp_ghostent(ARGS);
 #else
     DIE(no_sock_func, "gethostbyname");
@@ -3593,7 +3663,7 @@ PP(pp_ghbyname)
 
 PP(pp_ghbyaddr)
 {
-#ifdef HAS_SOCKET
+#ifdef HAS_GETHOSTBYADDR
     return pp_ghostent(ARGS);
 #else
     DIE(no_sock_func, "gethostbyaddr");
@@ -3603,37 +3673,42 @@ PP(pp_ghbyaddr)
 PP(pp_ghostent)
 {
     djSP;
-#ifdef HAS_SOCKET
+#if defined(HAS_GETHOSTBYNAME) || defined(HAS_GETHOSTBYADDR) || defined(HAS_GETHOSTENT)
     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
@@ -3687,7 +3762,7 @@ PP(pp_ghostent)
 
 PP(pp_gnbyname)
 {
-#ifdef HAS_SOCKET
+#ifdef HAS_GETNETBYNAME
     return pp_gnetent(ARGS);
 #else
     DIE(no_sock_func, "getnetbyname");
@@ -3696,7 +3771,7 @@ PP(pp_gnbyname)
 
 PP(pp_gnbyaddr)
 {
-#ifdef HAS_SOCKET
+#ifdef HAS_GETNETBYADDR
     return pp_gnetent(ARGS);
 #else
     DIE(no_sock_func, "getnetbyaddr");
@@ -3706,26 +3781,38 @@ PP(pp_gnbyaddr)
 PP(pp_gnetent)
 {
     djSP;
-#ifdef HAS_SOCKET
+#if defined(HAS_GETNETBYNAME) || defined(HAS_GETNETBYADDR) || defined(HAS_GETNETENT)
     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) {
@@ -3762,7 +3849,7 @@ PP(pp_gnetent)
 
 PP(pp_gpbyname)
 {
-#ifdef HAS_SOCKET
+#ifdef HAS_GETPROTOBYNAME
     return pp_gprotoent(ARGS);
 #else
     DIE(no_sock_func, "getprotobyname");
@@ -3771,7 +3858,7 @@ PP(pp_gpbyname)
 
 PP(pp_gpbynumber)
 {
-#ifdef HAS_SOCKET
+#ifdef HAS_GETPROTOBYNUMBER
     return pp_gprotoent(ARGS);
 #else
     DIE(no_sock_func, "getprotobynumber");
@@ -3781,25 +3868,35 @@ PP(pp_gpbynumber)
 PP(pp_gprotoent)
 {
     djSP;
-#ifdef HAS_SOCKET
+#if defined(HAS_GETPROTOBYNAME) || defined(HAS_GETPROTOBYNUMBER) || defined(HAS_GETPROTOENT)
     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)
+#ifdef HAS_GETPROTOBYNAME
 	pent = PerlSock_getprotobyname(POPp);
+#else
+	DIE(no_sock_func, "getprotobyname");
+#endif
     else if (which == OP_GPBYNUMBER)
+#ifdef HAS_GETPROTOBYNUMBER
 	pent = PerlSock_getprotobynumber(POPi);
+#else
+    DIE(no_sock_func, "getprotobynumber");
+#endif
     else
+#ifdef HAS_GETPROTOENT
 	pent = PerlSock_getprotoent();
+#else
+	DIE(no_sock_func, "getprotoent");
+#endif
 
     EXTEND(SP, 3);
     if (GIMME != G_ARRAY) {
@@ -3834,7 +3931,7 @@ PP(pp_gprotoent)
 
 PP(pp_gsbyname)
 {
-#ifdef HAS_SOCKET
+#ifdef HAS_GETSERVBYNAME
     return pp_gservent(ARGS);
 #else
     DIE(no_sock_func, "getservbyname");
@@ -3843,7 +3940,7 @@ PP(pp_gsbyname)
 
 PP(pp_gsbyport)
 {
-#ifdef HAS_SOCKET
+#ifdef HAS_GETSERVBYPORT
     return pp_gservent(ARGS);
 #else
     DIE(no_sock_func, "getservbyport");
@@ -3853,20 +3950,19 @@ PP(pp_gsbyport)
 PP(pp_gservent)
 {
     djSP;
-#ifdef HAS_SOCKET
+#if defined(HAS_GETSERVBYNAME) || defined(HAS_GETSERVBYPORT) || defined(HAS_GETSERVENT)
     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;
 
@@ -3874,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;
 
@@ -3883,9 +3983,16 @@ PP(pp_gservent)
 	port = PerlSock_htons(port);
 #endif
 	sent = PerlSock_getservbyport(port, proto);
+#else
+	DIE(no_sock_func, "getservbyport");
+#endif
     }
     else
+#ifdef HAS_GETSERVENT
 	sent = PerlSock_getservent();
+#else
+	DIE(no_sock_func, "getservent");
+#endif
 
     EXTEND(SP, 4);
     if (GIMME != G_ARRAY) {
@@ -3915,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
@@ -3932,8 +4039,8 @@ PP(pp_gservent)
 PP(pp_shostent)
 {
     djSP;
-#ifdef HAS_SOCKET
-    sethostent(TOPi);
+#ifdef HAS_SETHOSTENT
+    PerlSock_sethostent(TOPi);
     RETSETYES;
 #else
     DIE(no_sock_func, "sethostent");
@@ -3943,8 +4050,8 @@ PP(pp_shostent)
 PP(pp_snetent)
 {
     djSP;
-#ifdef HAS_SOCKET
-    setnetent(TOPi);
+#ifdef HAS_SETNETENT
+    PerlSock_setnetent(TOPi);
     RETSETYES;
 #else
     DIE(no_sock_func, "setnetent");
@@ -3954,8 +4061,8 @@ PP(pp_snetent)
 PP(pp_sprotoent)
 {
     djSP;
-#ifdef HAS_SOCKET
-    setprotoent(TOPi);
+#ifdef HAS_SETPROTOENT
+    PerlSock_setprotoent(TOPi);
     RETSETYES;
 #else
     DIE(no_sock_func, "setprotoent");
@@ -3965,8 +4072,8 @@ PP(pp_sprotoent)
 PP(pp_sservent)
 {
     djSP;
-#ifdef HAS_SOCKET
-    setservent(TOPi);
+#ifdef HAS_SETSERVENT
+    PerlSock_setservent(TOPi);
     RETSETYES;
 #else
     DIE(no_sock_func, "setservent");
@@ -3976,9 +4083,9 @@ PP(pp_sservent)
 PP(pp_ehostent)
 {
     djSP;
-#ifdef HAS_SOCKET
-    endhostent();
-    EXTEND(sp,1);
+#ifdef HAS_ENDHOSTENT
+    PerlSock_endhostent();
+    EXTEND(SP,1);
     RETPUSHYES;
 #else
     DIE(no_sock_func, "endhostent");
@@ -3988,9 +4095,9 @@ PP(pp_ehostent)
 PP(pp_enetent)
 {
     djSP;
-#ifdef HAS_SOCKET
-    endnetent();
-    EXTEND(sp,1);
+#ifdef HAS_ENDNETENT
+    PerlSock_endnetent();
+    EXTEND(SP,1);
     RETPUSHYES;
 #else
     DIE(no_sock_func, "endnetent");
@@ -4000,9 +4107,9 @@ PP(pp_enetent)
 PP(pp_eprotoent)
 {
     djSP;
-#ifdef HAS_SOCKET
-    endprotoent();
-    EXTEND(sp,1);
+#ifdef HAS_ENDPROTOENT
+    PerlSock_endprotoent();
+    EXTEND(SP,1);
     RETPUSHYES;
 #else
     DIE(no_sock_func, "endprotoent");
@@ -4012,9 +4119,9 @@ PP(pp_eprotoent)
 PP(pp_eservent)
 {
     djSP;
-#ifdef HAS_SOCKET
-    endservent();
-    EXTEND(sp,1);
+#ifdef HAS_ENDSERVENT
+    PerlSock_endservent();
+    EXTEND(SP,1);
     RETPUSHYES;
 #else
     DIE(no_sock_func, "endservent");
@@ -4042,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;
@@ -4069,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);
@@ -4118,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
@@ -4129,7 +4252,7 @@ PP(pp_spwent)
 PP(pp_epwent)
 {
     djSP;
-#ifdef HAS_PASSWD
+#if defined(HAS_PASSWD) && defined(HAS_ENDPWENT)
     endpwent();
     RETPUSHYES;
 #else
@@ -4158,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;
@@ -4186,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);
@@ -4207,7 +4335,7 @@ PP(pp_ggrent)
 PP(pp_sgrent)
 {
     djSP;
-#ifdef HAS_GROUP
+#if defined(HAS_GROUP) && defined(HAS_SETGRENT)
     setgrent();
     RETPUSHYES;
 #else
@@ -4218,7 +4346,7 @@ PP(pp_sgrent)
 PP(pp_egrent)
 {
     djSP;
-#ifdef HAS_GROUP
+#if defined(HAS_GROUP) && defined(HAS_ENDGRENT)
     endgrent();
     RETPUSHYES;
 #else
@@ -4232,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;
@@ -4245,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];
@@ -4459,4 +4587,3 @@ int operation;
 }
 
 #endif /* LOCKF_EMULATE_FLOCK */
-