1 /* BEGIN INCLUDE FILE gtss_filact_intp2.incl.pl1 */
  2 /*
  3   Created: (Wardd Multics)  10/05/78 1601.2 mst Thu
  4 */
  5 
  6 /* Change: Dave Ward          08/18/81 correct stringrange error.
  7 */
  8 get_ascii_file_name: proc (fnia, cfdl, acfp, grc)returns (bit (1));
  9 
 10 /**       Obtain the catalog/file description
 11           in ascii.
 12           Reset gcos retrun code (grc) only if error.
 13 **/
 14 dcl  fnia                     bit(1)parm          /* "1"b => file name in ascii. */;
 15 dcl  cfdl                     bit(18)parm         /* Location of catalog file description. */;
 16 dcl  acfp                     ptr parm  /* Pointer to ascii_cat_file structure. */;
 17 dcl  grc                      bit(18)parm         /* GCOS return status code. */;
 18 
 19           ap = acfp;                                        /* Local value. */
 20           cat_filedescr_name_offset = "0"b;                 /* => offset to "current" name in catalog file description. */
 21 
 22           if                                                /* (cfdl < low_b) | */
 23           (fixed (cfdl, 18)+5 > high_i) then do;
 24                goto return_err4;
 25           end;                                              /* Require USERID and atleast file name. */
 26           descriptor_ptr = addrel (gseg, cfdl);
 27 
 28           if cfd2.USERID = -1 then do;                      /* cfd2.USERID is that of current terminal user. */
 29                descriptor_ptr -> bit72 = gtss_ust.lid;
 30                cfd2.USERID_password = (12)"20"b3;
 31           end;
 32 
 33           cat_filedescr_name_offset = cfdl;
 34 
 35           do nic = 0 to 5;                                  /* Search for end of list. */
 36                if nic = 0 then
 37                     if cdf4.end_of_list = -1 then do;       /* Only a USERID. */
 38                          acf.nn = 1;
 39                          goto gal;
 40                     end;
 41 
 42                if (fixed (cfdl, 18)+ (nic*2)+6) > high_i then do;
 43                     goto return_err4;
 44                end;                                         /* cat/filedescr entry out of memory. */
 45 
 46                if cfd2.end_of_list = -1 then do;            /* cat/filedescr isolated. */
 47                     cat_filedescr_name_offset =
 48                          bit (fixed (fixed (cfdl, 18) + (nic*4) + 4, 18)); /* Offset to name entry (global). */
 49                     acf.nn = nic+2;
 50 
 51 gal:                ;
 52                     do i = 1 to acf.nn;
 53 
 54 /**       Store catalog file description for expand path. **/
 55 
 56                          if (i > 1) & (i = acf.nn) & fnia then do;
 57                               callers_buf.restore_switch = "000000000001"b3; /* => file name in ascii. */
 58                               acf.name (i) = translate (cfd3 (i).name,
 59                                    "abcdefghijklmnopqrstuvwxyz",
 60                                    "ABCDEFGHIJKLMNOPQRSTUVWXYZ");
 61                          end;
 62                          else
 63                          call gtss_bcd_ascii_$lc (
 64                               addr (cfd3 (i).name)
 65                               , 12
 66                               , addr (acf.name (i))
 67                               );
 68                     end;
 69 
 70                     if substr (string (gtss_ext_$db), 09, 11) then do;
 71                          call ioa_ ("cat/filedescr:");
 72                          do i = 1 to acf.nn;
 73                               call ioa_ ("^3i. ""^a""", i, acf.name (i));
 74                          end;
 75                     end;
 76 
 77                     if substr (acf.name (1), 1, 6) = "!!!!!!" then
 78                          acf.name (1) = gse_ext_$umc_name;
 79                     callers_buf.file_id_in_ascii =
 80                          substr (acf.name (acf.nn), 1, length (callers_buf.file_id_in_ascii));
 81 
 82 /* Determine if there are illegal characters
 83    in the name.
 84 */
 85                     do i = 1 to acf.nn;
 86                          if acf.name (i) = "*src" then return ("0"b);
 87                          if verify (
 88                          rtrim (acf.name (i))
 89                          , "0123456789abcdefghijklmnopqrstuvwxyz.-_"
 90                          )>0 then do;
 91                               grc = "403400"b3;             /* Yes, illegal characters. */
 92                               return ("1"b);
 93                          end;
 94                     end;
 95 
 96                     return ("0"b);                          /* Success. */
 97                end;
 98           end;
 99 
100 /**       cat/filedescr has no end of list marker. **/
101           cat_filedescr_name_offset = "0"b;
102           grc = "403500"b3;                                 /* Illegal cat/file desc. */
103           return ("1"b);                                    /* Failure. */
104 
105 dcl  ap                       ptr       /* Local acfp */;
106 dcl 1 acf aligned based(ap) like ascii_cat_file;
107 
108 dcl 1 callers_buf             aligned based(buffer_ptr),
109       3 restore_switch        bit(36),
110       3 file_id_in_ascii      char(8);
111 
112 dcl 1 cfd2                    aligned based(descriptor_ptr) /* 2nd description of catalog/file list. */
113 ,     3 user_master_catalog
114 ,       4 USERID              fixed bin(71)
115 ,       4 USERID_password     bit(72)
116 ,     3 intermediate_catalogs (nic)
117 ,       4 CATALOG             bit(72)
118 ,       4 CATALOG_password    bit(72)
119 ,     3 file_to_be_accessed
120 ,       4 FILENAME            bit(72)
121 ,       4 FILENAME_password   bit(72)
122 ,     3 end_of_list           fixed bin(35)
123 ;
124 
125 dcl 1 cfd3                    (7) aligned based(descriptor_ptr)       /* 3rd description of catalog/file list. */
126 ,     3 name                  char(8)
127 ,     3 password              bit(72)
128 ;
129 
130 dcl 1 cdf4                    aligned based(descriptor_ptr) /* 4th description of catalog/file list. */
131 ,     3 user_master_catalog
132 ,       4 USERID              fixed bin(71)
133 ,       4 USERID_password     bit(72)
134 ,     3 end_of_list           fixed bin(35)
135 ;
136      end                                                    /* get_ascii_file_name */;
137 
138 /*   END INCLUDE FILE gtss_filact_intp2.incl.pl1 */