1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1985 *
  6         *                                                         *
  7         *********************************************************** */
  8 
  9 /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */
 10 rcp_audit:
 11      procedure (a_caller, a_operation, a_req_info_ptr, a_res_info_ptr, a_owner, a_effmode, a_raw_mode, a_rbs, a_rm_on,
 12           a_error_code);
 13 
 14 /*            This internal subroutine determines if auditing is
 15    *          required for an RCP event.
 16    *            Created 841112 by Maria M. Pozzo
 17    *
 18 */
 19 
 20 
 21 /****^  HISTORY COMMENTS:
 22   1) change(87-07-14,Rauschelbach), approve(87-08-07,MCR7748),
 23      audit(87-11-11,Farley), install(87-11-30,MR12.2-1004):
 24      Removed signal to vfile_error condition as it was erroneously left from
 25      debugging.
 26                                                    END HISTORY COMMENTS */
 27 
 28 
 29 /*            ARGUMENTS                       */
 30 
 31 dcl       a_caller               char (*);                  /* (I) Identifies the program that made the call. */
 32 dcl       a_operation            bit (36) aligned;          /* (I) The RCP operation as defined in rcp_operations.incl.pl1 */
 33 dcl       a_req_info_ptr         ptr;                       /* (I) Pointer to requestor information. */
 34 dcl       a_res_info_ptr         ptr;                       /* (I) Pointer to object information. */
 35 dcl       a_owner                char (*);                  /* (I) Resource Owner. */
 36 dcl       a_effmode              bit (3);                   /* (I) "0"b3 if access was denied */
 37 dcl       a_raw_mode             bit (3);                   /* (I) Raw mode used in auditing. */
 38 dcl       a_rbs                  (2) fixed bin (3);         /* (I) Ring brackets of the ACS segment if there was one. */
 39 dcl       a_rm_on                bit (1);                   /* (I) True = resource management enabled */
 40 dcl       a_error_code           fixed bin (35);            /* (I) Error code */
 41 
 42 /*            AUTOMATIC                       */
 43 
 44 dcl       audit                  bit (1);                   /* Is audit needed. */
 45 dcl       1 auto_rcp_obj_info    like rcp_obj_info;
 46 dcl       based_bits             bit (bl * 9) aligned based (bp);
 47 dcl       rm_on                  bit (1);
 48 dcl       effmode                bit (3);
 49 dcl       raw_mode               bit (3);
 50 dcl       rbs                    (2) fixed bin (3);
 51 dcl       object_access_class    (2) bit (72) aligned;
 52 dcl       event_flags            bit (36) aligned;
 53 dcl       operation              bit (36) aligned;          /* Local operation */
 54 dcl       base_op                bit (36) aligned;          /* oper_code for audit. */
 55 
 56 dcl       caller                 char (32);                 /* Local caller */
 57 dcl       msg_str                char (256);                /* Format string for audit message. */
 58 dcl       object_name            char (177);                /* Object name is "Registry " plus the pathname of the registry, at it's largest. */
 59 dcl       owner                  char (32);                 /* Current resource owner. */
 60 dcl       registry_dir           char (168);                /* directory registry is contained in */
 61 dcl       registry_name          char (32);                 /* name of registry (for registry operations) */
 62 dcl       bl                     fixed bin (21);
 63 dcl       error_code             fixed bin (35);
 64 dcl       local_code             fixed bin (35);
 65 
 66 dcl       bp                     ptr;
 67 dcl       operation_ptr          ptr;
 68 
 69 dcl       1 en_access_op         like encoded_access_op aligned based (operation_ptr);
 70 
 71 dcl       addr                   builtin;
 72 dcl       bin                    builtin;
 73 dcl       null                   builtin;
 74 dcl       rtrim                  builtin;
 75 dcl       size                   builtin;
 76 dcl       unspec                 builtin;
 77 
 78 /*            EXTERNAL                       */
 79 
 80 dcl       access_audit_r1_$check_obj_class_range
 81                                  entry (bit (36) aligned, bit (36) aligned, (2) bit (72) aligned) returns (bit (1));
 82 dcl       access_audit_r1_$log_obj_class_range
 83                                  entry options (variable);
 84 dcl       hcs_$get_access_class  entry (char (*), char (*), bit (72) aligned, fixed bin (35));
 85 dcl       ioa_$rsnnl             entry () options (variable);
 86 dcl       pathname_              entry (char (*), char (*)) returns (char (168));
 87 dcl       rcp_setup_event        entry (bit (36) aligned, bit (3), bit (36) aligned, fixed bin (35));
 88 dcl       resource_info_$get_type
 89                                  entry (char (*), bit (1), fixed bin (35));
 90 dcl       suffixed_name_$make    entry (char (*), char (*), char (32), fixed bin (35));
 91 
 92 dcl       access_operations_$rcp_set
 93                                  bit (36) aligned ext static;
 94 dcl       access_operations_$rcp_set_access
 95                                  bit (36) aligned ext static;
 96 dcl       access_operations_$rcp_delete_registry
 97                                  bit (36) aligned external;
 98 dcl       access_operations_$rcp_copy_registry
 99                                  bit (36) aligned external;
