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 /* Rewritten 6/78 by J. A. Bush to conform to Multics programming standards
 13    Modified 79/02/08 by J. A. Bush to call the Multics T & D Slave Interface
 14    Module (mtdsim_) for Molts and Polts
 15    Modified 80/02/06 by J. A. Bush to handle the sus_ condition
 16    Modified 80/12/08 by R. E. Fakoury to handle a colts request.
 17    Modified 03/83 by Rick Fakoury to change the msg1 to msg and to call tolts_util_$opr_msg. Also added a
 18    check for user access to system data_bases and gates.
 19    Modified 10/83 to use access_mode_values.incl as recommended by the auditor.
 20    Modified 01/84 by R Fakoury to support new tolts debugger call.
 21    Modified 01/85 by R Fakoury to change the check for tandd.acs.
 22 */
 23 
 24 
 25 
 26 
 27 
 28 
 29 /****^  HISTORY COMMENTS:
 30   1) change(85-10-21,Fakoury), approve(86-08-21,MCR7514),
 31      audit(86-12-01,Martinson), install(86-12-09,MR12.0-1235):
 32      to check for user access to mca gate & system mca data segs.
 33                                                    END HISTORY COMMENTS */
 34 
 35 
 36 
 37 
 38 
 39 /* tolts_ - this is the TOLTS executive that controls execution of POLTS, MOLTS, COLTS, and ISOLTS */
 40 
 41 
 42 /* format: style4,ifthenstmt,ifthen,ind3,ll125,lineconind1 */
 43 tolts_: proc;
 44 
 45 /* AUTOMATIC */
 46 
 47 dcl  c_args (32) char (28) varying;
 48 dcl  c_len fixed bin;
 49 dcl  cardp ptr init (null);
 50 dcl  code fixed bin (35);
 51 dcl  com_string char (132) aligned;
 52 dcl  cmd_cnt fixed bin;
 53 dcl  entry_var entry variable;
 54 dcl  tandd_ok bit (1);
 55 dcl  term bit (1);
 56 dcl  ttl_date char (6);
 57 dcl  user_access fixed bin (5);
 58 
 59 
 60 /*  BUILTINS */
 61 
 62 dcl  null builtin;
 63 
 64 /*  CONDITIONS */
 65 
 66 dcl  linkage_error condition;
 67 
 68 
 69 /*  CONSTANTS */
 70 
 71 dcl  current_ring fixed bin int static options (constant) init (-1);
 72 dcl  no_error_expected fixed bin (35) int static options (constant) init (0);
 73 dcl  pname char (6) static options (constant) init ("tolts_");
 74 dcl  ring_1 fixed bin int static options (constant) init (1);
 75 dcl  sl_dir char (4) int static options (constant) init (">sl1");
 76 dcl  sc_admin_dir char (14) int static options (constant) init (">sc1>admin_acs");
 77 dcl  sc_dir char (4) int static options (constant) init (">sc1");
 78 
 79 
 80 /* ENTRIES */
 81 
 82 dcl  com_err_ entry () options (variable);
 83 dcl  hcs_$get_user_effmode entry (char (*), char (*), char (*), fixed bin, fixed bin (5), fixed bin (35));
 84 dcl  ioa_ entry options (variable);
 85 dcl  isolts_ entry;
 86 dcl  mca_$attach_mca entry;
 87 dcl  mtdsim_ entry options (variable);
 88 dcl  no_save_on_disconnect entry;
 89 dcl  save_on_disconnect entry;
 90 dcl  tandd_$ring_0_message entry;
 91 dcl  tolts_util_$get_ttl_date entry (entry, char (6));
 92 dcl  tolts_util_$on_off entry (char (6), char (3), char (6));
 93 dcl  tolts_util_$opr_msg entry;
 94 dcl  tolts_util_$query entry (char (*), char (132) aligned, fixed bin, (32) char (28) varying, fixed bin);
 95 
 96 
 97 /* EXTERNAL */
 98 
 99 dcl  error_table_$moderr fixed bin (35) ext static;
