[PATCH vms/vms.c] logical name translation iteration limits

The testing of PERLIO=perlio exposed a recursion bug at a number of 
places where iterative logical name translation is performed.  In 
particular, the handling of cases like:

     FOO -> BAR -> BAZ -> myfile.dat

left us open to cases like:

     FOO -> FOO -> FOO -> ad infinitum

where the logical name and its equivalence name are the same 
(regardless of case).

As far as I can tell, native VMS utilities don't generally check for
recursion, but they do limit the number of allowed iterations, which
has the side effect of preventing unlimited recursion.  I've added 
this behavior to our iterative logical name translations.  Patch 
below.

The patch also brings perldelta.pod more up-to-date with VMS news.

--- pod/perldelta.pod;-0	Thu May 23 13:43:21 2002
+++ pod/perldelta.pod	Fri May 24 14:50:36 2002
@@ -2394,8 +2394,7 @@
 
 The C<waitpid> emulation has been improved.  The worst bug (now fixed)
 was that a pid of -1 would cause a wildcard search of all processes on
-the system.  The most significant enhancement is that we can now
-usually get the completion status of a terminated process.
+the system.  
 
 POSIX-style signals are now emulated much better on VMS versions prior
 to 7.0.
@@ -2407,6 +2406,14 @@
 user's default privileges, which could sometimes result in a mismatch
 between reported access and actual access.
 
+There is a new C<kill> implementation based on C<sys$sigprc> that allows 
+older VMS systems (pre-7.0) to use C<kill> to send signals rather than
+simply force exit.  This implementation also allows later systems to
+call C<kill> from within a signal handler.
+
+Iterative logical name translations are now limited to 10 iterations in
+imitation of SHOW LOGICAL and other OpenVMS facilities.
+
 =item *
 
 Windows
--- vms/vms.c;-0	Tue May 21 18:23:03 2002
+++ vms/vms.c	Fri May 24 14:26:00 2002
@@ -105,6 +105,12 @@
 /* see system service docs for $TRNLNM -- NOT the same as LNM$_MAX_INDEX */
 #define PERL_LNM_MAX_ALLOWED_INDEX 127
 
+/* OpenVMS User's Guide says at least 9 iterative translations will be performed,
+ * depending on the facility.  SHOW LOGICAL does 10, so we'll imitate that for
+ * the Perl facility.
+ */
+#define PERL_LNM_MAX_ITER 10
+
 #define MAX_DCL_SYMBOL              255     /* well, what *we* can set, at least*/
 #define MAX_DCL_LINE_LENGTH        (4*MAX_DCL_SYMBOL-4)
 
@@ -3007,6 +3013,7 @@
     unsigned long int dirlen, retlen, addmfd = 0, hasfilename = 0;
     char *retspec, *cp1, *cp2, *lastdir;
     char trndir[NAM$C_MAXRSS+2], vmsdir[NAM$C_MAXRSS+1];
+    unsigned short int trnlnm_iter_count;
 
     if (!dir || !*dir) {
       set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return NULL;
@@ -3023,7 +3030,11 @@
     }
     if (!strpbrk(dir+1,"/]>:")) {
       strcpy(trndir,*dir == '/' ? dir + 1: dir);
-      while (!strpbrk(trndir,"/]>:>") && my_trnlnm(trndir,trndir,0)) ;
+      trnlnm_iter_count = 0;
+      while (!strpbrk(trndir,"/]>:>") && my_trnlnm(trndir,trndir,0)) {
+        trnlnm_iter_count++; 
+        if (trnlnm_iter_count >= PERL_LNM_MAX_ITER) break;
+      }
       dir = trndir;
       dirlen = strlen(dir);
     }
@@ -3329,6 +3340,7 @@
     static char __pathify_retbuf[NAM$C_MAXRSS+1];
     unsigned long int retlen;
     char *retpath, *cp1, *cp2, trndir[NAM$C_MAXRSS+1];
+    unsigned short int trnlnm_iter_count;
 
     if (!dir || !*dir) {
       set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return NULL;
@@ -3337,8 +3349,11 @@
     if (*dir) strcpy(trndir,dir);
     else getcwd(trndir,sizeof trndir - 1);
 
+    trnlnm_iter_count = 0;
     while (!strpbrk(trndir,"/]:>") && !no_translate_barewords
 	   && my_trnlnm(trndir,trndir,0)) {
+      trnlnm_iter_count++; 
+      if (trnlnm_iter_count >= PERL_LNM_MAX_ITER) break;
       STRLEN trnlen = strlen(trndir);
 
       /* Trap simple rooted lnms, and return lnm:[000000] */
@@ -3515,6 +3530,7 @@
   static char __tounixspec_retbuf[NAM$C_MAXRSS+1];
   char *dirend, *rslt, *cp1, *cp2, *cp3, tmp[NAM$C_MAXRSS+1];
   int devlen, dirlen, retlen = NAM$C_MAXRSS+1, expand = 0;
+  unsigned short int trnlnm_iter_count;
 
   if (spec == NULL) return NULL;
   if (strlen(spec) > NAM$C_MAXRSS) return NULL;
@@ -3561,11 +3577,14 @@
         if (ts) Safefree(rslt);
         return NULL;
       }
+      trnlnm_iter_count = 0;
       do {
         cp3 = tmp;
         while (*cp3 != ':' && *cp3) cp3++;
         *(cp3++) = '\0';
         if (strchr(cp3,']') != NULL) break;
+        trnlnm_iter_count++; 
+        if (trnlnm_iter_count >= PERL_LNM_MAX_ITER+1) break;
       } while (vmstrnenv(tmp,tmp,0,fildev,0));
       if (ts && !buf &&
           ((devlen = strlen(tmp)) + (dirlen = strlen(cp2)) + 1 > retlen)) {
@@ -6569,7 +6588,7 @@
          {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, usrname};
   char vmsname[NAM$C_MAXRSS+1], fileified[NAM$C_MAXRSS+1];
   unsigned long int objtyp = ACL$C_FILE, access, retsts, privused, iosb[2];
-  unsigned short int retlen;
+  unsigned short int retlen, trnlnm_iter_count;
   struct dsc$descriptor_s namdsc = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
   union prvdef curprv;
   struct itmlst_3 armlst[3] = {{sizeof access, CHP$_ACCESS, &access, &retlen},
@@ -6585,7 +6604,11 @@
   /* Make sure we expand logical names, since sys$check_access doesn't */
   if (!strpbrk(fname,"/]>:")) {
     strcpy(fileified,fname);
-    while (!strpbrk(fileified,"/]>:>") && my_trnlnm(fileified,fileified,0)) ;
+    trnlnm_iter_count = 0;
+    while (!strpbrk(fileified,"/]>:>") && my_trnlnm(fileified,fileified,0)) {
+        trnlnm_iter_count++; 
+        if (trnlnm_iter_count >= PERL_LNM_MAX_ITER) break;
+    }
     fname = fileified;
   }
   if (!do_tovmsspec(fname,vmsname,1)) return FALSE;
[end of patch]

• [PATCH vms/vms.c] logical name translation iteration limits by Craig A. Berry
• Re: [PATCH vms/vms.c] logical name translation iteration limits by Jarkko Hietaniemi