100 dcl       access_operations_$rcp_update_registry_header
101                                  bit (36) aligned external;
102 dcl       access_operations_$rcp_reconstruct_registry
103                                  bit (36) aligned external;
104 
105 /*        CONSTANTS           */
106 
107 dcl       COMPONENT_0_NAME       char (1) static options (constant) init ("0");
108 dcl       REGISTRY_SUFFIX        char (4) static options (constant) init ("rcpr");
109 dcl       REGISTRY_OLD_SUFFIX    char (3) static options (constant) init ("old");
110 ^L
111 /*  Copy argument data */
112 
113           caller = a_caller;
114           operation = a_operation;
115           base_op = operation;
116           addr (base_op) -> en_access_op.detailed_operation = 0;
117           ops_ptr = addr (addr (operation) -> en_access_op.detailed_operation);
118           requestor_info_ptr = a_req_info_ptr;
119           resource_info_ptr = a_res_info_ptr;
120           owner = a_owner;
121           effmode = a_effmode;
122           raw_mode = a_raw_mode;
123           rbs = a_rbs;
124           rm_on = a_rm_on;
125           error_code = a_error_code;
126 
127 /*  Initialize local variables. */
128 
129           audit = "0"b;
130           event_flags = "0"b;
131           object_name = "";
132           local_code = 0;
133           bp = null ();
134           bl = 0;
135 
136 /*  If resource management is not enabled then don't audit.  If this is */
137 /*  a search operation then we don't audit either. */
138 /*  If it's a reconstruct operation we are in the Initializer process and */
139 /*  rm is not turned on, since reconstructs are done in "stan". */
140 
141           if (^rm_on & (base_op ^= access_operations_$rcp_reconstruct_registry)) | detailed_operation.search then
142                goto MAIN_RETURN;
143 
144 /*  Set up the RCP event.  We already have the oper_code in base_op. */
145 
146           call rcp_setup_event (operation, effmode, event_flags, local_code);
147           if local_code ^= 0 then
148                goto MAIN_RETURN;
149 
150 /*  Get the access class range of the object. */
151 
152           registry_dir = resource_info.registry_dir;
153           if registry_operation (base_op) then do;          /* the registry itself is the object */
154                if base_op = access_operations_$rcp_delete_registry then
155                     call suffixed_name_$make (resource_info.resource_type, REGISTRY_OLD_SUFFIX, registry_name, local_code)
156                          ;
157                else call suffixed_name_$make (resource_info.resource_type, REGISTRY_SUFFIX, registry_name, local_code);
158                if local_code ^= 0 then
159                     goto MAIN_RETURN;
160 /**** Low end of access class range is access class of the directory (registry), high end is that of component 0. ****/
161                call hcs_$get_access_class (registry_dir, registry_name, object_access_class (1), local_code);
162                if local_code ^= 0 then
163                     goto MAIN_RETURN;
164                call hcs_$get_access_class (pathname_ (registry_dir, registry_name), COMPONENT_0_NAME,
165                     object_access_class (2), local_code);
166                if local_code ^= 0 then
167                     goto MAIN_RETURN;
168           end;
169           else do;                                          /* we can use the registry to find out the access class range */
170                record_ptr = resource_info.registry_record_ptr;
171                if registry_record.free then
172                     call chase (registry_record.potential_aim_range_desc, bp, bl, local_code);
173                else call chase (registry_record.aim_range_desc, bp, bl, local_code);
174                if local_code ^= 0 then
175                     goto MAIN_RETURN;
176                if bl > 0 then addr (object_access_class) -> based_bits = based_bits;
177                else unspec (object_access_class) = ""b;     /* no range, set to lowest possible */
178           end;
179 
180 /*  Determine if access is needed. */
181 
182           audit = access_audit_r1_$check_obj_class_range (event_flags, base_op, object_access_class);
183 
184 /*  If auditing is required then do it. */
185 
186           if audit then do;
187                call get_obj_name ();
188                audit_rcp_obj_ptr = addr (auto_rcp_obj_info);
189                call fill_audit_record (local_code);
190                if local_code ^= 0 then
191                     goto MAIN_RETURN;
192                call get_msg_str ();
193                call access_audit_r1_$log_obj_class_range (caller, (requestor_info.validation_level), event_flags, base_op,
194                     object_access_class, rtrim (object_name), error_code, addr (rcp_obj_info), (size (rcp_obj_info)),
195                     msg_str);
196           end;
197 
198 MAIN_RETURN:
199           return;
200 %page;
201 chase:
202      proc (descriptor, bp, bl, a_error_code);
203 
204 dcl       (
205           descriptor             fixed bin (35),
206           a_error_code           fixed bin (35),
207           bp                     pointer,
208           bl                     fixed bin (21)
209           )                      parameter;
210 
211 dcl       1 rs                   like rs_info aligned automatic;
212 dcl       local_code             fixed bin (35);
213 dcl       error_table_$action_not_performed
214                                  ext static fixed bin (35);
215 
216           a_error_code = 0;
217           if descriptor = 0 then do;
218                bp = addr (bp);                              /* gotta point somewhere */
219                bl = 0;
220                return;
221           end;
222 
223           unspec (rs) = ""b;
224           rs.version = rs_info_version_2;
225           rs.locate_sw = "1"b;
226           rs.descriptor = descriptor;
227           local_code = 0;
228 
229           call iox_$control (resource_info.registry_switch_ptr, "record_status", addr (rs), local_code);
230           if local_code ^= 0 then do;
231                a_error_code = error_table_$action_not_performed;
232                return;
233           end;
234           bl = rs.record_length;
235           bp = rs.record_ptr;
236 
237           return;
238 %include rs_info;
239 %include iox_dcls;
240      end chase;
241 ^L
242 get_obj_name:
243      proc ();
244 
245           if registry_operation (base_op) then
246                object_name = "Registry " || pathname_ (registry_dir, resource_info.resource_type);
247 
248           else object_name = (rtrim (resource_info.resource_type)) || " " || resource_info.resource_name;
249 
250           return;
251 
252      end get_obj_name;
253 
254 registry_operation:
255      proc (op) returns (bit (1) aligned);
256 
257 dcl       op                     bit (36) aligned;
258 
259           return (op = access_operations_$rcp_copy_registry | op = access_operations_$rcp_delete_registry
260                | op = access_operations_$rcp_reconstruct_registry | op = access_operations_$rcp_update_registry_header);
261 
262      end registry_operation;
263 ^L
264 fill_audit_record:
265      proc (a_code);
266 
267 dcl       a_code                 fixed bin (35);
268 
269 dcl       is_vol                 bit (1);
270 dcl       fill_code              fixed bin (35);
271 
272           fill_code = 0;
273           is_vol = "0"b;
274           unspec (rcp_obj_info) = ""b;
275           rcp_obj_info.info_type = AAB_rcp_object;
276           rcp_obj_info.version = AUDIT_RCP_OBJ_INFO_VERSION_1;
277           rcp_obj_info.pad = "0"b;
278           rcp_obj_info.resource_type = resource_info.resource_type;
279           rcp_obj_info.resource_name = resource_info.resource_name;
280           rcp_obj_info.owner_id = owner;
281           rcp_obj_info.access_class = object_access_class;
282           rcp_obj_info.raw_mode = raw_mode;
283           rcp_obj_info.rcp_ring_brackets = rbs;
284           if registry_operation (base_op) then
285                rcp_obj_info.registry = "1"b;
286           else do;
287                call resource_info_$get_type (resource_info.resource_type, is_vol, fill_code);
288                if fill_code ^= 0 then
289                     goto FILL_RETURN;
290                rcp_obj_info.device = ^is_vol;
291                rcp_obj_info.volume = is_vol;
292                rcp_obj_info.usage_locked = registry_record.usage_lock;
293                rcp_obj_info.release_locked = registry_record.release_lock;
294                rcp_obj_info.awaiting_clear = registry_record.awaiting_clear;
295                rcp_obj_info.has_acs_path = (registry_record.acs_path_desc ^= 0);
296                rcp_obj_info.flags.pad = "0"b;
297                rcp_obj_info.attributes = registry_record.attributes;
298           end;
299 
300 FILL_RETURN:
301           a_code = fill_code;
302           return;
303      end fill_audit_record;
304 ^L
305 get_msg_str:
306      proc ();
307 
308           call ioa_$rsnnl (
309                "^[raw_mode=^a ^;^s^]^[rcp_ring_brackets=^d,^d ^;^2s^]^[^[potential_attributes ^]^[desired_attributes ^]^[potential_aim_range ^]^[aim_range ^]^[owner ^]^[acs_path ^]^[location ^]^[comment ^]^[charge_type ^]^[usage_lock ^]^[release_lock ^]^[user_alloc^]^]",
310                msg_str, (0), (raw_mode ^= ""b), SEG_ACCESS_MODE_NAMES (bin (rcp_obj_info.raw_mode)), (rbs (1) ^= -1),
311                rcp_obj_info.rcp_ring_brackets,
312                (base_op = access_operations_$rcp_set | base_op = access_operations_$rcp_set_access),
313                detailed_operation.given.potential_attributes, detailed_operation.given.desired_attributes,
314                detailed_operation.given.potential_aim_range, detailed_operation.given.aim_range,
315                detailed_operation.given.owner, detailed_operation.given.acs_path, detailed_operation.given.location,
316                detailed_operation.given.comment, detailed_operation.given.charge_type,
317                detailed_operation.given.usage_lock, detailed_operation.given.release_lock,
318                detailed_operation.given.user_alloc);
319 
320      end get_msg_str;
321 ^L
322 %include access_audit_binary_def;
323 %page;
324 %include access_audit_encoded_op;
325 %page;
326 %include access_audit_rcp_info;
327 %page;
328 %include access_mode_values;
329 %page;
330 %include rcp_ops;
331 %page;
332 %include rcp_requestor_info;
333 %page;
334 %include rcp_resource_info;
335 %page;
336 %include rcp_registry;
337      end rcp_audit;