1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 
 13 
 14 /****^  HISTORY COMMENTS:
 15   1) change(86-06-05,GJohnson), approve(86-06-05,MCR7387),
 16      audit(86-06-10,Martinson), install(86-07-11,MR12.0-1091):
 17      Correct error message documentation.
 18                                                    END HISTORY COMMENTS */
 19 
 20 
 21 /* format: style4,indattr,ifthenstmt,ifthen,idind35,^indcomtxt */
 22 
 23 /* LOAD_SYSTEM - Load Collection 3 from Multics System Tape. */
 24 /* to v2pl1, RE Mullen, Nov 73 */
 25 /* last modified 3/76 by N. I. Morris & S. H. Webber for new reconfig */
 26 /* broken acl manipulations fixed BIM 3/82 */
 27 /* Modified October 1983 by Keith Loepere for warm boot from disk. */
 28 /* Modified January 1985 by Keith Loepere to set entry bounds on gates. */
 29 
 30 load_system: procedure;
 31 
 32 /* Variables */
 33 
 34 dcl  access                             bit (3);
 35 dcl  bitcount                           fixed bin (24);
 36 dcl  count                              fixed bin (18);
 37 dcl  cp                                 ptr;
 38 dcl  1 cw                               aligned,            /* Control word. */
 39      ( 2 type                           fixed bin (18) uns,
 40        2 count                          fixed bin (18) uns) unaligned;
 41 dcl  1 del_acl                          (1) aligned like delete_acl_entry;
 42 dcl  dir_name                           char (168);
 43 dcl  entry_bound                        fixed bin (14);
 44 dcl  entryname                          char (32);
 45 dcl  ercode                             fixed bin (35);
 46 dcl  header_area                        (1000) fixed bin (35);
 47 dcl  hp                                 ptr;
 48 dcl  lastword                           ptr;
 49 dcl  mapword                            fixed bin (18);
 50 dcl  must_delete_acl                    bit (1) aligned;
 51 dcl  must_set_acl                       bit (1) aligned;
 52 dcl  object_map_ptr                     ptr;
 53 dcl  old_mode                           bit (36);
 54 dcl  1 seg_acl_struc                    aligned,
 55        2 version                        fixed bin,
 56        2 count                          fixed bin,
 57        2 seg_acl                        (1) aligned like segment_acl_entry;
 58 dcl  segp                               ptr;
 59 dcl  wordcount                          fixed bin (18);
 60 
 61 /* Based */
 62 
 63 dcl  just_reference                     fixed bin (35) based;
 64 
 65 /* Misc */
 66 
 67 dcl  (addr, addrel, bit, divide, fixed, null, size, substr) builtin;
 68 
 69 /* External */
 70 
 71 dcl  pds$process_group_id               ext static char (32) aligned;
 72 
 73 /* Entries */
 74 
 75 dcl  asd_$add_sentries                  entry (char (*), char (*), ptr, fixed bin, fixed bin (35));
 76 dcl  asd_$del_sentries                  entry (char (*), char (*), ptr, fixed bin, fixed bin (35));
 77 dcl  asd_$r_list_sall                   entry (char (*), char (*), ptr, ptr, fixed bin (35));
 78 dcl  disk_reader                        entry (ptr, fixed bin (18));
 79 dcl  init_branches$branch               entry (ptr, ptr, ptr, bit (3), ptr);
 80 dcl  set$entry_bound_ptr                entry (ptr, fixed bin (14), fixed bin (35));
 81 dcl  syserr                             entry options (variable);
 82 dcl  syserr$error_code                  entry options (variable);
 83 %page;
 84           hp = addr (header_area);                          /* Pointer to header area in stack. */
 85           cp = addr (cw);                                   /* Pointer to control word. */
 86 
 87           seg_acl_struc.version = ACL_VERSION_1;
 88           seg_acl_struc.count = 1;
 89           seg_acl_struc.seg_acl (1).access_name = pds$process_group_id;
 90 
 91 loop:     call disk_reader (cp, 1);                         /* Read in next control word from disk. */
 92           if cw.type = 2 then do;                           /* Check for collection mark. */
 93                call disk_reader (cp, 1);                    /* It is, get it out of the way. */
 94                return;                                      /* End of collection..quit. */
 95           end;
 96           if cw.type ^= 0 then call syserr (CRASH, "load_system: illegal type in mst source");
 97           count = cw.count;                                 /* Copy count of header. */
 98           if count > 1000 then call syserr (CRASH, "load_system: illegal header length in mst source");
 99 
