1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1983 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 
 13 
 14 
 15 /****^  HISTORY COMMENTS:
 16   1) change(86-05-02,Elhard), approve(86-05-02,MCR7391),
 17      audit(86-07-18,DGHowe), install(86-11-20,MR12.0-1222):
 18      Modified to add extra indirection when applying the referencing_dir rule
 19      if the referencing segment is an object MSF component, and to add the
 20      same_directory entrypoint for object MSF link snapping.
 21                                                    END HISTORY COMMENTS */
 22 
 23 
 24 /* format: style2,indcomtxt */
 25 
 26 fs_search:
 27      procedure (a_refptr, a_refname, a_MSF_sw, a_segptr, a_code);
 28 
 29 /****
 30       Modified 85-04-09 by Keith Loepere to remove extraneous error codes from set_wdir.
 31       Modified 85-02-25 by Keith Loepere for name lookup error I missed last time.
 32       Modified 84-10-15 by Keith Loepere for auditing.  Also to not beep
 33       console on RNT damage.
 34       Modified 84-06-25 by Keith Loepere to use the new dc_find.
 35       Modified 83-12-08 BIM to protect against bad user ring pointers,
 36       flush get_rel_segment, and clean up pigsties.
 37       Modified 1/83 by Keith Loepere for object on unmounted logical volume.
 38       Modified 2/79 W. Olin Sibert to make fs_search return correct error code for error_table_$moderr
 39       Modified 3/77 by M. Weaver to use search rules in user ring and not zero lot entry
 40       Modified 8/76 by M. Weaver to initialize LOT entry directly
 41       Init search rules for ring 8/76 THVV
 42       Modified June 1976 by R. Bratt to dereference old wdirs
 43       Massively reorganized April 1975 by R. Bratt for new kst
 44       8/7/75        by S. Webber to remove get_seg_count, get_seg_ptr, and get_segment entries and
 45       to add fs_search entry
 46 
 47 */
 48 
 49 /* Parameters */
 50 
 51           dcl     a_code                 fixed bin (35) parameter;
 52                                                             /* returned status code */
 53           dcl     a_pathcnt              fixed bin (17) parameter;
 54           dcl     a_pathptr              ptr parameter;
 55           dcl     a_refname              char (*) parameter;/* segment referenced */
 56           dcl     a_refptr               ptr parameter;     /* pointer to segment attempting to link */
 57           dcl     a_segptr               ptr parameter;     /* returned pointer to segment referenced */
 58           dcl     a_MSF_sw               bit (1) aligned parameter;
 59                                                             /* on if refp refers to an MSF */
 60           dcl     a_wdir                 char (*) parameter;/* path name of new working directory */
 61 
 62 /* Variables */
 63 
 64           dcl     bc                     fixed bin (24);
 65           dcl     code                   fixed bin (35);
 66           dcl     dirname                char (168);
 67           dcl     i                      fixed bin;
 68           dcl     old_ep                 ptr;
 69           dcl     pathname               char (168) varying;
 70           dcl     refname                char (32);
 71           dcl     refptr                 ptr;               /* temporary storage */
 72           dcl     ring                   fixed bin (3);     /* variable for validation level */
 73           dcl     segment_number         fixed bin;
 74           dcl     segment_uid            bit (36) aligned;
 75           dcl     segptr                 ptr;               /* temporary storage */
 76           dcl     srp                    ptr;               /* pointer to search rules in current use */
 77           dcl     test_stack_reference   bit (36) aligned;
 78           dcl     type                   fixed bin (2);
 79           dcl     MSF_sw                 bit (1) aligned;
 80           dcl     wdir                   char (168);
 81           dcl     wdp                    ptr;               /* working directory pointer */
 82 
 83 /* Based */
 84 
 85           dcl     based_reference        bit (36) aligned based;
 86           dcl     dname                  char (168) based aligned;
 87           dcl     1 sr                   (22) based aligned,/* search rule declaration */
 88                   ( 2 base               bit (18),          /* segment number */
 89                     2 off                bit (18),          /* offset or code */
 90                     2 uid                bit (36)
 91                     )                    unaligned;         /* unique id */
 92 
 93 /* External */
 94           dcl     error_table_$dirseg    ext fixed bin (35);
 95           dcl     error_table_$inconsistent_rnt
 96                                          ext fixed bin (35);
 97           dcl     error_table_$logical_volume_not_defined
 98                                          ext fixed bin (35);
 99           dcl     error_table_$moderr    ext fixed bin (35);
