This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
getenv() failed lookup need not set errno on VMS.
authorCraig A. Berry <craigberry@mac.com>
Fri, 8 Aug 2014 02:29:14 +0000 (21:29 -0500)
committerCraig A. Berry <craigberry@mac.com>
Fri, 8 Aug 2014 02:29:14 +0000 (21:29 -0500)
The standard does not indicate any errno values set when getenv()
simply doesn't find the requested value, which is a pretty common
occurrence.  The VMS-specific implementation of getenv() has been
setting errno in this case, which means there is often an errno
value hanging around for later unsuspecting operations.  It
particularly tends to bite people who don't read the documentation
to die() and/or don't understand how errno works (only valid after
a failed syscall).

So we now stop setting errno in this case, but leave it for a few
serious errors that should be extremely rare.

vms/vms.c

index 7d556bc..43e9e41 100644 (file)
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -1033,9 +1033,14 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx,
       }
     }
     if (retsts & 1) { eqv[eqvlen] = '\0'; return eqvlen; }
-    else if (retsts == LIB$_NOSUCHSYM || retsts == LIB$_INVSYMNAM ||
-             retsts == SS$_IVLOGNAM   || retsts == SS$_IVLOGTAB   ||
+    else if (retsts == LIB$_NOSUCHSYM ||
              retsts == SS$_NOLOGNAM) {
+     /* Unsuccessful lookup is normal -- no need to set errno */
+     return 0;
+    }
+    else if (retsts == LIB$_INVSYMNAM ||
+             retsts == SS$_IVLOGNAM   ||
+             retsts == SS$_IVLOGTAB) {
       set_errno(EINVAL);  set_vaxc_errno(retsts);
     }
     else _ckvmssts_noperl(retsts);
@@ -1077,7 +1082,7 @@ Perl_my_getenv(pTHX_ const char *lnm, bool sys)
     static char *__my_getenv_eqv = NULL;
     char uplnm[LNM$C_NAMLENGTH+1], *cp2, *eqv;
     unsigned long int idx = 0;
-    int success, secure, saverr, savvmserr;
+    int success, secure;
     int midx, flags;
     SV *tmpsv;
 
@@ -1127,7 +1132,6 @@ Perl_my_getenv(pTHX_ const char *lnm, bool sys)
       if (sys) {
         /* Impose security constraints only if tainting */
         secure = PL_curinterp ? TAINTING_get : will_taint;
-        saverr = errno;  savvmserr = vaxc$errno;
       }
       else {
         secure = 0;
@@ -1159,10 +1163,6 @@ Perl_my_getenv(pTHX_ const char *lnm, bool sys)
 
       success = vmstrnenv(lnm,eqv,idx,secure ? fildev : NULL,flags);
 
-      /* Discard NOLOGNAM on internal calls since we're often looking
-       * for an optional name, and this "error" often shows up as the
-       * (bogus) exit status for a die() call later on.  */
-      if (sys && vaxc$errno == SS$_NOLOGNAM) SETERRNO(saverr,savvmserr);
       return success ? eqv : NULL;
     }
 
@@ -1179,7 +1179,7 @@ Perl_my_getenv_len(pTHX_ const char *lnm, unsigned long *len, bool sys)
     unsigned long idx = 0;
     int midx, flags;
     static char *__my_getenv_len_eqv = NULL;
-    int secure, saverr, savvmserr;
+    int secure;
     SV *tmpsv;
     
     midx = my_maxidx(lnm) + 1;
@@ -1226,7 +1226,6 @@ Perl_my_getenv_len(pTHX_ const char *lnm, unsigned long *len, bool sys)
       if (sys) {
         /* Impose security constraints only if tainting */
         secure = PL_curinterp ? TAINTING_get : will_taint;
-        saverr = errno;  savvmserr = vaxc$errno;
       }
       else {
         secure = 0;
@@ -1264,10 +1263,6 @@ Perl_my_getenv_len(pTHX_ const char *lnm, unsigned long *len, bool sys)
        }
       }
 
-      /* Discard NOLOGNAM on internal calls since we're often looking
-       * for an optional name, and this "error" often shows up as the
-       * (bogus) exit status for a die() call later on.  */
-      if (sys && vaxc$errno == SS$_NOLOGNAM) SETERRNO(saverr,savvmserr);
       return *len ? buf : NULL;
     }