Change 19143 by [EMAIL PROTECTED] on 2003/04/03 08:55:33
Subject: [PATCH] VMS %ENV fix (follow-up to 18852)
From: "Craig A. Berry" <[EMAIL PROTECTED]>
Date: Wed, 02 Apr 2003 18:09:03 -0600
Message-Id: <[EMAIL PROTECTED]>
Affected files ...
... //depot/perl/vms/vms.c#123 edit
... //depot/perl/vms/vmsish.h#57 edit
Differences ...
==== //depot/perl/vms/vms.c#123 (text) ====
Index: perl/vms/vms.c
--- perl/vms/vms.c#122~19054~ Sun Mar 23 22:54:23 2003
+++ perl/vms/vms.c Thu Apr 3 00:55:33 2003
@@ -262,7 +262,7 @@
}
}
else if (!ivlnm) {
- if (idx == 0) {
+ if ( (idx == 0) && (flags & PERL__TRNENV_JOIN_SEARCHLIST) ) {
midx = my_maxidx((char *) lnm);
for (idx = 0, cp1 = eqv; idx <= midx; idx++) {
lnmlst[1].bufadr = cp1;
@@ -290,7 +290,6 @@
(retsts == SS$_NOLOGNAM)) { continue; }
}
else {
- idx -= 1;
retsts = sys$trnlnm(&attr,tabvec[curtab],&lnmdsc,&acmode,lnmlst);
if (retsts == SS$_IVLOGNAM) { ivlnm = 1; continue; }
if (retsts == SS$_NOLOGNAM) continue;
@@ -341,7 +340,7 @@
char uplnm[LNM$C_NAMLENGTH+1], *cp1, *cp2, *eqv;
unsigned long int idx = 0;
int trnsuccess, success, secure, saverr, savvmserr;
- int midx;
+ int midx, flags;
SV *tmpsv;
midx = my_maxidx((char *) lnm) + 1;
@@ -370,27 +369,43 @@
return eqv;
}
else {
- if ((cp2 = strchr(lnm,';')) != NULL) {
- strcpy(uplnm,lnm);
- uplnm[cp2-lnm] = '\0';
- idx = strtoul(cp2+1,NULL,0) + 1;
- lnm = uplnm;
- }
/* Impose security constraints only if tainting */
if (sys) {
/* Impose security constraints only if tainting */
secure = PL_curinterp ? PL_tainting : will_taint;
saverr = errno; savvmserr = vaxc$errno;
}
- else secure = 0;
- success = vmstrnenv(lnm,eqv,idx,
- secure ? fildev : NULL,
+ else {
+ secure = 0;
+ }
+
+ flags =
#ifdef SECURE_INTERNAL_GETENV
- secure ? PERL__TRNENV_SECURE : 0
+ secure ? PERL__TRNENV_SECURE : 0
#else
- 0
+ 0
#endif
- );
+ ;
+
+ /* For the getenv interface we combine all the equivalence names
+ * of a search list logical into one value to acquire a maximum
+ * value length of 255*128 (assuming %ENV is using logicals).
+ */
+ flags |= PERL__TRNENV_JOIN_SEARCHLIST;
+
+ /* If the name contains a semicolon-delimited index, parse it
+ * off and make sure we only retrieve the equivalence name for
+ * that index. */
+ if ((cp2 = strchr(lnm,';')) != NULL) {
+ strcpy(uplnm,lnm);
+ uplnm[cp2-lnm] = '\0';
+ idx = strtoul(cp2+1,NULL,0);
+ lnm = uplnm;
+ flags &= ~PERL__TRNENV_JOIN_SEARCHLIST;
+ }
+
+ 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. */
@@ -408,7 +423,7 @@
{
char *buf, *cp1, *cp2;
unsigned long idx = 0;
- int midx;
+ int midx, flags;
static char *__my_getenv_len_eqv = NULL;
int secure, saverr, savvmserr;
SV *tmpsv;
@@ -440,26 +455,35 @@
return buf;
}
else {
- if ((cp2 = strchr(lnm,';')) != NULL) {
- strcpy(buf,lnm);
- buf[cp2-lnm] = '\0';
- idx = strtoul(cp2+1,NULL,0) + 1;
- lnm = buf;
- }
if (sys) {
/* Impose security constraints only if tainting */
secure = PL_curinterp ? PL_tainting : will_taint;
saverr = errno; savvmserr = vaxc$errno;
}
- else secure = 0;
- *len = vmstrnenv(lnm,buf,idx,
- secure ? fildev : NULL,
+ else {
+ secure = 0;
+ }
+
+ flags =
#ifdef SECURE_INTERNAL_GETENV
- secure ? PERL__TRNENV_SECURE : 0
+ secure ? PERL__TRNENV_SECURE : 0
#else
- 0
+ 0
#endif
- );
+ ;
+
+ flags |= PERL__TRNENV_JOIN_SEARCHLIST;
+
+ if ((cp2 = strchr(lnm,';')) != NULL) {
+ strcpy(buf,lnm);
+ buf[cp2-lnm] = '\0';
+ idx = strtoul(cp2+1,NULL,0);
+ lnm = buf;
+ flags &= ~PERL__TRNENV_JOIN_SEARCHLIST;
+ }
+
+ *len = vmstrnenv(lnm,buf,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. */
==== //depot/perl/vms/vmsish.h#57 (text) ====
Index: perl/vms/vmsish.h
--- perl/vms/vmsish.h#56~19042~ Thu Mar 20 23:45:54 2003
+++ perl/vms/vmsish.h Thu Apr 3 00:55:33 2003
@@ -307,6 +307,7 @@
/* Flags for vmstrnenv() */
#define PERL__TRNENV_SECURE 0x01
+#define PERL__TRNENV_JOIN_SEARCHLIST 0x02
/* Handy way to vet calls to VMS system services and RTL routines. */
#define _ckvmssts(call) STMT_START { register unsigned long int __ckvms_sts; \
End of Patch.
