1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    * Copyright (c) 1972 by Massachusetts Institute of        *
  6    * Technology and Honeywell Information Systems, Inc.      *
  7    *                                                         *
  8    *********************************************************** */
  9 
 10 
 11 get_raw_access_: proc (tptr, tlng, user_name, ring, dmode, emode, code);
 12 
 13 /* This procedure is given a pathname and returns the given user's access to the directory and entry.
 14    It calls chase_ to chase any links, imbedded or otherwise.
 15    The reason for using this procedure instead of hcs_$fs_get_path_name is to check a given user's access
 16    through a chain of links, and also to get the real directory even if the entry doesn't exist.
 17 */
 18 /* initially coded by M. Weaver 18 November 1970 */
 19 /* last modified by M. Weaver 8 January 1971 */
 20 
 21 dcl (tdir, dir, retpn) char (168);
 22 dcl (ent, tent) char (32);
 23 dcl  user_name char (*);
 24 dcl (ring, rl, rlev, lng, tlng, rlng) fixed bin;
 25 dcl  code fixed bin (35);
 26 dcl (dmode, emode) fixed bin (5);
 27 dcl (dptr, eptr, pptr, tptr, bptr, nptr) ptr;
 28 dcl  noent bit (1) aligned;
 29 dcl  name1 char (tlng) based (tptr);
 30 dcl  name2 char (lng) based (dptr);
 31 dcl  name3 char (lng) based (pptr);
 32 dcl  narea (0:959);                                         /* area for names from status_; safer to put in stack */
 33 dcl (addr, fixed, index, null, ptr, substr, unspec) builtin;
 34 
 35 dcl  expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
 36 dcl  absolute_pathname_ entry (char (*), char (*), fixed bin (35));
 37 dcl  hcs_$get_user_effmode entry (char (*), char (*), char (*), fixed bin, fixed bin (5), fixed bin (35));
 38 dcl (error_table_$root, error_table_$noentry) ext fixed bin (35);
 39 dcl  tarea (0:3);                                           /* area for hcs_$status info */
 40 
 41 
 42           rl, rlev = 0;                                     /* initialize recursion level indicators */
 43           bptr = addr (tarea);
 44           nptr = addr (narea);                              /* set up pointer to names area */
 45           pptr = addr (tdir);                               /* will expand arg pathname into tdir */
 46           call absolute_pathname_ (name1, tdir, code);
 47           if code ^= 0 then return;
 48           rlng = index (tdir, " ") - 1;                     /* get length of expanded path name */
 49 
 50           call chase_ (pptr, rlng, retpn, code);
 51                                                             /* if all goes well, retpn will contain the real absolute pathname of path */
 52           if code ^= 0 then do;
 53                if code = error_table_$noentry then do;      /* directory is still OK */
 54                     dir = retpn;                            /* only directory is returned in this case */
 55                     dptr = addr (dir);                      /* this would normally get set later */
 56                     noent = "1"b;                           /* return noentry code */
 57                     go to get_dmode;
 58                end;
 59                else return;                                 /* other non_zero codes */
 60           end;
 61           noent = "0"b;
 62           pptr = addr (retpn);
 63           dptr = addr (dir);
 64           eptr = addr (ent);
 65           lng = index (retpn, " ") - 1;                     /* get relevant length for expand_path_ */
 66           call expand_pathname_ (name3, dir, ent, code);
 67           if code ^= 0 then go to ret;
 68 
 69           call hcs_$get_user_effmode (dir, ent, user_name, ring, emode, code); /* get user's access to entry */
 70           if code ^= 0 then go to ret;
 71 
 72 /* the "extra" variable tent is used in case, at some future time, the above value of ent
 73    is to be kept intact as a return argument. */
 74 
 75 get_dmode: pptr = addr (tdir);
 76           eptr = addr (tent);
 77           lng = index (dir, " ") - 1;                       /* get relevant length for expand_path_ */
 78           call expand_pathname_ (name2, tdir, tent, code);
 79           if code ^= 0 then go to ret;
 80 
 81           call hcs_$get_user_effmode (tdir, tent, user_name, ring, dmode, code); /* get user's access to directory */
 82 
 83           if code = 0 then if noent then code = error_table_$noentry;
 84                else;
 85           else if code = error_table_$root then do;
 86                code = 0;
 87                dmode = 0100b;                               /* All users have at least "re" access to root */
 88           end;
 89 ret:      return;
 90 
 91 
 92 chase_:   proc (pptr, tlng, retpn, code) recursive;
 93 
 94 /*  This procedure chases links.  It is given a pathname, breaks it into a directory name and entry name
 95    and calls itself recursively in order to catch imbedded links.  After returning from a recursive call, it
 96    checks the returned directory name and the given entry name to see if it has a link.
 97    If it does, it checks to see whether there have already been 10 links and if the given user
 98    has e access to the link's directory; if so, it gets the link pathname and "starts over".
 99    If it has a branch, it returns the branch name concatenated with the entry name.
100 */
101 
102 /* initially coded by M. Weaver 19 November 1970 */
103 
104 dcl (path based (pptr), retpn, dir) char (168);
105 dcl (ent, tent) char (32);
106 dcl  mode fixed bin (5);
107 dcl (lng, tlng, trl, elng, i) fixed bin;
108 dcl  code fixed bin (35);
109 dcl (pptr, dptr, eptr) ptr;
110 dcl 1 link based aligned,
111     2 (type bit (2), nnames bit (16), nrp bit (18)) unaligned,
112     2 (dtem, dtd) bit (36) unaligned,
113     2 (pnl, pnrp) bit (18) unaligned;
114 dcl  lpname char (168) aligned based;
115 dcl  gt char (1) var;
116 
117 dcl (error_table_$noaccess, error_table_$linkmoderr, error_table_$toomanylinks,
118      error_table_$pathlong) ext fixed bin;
119 dcl  area_ entry (fixed bin, ptr);
120 dcl  hcs_$status_ entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35));
121 
122 /* * * * * * * * * * * * * * * * * * * * */
123 
124 
125                dptr = addr (dir);
126 process:       do i = tlng to 1 by -1 while (substr (path, i, 1) ^= ">"); end;
127                ent = substr (path, i+1, tlng-i);
128                if i = 1 then do;                            /* at root */
129                     retpn = ">";
130                     go to havadir;
131                end;
132                dir = substr (path, 1, i-1);
133                lng = i - 1;
134                trl = rl;                                    /* save rl;  # of links at lower levels doesn't affect this level */
135                rlev = rlev + 1;                             /* go to deeper recursion level */
136 
137                call chase_ (dptr, lng, retpn, code);        /* make recursive call */
138                if code ^= 0 then return;
139                rlev = rlev - 1;                             /* return from deeper recursion level */
140 
141 havadir:       call area_ (960, nptr);                      /* reinitialize each time; reuse same space */
142                                                             /* can't call freen_ on nptr */
143                call hcs_$status_ (retpn, ent, 0, bptr, nptr, code); /* see if entry is a link or dir */
144                if code ^= 0 then do;
145 noacc:              if rlev > 0 & code = error_table_$noentry then code = error_table_$noaccess;
146                     return;
147                end;
148                rl = trl;                                    /* restore this level's link record */
149                lng = index (retpn, " ") - 1;                /* find no. of relevant characters in retpn */
150 
151                if bptr -> link.type = "00"b then do;
152                                                             /* find out if user has access to use link */
153                     do i = lng to 1 by -1 while (substr (retpn, i, 1) ^= ">"); end; /* break into directory, entry */
154                     if i = 1 then dir = ">";
155                     else dir = substr (retpn, 1, i-1);
156                     tent = substr (retpn, i+1, lng-i);
157                     if user_name ^= "" then do;             /* don't need to check this for oneself */
158                          call hcs_$get_user_effmode (dir, tent, user_name, ring, mode, code);
159                          if code ^= 0 then go to noacc;
160                          if ^substr (unspec (mode), 34, 1) then do; /* user doesn't have e access on dir */
161                               code = error_table_$linkmoderr;
162                               return;
163                          end;
164                     end;
165                     if rl >= 10 then do;                    /* can't chase any more */
166                          code = error_table_$toomanylinks;
167                          return;
168                     end;
169                                                             /* get link pathname and start over */
170                     path = ptr (nptr, bptr -> link.pnrp) -> lpname;
171                     tlng = fixed (bptr -> link.pnl, 18);    /* get length of link pathname */
172                     rl = rl + 1;                            /* got another link */
173                     go to process;
174                end;
175 
176 /* have a branch */
177 /* check to be sure returned name isn't going to be too long */
178                elng = index (ent, " ");                     /* keep extra count; use for preceding ">" */
179                if elng = 0 then elng = 33;                  /* entry name is 32 characters or more */
180                if lng = -1 then go to too_long;             /* directory name = 168 characters */
181                if lng + elng > 168 then do;                 /* name to be returned is too long */
182 too_long:           code = error_table_$pathlong;
183                     return;
184                end;
185                rl = 0;
186                if lng = 1 then gt = ""; else gt = ">";      /* a single char absolute pathname must be ">" */
187                retpn = substr (retpn, 1, lng) || gt || ent;
188                return;
189           end chase_;
190      end get_raw_access_;