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 
 12 /* INSTALL - program to copy new tables into >system_control_1>update
 13    and signal the answering service to install them.
 14 
 15    Written by THVV
 16    Modified 750114 by PG to add command options for authorizations, etc.
 17    Modified 750614 by T. Casey to enable install of MGT
 18    Modified 760804 by THVV to eliminate response handler
 19    Modified 062377 by Robert Coren to add TTT to list of legal tables
 20    Modified 03/16/78 by C. D. Tavares to add RTDT
 21    Modified 12/26/81 by E. N. Kittlitz to use whotab instead of proj_admin_seg to send wakeup.
 22    Modified 1/2/82 by Benson I. Margulies for ttt installations through gate.
 23    Modified April 1982 by E. N. Kittlitz to not write original table.
 24    Modified July 1982 by E. N. Kittlitz to not use sc_stat_ (TOOLS), because this is an SSS program.
 25 */
 26 
 27 
 28 /****^  HISTORY COMMENTS:
 29   1) change(1986-05-02,Kissel), approve(1986-07-23,MCR7460),
 30      audit(1986-07-28,Ex), install(1986-08-05,MR12.0-1115):
 31      Changed to accept the "nit" suffix for the DSA NIT.  It is handled just
 32      like the "ttt" suffix, but dsa_install_nit_ is called rather than
 33      installation_gate_$install_ttt
 34   2) change(2023-02-20,Swenson), approve(2023-02-20,MCR10131),
 35      audit(2023-02-20,GDixon):
 36      Fixed race condition where segfaults can occur under certain conditions.
 37                                                    END HISTORY COMMENTS */
 38 
 39 
 40 /* format: style4 */
 41 install: proc;
 42 
 43 /* entries */
 44 
 45 dcl  com_err_ entry options (variable);
 46 dcl  cu_$arg_count entry returns (fixed bin);
 47 dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35));
 48 dcl  dsa_install_nit_ entry (ptr, uns fixed bin (18), char (*), fixed bin (35));
 49 dcl  expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35));
 50 dcl  get_group_id_ entry returns (char (32));
 51 dcl  get_process_id_ entry returns (bit (36));
 52 dcl  get_wdir_ entry returns (char (168));                  /* return working dir */
 53 dcl  hcs_$chname_seg entry (ptr, char(*), char(*), fixed bin(35));
 54 dcl  hcs_$delentry_seg entry (ptr, fixed bin (35));
 55 dcl  hcs_$make_seg entry (char (*), char (*), char (*),
 56           fixed bin (5), ptr, fixed bin (35));
 57 dcl  hcs_$wakeup entry (bit (*), fixed bin (71), fixed bin (71), fixed bin (35));
 58 dcl  hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35));
 59 dcl  initiate_file_ entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35));
 60 dcl  installation_gate_$install_ttt entry (ptr, fixed bin (18) uns, char (*), fixed bin (35));
 61 dcl  ioa_ entry options (variable);
 62 dcl  pathname_ entry (char (*), char (*)) returns (char (168));
 63 dcl  unique_chars_ entry (bit (*)) returns (char (15));
 64 dcl  terminate_file_ entry (ptr, fixed bin (24), bit (*), fixed bin (35));
 65 
 66 /* builtins */
 67 
 68 dcl  (dim, divide, index, length, null, reverse, rtrim, substr) builtin;
 69 
 70 /* external static */
 71 
 72 dcl  error_table_$bad_arg fixed bin (35) ext static;
 73 dcl  error_table_$badopt fixed bin (35) ext static;
 74 dcl  error_table_$not_seg_type ext fixed bin (35) static;
 75 
 76 /* static */
 77 
 78 dcl  LEGAL_TYPES (7) char (4) aligned static options (constant) initial
 79           ("sat", "pdt", "mgt", "cdt", "ttt", "rtdt", "nit");
 80 dcl  sysdir char (64) int static init (">system_control_1");
 81 dcl  temp_suffix char(5) internal static options(constant) init (".temp"); /* suffix added by install while updating table copy */
 82 
 83 /* automatic */
 84 
 85 dcl  (idir char (80), copyname char (15));
 86 dcl  (dir char (168), ename char (32));
 87 
 88 dcl  (argno, i) fixed bin;
 89 dcl  code fixed bin (35);
 90 dcl  arg_length fixed bin (21);
 91 dcl  lng fixed bin (21);
 92 dcl  arg_ptr ptr;
 93 dcl  bitcount fixed bin (24);
 94 dcl  (segp, copyp) ptr;                                     /* ... */
 95 dcl  suffix char (4) varying;                               /* pdt, etc */
 96 dcl  whoptr pointer;
 97 dcl  answer character (256);
 98 dcl  update_attributes_sw bit (1) aligned;
 99 dcl  update_authorization_sw bit (1) aligned;