100 dcl  error_table_$noentry fixed bin (35) ext static;
101 
102 
103 %page;
104 
105 
106       call no_save_on_disconnect;                           /* do not want process saved on terminal disconnect */
107       call tolts_util_$get_ttl_date (tolts_, ttl_date);
108       call tolts_util_$on_off ("tolts", "on", ttl_date);    /* signon */
109 
110 
111 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
112 /*                                                                                                            */
113 /* Verify user access to system data and system gates.                                                        */
114 /*                                                                                                            */
115 /*  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *  *   */
116 
117 
118       call check_access (sc_dir, "opr_query_data",
119        RW_ACCESS_BIN, no_error_expected, current_ring);
120 
121       call check_access (sc_admin_dir, "tandd.acs",
122        RW_ACCESS_BIN, no_error_expected, current_ring);
123 
124       call check_access (sc_dir, "cdt",
125        R_ACCESS_BIN, no_error_expected, current_ring);
126 
127       call check_access (sl_dir, "mca_data_seg",
128        RW_ACCESS_BIN, error_table_$noentry, ring_1);
129 
130 
131       on linkage_error begin;
132          call com_err_ (error_table_$moderr, pname, "^[mca_^;tandd_^]", tandd_ok);
133          goto t_off;                                        /* exit */
134       end;
135 
136       tandd_ok = "0"b;
137       entry_var = tandd_$ring_0_message;
138       tandd_ok = "1"b;
139       entry_var = mca_$attach_mca;
140       revert linkage_error;
141 
142 
143 %page;
144 
145 
146 /* Now loop until user quits */
147 
148       term = "0"b;                                          /* reset terminate condition */
149       do while (^term);
150          call ioa_ (" ^/***enter ""polts"", ""molts"", ""colts"", ""isolts"", ""quit"", or ""msg""");
151          call tolts_util_$query ("??? ", com_string, c_len, c_args, cmd_cnt);
152 
153 /* Now see what user wants to do */
154 
155          if c_args (1) = "quit"
156           | c_args (1) = "q" then                           /* user wants to quit */
157             term = "1"b;
158          else if c_args (1) = "polts" then                  /* user wants to run polts */
159             call mtdsim_ ("polt");
160          else if c_args (1) = "molts" then                  /* user wants to run molts */
161             call mtdsim_ ("molt");
162          else if c_args (1) = "colts" then                  /* user wants to run colts */
163             call mtdsim_ ("colt");
164          else if c_args (1) = "isolts" then                 /* user wants to run isolts */
165             call isolts_;
166          else if c_args (1) = "msg" then                    /* user wants to send message to operator */
167             call tolts_util_$opr_msg;
168          else call ioa_ ("^/invalid response - ^a", com_string);
169       end;
170 
171 /* User is all done, output Tolts wrap up message */
172 
173 t_off: call tolts_util_$on_off ("tolts", "off", ttl_date);  /* signoff */
174       call save_on_disconnect;                              /* restore users save on disconnect state */
175 
176       return;
177 
178 %page;
179 
180 /* check_access - int proc that will check the user's access to system gates & data bases */
181 
182 check_access: proc (dir, entry, lowest_access, error_expected, ring);
183 
184 dcl  error_expected fixed bin (35);
185 dcl  dir char (*);
186 dcl  entry char (*);
187 dcl  lowest_access fixed bin (5);
188 dcl  ring fixed bin;
189 
190       call hcs_$get_user_effmode (dir, entry, "", ring, user_access, code);
191       if code ^= 0 then do;
192          if code = error_expected then return;
193          call com_err_ (code, pname, "attemping to get user access to ^a>^a.",
194           dir, entry);
195          go to t_off;                                       /* exit */
196       end;
197 
198       if user_access >= lowest_access then return;
199 
200       call com_err_ (error_table_$moderr, pname, "^a>^a", dir, entry);
201       goto t_off;                                           /* exit */
202 
203    end check_access;
204 
205 %page;
206 
207 %include access_mode_values;
208 
209 
210    end tolts_;                                              /* thats it */