100           dcl     error_table_$root      ext fixed bin (35);
101           dcl     error_table_$seg_not_found
102                                          ext fixed bin (35);
103           dcl     error_table_$segknown  ext fixed bin (35);
104           dcl     pds$stacks             (0:7) ptr ext;
105           dcl     pds$process_group_id   char (32) ext static;
106           dcl     pds$wdir               (0:7) ptr ext;     /* pointers to working directories (per ring) */
107           dcl     pds$wdir_uid           (0:7) ext bit (36);
108 
109 /* Entries */
110 
111           dcl     get_kstep              entry (fixed bin (17), ptr, fixed bin (35));
112           dcl     get_pathname_          entry (fixed bin (17), char (*) varying, fixed bin (35));
113           dcl     initiate$initiate_count
114                                          entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr,
115                                          fixed bin (35));
116           dcl     initiate$initiate_seg_count
117                                          entry (ptr, char (*), char (*), fixed bin (24), fixed bin (2), ptr,
118                                          fixed bin (35));
119           dcl     level$get              entry returns (fixed bin);
120           dcl     lock$dir_unlock        entry (ptr);
121           dcl     ref_name_$get_segno    entry (char (32) varying, fixed bin (17), fixed bin (35));
122           dcl     segno_usage$decrement  entry (fixed bin (17), fixed bin (35));
123           dcl     status_$minf           entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24),
124                                          fixed bin (35));
125           dcl     syserr                 entry options (variable);
126           dcl     terminate_proc         entry (fixed bin (35));
127 
128 /* Misc */
129 
130           dcl     any_other              condition;
131 
132           dcl     (addr, baseptr, hbound, length, null, ptr, rtrim, segno)
133                                          builtin;
134 %page;
135           refptr = a_refptr;                                /* copy arguments */
136           refname = a_refname;
137           MSF_sw = a_MSF_sw;
138           segptr = null;
139 
140           code = 0;
141           ring = level$get ();
142           test_stack_reference = pds$stacks (ring) -> based_reference;
143                                                             /* in a new ring this will fault on stack which
144                                                                will cause makestack to be invoked which
145                                                                will init rnt and search rules */
146           on any_other call USER_RING_DAMAGED ("stack_header.rnt_ptr", ring);
147                                                             /* now, however, a fault is evidence of a real problem */
148           rntp = pds$stacks (ring) -> stack_header.rnt_ptr;
149           on any_other call USER_RING_DAMAGED ("rnt.srulep", ring);
150           srp = rnt.srulep;                                 /* get pointer to search rules */
151           on any_other call USER_RING_DAMAGED ("the RNT", ring);
152 
153 /* start the search */
154 
155           do i = 1 to hbound (srp -> sr, 1);
156 
157                if srp -> sr (i).off
158                then do;                                     /* special code */
159 
160 /* do this for special codes */
161 
162                          if srp -> sr (i).off = INITIATED_RULE
163                          then do;                           /* search RNT */
164                                    call ref_name_$get_segno ((refname), segment_number, code);
165                                    if code = 0
166                                    then do;
167                                              segptr = baseptr (segment_number);
168                                              addr (segptr) -> its_unsigned.ringno = 0;
169                                                             /* writearound for compiler bug to force ring num = ring of exec (i.e., 0) */
170                                              go to return;
171                                         end;
172                               end;
173 
174                          else if srp -> sr (i).off = REFERENCING_DIR_RULE
175                          then do;                           /* search parent of referencing proceedure */
176                                    if refptr ^= null
177                                    then do;                 /* must have pointer to referencing proceedure */
178                                              call get_kstep (segno (refptr), kstep, code);
179                                              if code = 0
180                                              then do;       /* see if we have to go up another level for an MSF */
181                                                        if MSF_sw
182                                                             then call get_kstep (segno (kste.entryp), kstep, code);
183                                                        dp = ptr (kste.entryp, 0);
184                                                        go to init_seg;
185                                                   end;
186                                         end;
187                               end;
188 
189                          else if srp -> sr (i).off = WDIR_RULE
190                          then do;                           /* search the working directory */
191                                    dp = pds$wdir (ring);    /* get the working directory for this ring */
192                                    if dp ^= null
193                                    then do;
194                                              call get_kstep (segno (dp), kstep, code);
195                                              if code = 0
196                                              then if pds$wdir_uid (ring) = kstep -> kste.uid
197                                                             /* check uid to make sure */
198                                                   then go to init_seg;
199                                         end;
200                               end;
201 
202                          else if srp -> sr (i).off = END_RULE
203                          then do;                           /* not found */
204                                    code = error_table_$seg_not_found;
205                                    goto return;
206                               end;
207 
208                          else if srp -> sr (i).off = BAD_RULE
209                          then ;                             /* ignore bad rule */
210                     end;
211 
212 /* come here for fixed directory search rules */
213 
214                else do;
215                          dp = baseptr (srp -> sr (i).base); /* set up pointer to directory */
216                          call get_kstep (segno (dp), kstep, code);
217                          if code = 0
218                          then if srp -> sr (i).uid = kstep -> kste.uid
219                               then do;                      /* check uid to make sure */
220 init_seg:
221                                         call initiate$initiate_seg_count (dp, refname, refname, (0), 1b, segptr, code);
222                                         if segptr ^= null
223                                         then do;
224                                                   if code = error_table_$segknown
225                                                   then code = 0;
226                                                             /* Clear residual code */
227                                                   go to return;
228                                              end;
229                                         else if code = error_table_$moderr
230                                              | code = error_table_$logical_volume_not_defined
231                                         then go to return;
232                                         else if code = error_table_$dirseg
233                                         then do;
234                                                   call dc_find$obj_existence_ptr (dp, ep, code);
235                                                   if code = 0
236                                                   then do;
237                                                             call get_pathname_ (segno (dp), pathname, code);
238                                                             call dc_find$finished (ep, DC_FIND_UNLOCK_DIR);
239                                                        end;
240                                                   if code = 0
241                                                   then do;
242                                                             dirname = pathname;
243                                                             call status_$minf (dirname, refname, 1, type, bc, code);
244                                                        end;
245                                                   if code = 0 & bc > 0 & type = 2
246                                                   then do;
247                                                             dirname = rtrim (pathname) || ">" || refname;
248                                                             call initiate$initiate_count (dirname, "0", refname,
249                                                                  (0), 1, segptr, code);
250                                                             if segptr ^= null
251                                                             then do;
252                                                                       if code = error_table_$segknown
253                                                                       then code = 0;
254                                                             /* Clear residual code */
255                                                                       go to return;
256                                                                  end;
257                                                             else if code = error_table_$moderr
258                                                                  | code = error_table_$logical_volume_not_defined
259                                                             then go to return;
260                                                        end;
261                                              end;
262                                    end;
263                     end;
264           end;
265 
266           code = error_table_$seg_not_found;                /* If fall through, indicate not found */
267 
268 return:
269           a_segptr = segptr;                                /* return segptr to caller */
270           a_code = code;
271           return;                                           /* and return */
272 %page;
273 same_directory:
274      entry (a_refptr, a_refname, a_segptr, a_code);
275 
276           refptr = a_refptr;
277           refname = a_refname;
278 
279 /* preset return values */
280 
281           segptr = null;
282           code = 0;
283 
284           if refptr ^= null
285           then do;
286                     call get_kstep (segno (refptr), kstep, code);
287                     if code = 0
288                     then do;
289                               dp = ptr (kste.entryp, 0);
290                               call initiate$initiate_seg_count (dp, refname, "", 0, 1b, segptr, code);
291                               if code = error_table_$segknown
292                               then code = 0;
293                          end;
294                end;
295           else code = error_table_$seg_not_found;
296 
297           a_segptr = segptr;
298           a_code = code;
299 
300           return;
301 %page;
302 set_wdir:
303      entry (a_wdir, a_code);
304 
305           wdir = a_wdir;                                    /* copy args */
306 
307           call dc_find$dir_initiate (wdir, dp, code);
308           if code = 0                                       /* user has access to see object */
309           then do;
310                     ring = level$get ();                    /* which ring is this for */
311                     segment_number = segno (pds$wdir (ring));
312                     segment_uid = pds$wdir_uid (ring);
313 
314                     pds$wdir (ring) = dp;                   /* save the pointer */
315                     pds$wdir_uid (ring) = dp -> dir.uid;    /* and the uid */
316                     call lock$dir_unlock (dp);
317 
318                     call get_kstep (segment_number, kstep, code);
319                     if code = 0
320                     then if segment_uid = kstep -> kste.uid
321                          then do;                           /* dereference old wdir */
322                                    call dc_find$obj_terminate_ptr (baseptr (segment_number), old_ep, code);
323                                                             /* audit termination */
324                                    if code = 0
325                                    then call lock$dir_unlock (ptr (old_ep, 0));
326                                    if code = error_table_$root
327                                    then code = 0;
328                                    if code = 0
329                                    then call segno_usage$decrement (segment_number, (0));
330                               end;
331                     code = 0;
332                end;
333           a_code = code;
334           return;
335 %page;
336 get_wdir:
337      entry (a_pathptr, a_pathcnt);                          /* to return the path name of the working directory */
338 
339           pathname = "";                                    /* in case of error */
340           ring = level$get ();                              /* which ring is this for */
341           wdp = pds$wdir (ring);
342           call get_kstep (segno (wdp), kstep, code);
343           if code = 0
344           then if pds$wdir_uid (ring) = kstep -> kste.uid
345                then do;
346                          call dc_find$obj_existence_ptr (wdp, ep, code);
347                          if code = 0
348                          then do;
349                                    call get_pathname_ (segno (wdp), pathname, code);
350                                    call dc_find$finished (ep, DC_FIND_UNLOCK_DIR);
351                               end;
352                          else if code = error_table_$root
353                          then do;
354                                    code = 0;
355                                    pathname = ">";
356                               end;
357                     end;
358           a_pathptr -> dname = pathname;
359           a_pathcnt = length (pathname);
360           return;
361 %page;
362 USER_RING_DAMAGED:
363      procedure (Damaged_thing, Ring);
364 
365           dcl     Damaged_thing          char (*) parameter;
366           dcl     Ring                   fixed bin (3) parameter;
367 
368           call syserr (JUST_LOG, "fs_search: Fatal damage detected to ^a in ring ^d for ^a.", Damaged_thing, Ring,
369                pds$process_group_id);
370           call terminate_proc (error_table_$inconsistent_rnt);
371      end USER_RING_DAMAGED;
372 %page;
373 %include dc_find_dcls;
374 %page;
375 %include dir_entry;
376 %page;
377 %include dir_header;
378 %page;
379 %include its;
380 %page;
381 %include kst;
382 %page;
383 %include rnt;
384 %page;
385 %include search_rule_flags;
386 %page;
387 %include stack_header;
388 %page;
389 %include syserr_constants;
390 %page;
391 /* BEGIN MESSAGE DOCUMENTATION
392 
393    Message:
394    fs_search: Fatal damage detected to WHAT in ring RING for USER.
395 
396    S:     $log
397 
398    T:     $run
399 
400    M:     Some object crucial to the operation of the dynamic linker in ring
401    RING was detected damaged. Since the dynamic linker cannot operate
402    in the process, it is terminated.
403 
404    A:     $ignore
405 
406    END MESSAGE DOCUMENTATION */
407 
408      end fs_search;