100 
101 /* based */
102 
103 dcl  arg_string char (arg_length) based (arg_ptr);
104 
105 dcl  1 t based (segp) aligned,                              /* dummy structure for seg. header */
106        2 author like author_dcl.author;
107 
108 dcl  1 segmnt based aligned,                                /* structure to move_ stuff */
109        2 words (lng) fixed bin;
110 
111 /* ext static */
112 
113 declare  whotab_$ ext bit (36) aligned;
114 
115 /* include files */
116 
117 %include access_mode_values;
118 %include author_dcl;
119 %include whotab;
120 %include terminate_file;
121 /* condition */
122 
123 declare  cleanup condition;
124 declare  linkage_error condition;
125 ^L
126 
127 /* - - - - - - - - - - - - - - - -- - - - - */
128 
129 
130           update_attributes_sw, update_authorization_sw = ""b;
131 
132           on linkage_error begin;
133                call hcs_$initiate (sysdir, "whotab", "whotab_", 0, 0,
134                     whoptr, code);
135                if whoptr = null
136                then do;
137                     call com_err_ (code, "install", "cannot initiate ^a.", pathname_ (sysdir, "whotab"));
138                     go to RETURN;
139                end;
140           end;
141 
142           whoptr = addr (whotab_$);
143           revert linkage_error;
144 
145           call cu_$arg_ptr (1, arg_ptr, arg_length, code);  /* get name of segment */
146           if code ^= 0 then do;
147                call com_err_ (code, "install", "Usage: install pathname -all(-a), -attributes(-attr), -authorization(-auth)");
148                return;
149           end;
150 
151           call expand_pathname_ (arg_string, dir, ename, code);
152           if code ^= 0 then do;
153                call com_err_ (code, "install", arg_string);
154                return;
155           end;
156 
157           if index (ename, ".") = 0 then goto not_known_type;
158 
159           i = length (rtrim (ename));
160 
161           suffix = reverse (before (reverse (ename), "."));
162 
163           do i = 1 to dim (LEGAL_TYPES, 1) while (LEGAL_TYPES (i) ^= suffix);
164           end;
165 
166           if i > dim (LEGAL_TYPES, 1) then do;
167 not_known_type:
168                call com_err_ (error_table_$not_seg_type, "install",
169                     "Table is not ^v(^a, ^)or ^a.  Installation refused.",
170                     dim (LEGAL_TYPES, 1) - 1, LEGAL_TYPES (*));
171                return;
172           end;
173 
174           copyp, segp = null;
175           on cleanup call clean_up;
176 
177           call initiate_file_ (dir, ename, R_ACCESS, segp, bitcount, code);
178           if code ^= 0 then do;
179                call com_err_ (code, "install", "^a", pathname_ (dir, ename));
180                go to RETURN;                                /* segp may be nonnull */
181           end;
182 
183           if bitcount < 2304 then do;                       /* check length of segment */
184                call ioa_ ("install: ^a less than 64 words long.", pathname_ (dir, ename));
185                go to RETURN;
186           end;
187 
188 /* read the arguments */
189 
190           do argno = 2 to cu_$arg_count ();
191                call cu_$arg_ptr (argno, arg_ptr, arg_length, code);
192                if code ^= 0 then go to no_more_args;
193 
194                if arg_string = "-all" | arg_string = "-a" then
195                     update_attributes_sw, update_authorization_sw = "1"b;
196                else if arg_string = "-attributes" | arg_string = "-attr" then
197                     update_attributes_sw = "1"b;
198                else if arg_string = "-authorization" | arg_string = "-auth" then
199                     update_authorization_sw = "1"b;
200                else do;
201                     call com_err_ (error_table_$badopt, "install", "^a", arg_string);
202                     return;
203                end;
204           end;
205 
206 no_more_args:
207           if argno = 2 then                                 /* if no options were given, use default */
208                update_attributes_sw = "1"b;                 /* dft is -attr */
209 
210           lng = divide (bitcount + 35, 36, 17, 0);          /* get wordcount */
211 
212           if t.table = "TTT"
213           then do;                                          /* The first of the easy variety */
214                                                             /* Note we ignore control arguments */
215                call installation_gate_$install_ttt (segp, (lng), answer, code);
216                if code ^= 0
217                then call com_err_ (code, "install", "^a installing ^a.",
218                          answer, pathname_ (dir, ename));
219                else call ioa_ ("install: Installed ^a as system ttt.",
220                          pathname_ (dir, ename));
221                go to RETURN;
222           end;
223 
224           if t.table = "NIT"
225           then do;                                          /* The next of the easy variety */
226                                                             /* Note we ignore control arguments */
227                /*** Get ready for problems. */
228 
229                on linkage_error
230                     begin;
231                     code = error_table_$bad_arg;
232                     answer = "DSA is not enabled on this system.  ";
233                     goto NIT_ERROR;
234                end;
235 
236                call dsa_install_nit_ (segp, (lng), answer, code);
237 
238                revert linkage_error;
239 
240 NIT_ERROR:
241                if code ^= 0
242                then call com_err_ (code, "install", "^a installing ^a.",
243                          answer, pathname_ (dir, ename));
244                else call ioa_ ("install: Installed ^a as DSA system nit.",
245                          pathname_ (dir, ename));
246                go to RETURN;
247           end;
248 
249           idir = pathname_ (sysdir, "update");
250           copyname = unique_chars_ (""b);                   /* make up a name */
251 
252           call hcs_$make_seg (idir, copyname || temp_suffix, "", 01010b, copyp, code);
253           if copyp = null then do;                          /* make null segment */
254                call com_err_ (code, "install", "can't create ^a>^a", idir, copyname);
255                go to RETURN;
256           end;
257           copyp -> segmnt = segp -> segmnt;                 /* copy seg into update dir */
258           copyp -> t.author.w_dir = get_wdir_ ();           /* set working dir into head of table */
259           copyp -> t.author.proc_group_id = get_group_id_ (); /* Get name of this user (with tag) */
260           copyp -> t.update_authorization = update_authorization_sw; /* now the controls */
261           copyp -> t.update_attributes = update_attributes_sw; /* ... */
262 
263           /* first set bit count before renaming segment */
264           call terminate_file_ (copyp, bitcount, TERM_FILE_TRUNC_BC, (0));
265 
266           call hcs_$chname_seg (copyp, copyname || temp_suffix, copyname, code);
267           if code ^= 0 then
268                call com_err_ (code, "install", "Could not rename table in installation directory");
269 
270           /* now terminate file prior to sending wakeup -- we're done making changes to it */
271           call terminate_file_ (copyp, bitcount, TERM_FILE_TERM, (0));
272 
273           call hcs_$wakeup ((whotab.installation_request_pid), whotab.installation_request_channel, 0, code);
274 
275 RETURN:
276           call clean_up;
277           return;                                           /* done */
278 
279 clean_up:
280      procedure;
281           if copyp ^= null
282           then call hcs_$delentry_seg (copyp, (0));
283           copyp = null;
284           if segp ^= null
285           then call terminate_file_ (segp, (0), TERM_FILE_TERM, (0));
286           segp = null;
287      end clean_up;
288 
289      end install;