100           call disk_reader (hp, count);                     /* Suck in the header. */
101           namep = addrel (hp, size (slte));                 /* Set ptr to names */
102           pathp = addrel (namep, namep -> segnam.count * 9 + 1); /* ptr to path name */
103           access = bit (hp -> slte.access, 3);              /* Set access from header, mask off P bit */
104           bitcount = hp -> slte_uns.bit_count;
105 
106           call init_branches$branch (pathp, namep, hp, access, segp); /* Go set up branch. */
107 
108           dir_name = pathp -> path.name;
109           entryname = namep -> segnam.names (1).name;
110 
111           must_set_acl, must_delete_acl = "0"b;
112           old_mode = ""b;
113 
114           call asd_$r_list_sall (dir_name, entryname, null (), addr (seg_acl_struc), ercode);
115 
116           if ercode ^= 0 then call syserr$error_code (CRASH, ercode, "load_system: error from asd_$r_list_sall on ^a>^a.", dir_name, entryname);
117 
118           if seg_acl_struc.seg_acl (1).status_code = 0 then if ^substr (seg_acl_struc.seg_acl (1).mode, 3, 1) then do; /* no w */
119                     must_set_acl = "1"b;
120                     must_delete_acl = "0"b;
121                     old_mode = seg_acl_struc.seg_acl (1).mode;
122                end;
123                else must_set_acl, must_delete_acl = "0"b;   /* already have w */
124           else must_set_acl, must_delete_acl = "1"b;
125 
126           if must_set_acl then do;
127                seg_acl_struc.seg_acl (1).mode = RW_ACCESS;
128                call asd_$add_sentries (dir_name, entryname, addr (seg_acl_struc.seg_acl), 1, ercode);
129                if ercode ^= 0 then
130 asd_error:          call syserr$error_code (CRASH, ercode, "load_system: error from asd_$add_sentries on ^a>^a.", dir_name, entryname);
131           end;
132 
133           call disk_reader (cp, 1);                         /* Get next control word for seg. */
134           if cw.type ^= 1 then call syserr (CRASH, "load_system: illegal type in mst source");
135 
136           call disk_reader (segp, (cw.count));              /* Suck in the segment. */
137 
138 /* Find entry bound in object map; see if entry bound should be set. */
139 
140           if bitcount = 0 then go to no_entry_bound;
141           wordcount = divide (bitcount + 35, 36, 18, 0);
142           lastword = addrel (segp, wordcount - 1);
143           mapword = fixed (lastword -> map_ptr, 18);        /* will want to see if value is in reasonable range */
144 
145           if mapword <= 0 then go to no_entry_bound;        /* last word won't point to new format map */
146           if mapword >= wordcount then go to no_entry_bound;
147           object_map_ptr = addrel (segp, lastword -> map_ptr); /* get ptr to map */
148           if object_map_ptr -> object_map.identifier ^= "obj_map " then goto no_entry_bound;
149           if object_map_ptr -> object_map.decl_vers ^= 2 then go to no_entry_bound;
150 
151           entry_bound = fixed (object_map_ptr -> object_map.entry_bound, 18);
152           if entry_bound > 0 then do;
153                call set$entry_bound_ptr (segp, entry_bound, ercode);
154                if ercode ^= 0 then
155                     call syserr$error_code (CRASH, ercode, "load_system: error from set$entry_bound_ptr for ^a>^a.", dir_name, entryname);
156           end;
157 
158 no_entry_bound:
159           if must_set_acl & ^must_delete_acl then do;       /* must_restore_acl ... */
160                seg_acl_struc.seg_acl (1).mode = old_mode;
161                call asd_$add_sentries (dir_name, entryname, addr (seg_acl_struc.seg_acl), 1, ercode);
162                if ercode ^= 0 then go to asd_error;
163           end;
164 
165           if must_delete_acl then do;
166                del_acl (1).access_name = pds$process_group_id;
167                call asd_$del_sentries (dir_name, entryname, addr (del_acl), 1, ercode);
168                if ercode ^= 0 then
169                     call syserr$error_code (CRASH, ercode, "load_system: error from asd_$delete_sentries for ^a>^a.", dir_name, entryname);
170           end;
171 
172 
173           ercode = segp -> just_reference;                  /* make it active again */
174           ercode = 0;
175           go to loop;
176 %page; %include access_mode_values;
177 %page; %include acl_structures;
178 %page; %include object_map;
179 %page; %include slt;
180 %page; %include slte;
181 %page; %include syserr_constants;
182 %page;
183 
184 /* BEGIN MESSAGE DOCUMENTATION
185 
186    Message:
187    load_system: illegal type in mst source
188 
189    S:     $crash
190 
191    T:     $init
192 
193    M:     $err
194 
195    A:     $recover
196    $boot_tape
197 
198 
199    Message:
200    load_system: error from asd_$add_sentries
201    The system could not remove the write access it had set to load the
202    contents of a segment from the mst source.
203 
204    S:     $crash
205 
206    T:     $init
207 
208    M:     $err
209 
210    A:     $recover
211    $boot_tape
212 
213 
214    Message:
215    load_system: illegal header length in mst source
216 
217    S:     $crash
218 
219    T:     $init
220 
221    M:     $err
222 
223    A:     $recover
224    $boot_tape
225 
226 
227    Message:
228    load_system: illegal type in mst source
229 
230    S:     $crash
231 
232    T:     $init
233 
234    M:     $err
235 
236    A:     $recover
237    $boot_tape
238 
239 
240    Message:
241    load_system: error from set$entry_bound_ptr
242 
243    S:     $crash
244 
245    T:     $init
246 
247    M:     $err
248 
249    A:     $recover
250    $boot_tape
251 
252    END MESSAGE DOCUMENTATION */
253 
254      end;