1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1984 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 /* format: style4 */
 13 init_proc: proc;
 14 
 15 /* This program is the first program executed (in ring 0) in a user, absentee, or
 16    daemon process. It is entered from special code in pxss via a return pointer
 17    left in the stack by build_template_pds. It is also called explicitly during
 18    initialization to get the initializer process into the user ring.
 19 
 20    Last modified (date and reason):
 21    8/15/74  by S.Webber --  completely recoded to make references to the pit.
 22 
 23    76/04/29 by T. Casey to fix bug in implementation of "-initproc path,direct",
 24    *                allow path to be relative to homedir,
 25    *                and to replace all instances of call syserr (2,...) (print with alarm and terminate process) by
 26    *                call syserr (4,...) or (3,...) (log, or print with alarm), followed by
 27    *                direct calls to terminate_proc$init_failure with a relevant error_table_ code.
 28    77/03/29 by M. Weaver to call makestack explicitly because of moving search rules to user ring
 29    79/03/01 by B. Margulies to set the working dir BEFORE calling makestack
 30    79/03/05 by B. Margulies to never set the working directory for users without
 31    v_init_proc.
 32    79/17/06 by B. Margulies to fix uninitialized variable bug introduced by
 33    above.
 34    79/07/14 by Mike Grady for ring 0 stack sharing
 35    81/10/05 by B. Margulies for new call_out mechanism.
 36    81/11/23 by B. Margulies for new initial procedure.
 37    84/11/05 by K. Loepere to rename terminate to terminate_.
 38    Modified 1984-11-11 by E. Swenson for IPC event channel validation.
 39    Here we set the value of apte.ipc_r_factor.
 40 */
 41 
 42 /* Automatic */
 43 
 44 dcl  (pp, caller_ptr) ptr;
 45 dcl  (i, j) fixed bin;
 46 dcl  (d_len, e_len, hd_len, less_thans, po_len) fixed bin;
 47 dcl  code fixed bin (35);
 48 dcl  dirname char (168);
 49 dcl  initial_proc char (32);
 50 dcl  temp fixed bin (71);
 51 
 52 /* Entries */
 53 
 54 dcl  makestack entry (fixed bin);
 55 dcl  fs_search$set_wdir entry (char (*), fixed bin (35));
 56 dcl  terminate_$noname entry (ptr, fixed bin (35));
 57 dcl  pmut$set_mask entry (fixed bin (71), fixed bin (71));
 58 dcl  level$set entry (fixed bin);
 59 dcl  (syserr, syserr$error_code) entry options (variable);
 60 dcl  terminate_proc$init_failure entry (fixed bin (35));
 61 dcl  initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35));
 62 dcl  initialize_kst entry;
 63 dcl  pathname_am$initialize ext entry;
 64 dcl  call_outer_ring_ entry (ptr, char (*), char (*), fixed bin (3), fixed bin (35));
 65 
 66 /* External */
 67 
 68 dcl  scs$open_level fixed bin (71) ext;
 69 dcl  pds$stack_0_ptr ptr ext;
 70 dcl  pds$stacks (0:7) ptr ext;
 71 dcl  pds$process_dir_name char (32) aligned ext;
 72 dcl  pds$process_group_id char (32) aligned ext;
 73 dcl  pds$initial_ring fixed bin ext;
 74 dcl  pds$apt_ptr pointer external;
 75 dcl  error_table_$badpath ext fixed bin (35);
 76 dcl  error_table_$bad_process_type ext fixed bin (35);
 77 
 78 /* Constants */
 79 
 80 dcl  (addr, index, length, null, reverse, rtrim, search, substr, verify) builtin;
 81 %page;
 82 /* First get a pointer to the PIT. Do this with a call to initiate since we know our process directory name */
 83 
 84           call pathname_am$initialize ();                   /* initialize associative memory before doing anything */
 85           call initialize_kst;                              /* before initiate can be called we must have a KST */
 86 
 87           pds$stacks (0) = pds$stack_0_ptr;
 88 
 89           call level$set (pds$initial_ring);                /* set user ring validation level before initiating */
 90           call pmut$set_mask (scs$open_level, temp);
 91                                                             /* Now dispatch on the process type */
 92 
 93 /* our goal is to establish wdir before calling makestack, so as to allow
 94    the user to substitute a signal_ or unwinder_ if she has v_init_proc.
 95    In order to do this we must initiate pit to check attribute.
 96    Luckily, if you call initiate without a refname it doesnt attempt to
 97    use the rnt, which isnt there yet. We would like to call initiate with
 98    the refname of "pit_", but as it is we will have to leave that for the
 99    user ring to do. */
100 
101           call initiate ((pds$process_dir_name), "pit", "", (0), (0), pp, code);
102           if pp = null then do;
103                call syserr$error_code (3, code, "init_proc: could not get pointer to pit for ^a", pds$process_group_id);
104                call terminate_proc$init_failure (code);
105           end;
106 
107           if pp -> pit.process_type = 0 then                /* initializer */
108                initial_proc = "system_startup_";
109 
110           else if pp -> pit.process_type < 4 then           /* interactive, absentee, or daemon */
111                initial_proc = "initialize_process_";
112 
113           else do;
114                call syserr$error_code (3, "init_proc: bad process type (^d) given for ^a",
115                     pp -> pit.process_type, pds$process_group_id);
116                call terminate_proc$init_failure (error_table_$bad_process_type);
117           end;
118 
119           if initial_proc ^= "system_startup_" then         /* skip this setting for initializer as vol may not be there */
120                if pp -> pit.at.vinitproc then               /* if user is allowed to have his own process overseer */
121                     call fs_search$set_wdir (pp -> pit.homedir, (0)); /* set initial working dir to homedir */
122                                                             /* Otherwise avoid
123                                                                * setting wdir, so user can't violate vinitproc restriction
124                                                                * by putting a copy of xxxx_init_admin_ in his homedir */
125 
126 /* The error code from fs_search is ignored; if we can't
127    * set a working dir we do the best we can without one */
128 
129           call makestack (pds$initial_ring);                /* create stack, RNT and search rules */
130 
131 
132 /* Now initialize more of the process */
133 
134 /* * Now get a pointer to the initial procedure - the first one to be executed in the user's initial ring.
135    *
136    * The default initial procedure for a user is user_init_admin_ for an interactive process, or absentee_init_admin_
137    * for an absentee process. The proper one was selected above (its name being stored in initial_proc) as a function
138    * of the process type. The initial procedure calls the login responder (also known as the process overseer).
139    *
140    * The default process overseer for a user is process_overseer_.
141    *
142    * It is possible for a procedure to be specified, either in the user's pdt entry, or by the user on the login line,
143    * to be called instead of one of these two default procedures. The keyword "initproc" is used to identify this
144    * procedure in both cases, and the keyword "direct" is used to indicate that the procedure is to be called directly,
145    * in place of the default initial procedure, rather than being called by the default initial procedure
146    * in place of the default process overseer. It is the "direct" case which we must check for here.
147    *
148    * By default, we do not use the referencing_dir search rule when searching for the initial procedure. This
149    * allows a user to have an initial procedure of the same name as the default, in his home directory, and have
150    * it used instead of the installed one. This will only happen if the user has the vinitproc attribute,
151    * since, to enforce vinitproc, we put off setting his working directory to his home directory until
152    * after we get the pointer to the initial procedure, if he does not have that attribute.
153 */
154 
155           caller_ptr = null;                                /* caller_ptr points to something in the referencing directory */
156 
157 /* * The implementation of the "direct" feature is being changed, in stages.
158    * Originally, this procedure was to scan for the string ",direct" at the end of the process overseer name,
159    * and upon finding it, eliminate that string, and call the procedure specified by the remainder of the pathname, directly.
160    * Then, the switch, pit.dont_call_init_admin was defined, and parts of the answering service were changed to
161    * check for the string ",direct", and upon finding it, eliminate it from the pathname and turn on that switch.
162    * However, some parts of the answering service do not check for the string or set the switch, so for now,
163    * this procedure must check for both indications, and must be sure to eliminate the string ",direct" from the pathname
164    * before attempting to get a pointer to the segment, even when the switch is found to be on.
165    * The lines that check for ",direct" may be deleted after all parts of the answering service have been changed to
166    * eliminate that string from the pathname and turn on the switch.
167 */
168 
169           po_len = -1 + index (pp -> pit.login_responder, ",direct"); /* look for ",direct" */
170           if po_len >= 0 then goto direct;                  /* ",direct" is there, and
171                                                                po_len is the length of the pathname that preceeds it */
172 
173           if pp -> pit.dont_call_init_admin then do;        /* check for the "direct" option */
174                                                             /* compute length of pathname without trailing blanks */
175                po_len = length (rtrim (pp -> pit.login_responder));
176 
177 direct:                                                     /* come here if ",direct" is in the process overseer pathname */
178 
179 /* If string contains any ">" or "<" characters, it is a pathname */
180                e_len = -1 + search (reverse (substr (pp -> pit.login_responder, 1, po_len)), "<>"); /* see if it does */
181 
182                if e_len >= 0 then do;                       /* it is a pathname, and e_len is the length of the entryname */
183                     d_len = po_len - e_len - 1;             /* compute length of dirname part */
184 
185 /* * Since expand_path_ is not available in ring zero, and it does not have
186    * an ideal interface for use in this stage of process initialization anyway,
187    * we do the equivalent pathname parsing in-line. This algorithm is copied from
188    * expand_path_, modified to avoid unnecessary generality.
189 */
190 
191                     initial_proc = substr (pp -> pit.login_responder, d_len + 2, e_len); /* copy the entryname */
192                     if substr (pp -> pit.login_responder, 1, 1) = ">" then /* if we have a full pathname */
193                          dirname = substr (pp -> pit.login_responder, 1, d_len); /* just copy the directory portion */
194 
195                     else do;                                /* relative pathname - build dirname, using pit.homedir */
196                          hd_len = length (pp -> pit.homedir) - verify (reverse (pp -> pit.homedir), " ") + 1;
197                                                             /* compute length of home directory */
198                          less_thans = -1 + verify (substr (pp -> pit.login_responder, 1, d_len + 2), "<");
199                                                             /* count leading "<"s */
200                                                             /* if there is nothing but "<"s before the entry name, the verify
201                                                                gives the index of the first char of the entry name,
202                                                                and the -1 makes the less_than count correct */
203                          if index (substr (pp -> pit.login_responder, 1 + less_thans, d_len - less_thans + 1), "<") > 0 then do;
204                                                             /* if any non-leading less thans, bad syntax in path */
205 bad_path:                     call syserr (4, "init_proc: bad syntax in initial procedure name: ^a for ^a",
206                                    pp -> pit.login_responder, pds$process_group_id);
207                               call terminate_proc$init_failure (error_table_$badpath);
208                          end;
209 
210                          do i = 1 to less_thans;            /* if there are no less thans, this loop is skipped */
211                               j = index (reverse (substr (pp -> pit.homedir, 1, hd_len)), ">");
212                                                             /* back up thru "less_thans" components and ">"s */
213                               if j = 0 then                 /* if no more left, too many "<"s */
214                                    goto bad_path;           /* just say bad path - don't bother with details */
215                               hd_len = hd_len - j;          /* shorten hd len by length of component and its leading ">" */
216                          end;                               /* end less thans loop */
217 
218                          if hd_len > 166 then               /* just a formality */
219                               goto bad_path;
220                          if hd_len + d_len - less_thans + e_len + 2 > 168 then /* not just a formality */
221                               goto bad_path;                /* path too long */
222 
223 /* now build the directory portion of the pathname */
224 
225                          if hd_len > 0 then                 /* if the less thans did not get us back to the root */
226                               substr (dirname, 1, hd_len) = substr (pp -> pit.homedir, 1, hd_len);
227                          if d_len - less_thans > 0 then do; /* if <dir>ent rather than <ent */
228                               substr (dirname, hd_len + 1, 1) = ">"; /* fill in ">dir" */
229                               substr (dirname, hd_len + 2) = substr (pp -> pit.login_responder, less_thans + 1, d_len - less_thans);
230                          end;
231 
232                     end;                                    /* end relative pathname */
233 
234 
235 /* * Try to initiate the segment specified by that pathname. Note that the pointer to it goes into caller_ptr,
236    * which is used below, in the call to call_outer_ring_, to indicate the referencing directory.
237 */
238 
239                     call initiate (dirname, initial_proc, initial_proc, 0, 0, caller_ptr, code);
240                     if caller_ptr = null then do;           /* code could be error_table_$segknown if process is prelinked */
241                          call syserr$error_code (4, code, "init_proc: can not get pointer to initial procedure: ^a>^a for ^a",
242                               dirname, initial_proc, pds$process_group_id);
243                          call terminate_proc$init_failure (code);
244                     end;
245                end;                                         /* end pathname */
246 
247 /* End of in-line expand_path_   */
248 
249                else initial_proc = substr (pp -> pit.login_responder, 1, po_len); /* must be an entry name */
250 
251           end;                                              /* end dont_call_init_admin (call process overseer directly) */
252 
253           call terminate_$noname (pp, code);                /* terminate the pit */
254 
255 /**** The following code sets the value of apte.ipc_r_factor used in
256       conjunction with apte.ipc_r_offset for IPC event channel
257       validation.  apte.ipc_r_offset was set in act_proc, and
258       apte.ipc_r_factor is set here to allow for an unpredictable delay
259       between setting the two values.  This makes it difficult to
260       guess the value of apte.ipc_r_factor given the value of
261       apte.ipc_r_offset.
262 
263       Note we are modifying our own apte here.  This should be ok since
264       we can be sure that no one else will attempt to modify this value,
265       and that the apte is not going anywhere while we are executing
266       here in ring-0. */
267 
268           aptep = pds$apt_ptr;
269           apte.ipc_r_factor =
270                binary (substr (bit (binary (clock (), 54), 54), 19, 36), 35);
271 
272 /* Now call out. this program does all the work of snapping the link */
273 /* caller_ptr will be nonnull if there was a pathname */
274 
275           call call_outer_ring_ (caller_ptr, initial_proc, initial_proc, (pds$initial_ring), code);
276 
277           if code ^= 0 then do;
278                call syserr$error_code (4, code, "init_proc: can not call out to initial procedure: ^a for ^a",
279                     initial_proc, pds$process_group_id);
280                call terminate_proc$init_failure (code);
281           end;
282 
283 /* format: off */
284 %page; %include apte;
285 %page; %include pit;
286 %page; %include user_attributes;
287 %page;
288 /* BEGIN MESSAGE DOCUMENTATION
289 
290    Message:
291    init_proc: could not get pointer to pit for PERSON.PROJ.T ERROR_MESSAGE
292 
293    S:     $beep
294 
295    T:     $run
296 
297    M:     The answering service has created
298    the process directory for a new process incorrectly.
299    The user cannot be logged in.
300 
301    A:     $contact
302 
303 
304    Message:
305    init_proc: bad process type (N) given for PERSON.PROJ.T
306 
307    S:     $beep
308 
309    T:     $run
310 
311    M:     The answering service has specified an
312    unknown integer in the process type field.
313    Incorrect arguments were passed to hphcs_$create_proc.
314    The user cannot be logged in.
315 
316    A:     $contact
317 
318 
319    Message:
320    init_proc: bad syntax in initial procedure name: STRING for PERSON.PROJ.T
321 
322    S:     $log
323 
324    T:     $run
325 
326    M:     An illegal initial procedure name was specified for the user.
327    The user may have given an incorrect -po argument, or the project's PDT may be wrong.
328    No process is created.
329 
330    A:     $ignore
331 
332 
333    Message:
334    init_proc: can not get pointer to initial procedure: PATH for PERSON.PROJ.T ERROR_MESSAGE
335 
336    S:     $log
337 
338    T:     $run
339 
340    M:     The supervisor could not initiate the specified initial procedure PATH.
341    The process overseer may be in invalid form, inaccessible, or missing.
342    The user may have given an incorrect -po argument, or the project's PDT may be incorrect.
343 
344    A:     $ignore
345 
346 
347    Message:
348    init_proc: can not call out to initial procedure: NAME for PERSON.PROJ.T ERROR_MESSAGE
349 
350    S:     $log
351 
352    T:     $run
353 
354    M:     The supervisor could not snap a link to NAME$NAME.
355    The process overseer may be in invalid form, inaccessible, or missing.
356    The user may have given an incorrect -po argument, or the project's PDT may be incorrect.
357 
358    A:     $ignore
359 
360 
361    END MESSAGE DOCUMENTATION */
362 /* format: on */
363 
364      end init_proc;