attach_audit.pl1 11/04/82 1918.6rew 11/04/82 1605.2 55413 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style2,ind3 */ attach_audit: ata: proc; /* This module turns on auditing for the calling process. IF no arguments are given, it generates default switchnames, and audit_ is set up with no arguments. Written 1/1/79 by Lindsey L. Spratt Modified: 11/26/79 by Lindsey L. Spratt to implement the -modes control argument. 06/05/81 by Lindsey Spratt: Changed error message for non-zero code when trying to attach audit_ to the old switch to give the attach description being attempted. Changed the error code from bad_arg to badopt when more than one mode string is specified. 09/09/81 by Lindsey Spratt: Added a check of arguments being placed in the attach description "ad". This allows more elegant error reporting than the "argerr" produced by audit_. This fixes bug 9. 11/12/81 by Lindsey Spratt: Made all error messages start with a newline. Changed the argument index variable from "i" to "arg_idx". */ /* Automatic */ dcl nargs fixed bin; dcl arg_idx fixed bin; dcl tp ptr; dcl tc fixed bin; dcl (code, code1) fixed bin (35); dcl ad char (128) varying; dcl mode_string char (256) varying init (""); dcl old_modes char (256) init (""); dcl (old_switch, new_switch) char (32); dcl (old_iocb, new_iocb) ptr; dcl (have_old_iocb, have_new_iocb) bit (1); dcl time char (16); /* Based */ dcl targ char (tc) based (tp); /* Builtins */ dcl clock builtin; dcl codeptr builtin; dcl rtrim builtin; dcl substr builtin; /* Constant */ dcl MYNAME char (12) init ("attach_audit") internal static options (constant); /* Entries */ dcl date_time_ entry (fixed bin (71), char (*)); dcl cu_$arg_count entry (fixed bin); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl com_err_ entry options (variable); /* External */ dcl error_table_$badopt fixed bin (35) ext; have_old_iocb = "0"b; have_new_iocb = "0"b; ad = " "; call cu_$arg_count (nargs); do arg_idx = 1 to nargs; call cu_$arg_ptr (arg_idx, tp, tc, code); if code ^= 0 then do; call com_err_ (code, MYNAME, "^/Unable to get argument ^d.", arg_idx); return; end; if index (targ, "-") = 1 then if targ = "-modes" then if mode_string = "" then do; arg_idx = arg_idx + 1; call cu_$arg_ptr (arg_idx, tp, tc, code); if code ^= 0 then do; call com_err_ (code, MYNAME, "^/No mode string followed the -modes control argument."); return; end; mode_string = targ; end; else do; call com_err_ (error_table_$badopt, MYNAME, "^/Only one mode string may be given."); return; end; else if targ = "-pn" | targ = "-pathname" | targ = "-tc" | targ = "-truncate" then ad = ad || targ || " "; else do; call com_err_ (error_table_$badopt, MYNAME, "^/^a is not a known control argument.", targ); return; end; else if arg_idx = 1 then do; old_switch = targ; call iox_$look_iocb (old_switch, old_iocb, code); if code ^= 0 then do; call com_err_ (code, MYNAME, "^/Unable to find the switch named ^a.", old_switch); return; end; have_old_iocb = "1"b; end; else if arg_idx ^= 2 then ad = ad || targ || " "; else if have_old_iocb then do; new_switch = targ; call iox_$find_iocb (new_switch, new_iocb, code); if code ^= 0 then do; call com_err_ (code, MYNAME, "^/Unable to find or create the new switch named ^a.", new_switch); return; end; have_new_iocb = "1"b; end; else ad = ad || targ || " "; end; if ^have_new_iocb then do; call date_time_ (clock, time); new_switch = "audit_i/o." || substr (time, 11, 6); call iox_$find_iocb (new_switch, new_iocb, code); if code ^= 0 then do; call com_err_ (code, MYNAME, "^/Unable to find or create the new switch with default switchname ^a.", new_switch); return; end; end; if ^have_old_iocb then do; old_switch = "user_i/o"; call iox_$look_iocb (old_switch, old_iocb, code); if code ^= 0 then do; call com_err_ (code, MYNAME, "^/Unable to find the switch to be audited ^a.", old_switch); return; end; end; ad = "audit_ " || rtrim (new_switch) || " " || ad; call iox_$move_attach (old_iocb, new_iocb, code); if code ^= 0 then do; call com_err_ (code, MYNAME, "^/Unable to move attachment from ^a to ^a", old_switch, new_switch); return; end; call iox_$attach_ptr (old_iocb, (ad), codeptr (attach_audit), code); if code ^= 0 then do; call iox_$detach_iocb (old_iocb, code1); call iox_$move_attach (new_iocb, old_iocb, code1); call com_err_ (code, MYNAME, "^/Unable to attach audit_ to switch ^a, using the attach description ""^a"".", old_switch, ad); return; end; call iox_$modes (old_iocb, (mode_string), old_modes, code); return; /* Include */ %include iox_dcls; end;  audit_.pl1 05/10/89 0953.5rew 05/10/89 0948.4 522621 /****^ *********************************************************** * * * Copyright, (C) BULL HN Information Systems Inc., 1989 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(89-04-06,Vu), approve(89-04-06,MCR8095), audit(89-04-25,Lee), install(89-05-10,MR12.3-1040): - output modes are returned even if the input modes string contains only audit modes (ie. audit_input). - The following builtin functions: after, before, empty, max, rtrim are now declared explicitly. END HISTORY COMMENTS */ /* format: style2,ind3 */ audit_: audit_attach: proc (p_iocb_ptr, p_option_array, p_com_err_sw, p_code); /* This program is the main driver for the "audit" module. It has entries for attachment (which also opens), for reading, writing, and detachment (which also precedes it with a close). The following I/O system calls are provided for this module: attach (open) audit_$audit_attach close audit_$audit_close detach audit_$audit_detach get_chars audit_$audit_get_chars get_line audit_$audit_get_line put_chars audit_$audit_put_chars control audit_$audit_control modes audit_$audit_modes Last Modified: 12/01/78 Written by Lindsey L. Spratt (from existing code by J. Stern, S. Webber, and R. Bratt) 11/26/79 by Lindsey L. Spratt to support prompting in the editor. 05/20/80 by Lindsey L. Spratt to fix -tc option and assume "audit" suffix. 12/22/80 by Lindsey L. Spratt: Change all mode string references from 256 char string to 512. 03/20/81 by Lindsey L. Spratt: remove "audit_editor_prompt_terminator=" mode. Set default editor_prompt_string to "audit editor^[(^d)^]:^2x". 08/05/81 by Lindsey Spratt: Changed modes entry to use the mode_string_$parse and mode_string_$delete entries to manipulate the mode strings. Changed all calls to iox entries to be calls instead of function references. Changed from using the iocbx.incl.pl1 file to iocb.incl.pl1. Changed entry sequences to be calls instead of functions, i.e. the returns (fixed bin(35)) was replaced by including "p_code" in the entry parameters. 10/29/81 by Lindsey Spratt: Fixed conversion of ll= and pl= to only be invoked if the respective strings are actually present to be converted. Also, added rtrimming of the unrecognized_modes string in the calls of the before and after builtins. Added initialization of the blk pointers audit_file_header_ptr, temp_seg_ptr, work_area, audit_fcb, begin_ptr, and audit_ptr. Added checks for null pointers and non-zero error codes to the detach entry. 11/12/81 by Lindsey Spratt: Changed to call hcs_$assign_linkage as a subroutine instead of a function. 06/01/82 by Lindsey Spratt: Was not honoring the maximum length of the audit file when "adjusting" during the audit_detach operation, the current_component and (audit_index - 1) were being used instead of the max_component and max_index (set by the audit_file_size mode). The audit_detach entry now checks the audit_file_header.filled flag to determine if it should use the max component and index (file_limit = "1"b) or the current_component and audit_index (file_limit = "0"b). 06/03/82 by Lindsey Spratt: Changed the setting of the bit count in audit_detach to be the value of audit_index*9, instead of audit_index*9-9. 06/08/82 by Lindsey Spratt: Removed the code which always set audit_file_header.max_index to sys_info$max_seg_size*4 whenever attaching to an audit file. The max_index and max_componenet values of the audit_file_header are now only set when initializing an empty audit file and when setting the audit_file_size mode. This makes max_index a reliable indicator of whether the "current" audit file is supposed to be circular or not. The setting of the file_limit flag in blk.current_flags in audit_attach relies on this fact. 06/09/82 by Lindsey Spratt: Added an any_other handler to audit_detach. Changed detach logic to not use the bit-count-setting feature of msf_manager_$adjust when adjusting the audit file, instead an explicit set_bc_seg is done (when appropriate) to the final component of the audit file. All preceding components will have had their bit counts correctly set by the "next_component" operation of insert_line. 10/13/82 by Lindsey Spratt: Moved setting of safety_sw off into the audit_close entry. This makes it possible for the standard process epilogue handler to cause audit files to have their safety switches turned off. Previously, this was done in the audit_detach entry, which does not get invoked during process termination. 02/10/83 by Lindsey Spratt: Fixed audit_line to set audit_file_header.max_component to be the highest used component number in the non-file_limit (non-circular file) case. display_audit_file/audit_file_position_ relies on the max_component to know where the audit file ends (in some circumstances). Fixed insert_line to set audit_file_header.max_index to equal audit_file_header.audit_index when working with a non-file_limit audit file. 03/02/83 by Lindsey Spratt: More fixes to make all portions of code respect the protocol that for "unlimited" (or non-circular) files afh.max_index always equals afh.audit_index and afh.max_component always equals afh.current_component. For circular files, afh.max_index is > afh.audit_index when afh.max_component = afh.current_component, and afh.max_component is always >= afh.current_component. Also, fixed audit_suspend mode to have no effect when audit is already suspended. */ /* Parameters */ dcl (p_newmodes, p_oldmodes) char (*); dcl p_real_order char (*); dcl p_code fixed bin (35); dcl (p_iocb_ptr, buff_ptr, p_info_ptr) ptr; dcl (actual_len, buff_len) fixed bin (21); dcl p_option_array (*) char (*) var; dcl p_com_err_sw bit (1) aligned; dcl ptype fixed bin; dcl n fixed bin (21); dcl p_buff_ptr ptr; dcl (p_buff_len, p_actual_len) fixed bin (21); /* Entries */ dcl cpu_time_and_paging_ entry (fixed bin, fixed bin (71), fixed bin); dcl get_temp_segment_ entry (char (*), ptr, fixed bin (35)); dcl release_temp_segment_ entry (char (*), ptr, fixed bin (35)); dcl decode_clock_value_ entry (fixed bin (71), fixed bin, fixed bin, fixed bin, fixed bin (71), fixed bin, char (3) aligned); dcl audit_editor entry (ptr, fixed bin (21), fixed bin (21), ptr, fixed bin (35)); dcl audit_editor$set_last_return_line_position entry (ptr); dcl audit_file_position_$last entry (ptr, ptr, fixed bin (35)); dcl com_err_ entry options (variable); dcl sub_err_ entry options (variable); dcl expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35)); dcl ioa_$ioa_switch entry options (variable); dcl ioa_$ioa_switch_nnl entry options (variable); dcl date_time_ entry (fixed bin (71), char (*)); dcl user_info_$homedir entry (char (*)); dcl hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35)); dcl hcs_$set_safety_sw_seg entry (ptr, bit (1), fixed bin (35)); dcl hcs_$status_mins entry (ptr, fixed bin (2), fixed bin (24), fixed bin (35)); dcl hcs_$set_ips_mask entry (fixed bin, fixed bin); dcl hcs_$assign_linkage entry (fixed bin, ptr, fixed bin (35)); dcl abbrev_$expanded_line entry (ptr, fixed bin, ptr, fixed bin, ptr, fixed bin); dcl msf_manager_$open entry (char (*), char (*), ptr, fixed bin (35)); dcl msf_manager_$get_ptr entry (ptr, fixed bin, bit (1), ptr, fixed bin (24), fixed bin (35)); dcl msf_manager_$adjust entry (ptr, fixed bin, fixed bin (24), bit (3), fixed bin (35)); dcl msf_manager_$close entry (ptr); dcl mode_string_$parse entry (char (*), ptr, ptr, fixed bin (35)); dcl mode_string_$delete entry (ptr, (*) char (*), char (*), fixed bin (35)); dcl mode_string_$combine entry (ptr, ptr, char (*), fixed bin (35)); /* Constants */ dcl any_other condition; /* Static Variables */ dcl SUFFIX char (32) varying init ("audit") internal static options (constant); dcl sio_open_desc char (20) varying init ("stream_input_output") static options (constant); dcl myname char (6) static options (constant) init ("audit_"); dcl NL char (1) aligned static options (constant) init (" "); dcl AUDIT_MODE_NAMES (12) char (32) init ("audit_suspend", "audit_input", "audit_output", "audit_edit", "audit_trace", "audit_use_editor_prompt", "audit_editor_prompt_string", "audit_epstr", "audit_file_size", "audit_meter", "audit_transparent", "audit_trigger") internal static options (constant); /* Based */ dcl mode_str char (512) varying based; dcl aut_input_string char (actual_len) based (buff_ptr); dcl param_output_string char (p_buff_len) based (p_buff_ptr); dcl param_input_string char (p_actual_len) based (p_buff_ptr); /* Automatic Variables */ dcl out_ptr ptr; dcl type fixed bin (2); dcl bit_count24 fixed bin (24); dcl mode_idx fixed bin (17); dcl records fixed bin; dcl newmodes char (64) varying; dcl unrecognized_modes char (512); dcl order char (32); dcl (audited_iocb, blkptr, auditing_iocb) ptr; dcl device char (32); dcl i fixed bin; dcl (tc, mask) fixed bin; dcl ename char (32); dcl time char (8); dcl dirname char (168); dcl tactual_len fixed bin (21); dcl extend bit (1); dcl request char (1); dcl set_last_return_line_position bit (1) init ("0"b); dcl ab_buf char (512); dcl ab_len fixed bin; dcl temp_area area (2048); /* External Variables */ dcl sys_info$max_seg_size fixed bin (24) ext; dcl error_table_$bad_mode_value fixed bin (35) ext; dcl error_table_$bad_mode_syntax fixed bin (35) ext; dcl error_table_$long_record fixed bin (35) ext; dcl error_table_$empty_file fixed bin (35) ext; dcl error_table_$noarg fixed bin (35) ext; dcl error_table_$unimplemented_version fixed bin (35) ext; dcl error_table_$not_detached fixed bin (35) ext; dcl error_table_$noentry fixed bin (35) ext; dcl error_table_$bad_arg fixed bin (35) ext; /* Builtins */ dcl string builtin; dcl currentsize builtin; dcl clock builtin; dcl mod builtin; dcl (substr, addr, null, divide, hbound, index, length, size) builtin; dcl (after, before, empty, max, rtrim) builtin; /* */ /* attach --- subroutine to attach and open the audit module */ /* Look at option array and collect data */ ename = ""; audited_iocb = p_iocb_ptr; extend = "1"b; if hbound (p_option_array, 1) < 1 then do; if p_com_err_sw then call com_err_ (error_table_$bad_arg, (myname), "No device name given."); p_code = error_table_$bad_arg; return; end; device = p_option_array (1); /* device name must be first option */ call iox_$find_iocb (device, auditing_iocb, p_code); if p_code ^= 0 then do; if p_com_err_sw then call com_err_ (p_code, (myname), "^a", device); return; end; do i = 2 to hbound (p_option_array, 1); /* now search the options */ if p_option_array (i) = "-tc" | p_option_array (i) = "-truncate" then extend = "0"b; else if p_option_array (i) = "-pn" | p_option_array (i) = "-pathname" then do; i = i + 1; if i > hbound (p_option_array, 1) then do; if p_com_err_sw then call com_err_ (error_table_$noarg, (myname), "^/A pathname must be given with the the -pathname control argument."); p_code = error_table_$noarg; return; end; call expand_pathname_$add_suffix ((p_option_array (i)), (SUFFIX), dirname, ename, p_code); if p_code ^= 0 then do; if p_com_err_sw then call com_err_ (p_code, (myname), "^a", p_option_array (i)); return; end; end; else do; if p_com_err_sw then call com_err_ (error_table_$bad_arg, (myname), "^/Unsupported option ^a.", p_option_array (i)); p_code = error_table_$bad_arg; return; end; end; if ename = "" then do; call date_time_ (clock, time); /* get time for default file name */ ename = time || ".audit"; call user_info_$homedir (dirname); /* get default dirname */ end; call hcs_$set_ips_mask (0, mask); /* enter critical code */ if audited_iocb -> iocb.attach_descrip_ptr ^= null () then do; call hcs_$set_ips_mask (mask, 0); if p_com_err_sw then call com_err_ (error_table_$not_detached, (myname)); p_code = error_table_$not_detached; return; end; call hcs_$assign_linkage (size (blk), blkptr, p_code); if blkptr = null () then do; /* can't get storage for data */ call hcs_$set_ips_mask (mask, 0); if p_com_err_sw then call com_err_ (p_code, (myname)); return; end; audited_iocb -> iocb.attach_descrip_ptr = addr (blk.attach); audited_iocb -> iocb.attach_data_ptr = blkptr; audited_iocb -> iocb.detach_iocb = audit_detach; audited_iocb -> iocb.open = iox_$err_no_operation; audited_iocb -> iocb.close = audit_close; /* Now fill in some stuff in the block */ tc = index (device, " "); if tc = 0 then tc = length (device); blk.attach = "audit_ " || substr (device, 1, tc); do i = 2 to hbound (p_option_array, 1); blk.attach = blk.attach || " "; blk.attach = blk.attach || p_option_array (i); end; blk.auditing_iocb = auditing_iocb; /* fill in target iocb pointer */ blk.default_iocb = audited_iocb; /* Now the code to open the stream as well */ blk.dirname = dirname; blk.ename = ename; blk.audit_file_header_ptr = null; blk.audit_fcb = null; blk.audit_ptr = null; blk.begin_ptr = null; blk.temp_seg_ptr = null; blk.work_space = null; audited_iocb -> iocb.get_line = audit_get_line; audited_iocb -> iocb.control = audit_control; audited_iocb -> iocb.put_chars = audit_put_chars; audited_iocb -> iocb.get_chars = audit_get_chars; audited_iocb -> iocb.open_descrip_ptr = addr (sio_open_desc); audited_iocb -> iocb.open_data_ptr = blkptr; audited_iocb -> iocb.modes = audit_modes; audited_iocb -> iocb.position = audit_position; call msf_manager_$open (blk.dirname, blk.ename, blk.audit_fcb, p_code); if p_code ^= 0 then if p_code = error_table_$noentry then do; call msf_manager_$get_ptr (blk.audit_fcb, 0, "1"b, blk.audit_ptr, bit_count24, p_code); if p_code ^= 0 then do; call hcs_$set_ips_mask (mask, 0); if p_com_err_sw then call com_err_ (p_code, (myname), "While attempting to get a pointer to component 0 of the audit file."); return; end; INIT_AUDIT_FILE: audit_file_header_ptr = blk.audit_ptr; blk.audit_file_header_ptr = blk.audit_ptr; audit_file_header.last_entry_length = impossible_audit_entry_length; audit_file_header.filled = "0"b; audit_file_header.current_component = 0; audit_file_header.unused1 = "0"b; audit_file_header.pad2 = 0; audit_file_header.begin_component = 0; audit_file_header.begin_index = (4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8); blk.begin_ptr = blk.audit_ptr; audit_file_header.version = audit_file_header_version_1; audit_file_header.last_entry_length = -1; call truncate_audit_file; audit_file_header.max_component = audit_file_header.current_component; audit_file_header.max_index = audit_file_header.audit_index; end; else do; call hcs_$set_ips_mask (mask, 0); if p_com_err_sw then call com_err_ (p_code, (myname), "While attempting to open audit file ^a^[>^]^a .", blk.dirname, blk.dirname ^= ">", blk.ename); return; end; else if extend then do; call msf_manager_$get_ptr (blk.audit_fcb, 0, "1"b, audit_file_header_ptr, bit_count24, p_code); if p_code ^= 0 then do; call hcs_$set_ips_mask (mask, 0); if p_com_err_sw then call com_err_ (p_code, (myname), "While attempting to get pointer to component 0 of audit file."); return; end; if audit_file_header.version = 0 then do; blk.audit_ptr = audit_file_header_ptr; go to INIT_AUDIT_FILE; end; else if audit_file_header.version ^= audit_file_header_version_1 then do; call hcs_$set_ips_mask (mask, 0); if p_com_err_sw then call com_err_ (p_code, (myname)); p_code = error_table_$unimplemented_version; return; end; call msf_manager_$get_ptr (blk.audit_fcb, audit_file_header.current_component, "1"b, blk.audit_ptr, bit_count24, p_code); if p_code ^= 0 then do; call hcs_$set_ips_mask (mask, 0); if p_com_err_sw then call com_err_ (p_code, (myname), "While attempting to get pointer to audit file."); return; end; call msf_manager_$get_ptr (blk.audit_fcb, audit_file_header.begin_component, "1"b, blk.begin_ptr, bit_count24, p_code); if p_code ^= 0 then do; call hcs_$set_ips_mask (mask, 0); if p_com_err_sw then call com_err_ (p_code, (myname), "While attempting to get pointer to component ^d of audit file.", audit_file_header.begin_component); return; end; blk.current_flags.file_limit = audit_file_header.max_index > audit_file_header.audit_index | audit_file_header.max_component > audit_file_header.current_component; end; else do; call msf_manager_$get_ptr (blk.audit_fcb, 0, "1"b, blk.audit_ptr, bit_count24, p_code); if p_code ^= 0 then do; call hcs_$set_ips_mask (mask, 0); if p_com_err_sw then call com_err_ (p_code, (myname), "While attempting to get pointer to component ^d of audit file.", audit_file_header.current_component); return; end; audit_file_header_ptr = blk.audit_ptr; blk.audit_file_header_ptr = blk.audit_ptr; audit_file_header.current_component = 0; call msf_manager_$adjust (blk.audit_fcb, 0, ((4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8)) * 9, "110"b, p_code); if p_code ^= 0 then do; call hcs_$set_ips_mask (mask, 0); if p_com_err_sw then call com_err_ (p_code, (myname), "While attempting to adjust audit file."); return; end; call truncate_audit_file; audit_file_header.begin_index = audit_file_header.audit_index; audit_file_header.begin_component = 0; audit_file_header.max_component = audit_file_header.current_component; audit_file_header.max_index = audit_file_header.audit_index; audit_file_header.filled = "0"b; blk.begin_ptr = blk.audit_ptr; end; blk.audit_file_header_ptr = audit_file_header_ptr; blk.current_flags.read_audit = "1"b; blk.current_flags.write_audit = "1"b; blk.trigger = "!"; blk.current_flags.edit = "1"b; blk.current_flags.use_editor_prompt = "1"b; blk.editor_prompt_string = "audit editor^[(^d)^]:^2x"; blk.work_space = null; blk.work_space_len = 0; call hcs_$set_safety_sw_seg (blk.audit_file_header_ptr, "1"b, p_code); /* The audit_file_header_ptr always points at component 0 of the audit file, the safety switch on comp 0 is on when audit is attached and off when audit isn't attached. */ call get_temp_segment_ ("audit_", blk.temp_seg_ptr, p_code); if p_code ^= 0 then do; call hcs_$set_ips_mask (mask, 0); if p_com_err_sw then call com_err_ (p_code, (myname), "While attempting to get temp seg."); return; end; /* Now propagate through all appropriate IOCB's */ call iox_$propagate (audited_iocb); call hcs_$set_ips_mask (mask, 0); p_code = 0; return; audit_detach: entry (p_iocb_ptr, p_code); p_code = 0; call hcs_$set_ips_mask (0, mask); blkptr = p_iocb_ptr -> iocb.attach_data_ptr; p_iocb_ptr -> iocb.open_descrip_ptr = null (); p_iocb_ptr -> iocb.open_data_ptr = null (); p_iocb_ptr -> iocb.attach_descrip_ptr, p_iocb_ptr -> iocb.attach_data_ptr = null (); p_iocb_ptr -> iocb.detach_iocb = iox_$err_not_attached; p_iocb_ptr -> iocb.open = iox_$err_not_attached; call iox_$propagate (p_iocb_ptr); on any_other begin; call force_audit_suspension; goto RETURN; end; if blkptr = null then return; else if blk.audit_file_header_ptr ^= null then do; audit_file_header_ptr = blk.audit_file_header_ptr; if ^(blk.current_flags.file_limit & (audit_file_header.begin_component > audit_file_header.current_component | (audit_file_header.begin_component = audit_file_header.current_component & audit_file_header.begin_index >= audit_file_header.audit_index))) then do; call hcs_$set_bc_seg (blk.audit_ptr, audit_file_header.audit_index * 9, p_code); if p_code ^= 0 then goto RETURN; /* Can't use the bit count setting feature of msf_manager_$adjust because it will attempt to set the bit counts of the preceding components to max_length, which is not the correct value. In any event, their bit counts have already been set. */ call msf_manager_$adjust (blk.audit_fcb, audit_file_header.current_component, 9 * audit_file_header.audit_index, "011"b, p_code); if p_code ^= 0 then goto RETURN; end; end; if blk.temp_seg_ptr ^= null then do; call release_temp_segment_ ("audit_", blk.temp_seg_ptr, p_code); if p_code ^= 0 then goto RETURN; end; if blk.audit_fcb ^= null then call msf_manager_$close (blk.audit_fcb); RETURN: revert any_other; call hcs_$set_ips_mask (mask, 0); return; audit_close: entry (p_iocb_ptr, p_code); audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr; blkptr = p_iocb_ptr -> iocb.attach_data_ptr; if blk.audit_file_header_ptr ^= null then call hcs_$set_safety_sw_seg (blk.audit_file_header_ptr, "0"b, p_code); /* The audit_file_header_ptr always points to the base of component 0 in the audit file. The safety switch on component 0 is on when audit is attached and off when it isn't.*/ call hcs_$set_ips_mask (0, mask); audited_iocb -> iocb.open_descrip_ptr = null (); audited_iocb -> iocb.detach_iocb = audit_detach; call iox_$propagate (audited_iocb); call hcs_$set_ips_mask (mask, 0); p_code = 0; return; /* */ /* The following are dummy entries that pass on the given request */ audit_get_chars: entry (p_iocb_ptr, p_buff_ptr, p_buff_len, p_actual_len, p_code); audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr; blkptr = audited_iocb -> iocb.attach_data_ptr; auditing_iocb = blk.auditing_iocb; call iox_$get_chars (auditing_iocb, p_buff_ptr, p_buff_len, p_actual_len, p_code); if p_code ^= 0 then return; if blk.current_flags.read_audit then call audit_line ("IC", param_input_string); p_code = 0; return; audit_modes: entry (p_iocb_ptr, p_newmodes, p_oldmodes, p_code); audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr; blkptr = audited_iocb -> iocb.attach_data_ptr; auditing_iocb = blk.auditing_iocb; audit_file_header_ptr = blk.audit_file_header_ptr; if blk.current_flags.trace then call audit_line ("TM", rtrim (p_newmodes) || NL); unrecognized_modes = ""; if length (rtrim (p_newmodes)) = 0 then do; call iox_$modes (blk.auditing_iocb, p_newmodes, p_oldmodes, p_code); return; end; call mode_string_$parse (p_newmodes, addr (temp_area), mode_string_info_ptr, p_code); if p_code ^= 0 then return; if mode_string_info.version ^= mode_string_info_version_2 then call sub_err_ (error_table_$unimplemented_version, myname, "s", null, 0, "^/Unable to use the mode_string_info structure. Expecting version ^d, received version ^d.", mode_string_info_version_2, mode_string_info.version); if mode_string_info.number > 0 then if mode_string_info.modes (1).version ^= mode_value_version_3 then call sub_err_ (error_table_$unimplemented_version, myname, "s", null, 0, "^/Unable to use the mode_value structure. Expecting version ^d, received version ^d.", mode_value_version_3, mode_string_info.modes (1).version); MODE_LOOP: do mode_idx = 1 to mode_string_info.number; newmodes = mode_string_info.modes (mode_idx).mode_name; if index (newmodes, "audit_") = 1 then if newmodes = "audit_suspend" then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep then do; p_code = error_table_$bad_mode_syntax; return; end; else if mode_string_info.modes (mode_idx).boolean_value then do; if ^blk.suspend then call suspend_auditing ("", null); end; else do; string (blk.current_flags) = string (blk.saved_flags); blk.suspend = "0"b; end; else if blk.suspend then call ioa_$ioa_switch (auditing_iocb, "audit_: auditing suspended, no audit_ modes operations allowed except ^^audit_suspend"); else if newmodes = "audit_input" then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep then do; p_code = error_table_$bad_mode_syntax; return; end; else blk.current_flags.read_audit = mode_string_info.modes (mode_idx).flags.boolean_value; else if newmodes = "audit_transparent" then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep then do; p_code = error_table_$bad_mode_syntax; return; end; else if mode_string_info.modes (mode_idx).flags.boolean_value then blk.default_iocb = auditing_iocb; else blk.default_iocb = audited_iocb; else if newmodes = "audit_file_size" then if mode_string_info.modes (mode_idx).flags.boolean_valuep then do; p_code = error_table_$bad_mode_syntax; return; end; else if mode_string_info.modes (mode_idx).flags.char_valuep then if mode_string_info.modes (mode_idx).char_value = "unlimited" then do; blk.begin_ptr = audit_file_header_ptr; audit_file_header.begin_component = 0; audit_file_header.begin_index = size (audit_file_header) * 4 + 7 - mod (size (audit_file_header) * 4 + 7, 8); audit_file_header.max_index = audit_file_header.audit_index; audit_file_header.max_component = audit_file_header.current_component; audit_file_header.filled = "0"b; blk.current_flags.file_limit = "0"b; end; else do; p_code = error_table_$bad_mode_value; return; end; else do; records = mode_string_info.modes (mode_idx).numeric_value; if records <= 0 then do; p_code = error_table_$bad_mode_value; return; end; audit_file_header.max_component = divide (records, 256, 17, 0); audit_file_header.max_index = 4096 * (records - audit_file_header.max_component * 256); blk.current_flags.file_limit = "1"b; end; else if newmodes = "audit_output" then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep then do; p_code = error_table_$bad_mode_syntax; return; end; else blk.current_flags.write_audit = mode_string_info.modes (mode_idx).flags.boolean_value; else if newmodes = "audit_edit" then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep then do; p_code = error_table_$bad_mode_syntax; return; end; else blk.current_flags.edit = mode_string_info.modes (mode_idx).flags.boolean_value; else if newmodes = "audit_trace" then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep then do; p_code = error_table_$bad_mode_syntax; return; end; else blk.current_flags.trace = mode_string_info.modes (mode_idx).flags.boolean_value; else if newmodes = "audit_meter" then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep then do; p_code = error_table_$bad_mode_syntax; return; end; else blk.current_flags.meter = mode_string_info.modes (mode_idx).flags.boolean_value; else if newmodes = "audit_trigger" then if ^mode_string_info.modes (mode_idx).flags.char_valuep then do; p_code = error_table_$bad_mode_syntax; return; end; else blk.trigger = mode_string_info.modes (mode_idx).char_value; else if newmodes = "audit_use_editor_prompt" then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep then do; p_code = error_table_$bad_mode_syntax; return; end; else blk.current_flags.use_editor_prompt = mode_string_info.modes (mode_idx).flags.boolean_value; else if newmodes = "audit_editor_prompt_string" | newmodes = "audit_epstr" then if ^mode_string_info.modes (mode_idx).flags.char_valuep then do; p_code = error_table_$bad_mode_syntax; return; end; else blk.editor_prompt_string = mode_string_info.modes (mode_idx).char_value; end MODE_LOOP; call mode_string_$delete (mode_string_info_ptr, AUDIT_MODE_NAMES, unrecognized_modes, p_code); if unrecognized_modes ^= "" & unrecognized_modes ^= "." then do; /*** It is necessary to convert ll=NN and pl=NN, which mode_string_ produces, into llNN and plNN, which is the only form the tty_ dim currently understands. Hopefully, any other io module under audit_ which gets ll= and pl= modes will also understand the other forms. */ if index (unrecognized_modes, "ll=") > 0 then unrecognized_modes = before (rtrim (unrecognized_modes), "ll=") || "ll" || after (rtrim (unrecognized_modes), "ll="); if index (unrecognized_modes, "pl=") > 0 then unrecognized_modes = before (rtrim (unrecognized_modes), "pl=") || "pl" || after (rtrim (unrecognized_modes), "pl="); call iox_$modes (blk.auditing_iocb, (unrecognized_modes), p_oldmodes, p_code); end; /**** vp: tr phx19369 , display old modes when input modes are only audit modes ****/ else call iox_$modes (blk.auditing_iocb, "", p_oldmodes, p_code); return; audit_get_line: entry (p_iocb_ptr, p_buff_ptr, p_buff_len, p_actual_len, p_code); dcl file_char_array (0:sys_info$max_seg_size * 4) char (1) based (buff_ptr); audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr; blkptr = audited_iocb -> iocb.attach_data_ptr; auditing_iocb = blk.auditing_iocb; buff_ptr = p_buff_ptr; buff_len = p_buff_len; GET_LINE: if blk.work_space ^= null then do; /* set up input_string on temp_seg. */ buff_ptr = blk.work_space; actual_len = blk.work_space_len; buff_len = sys_info$max_seg_size * 4; /* if input_string bigger than p_string, fill p_string and return long_record */ /* if input_string smaller than p_string, fill p_string and return. */ if actual_len > p_buff_len then do; p_actual_len = p_buff_len; param_input_string = substr (aut_input_string, 1, p_buff_len); blk.work_space = addr (file_char_array (p_buff_len)); blk.work_space_len = actual_len - p_buff_len; p_code = error_table_$long_record; return; end; else do; p_actual_len = actual_len; param_input_string = aut_input_string; blk.work_space = null; blk.work_space_len = 0; p_code = 0; return; end; end; else do; call iox_$get_line (auditing_iocb, p_buff_ptr, p_buff_len, p_actual_len, p_code); if p_code ^= 0 then if p_code = error_table_$long_record then do; blk.work_space = blk.temp_seg_ptr; blk.work_space_len = sys_info$max_seg_size * 4; buff_len = blk.work_space_len; buff_ptr = blk.work_space; actual_len = p_buff_len; substr (aut_input_string, 1, actual_len) = substr (param_input_string, 1, p_actual_len); buff_ptr = addr (file_char_array (actual_len)); buff_len = buff_len - actual_len; call iox_$get_line (auditing_iocb, buff_ptr, buff_len, actual_len, p_code); if p_code ^= 0 then return; buff_ptr = blk.temp_seg_ptr; actual_len = actual_len + p_actual_len; buff_len = blk.work_space_len; blk.work_space_len = actual_len; end; else return; else actual_len = p_actual_len; MORE_GET_LINE: if ^(blk.current_flags.edit & (actual_len > 2)) then do; if blk.current_flags.read_audit then call audit_line ("IL", aut_input_string); end; else if (substr (aut_input_string, actual_len - 2, 1) = blk.trigger) then do; request = substr (aut_input_string, actual_len - 1, 1); if request = "." then do; if blk.current_flags.read_audit & (blk.default_iocb ^= blk.auditing_iocb) then call audit_line ("IL", aut_input_string); call ioa_$ioa_switch (blk.default_iocb, "audit ^[input^]^[/^]^[output^]", blk.current_flags.read_audit, blk.current_flags.read_audit & blk.current_flags.write_audit, blk.current_flags.write_audit); substr (aut_input_string, 1, actual_len - 2) = substr (aut_input_string, 1, actual_len - 3) || NL; actual_len = actual_len - 2; end; else if request = "?" then do; if blk.current_flags.read_audit & (blk.default_iocb ^= blk.auditing_iocb) then call audit_line ("IL", aut_input_string); call ioa_$ioa_switch (blk.default_iocb, "REQUESTS:"); call ioa_$ioa_switch (blk.default_iocb, "^a. -> who am I", blk.trigger); call ioa_$ioa_switch (blk.default_iocb, "^a? -> what can I do", blk.trigger); call ioa_$ioa_switch (blk.default_iocb, "^ae -> enter editor", blk.trigger); call ioa_$ioa_switch (blk.default_iocb, "^aE -> enter editor, process input line as edit requests", blk.trigger); call ioa_$ioa_switch (blk.default_iocb, "^aa -> abbrev expand input line", blk.trigger); call ioa_$ioa_switch (blk.default_iocb, "^ar -> replay input line", blk.trigger); call ioa_$ioa_switch (blk.default_iocb, "^at -> transparent input line (do not log)", blk.trigger); call ioa_$ioa_switch (blk.default_iocb, "^ad -> delete line", blk.trigger); call ioa_$ioa_switch (blk.default_iocb, "^an -> no operation", blk.trigger); call ioa_$ioa_switch (blk.default_iocb, "NOTE: above requests recognized only in audit_edit mode"); substr (aut_input_string, 1, actual_len - 2) = substr (aut_input_string, 1, actual_len - 3) || NL; actual_len = actual_len - 2; end; else if request = "r" then do; call ioa_$ioa_switch_nnl (blk.default_iocb, "^a", substr (aut_input_string, 1, actual_len - 3)); call iox_$get_line (auditing_iocb, addr (file_char_array (actual_len - 3)), buff_len - actual_len + 3, tactual_len, p_code); if p_code ^= 0 then if p_code ^= error_table_$long_record then return; else if blk.work_space ^= null then return; else do; blk.work_space = blk.temp_seg_ptr; blk.work_space_len = sys_info$max_seg_size * 4; buff_ptr = blk.temp_seg_ptr; buff_len = blk.work_space_len; actual_len = tactual_len + actual_len - 3; substr (aut_input_string, 1, actual_len) = substr (param_input_string, 1, actual_len); buff_ptr = addr (file_char_array (actual_len)); buff_len = buff_len - actual_len; call iox_$get_line (default_iocb, buff_ptr, buff_len, tactual_len, p_code); if p_code ^= 0 then return; buff_ptr = blk.temp_seg_ptr; buff_len = blk.work_space_len; actual_len = actual_len + tactual_len; blk.work_space_len = actual_len; end; else actual_len = actual_len + tactual_len - 3; goto MORE_GET_LINE; end; else if request = "e" | request = "E" then do; if blk.current_flags.read_audit & (blk.default_iocb ^= blk.auditing_iocb) then call audit_line ("IL", aut_input_string); blk.work_space = null; call audit_editor (buff_ptr, buff_len, actual_len, audited_iocb, p_code); if p_code ^= 0 then if p_code = error_table_$empty_file then call ioa_$ioa_switch (blk.default_iocb, "audit_: Can't edit, the audit file is empty."); else call ioa_$ioa_switch (blk.default_iocb, "audit_: Error attempting to use editor."); else do; set_last_return_line_position = "1"b; if blk.current_flags.read_audit then call audit_line ("EL", aut_input_string); end; end; else if request = "a" then do; if blk.current_flags.read_audit & (blk.default_iocb ^= blk.auditing_iocb) then call audit_line ("IL", aut_input_string); substr (aut_input_string, 1, actual_len - 2) = substr (aut_input_string, 1, actual_len - 3) || NL; actual_len = actual_len - 2; call abbrev_$expanded_line (buff_ptr, (actual_len), addr (ab_buf), 512, out_ptr, ab_len); if ab_len > 512 then if ab_len > buff_len then do; buff_ptr = blk.temp_seg_ptr; buff_len = ab_len; actual_len = ab_len; buff_ptr -> aut_input_string = out_ptr -> aut_input_string; free out_ptr -> aut_input_string; end; else do; buff_len = ab_len; actual_len = ab_len; buff_ptr -> aut_input_string = out_ptr -> aut_input_string; free out_ptr -> aut_input_string; end; else if ab_len > buff_len then do; buff_ptr = blk.temp_seg_ptr; buff_len = ab_len; actual_len = ab_len; aut_input_string = substr (ab_buf, 1, ab_len); end; else do; actual_len = ab_len; substr (aut_input_string, 1, ab_len) = substr (ab_buf, 1, ab_len); end; end; else if request = "d" then do; blk.work_space = null; blk.work_space_len = 0; buff_ptr = p_buff_ptr; buff_len = p_buff_len; actual_len = 0; goto GET_LINE; end; else if request = "n" then do; if blk.current_flags.read_audit & (blk.default_iocb ^= blk.auditing_iocb) then call audit_line ("IL", aut_input_string); actual_len = actual_len - 2; substr (aut_input_string, actual_len, 1) = NL; end; else if request = "t" then do; actual_len = actual_len - 2; substr (aut_input_string, actual_len, 1) = NL; end; else if blk.current_flags.read_audit then call audit_line ("IL", aut_input_string); end; else if blk.current_flags.read_audit then call audit_line ("IL", aut_input_string); if actual_len > p_buff_len then do; p_actual_len = p_buff_len; param_input_string = substr (aut_input_string, 1, p_buff_len); blk.work_space = addr (file_char_array (p_buff_len)); blk.work_space_len = actual_len - p_buff_len; p_code = error_table_$long_record; return; end; else do; p_actual_len = actual_len; param_input_string = substr (aut_input_string, 1, actual_len); blk.work_space = null; blk.work_space_len = 0; p_code = 0; return; end; p_code = 0; return; end; audit_put_chars: entry (p_iocb_ptr, p_buff_ptr, p_buff_len, p_code); audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr; blkptr = audited_iocb -> iocb.attach_data_ptr; auditing_iocb = blk.auditing_iocb; call iox_$put_chars (auditing_iocb, p_buff_ptr, p_buff_len, p_code); if p_code ^= 0 then return; if blk.current_flags.write_audit then call audit_line ("OC", param_output_string); p_code = 0; return; audit_position: entry (p_iocb_ptr, ptype, n, p_code); audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr; blkptr = audited_iocb -> iocb.attach_data_ptr; auditing_iocb = blk.auditing_iocb; call iox_$position (auditing_iocb, ptype, n, p_code); return; audit_control: entry (p_iocb_ptr, p_real_order, p_info_ptr, p_code); audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr; blkptr = audited_iocb -> iocb.attach_data_ptr; audit_file_header_ptr = blk.audit_file_header_ptr; if blk.current_flags.trace then call audit_line ("TC", p_real_order || NL); order = p_real_order; if substr (order, 1, 6) = "audit_" then do; order = substr (order, 7); if order = "truncate" then do; audit_file_header.current_component = 0; call msf_manager_$adjust (blk.audit_fcb, 0, ((4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8)) * 9, "110"b, p_code); call truncate_audit_file; audit_file_header.begin_index = audit_file_header.audit_index; audit_file_header.begin_component = 0; audit_file_header.filled = "0"b; blk.begin_ptr = blk.audit_ptr; end; else if order = "modes" then do; p_info_ptr -> mode_str = mode_string (p_code); end; else do; call iox_$control (blk.auditing_iocb, p_real_order, p_info_ptr, p_code); return; end; end; else if order = "io_call" then if p_info_ptr -> io_call_info.order_name = "audit_modes" then do; call p_info_ptr -> io_call_info.report ("audit modes: ^a", mode_string (p_code)); return; end; else do; call iox_$control (blk.auditing_iocb, p_real_order, p_info_ptr, p_code); return; end; else if order = "resetread" | order = "abort" then do; blk.work_space = null; blk.work_space_len = 0; call iox_$control (blk.auditing_iocb, p_real_order, p_info_ptr, p_code); return; end; else do; call iox_$control (blk.auditing_iocb, p_real_order, p_info_ptr, p_code); return; end; p_code = 0; return; /* */ audit_line: proc (p_tag, p_string); dcl 1 position like position_template; dcl 1 previous_position like position_template; dcl 1 position_info like position_info_template; dcl bytes_required fixed bin (24); dcl max_entry_size fixed bin (24); dcl room_for_insertion fixed bin (24); dcl trim_entry bit (1) init ("0"b); dcl p_tag char (*); dcl p_string char (*); call hcs_$set_ips_mask (0, mask); on any_other begin; call force_audit_suspension; goto RETURN; end; audit_file_header_ptr = blk.audit_file_header_ptr; position.aep = null; bytes_required = length (p_string) + 7 - mod (length (p_string) + 7, 8) + (4 * size (audit_entry)); call set_max_entry_size; if bytes_required > max_entry_size then do; bytes_required = max_entry_size; trim_entry = "1"b; end; call get_room_for_insertion; do while (bytes_required > room_for_insertion); call adjust_indices; call get_room_for_insertion; end; call set_position_info; call insert (p_tag, p_string); if set_last_return_line_position then do; set_last_return_line_position = "0"b; call audit_editor$set_last_return_line_position (addr (position)); end; RETURN: revert any_other; call hcs_$set_ips_mask (mask, 0); return; set_max_entry_size: proc; if ^blk.current_flags.file_limit then max_entry_size = sys_info$max_seg_size * 4; else if audit_file_header.max_component > 1 then max_entry_size = sys_info$max_seg_size * 4; else if audit_file_header.max_component = 1 then max_entry_size = max (audit_file_header.max_index, sys_info$max_seg_size * 4 - ((4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8))); else max_entry_size = audit_file_header.max_index - ((4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8)); end; get_room_for_insertion: proc; if ^blk.current_flags.file_limit then room_for_insertion = sys_info$max_seg_size * 4 - audit_file_header.audit_index; else if (audit_file_header.begin_component = audit_file_header.current_component) & (audit_file_header.begin_index >= audit_file_header.audit_index) & audit_file_header.filled then room_for_insertion = audit_file_header.begin_index - audit_file_header.audit_index; else if audit_file_header.current_component = audit_file_header.max_component then room_for_insertion = audit_file_header.max_index - audit_file_header.audit_index; else room_for_insertion = sys_info$max_seg_size * 4 - audit_file_header.audit_index; end; adjust_indices: proc; if ^blk.current_flags.file_limit then call next_component (audit_file_header.current_component, audit_file_header.audit_index, blk.audit_ptr); else if audit_file_header.begin_component = audit_file_header.current_component & audit_file_header.begin_index >= audit_file_header.audit_index & audit_file_header.filled then do; position.aep = addr (blk.begin_ptr -> file_char_array (audit_file_header.begin_index)); call hcs_$status_mins (blk.begin_ptr, type, bit_count24, p_code); if audit_file_header.begin_index + (4 * currentsize (position.aep -> audit_entry)) + 7 - mod ((4 * currentsize (position.aep -> audit_entry)) + 7, 8) >= divide (bit_count24, 9, 24, 0) then call next_component (audit_file_header.begin_component, audit_file_header.begin_index, blk.begin_ptr); else audit_file_header.begin_index = audit_file_header.begin_index + (4 * currentsize (position.aep -> audit_entry)) + 7 - mod ((4 * currentsize (position.aep -> audit_entry)) + 7, 8); end; else call next_component (audit_file_header.current_component, audit_file_header.audit_index, blk.audit_ptr); end; next_component: proc (p_component_number, p_component_index, p_component_ptr); dcl p_component_number fixed bin (17); dcl p_component_index fixed bin (24); dcl p_component_ptr ptr; call hcs_$set_bc_seg (blk.audit_ptr, audit_file_header.audit_index * 9, p_code); if p_component_number = audit_file_header.max_component & blk.current_flags.file_limit then do; p_component_number = 0; p_component_index = (4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8); p_component_ptr = audit_file_header_ptr; audit_file_header.filled = "1"b; end; else do; p_component_number = p_component_number + 1; if ^blk.current_flags.file_limit then audit_file_header.max_component = p_component_number; p_component_index = 0; call msf_manager_$get_ptr (blk.audit_fcb, p_component_number, "1"b, p_component_ptr, bit_count24, p_code); end; end; set_position_info: proc; position_info.last_entry_length = audit_file_header.last_entry_length; position_info.max_component = audit_file_header.max_component; position_info.max_index = audit_file_header.max_index; position_info.begin_component = audit_file_header.begin_component; position_info.begin_index = audit_file_header.begin_index; position_info.current_component = audit_file_header.current_component; position_info.audit_index = audit_file_header.audit_index; position_info.audit_fcb = blk.audit_fcb; position_info.audit_ptr = blk.audit_ptr; position_info.default_search_tag = ""; position_info.any_tag = "1"b; position_info.dirname = blk.dirname; position_info.ename = blk.ename; position_info.file_limit = audit_file_header.filled; position.char_index = audit_file_header.audit_index; position.component_number = audit_file_header.current_component; position.component_ptr = blk.audit_ptr; if position.component_number = audit_file_header.max_component & blk.current_flags.file_limit then position.component_max_char_index = audit_file_header.max_index; else position.component_max_char_index = sys_info$max_seg_size * 4; position.search_tag = ""; position.entry_number = 0; end; insert: proc (p_tag, p_string); dcl p_string char (*); dcl p_tag char (*); dcl virtual_time fixed bin (71); dcl paging fixed bin; dcl dev_paging fixed bin; dcl month fixed bin; dcl day fixed bin; dcl year fixed bin; dcl dow fixed bin; dcl zone char (3) aligned; dcl file_char_array (0:sys_info$max_seg_size * 4) char (1) unaligned based (blk.audit_ptr); position.aep = addr (file_char_array (audit_file_header.audit_index)); if blk.current_flags.meter then do; call cpu_time_and_paging_ (paging, virtual_time, dev_paging); previous_position = position; call audit_file_position_$last (addr (previous_position), addr (position_info), p_code); if p_code = 0 then do; previous_position.aep -> audit_entry.virtual_time = virtual_time - blk.virtual_time; previous_position.aep -> audit_entry.paging = paging - blk.paging; end; call decode_clock_value_ (clock, day, month, year, position.aep -> audit_entry.time, dow, zone); blk.virtual_time = virtual_time; blk.paging = paging; end; else position.aep -> audit_entry.time = -1; position.aep -> audit_entry.last_entry_length = audit_file_header.last_entry_length; if trim_entry then p_string = substr (p_string, 1, bytes_required - (4 * size (position.aep -> audit_entry))); position.aep -> audit_entry.entry_length = length (p_string); position.aep -> audit_entry.tag = p_tag; position.aep -> audit_entry.string = p_string; position.aep -> audit_entry.virtual_time = -1; position.aep -> audit_entry.paging = -1; audit_file_header.last_entry_length = position.aep -> audit_entry.entry_length; audit_file_header.audit_index = audit_file_header.audit_index + 4 * currentsize (position.aep -> audit_entry); audit_file_header.audit_index = audit_file_header.audit_index + 7 - mod (audit_file_header.audit_index + 7, 8); if ^blk.current_flags.file_limit then audit_file_header.max_index = audit_file_header.audit_index; return; end; end audit_line; /* */ force_audit_suspension: proc; dcl 1 info aligned, %include cond_info; dcl find_condition_info_ entry (ptr, ptr, fixed bin (35)); call find_condition_info_ (null (), addr (info), p_code); call suspend_auditing (info.condition_name, info.loc_ptr); end force_audit_suspension; suspend_auditing: proc (condition, p_ptr); dcl condition char (32) varying; dcl p_ptr ptr; if blk.suspend then return; blk.suspend = "1"b; string (blk.saved_flags) = string (blk.current_flags); string (blk.current_flags) = "0"b; if condition ^= "" then call ioa_$ioa_switch (p_iocb_ptr, "audit_: ^a on audit file by ^p, auditing suspended.", condition, p_ptr); return; end suspend_auditing; mode_string: proc (p_code) returns (char (512) varying); dcl p_code fixed bin (35); dcl modes char (512); dcl mode_idx fixed bin (17); audit_file_header_ptr = blk.audit_file_header_ptr; modes = ""; number_of_modes = 10; alloc mode_string_info in (temp_area); mode_string_info.version = mode_string_info_version_2; MODE_LOOP: do mode_idx = 1 to hbound (mode_string_info.modes, 1); mode_value_ptr = addr (mode_string_info.modes (mode_idx)); mode_value.flags = "0"b; mode_value.boolean_value = "0"b; mode_value.char_value = ""; mode_value.numeric_value = 0; goto MODE (mode_idx); MODE (1): mode_value.mode_name = "audit_input"; mode_value.flags.boolean_valuep = "1"b; mode_value.boolean_value = blk.current_flags.read_audit; goto NEXT_MODE; MODE (2): mode_value.mode_name = "audit_output"; mode_value.flags.boolean_valuep = "1"b; mode_value.boolean_value = blk.current_flags.write_audit; goto NEXT_MODE; MODE (3): mode_value.mode_name = "audit_edit"; mode_value.flags.boolean_valuep = "1"b; mode_value.boolean_value = blk.current_flags.edit; goto NEXT_MODE; MODE (4): mode_value.mode_name = "audit_trace"; mode_value.flags.boolean_valuep = "1"b; mode_value.boolean_value = blk.current_flags.trace; goto NEXT_MODE; MODE (5): mode_value.mode_name = "audit_meter"; mode_value.flags.boolean_valuep = "1"b; mode_value.boolean_value = blk.current_flags.meter; goto NEXT_MODE; MODE (6): mode_value.mode_name = "audit_transparent"; mode_value.flags.boolean_valuep = "1"b; mode_value.boolean_value = (blk.default_iocb = blk.auditing_iocb); goto NEXT_MODE; MODE (7): mode_value.mode_name = "audit_trigger"; mode_value.flags.char_valuep = "1"b; mode_value.char_value = blk.trigger; goto NEXT_MODE; MODE (8): mode_value.mode_name = "audit_file_size"; if blk.current_flags.file_limit then do; mode_value.flags.numeric_valuep = "1"b; mode_value.numeric_value = (audit_file_header.max_component * 256) + divide (audit_file_header.max_index, 4096, 17, 0); end; else do; mode_value.flags.char_valuep = "1"b; mode_value.char_value = "unlimited"; end; goto NEXT_MODE; MODE (9): mode_value.mode_name = "audit_use_editor_prompt"; mode_value.flags.boolean_valuep = "1"b; mode_value.boolean_value = blk.current_flags.use_editor_prompt; goto NEXT_MODE; MODE (10): mode_value.mode_name = "audit_editor_prompt_string"; mode_value.flags.char_valuep = "1"b; mode_value.char_value = blk.editor_prompt_string; goto NEXT_MODE; NEXT_MODE: end MODE_LOOP; call mode_string_$combine (mode_string_info_ptr, null, modes, p_code); return (modes); end mode_string; truncate_audit_file: proc; /* This program always sets up afh and blk.audit_ptr for afh.current_component = 0. */ audit_file_header_ptr = blk.audit_file_header_ptr; call msf_manager_$get_ptr (blk.audit_fcb, 0, "1"b, blk.audit_ptr, bit_count24, p_code); if p_code ^= 0 then do; call com_err_ (p_code, "audit_"); return; end; audit_file_header.audit_index = (4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8); audit_file_header.last_entry_length = impossible_audit_entry_length; end truncate_audit_file; /* */ %include audit_block; %page; %include audit_entry; %page; %include audit_file_header; %page; %include audit_position; %page; %include io_call_info; %page; %include iocb; %page; %include iox_dcls; %page; %include mode_string_info; end;  audit_editor.pl1 06/03/83 0951.3rew 06/03/83 0829.0 370746 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style2 */ audit_editor: proc (p_buff_ptr, p_buff_len, p_actual_len, p_audited_iocb, p_code); /* The audit_editor procedure is bound in with audit_, and is not an externally available entry. INput is in param_buffer (defined by p_buff_ptr, p_buff_len, and p_actual_len). param_buffer is also used for output from the editor. If the string to be output is too large for the param_buffer as defined on entry, i.e. if p_buff_len is too small, param_buffer is redefined on the audit_ temp_seg pointed to by blk.temp_seg_ptr. To preserve "recursiveness" of audit_editor and audit_get_line(in audit_), the audit_editor uses a temp_seg in calls to iox_$get_line as its input buffer. Also, to avoid edit buffer size problems, edit_buffer is based on a temp_seg. The requests supported by audit_editor are in the parse_request internal procedure, the addressing syntax is enforced by decode_address. 12/08/78 Written by Lindsey L. Spratt Modified: 11/26/79 by Lindsey L. Spratt to add prompting. 12/11/79 by Lindsey L. Spratt to modify prompting, add "=" request, add short names for requests (remove "." prefix). 03/20/81 by Lindsey L. Spratt: Remove blk.editor_prompt_terminator, use blk.editor_prompt_string as an ioa_ control string. */ /* Parameter */ dcl p_buff_ptr ptr; dcl p_buff_len fixed bin (21); dcl p_actual_len fixed bin (21); dcl p_audited_iocb ptr; dcl p_code fixed bin (35); /* Automatic */ dcl 1 position_info like position_info_template; dcl 1 saved_audit_file_header like audit_file_header; dcl 1 aut_last_return_line, 2 not_in_string bit (1), 2 string char (512) varying, 2 position like position_template; dcl 1 current_position like position_template; dcl 1 begin_position like position_template; dcl 1 end_position like position_template; dcl idx_of_first_non_white_space_char fixed bin (35); dcl level fixed bin; dcl request_index fixed bin; dcl code fixed bin (35); dcl areap ptr; dcl new_edit_buffer_ptr ptr; dcl default_iocb ptr; dcl request_line_length fixed bin; dcl request_line_ptr ptr; dcl no_last_return_line bit (1); dcl edit_buffer_ptr ptr; dcl string_delimiter char (1); dcl auditing_iocb ptr; dcl blkptr ptr; dcl warn_user_on_bad_request bit (1); dcl (edit_buffer_length, new_edit_buffer_length) fixed bin; dcl (max_edit_buffer_length, max_request_line_length) fixed bin; dcl temp_seg_ptr (3) ptr; /* Based */ dcl area area (2048) based (areap); dcl request_line char (request_line_length) based (request_line_ptr); dcl edit_buffer char (edit_buffer_length) based (edit_buffer_ptr); dcl param_buffer char (p_actual_len) based (p_buff_ptr); dcl new_edit_buffer char (new_edit_buffer_length) based (new_edit_buffer_ptr); /* Builtin */ dcl null builtin; dcl (addr, addrel, allocation, bin, hbound, index, length, ltrim, rtrim, search, substr, verify) builtin; /* Condition */ dcl cleanup condition; /* Controlled */ dcl 1 con_last_return_line controlled, 2 not_in_string bit (1), 2 string char (512) varying, 2 position like position_template; /* Entry */ dcl audit_file_position_$move_number entry (ptr, bit (1), bit (1), bit (1), fixed bin, ptr, fixed bin (35)); dcl audit_file_position_$forward_search entry (ptr, char (*) varying, ptr, fixed bin (35)); dcl audit_file_position_$backward_search entry (ptr, char (*) varying, ptr, fixed bin (35)); dcl audit_file_position_$next entry (ptr, ptr, fixed bin (35)); dcl audit_file_position_$previous entry (ptr, ptr, fixed bin (35)); dcl audit_file_position_$last entry (ptr, ptr, fixed bin (35)); dcl audit_file_position_$set_count entry (ptr, ptr, fixed bin (35)); dcl get_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)); dcl release_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)); dcl get_system_free_area_ entry () returns (ptr); dcl iox_$get_line entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35)); dcl ioa_$ioa_switch entry options (variable); dcl ioa_$ioa_switch_nnl entry options (variable); dcl cu_$cp entry (ptr, fixed bin, fixed bin (35)); dcl abbrev_$expanded_line entry (ptr, fixed bin, ptr, fixed bin, ptr, fixed bin); dcl search_file_ entry (ptr, fixed bin, fixed bin, ptr, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin (35)); /* External */ dcl sys_info$max_seg_size fixed bin (35) ext; dcl error_table_$empty_file fixed bin (35) ext; dcl error_table_$no_stmt_delim fixed bin (35) ext; dcl error_table_$end_of_info fixed bin (35) ext; /* Static */ dcl static_level fixed bin internal static init (0); dcl NL char (1) internal static options (constant) init (" "); /* Increment the count of the recursive invocations of the editor. */ static_level = static_level + 1; level = static_level; /* Push the last_return_line stack if its depth is less than the current level of recursion. The no_last_return_line switch is "1"b if there was no last_return_line at this level of recursion. */ if allocation (con_last_return_line) < level then do; no_last_return_line = "1"b; allocate con_last_return_line; end; else no_last_return_line = "0"b; on condition (cleanup) begin; do while (allocation (con_last_return_line) >= level); free con_last_return_line; end; static_level = level - 1; end; /* Put the contents of the last_return_line of this level in automatic storage, to insure reference to the correct value, regardless of additional recursion. */ aut_last_return_line = con_last_return_line; warn_user_on_bad_request = "0"b; max_request_line_length = sys_info$max_seg_size * 4; max_edit_buffer_length = sys_info$max_seg_size * 4; position_info.any_tag = "0"b; current_position.component_number = -1; current_position.component_max_char_index = -1; current_position.component_ptr = null; current_position.char_index = -1; current_position.aep = null; areap = get_system_free_area_ (); call get_temp_segments_ ("audit_editor", temp_seg_ptr, code); if code ^= 0 then do; p_code = code; return; end; edit_buffer_ptr = temp_seg_ptr (1); new_edit_buffer_ptr = temp_seg_ptr (2); request_line_ptr = temp_seg_ptr (3); /* Get the attached data, in blk, which describes various things about the audit file. Make a snapshot of this data to protect against the result of further auditing while in the editor. */ blkptr = p_audited_iocb -> iocb.attach_data_ptr; audit_file_header_ptr = blk.audit_file_header_ptr; saved_audit_file_header = audit_file_header; position_info.max_index = audit_file_header.max_index; position_info.begin_component = audit_file_header.begin_component; position_info.begin_index = audit_file_header.begin_index; position_info.file_limit = audit_file_header.filled; position_info.default_search_tag = "I"; position_info.max_component = audit_file_header.max_component; position_info.current_component = audit_file_header.current_component; position_info.audit_fcb = blk.audit_fcb; position_info.dirname = blk.dirname; position_info.ename = blk.ename; position_info.audit_index = audit_file_header.audit_index; position_info.audit_ptr = blk.audit_ptr; position_info.last_entry_length = audit_file_header.last_entry_length; auditing_iocb = blk.auditing_iocb; default_iocb = blk.default_iocb; /* Set up request_line, edit_buffer, current_position, begin_position, and end_position. */ if p_actual_len = 3 then do; /* Editor triggered with line containing only editor request */ /* sequence. Set edit_line to the input line preceding the */ /* trigger sequence, get request_line from default_iocb. */ call audit_file_position_$last (addr (current_position), addr (position_info), code); if code ^= 0 then if code = error_table_$empty_file then do; call ioa_$ioa_switch (default_iocb, "Empty audit file."); param_buffer = ""; p_actual_len = 0; p_code = 0; call finish; return; end; else do; p_code = code; call finish; return; end; if default_iocb ^= auditing_iocb then do; call audit_file_position_$previous (addr (current_position), addr (position_info), code); if code ^= 0 then do; p_code = code; call finish; return; end; end; begin_position, end_position = current_position; call replace_buffer_with_entry (current_position); if blk.current_flags.use_editor_prompt then call put_prompt; call iox_$get_line (default_iocb, request_line_ptr, 512, request_line_length, code); if code ^= 0 then do; p_code = code; call finish; return; end; end; else if substr (param_buffer, p_actual_len - 1, 1) = "E" then do; /* Editor triggered with line containing requests. Prepare to */ /* warn user if part of the supplied request_line */ /* fails. Set edit_line to most recent input line. */ warn_user_on_bad_request = "1"b; request_line_length = p_actual_len - 2; request_line = substr (param_buffer, 1, p_actual_len - 3) || NL; call audit_file_position_$last (addr (current_position), addr (position_info), code); if code ^= 0 then if code = error_table_$empty_file then do; call ioa_$ioa_switch (default_iocb, "Empty audit file."); p_code = 1; call finish; p_code = 0; return; end; else do; p_code = code; call finish; return; end; if default_iocb ^= auditing_iocb then do; call audit_file_position_$previous (addr (current_position), addr (position_info), code); if code ^= 0 then do; p_code = code; call finish; return; end; end; call replace_buffer_with_entry (current_position); begin_position, end_position = current_position; end; else do; /* Set edit_line to the characters preceding the trigger */ /* sequence. Get the request_line from default_iocb. */ edit_buffer_length = p_actual_len - 2; edit_buffer = substr (param_buffer, 1, p_actual_len - 3) || NL; call audit_file_position_$last (addr (current_position), addr (position_info), code); begin_position, end_position = current_position; if blk.current_flags.use_editor_prompt then call put_prompt; call iox_$get_line (default_iocb, request_line_ptr, 512, request_line_length, code); if code ^= 0 then do; p_code = code; call finish; return; end; end; /* Loop through the requests, getting new request_line's as necessary. */ do while ("1"b); begin_position, end_position = current_position; code = 0; call parse_request (request_index); /* Get the label index of first request on request_line */ if request_index > 0 /* All non-zero indexes are valid requests. */ then goto LAB (request_index); else if warn_user_on_bad_request then do; /* Print a station id since an error has occurred in processing. */ warn_user_on_bad_request = "0"b; goto LAB (1); end; else goto NEXT_REQUEST; /* Zero index indicates no valid request found. */ /* Each label is an editor request call followed by a transfer to NEXT_REQUEST or a return. */ LAB (1): call whoami; goto NEXT_REQUEST; LAB (2): call colon; /* Turns on the no_default_tag switch. */ goto NEXT_REQUEST; LAB (3): call print; /* Print the lines between begin_index and end_index. */ goto NEXT_REQUEST; LAB (4): call substitute (code); /* Substitute rep_str for reg_exp in edit_line. */ goto NEXT_REQUEST; /* rep_str and reg_exp are parsed from request_line by substitute. */ LAB (5): p_code = 1; /* Quit from the editor. */ call finish; p_code = 0; return; LAB (6): call command_processor_escape; goto NEXT_REQUEST; LAB (7): LAB (18): call return_edit_line (code); /* Return edit_line to audit_. */ if code = 0 then do; p_code = 0; call finish; return; end; else goto NEXT_REQUEST; LAB (8): LAB (19): call get_last_line_returned; /* Put the last line returned by */ goto NEXT_REQUEST; /* the audit_editor in edit_line, and set position to its location in the audit file. */ LAB (9): LAB (20): call return_newline; /* Return a newline to audit_. */ p_code = 1; call finish; p_code = 0; return; LAB (10): LAB (21): call set_default_search_tag (position_info.default_search_tag, code); /* Set the default tag used in searching */ goto NEXT_REQUEST; /* to tag_str, which is gotten from request_line. */ LAB (11): LAB (22): call audit_on; /* Turn on auditting of the editor. */ goto NEXT_REQUEST; LAB (12): LAB (23): call audit_off; /* Turn off auditting of the editor. */ goto NEXT_REQUEST; LAB (13): LAB (24): call print_type; /* Print the type(tag) of the current entry */ goto NEXT_REQUEST; /* (in edit_line). */ LAB (14): LAB (25): call execute_edit_line; /* Execute (pass to the comand processor) edit_line */ goto NEXT_REQUEST; /* and continue processing editor requests. */ LAB (15): LAB (26): call abbrev_expand_edit_line; /* Expand, using the abbrev processor, the */ goto NEXT_REQUEST; /* contents of edit_line, and replace edit_line with the expanded version. */ LAB (16): LAB (27): call list_requests; goto NEXT_REQUEST; LAB (17): call print_entry_number; goto NEXT_REQUEST; /* If the request line length is 0, a new line is gotten from the user. In any case, the beginning of the loop is returned to. */ NEXT_REQUEST: if code ^= 0 then do; code = 0; request_line_length = 0; request_line = ""; if warn_user_on_bad_request then do; warn_user_on_bad_request = "0"b; goto LAB (1); end; end; if request_line_length < 2 then do; position_info.any_tag = "0"b; if blk.current_flags.use_editor_prompt then call put_prompt; call iox_$get_line (default_iocb, request_line_ptr, max_request_line_length, request_line_length, code); if code ^= 0 then do; p_code = code; call finish; return; end; else warn_user_on_bad_request = "0"b; end; end; return; /* End the main procedure, audit_editor. */ set_last_return_line_position: entry (p_position_ptr); dcl 1 p_position like position_template based (p_position_ptr); dcl p_position_ptr ptr; con_last_return_line.position = p_position; return; /* End set_last_return_line_position. */ /* The 14 following procedures are the various editor requests. After them are the procedures for parsing the request line, then the procedures for position control. */ whoami: proc; /* Station identification. */ call ioa_$ioa_switch (default_iocb, "audit editor ^v(at level ^d ^)", level - 1, level); end; colon: proc; /* Defeat entry type specificity in address searches. */ position_info.any_tag = "1"b; end; print: proc; /* Print entries in the audit file from */ dcl code fixed bin (35); code = 0; /* begin position to end position. */ if begin_position.aep = end_position.aep then call ioa_$ioa_switch_nnl (default_iocb, "^a", edit_buffer); else do; current_position = begin_position; begin_position = end_position; do while (current_position.aep ^= end_position.aep); call replace_buffer_with_entry (current_position); call ioa_$ioa_switch_nnl (default_iocb, "^a", edit_buffer); call audit_file_position_$next (addr (current_position), addr (position_info), code); if code = error_table_$end_of_info then do; call ioa_$ioa_switch (default_iocb, "EOF"); /* There is no next entry. */ return; end; end; if code = 0 then do; call replace_buffer_with_entry (current_position); /* The entry at end_position has yet to be printed. */ call ioa_$ioa_switch_nnl (default_iocb, "^a", edit_buffer); end; end; end; substitute: proc (p_code); dcl (code, p_code) fixed bin (35); dcl reg_exp char (512) varying based (reg_exp_ptr); dcl rep_str char (512) varying; dcl char_after_last_match fixed bin; dcl match_index fixed bin; dcl match_begin fixed bin; dcl match_end fixed bin; dcl start_next_search fixed bin; dcl slash_amp_index fixed bin; dcl reg_exp_ptr ptr; alloc reg_exp in (area); call get_string (reg_exp, "1"b, code); /* Get the string to be replaced, a qedx regular expression, from the request line. */ if code ^= 0 then do; p_code = code; free reg_exp in (area); return; end; call get_string (rep_str, "0"b, code); /* Get the replacement string from the request line. */ if code ^= 0 then do; p_code = code; free reg_exp in (area); return; end; new_edit_buffer_length = 0; char_after_last_match = 1; do match_index = 1 by 1 while (char_after_last_match <= edit_buffer_length); /* Search edit_line for reg_exp. */ call search_file_ (addrel (reg_exp_ptr, 1), 1, length (reg_exp), edit_buffer_ptr, char_after_last_match, edit_buffer_length, match_begin, match_end, code); if code ^= 0 then do; /* No match for reg_exp was found, starting at */ /* char_after_last_match. */ if match_index > 1 then do; /* At least one match has been found, so update */ /* the edit_line and return. */ if new_edit_buffer_length + 1 >= char_after_last_match then do; edit_buffer_length = new_edit_buffer_length + edit_buffer_length - char_after_last_match + 1; edit_buffer = new_edit_buffer || substr (edit_buffer, char_after_last_match, edit_buffer_length - new_edit_buffer_length); end; else do; substr (edit_buffer, 1, edit_buffer_length + new_edit_buffer_length - char_after_last_match + 1) = new_edit_buffer || substr (edit_buffer, char_after_last_match); edit_buffer_length = new_edit_buffer_length + edit_buffer_length - char_after_last_match + 1; end; p_code = 0; free reg_exp in (area); return; end; if code = 1 then call ioa_$ioa_switch (default_iocb, "Substitution failed."); free reg_exp in (area); p_code = code; return; end; /* If the match starts after char_after_last_match, then append the part of the edit_line between char_after_last_match and match_begin to the new_edit_line. */ if match_begin > char_after_last_match then do; new_edit_buffer_length = new_edit_buffer_length + match_begin - char_after_last_match; new_edit_buffer = substr (new_edit_buffer, 1, new_edit_buffer_length - match_begin + char_after_last_match) || substr (edit_buffer, char_after_last_match, match_begin - char_after_last_match); end; /* Having found a match, rep_str indicates what characters are to be appended to the growing new_edit_line, instead of the characters in edit_line between match_begin and match_end. Any unescaped ampersand (&) in rep_str is replaced by the matched string in edit_line. An escape is the two character sequence "\c". The following loop searches for escapes and unescaped ampersands in rep_str. */ start_next_search = 1; if rep_str = "" then do; new_edit_buffer_length = new_edit_buffer_length + length (rep_str) - start_next_search + 1; new_edit_buffer = substr (new_edit_buffer, 1, new_edit_buffer_length - (length (rep_str) - start_next_search + 1)) || substr (rep_str, start_next_search); end; else do while (start_next_search <= length (rep_str)); slash_amp_index = search (substr (rep_str, start_next_search), "\&"); if slash_amp_index = 0 then do; new_edit_buffer_length = new_edit_buffer_length + length (rep_str) - start_next_search + 1; new_edit_buffer = substr (new_edit_buffer, 1, new_edit_buffer_length - (length (rep_str) - start_next_search + 1)) || substr (rep_str, start_next_search); start_next_search = length (rep_str) + 1; end; else if substr (rep_str, start_next_search + slash_amp_index - 1, 1) = "&" then do; new_edit_buffer_length = new_edit_buffer_length + slash_amp_index - 1; new_edit_buffer = substr (new_edit_buffer, 1, new_edit_buffer_length - slash_amp_index + 1) || substr (rep_str, start_next_search, slash_amp_index - 1); start_next_search = start_next_search + slash_amp_index; if match_end >= match_begin then do; new_edit_buffer_length = new_edit_buffer_length + match_end - match_begin + 1; new_edit_buffer = substr (new_edit_buffer, 1, new_edit_buffer_length - match_end + match_begin - 1) || substr (edit_buffer, match_begin, match_end - match_begin + 1); end; end; else if start_next_search + slash_amp_index > length (rep_str) then do; new_edit_buffer_length = new_edit_buffer_length + length (rep_str) - start_next_search + 1; new_edit_buffer = substr (new_edit_buffer, 1, new_edit_buffer_length - length (rep_str) + start_next_search - 1) || substr (rep_str, start_next_search); start_next_search = length (rep_str) + 1; end; else if substr (rep_str, start_next_search + slash_amp_index, 1) ^= "c" then do; new_edit_buffer_length = new_edit_buffer_length + slash_amp_index; new_edit_buffer = substr (new_edit_buffer, 1, new_edit_buffer_length - slash_amp_index) || substr (rep_str, start_next_search, slash_amp_index); start_next_search = start_next_search + slash_amp_index; end; else if start_next_search + slash_amp_index = length (rep_str) then do; new_edit_buffer_length = new_edit_buffer_length + length (rep_str) - start_next_search + 1; new_edit_buffer = substr (rep_str, start_next_search); start_next_search = length (rep_str) + 1; end; else do; new_edit_buffer_length = new_edit_buffer_length + slash_amp_index; new_edit_buffer = substr (new_edit_buffer, 1, new_edit_buffer_length - slash_amp_index) || substr (rep_str, start_next_search, slash_amp_index - 1) || substr (rep_str, start_next_search + slash_amp_index + 1, 1); start_next_search = start_next_search + slash_amp_index + 2; end; end; if match_end < match_begin then do; new_edit_buffer_length = new_edit_buffer_length + 1; new_edit_buffer = substr (new_edit_buffer, 1, new_edit_buffer_length - 1) || substr (edit_buffer, match_begin, 1); char_after_last_match = match_begin + 1; end; else char_after_last_match = match_end + 1; reg_exp = ""; /* A null reg_exp will cause search_file_ to use the last non_null value of reg_exp. */ end; free reg_exp in (area); edit_buffer_length = new_edit_buffer_length; edit_buffer = new_edit_buffer; end; command_processor_escape: proc; call cu_$cp (request_line_ptr, request_line_length, code); request_line = ""; request_line_length = 0; end; return_edit_line: proc (p_code); dcl p_code fixed bin (35); if request_line_length > 1 then do; if substr (request_line, 1, request_line_length - 1) ^= "" then do; edit_buffer_length = request_line_length; edit_buffer = request_line; request_line_length = 0; request_line = ""; end; end; if edit_buffer_length <= 512 then do; aut_last_return_line.string = edit_buffer; aut_last_return_line.not_in_string = "0"b; end; else do; aut_last_return_line.string = ""; aut_last_return_line.not_in_string = "1"b; end; p_code = 0; end; get_last_line_returned: proc; if no_last_return_line then call ioa_$ioa_switch (default_iocb, "No previously returned line known."); else do; current_position = aut_last_return_line.position; begin_position = current_position; end_position = current_position; if aut_last_return_line.not_in_string then call replace_buffer_with_entry (current_position); else do; edit_buffer_length = length (aut_last_return_line.string); edit_buffer = aut_last_return_line.string; end; end; end; return_newline: proc; p_actual_len = 1; param_buffer = NL; end; set_default_search_tag: proc (p_default_search_tag, p_code); dcl default_search_tag char (32) varying; dcl p_default_search_tag char (*) varying; dcl (p_code, code) fixed bin (35); call get_string (default_search_tag, "1"b, code); if code ^= 0 then do; p_code = code; return; end; if length (default_search_tag) > 2 then do; call ioa_$ioa_switch (default_iocb, "Tag too long. ^a", default_search_tag); p_code = 1; return; end; p_default_search_tag = default_search_tag; return; end; audit_on: proc; default_iocb = p_audited_iocb; end; audit_off: proc; default_iocb = auditing_iocb; end; print_type: proc; call ioa_$ioa_switch (default_iocb, "^a", current_position.aep -> audit_entry.tag); end; execute_edit_line: proc; call cu_$cp (addr (edit_buffer), length (rtrim (edit_buffer)), code); end; abbrev_expand_edit_line: proc; dcl out char (abline_len) based (outp); dcl outp ptr, abline_len fixed bin; dcl abline char (512); call abbrev_$expanded_line (edit_buffer_ptr, edit_buffer_length, addr (abline), max_edit_buffer_length, outp, abline_len); if abline_len > max_edit_buffer_length then do; call ioa_$ioa_switch (default_iocb, "Expanded line too long. ^/^a", out); request_line = ""; request_line_length = 0; return; end; edit_buffer_length = abline_len; edit_buffer = out; end; list_requests: proc; call ioa_$ioa_switch (default_iocb, "^5x. -> who am I?"); call ioa_$ioa_switch (default_iocb, "^5x: -> defeat default search tag"); call ioa_$ioa_switch (default_iocb, "^5xp -> print"); call ioa_$ioa_switch (default_iocb, "^5xs -> substitute"); call ioa_$ioa_switch (default_iocb, "^5xq -> quit"); call ioa_$ioa_switch (default_iocb, "^5x.. -> command escape"); call ioa_$ioa_switch (default_iocb, "^5x.r -> return edit buffer"); call ioa_$ioa_switch (default_iocb, "^5x.l -> get last returned line"); call ioa_$ioa_switch (default_iocb, "^5x.n -> return newline"); call ioa_$ioa_switch (default_iocb, "^5x.d -> set default tag"); call ioa_$ioa_switch (default_iocb, "^5x.on -> audit editting"); call ioa_$ioa_switch (default_iocb, "^5x.off -> don't audit editting"); call ioa_$ioa_switch (default_iocb, "^5x.type -> print tag of entry in buffer"); call ioa_$ioa_switch (default_iocb, "^5x.exec -> execute edit buffer with call to command processor"); call ioa_$ioa_switch (default_iocb, "^5x.expand -> expand abbrevs in edit buffer"); call ioa_$ioa_switch (default_iocb, "^5x.? -> print this list"); end; print_entry_number: proc; if current_position.entry_number = 0 | (current_position.search_tag ^= position_info.default_search_tag) | position_info.any_tag then call audit_file_position_$set_count (addr (current_position), addr (position_info), code); call ioa_$ioa_switch (default_iocb, "^d", current_position.entry_number); end; /* End of print_entry_number.*/ put_prompt: proc; call ioa_$ioa_switch_nnl (default_iocb, blk.editor_prompt_string, (level > 1), level); end; /* End of put_prompt.*/ /* The next group of procedures are concerned primarily with parsing the request line. */ parse_request: proc (p_index) recursive; dcl (p_index, index) fixed bin; dcl request_name_length fixed bin; dcl request (27) char (12) varying static options (constant) init (".", ":", "p", "s", "q", "..", ".r", ".l", ".n", ".d", ".on", ".off", ".type", ".exec", ".expand", ".?", "=", "r", "l", "n", "d", "on", "off", "type", "exec", "expand", "?"); p_index = 0; if request_line_length < 2 then do; /* The request line is too short to contain any requests */ p_index = 0; return; end; else if (request_line_length = 2) & substr (request_line, 1, 1) = "." then do; /* the "." (station id) request is only recognized when */ /* immediately followed by a newline. */ request_line_length = 0; request_line = ""; p_index = 1; return; end; else do; /* This sets p_index to an appropriate request label */ /* index if the request line begins with a recognizable */ /* If no recognizable request begins the line, */ /* p_index is set to 0. */ call request_check; if p_index = 0 then do; /* The beginning of the request line is assumed */ /* to be an address and is interpreted accordingly */ call decode_address (code); if code ^= 0 then do; if code = 1 then call unrecognized_request; return; end; else if request_line_length < 2 then do; p_index = 3; /* The request line contained only an address */ begin_position = end_position; /* so the default is to print the current position. */ return; end; else do; /* An address was gotten from the request line, */ /* now the trailing request is gotten. */ call request_check; if index > hbound (request, 1) /* No matching request found for beginning of request */ /* line, so complain and return. */ then call unrecognized_request; else p_index = index; return; end; end; end; request_check: proc; /* The array request is looped through to find a match for the beginning of the request line. The loop starts at 2 because request(1), ".", is handled as a special case above. */ do index = 2 to hbound (request, 1); request_name_length = length (request (index)); if request_line_length >= request_name_length + 1 then if substr (request_line, 1, request_name_length) = request (index) then do; substr (request_line, 1, request_line_length - request_name_length) = substr (request_line, request_name_length + 1); request_line_length = request_line_length - request_name_length; idx_of_first_non_white_space_char = verify (request_line, " "); if idx_of_first_non_white_space_char > 1 /* Leading white space exists and needs to be stripped off. */ then do; substr (request_line, 1, request_line_length - idx_of_first_non_white_space_char + 1) = substr (request_line, idx_of_first_non_white_space_char, request_line_length - idx_of_first_non_white_space_char + 1); request_line_length = request_line_length - idx_of_first_non_white_space_char + 1; end; p_index = index; return; end; end; end; unrecognized_request: proc; call ioa_$ioa_switch (default_iocb, "audit editor: Unrecognized request. ^a", substr (request_line, 1, request_line_length)); request_line_length = 0; request_line = ""; p_index = 0; end; end; decode_address: proc (p_code); dcl (code, p_code) fixed bin (35); dcl (number, non_number_index) fixed bin; dcl forward bit (1); dcl ch char (1); dcl have_begin_position bit (1); dcl match_string char (256) varying; dcl continue bit (1); dcl (abs_addr, add_addr, subtract_addr) bit (1); dcl 1 new_current_position like position_template; dcl 1 new_begin_position like position_template; dcl 1 new_end_position like position_template; if index ("0123456789/<$,+-", substr (request_line, 1, 1)) = 0 then do; p_code = 1; return; end; forward = "1"b; abs_addr = "1"b; add_addr = "0"b; subtract_addr = "0"b; have_begin_position = "0"b; continue = "1"b; new_current_position = current_position; do while (request_line_length > 0 & continue); substr (request_line, 1, length (ltrim (request_line))) = ltrim (request_line); request_line_length = length (ltrim (request_line)); /* Find position in request_line of leftmost non-numeric character. */ non_number_index = verify (request_line, "0123456789"); if non_number_index > 1 then do; /* Convert the character representation of the number tofixed bin. */ number = bin (substr (request_line, 1, non_number_index - 1)); substr (request_line, 1, request_line_length - non_number_index + 1) = substr (request_line, non_number_index); request_line_length = request_line_length - non_number_index + 1; code = 0; call audit_file_position_$move_number (addr (new_current_position), abs_addr, add_addr, subtract_addr, number, addr (position_info), code); if code ^= 0 then if code = error_table_$end_of_info then code = 0; else do; request_line_length = 0; request_line = ""; p_code = code; return; end; end; ch = substr (request_line, 1, 1); /* Process the next, and necessarily non-numeric, item on the request_line. */ if ch = "/" then do; /* Beginning of regular expression. */ call get_string (match_string, "1"b, code); if code ^= 0 then do; p_code = code; return; end; if forward then call audit_file_position_$forward_search (addr (new_current_position), match_string, addr (position_info), code); else call audit_file_position_$backward_search (addr (new_current_position), match_string, addr (position_info), code); if code ^= 0 then do; p_code = code; call ioa_$ioa_switch (default_iocb, "Search failed. ^a", match_string); request_line_length = 0; request_line = ""; return; end; forward = "1"b; abs_addr = "0"b; end; else if ch = "<" then do; forward = "0"b; substr (request_line, 1, request_line_length - 1) = substr (request_line, 2); request_line_length = request_line_length - 1; end; else if ch = "$" then if ^abs_addr then do; call ioa_$ioa_switch (default_iocb, "Syntax error in address."); request_line_length = 0; request_line = ""; p_code = 1; return; end; else do; call audit_file_position_$last (addr (new_current_position), addr (position_info), code); abs_addr = "0"b; substr (request_line, 1, request_line_length - 1) = substr (request_line, 2); request_line_length = request_line_length - 1; end; else if ch = "," | ch = ";" then if have_begin_position then do; call ioa_$ioa_switch (default_iocb, "Syntax error in address."); request_line_length = 0; request_line = ""; p_code = 1; return; end; else do; new_begin_position = new_current_position; if ch = "," then new_current_position = current_position; have_begin_position = "1"b; substr (request_line, 1, request_line_length - 1) = substr (request_line, 2); request_line_length = request_line_length - 1; abs_addr = "1"b; end; else if ch = "+" then do; abs_addr = "0"b; subtract_addr = "0"b; add_addr = "1"b; substr (request_line, 1, request_line_length - 1) = substr (request_line, 2); request_line_length = request_line_length - 1; end; else if ch = "-" then do; abs_addr = "0"b; add_addr = "0"b; subtract_addr = "1"b; substr (request_line, 1, request_line_length - 1) = substr (request_line, 2); request_line_length = request_line_length - 1; end; else do; continue = "0"b; end; end; new_end_position = new_current_position; if ^have_begin_position then new_begin_position = new_current_position; begin_position = new_begin_position; current_position = new_current_position; end_position = new_end_position; call replace_buffer_with_entry (current_position); p_code = 0; end; get_string: proc (p_string, p_beginning_delim, p_code); dcl (code, p_code) fixed bin (35); dcl p_string char (*) varying; dcl str char (512) varying; dcl p_beginning_delim bit (1); dcl search_string char (2); dcl search_index fixed bin; if p_beginning_delim then do; /* The string is supposed to begin with a delimiter, so get it. */ string_delimiter = substr (request_line, 1, 1); substr (request_line, 1, request_line_length - 1) = substr (request_line, 2); request_line_length = request_line_length - 1; end; code = 2; str = ""; search_string = "\" || string_delimiter; do while (request_line_length > 0 & code = 2); search_index = search (request_line, search_string); if search_index = 0 then call missing_delim; else if substr (request_line, search_index, 1) = string_delimiter then call add_rest_of_str; else if search_index = request_line_length then call missing_delim; else if substr (request_line, search_index + 1, 1) ^= "c" then call add_char_to_str; else if search_index + 2 = request_line_length then do; str = str || substr (request_line, 1, search_index - 1) || substr (request_line, search_index + 2, 1); if blk.current_flags.use_editor_prompt then call put_prompt; call iox_$get_line (default_iocb, request_line_ptr, max_request_line_length, request_line_length, code); if code = 0 then code = 2; end; else if substr (request_line, search_index + 2, 1) = string_delimiter then do; str = str || substr (request_line, 1, search_index - 1) || string_delimiter; substr (request_line, 1, request_line_length - (search_index + 2)) = substr (request_line, search_index + 3); request_line_length = request_line_length - (search_index + 2); end; else call add_char_to_str; end; if code = 2 then call missing_delim; p_code = code; p_string = str; return; missing_delim: proc; call ioa_$ioa_switch (default_iocb, "Missing delimiter. ^a", string_delimiter); request_line_length = 0; request_line = ""; code = error_table_$no_stmt_delim; str = ""; end; add_rest_of_str: proc; str = str || substr (request_line, 1, search_index - 1); substr (request_line, 1, request_line_length - search_index) = substr (request_line, search_index + 1); request_line_length = request_line_length - search_index; code = 0; end; add_char_to_str: proc; str = str || substr (request_line, 1, search_index); substr (request_line, 1, request_line_length - search_index) = substr (request_line, search_index + 1); request_line_length = request_line_length - search_index; end; end; replace_buffer_with_entry: proc (position); dcl 1 position like position_template; edit_buffer_length = position.aep -> audit_entry.entry_length; edit_buffer = substr (position.aep -> audit_entry.string, 1, position.aep -> audit_entry.entry_length); end; finish: proc; if p_code ^= 0 then do; p_actual_len = 0; param_buffer = ""; end; else if edit_buffer_length > p_buff_len then do; p_buff_ptr = blk.temp_seg_ptr; blk.work_space = p_buff_ptr; blk.work_space_len = edit_buffer_length; p_buff_len = sys_info$max_seg_size * 4; p_actual_len = edit_buffer_length; param_buffer = edit_buffer; end; else do; p_actual_len = edit_buffer_length; param_buffer = edit_buffer; end; if allocation (con_last_return_line) > level then free con_last_return_line; static_level = level - 1; con_last_return_line.string = aut_last_return_line.string; con_last_return_line.not_in_string = aut_last_return_line.not_in_string; call release_temp_segments_ ("audit_editor", temp_seg_ptr, code); if code ^= 0 then p_code = code; end; /* Include */ %include iocbx; %include audit_position; %include audit_entry; %include audit_block; %include audit_file_header; end;  audit_file_position_.pl1 09/15/88 1342.7rew 09/15/88 1341.2 267516 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(88-08-02,TLNguyen), approve(88-08-02,MCR7939), audit(88-09-14,Parisek), install(88-09-15,MR12.2-1110): a. Return error_table_$bad_file when the audit file contains gargage or nothing other than the header. b. Remove the external entry named find_valid_entry because pcref shows it has no caller and is virtually useless anyway. END HISTORY COMMENTS */ /* format: style2,ind3 */ audit_file_position_: proc; return; /* Not a valid entry. */ /* The entries in this procedure are all of the entries used for getting around in the audit file. The position_info structure is used to specify various things about the state of the audit file which some of theses procedures need to know. The entries are: move_number - move a specified number of entries either relative to the current position or from the beginning of the file. move_time - move to a specified time, relative to the current entry or an absolute time. forward_search - search forward through the audit file for an entry which contains a match for the specified regular expression (qedx style). backward_search - search backward through the audit file for and entry which contains a match for the specified regular expression. next - move to the next entry. previous - move to the previous entry. first - move to the first entry in the file. last - move to the last entry in the file. count_last - count to the last entry in the file. Unlike "last", this entry sets the entry_number in the position structure. set_count - set the count in the position structure to be the count up to the current entry, given the class id of the current entry. The "any entry" flag in the position info structure is ignored by this entry. 12/08/78 Written by Lindsey L. Spratt Modified: 12/08/79 by Lindsey Spratt: Add the count_last and set_count entries. 10/26/80 by Lindsey Spratt: Change spurious error code incompatible_operations to be "inconsistent". Changed set_count to set the class_identifier in the position structure to "" if the "any entry" bit is on in the position_info structure. 06/02/82 by Lindsey Spratt: Change go_to_first and go_to_last internal procedures to set the component_max_char_index correctly when the audit file is circular. Also, changed "move_number" from being a synonym label for audit_file_position_ to being a separate entrypoint label. 06/03/82 by Lindsey Spratt: Fixed bug in setting of last entry position when the file is circular. 06/04/82 by Lindsey Spratt: Fixed problem in go_to_previous_entry which was generating a size or subscriptrange error. msf_manager_$get_ptr returns the bit count of the component when the component was first initiated for the "current" opening of the MSF, not the current bit count as one might expect. The fix is to do an explicit hcs_$status_mins to determine the bit count. 06/08/82 by Lindsey Spratt: Fixed go_to_last to behave correctly when the position_info.audit_index = 0, meaning the "last" entry is at the end of the "previous" component. This comes up when updating the metering info is being done by audit_ (in insert_line) and the entry being inserted is to large to fit in the current component, hence the new entry is being placed at index 0 of the "next" component (which is now the current component) and the last entry is at the end of the previous component. 10/13/82 by Lindsey Spratt: Added limits to all loops. The limit is somewhat arbitrarily set to by assuming that an audit file won't have more than 1000 components, each of 255 pages, each page having no more than 128 audit entries. These loop limits are to prevent any infinite looping, no matter how damaged the audit file may be. Added explicit subscriptrange condition enabling for setting the position.aep pointer by indexing into file_char_array by position.char_index. 03/16/83 by Lindsey Spratt: Updated the search_file_ entry declaration to fix a size condition. */ dcl (p_position_ptr, p_position_info_ptr) ptr; dcl (time, p_time) fixed bin (71); dcl 1 p_position based (p_position_ptr) like position_template; dcl 1 position like position_template; dcl 1 position_info based (p_position_info_ptr) like position_info_template; dcl error_table_$bad_file fixed bin (35) ext static; dcl error_table_$empty_file fixed bin (35) ext; dcl error_table_$end_of_info fixed bin (35) ext; dcl error_table_$nomatch fixed bin (35) ext; dcl (p_abs, p_add, p_subtract) bit (1); dcl add bit (1); dcl (p_number, number) fixed bin; dcl entry_idx fixed bin (35); dcl entry_number fixed bin; dcl (code, p_code) fixed bin (35); dcl type fixed bin (2); dcl MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE init (3.264e7) /* 1000 components * 255 pages/component * 128 entries/page */ fixed bin (35) internal static options (constant); dcl error_table_$inconsistent fixed bin (35) ext; dcl search_file_ entry (ptr, fixed bin (21), fixed bin (21), ptr, fixed bin (21), fixed bin (21), fixed bin (21), fixed bin (21), fixed bin (35)); dcl hcs_$status_mins entry (ptr, fixed bin (2), fixed bin (24), fixed bin (35)); dcl msf_manager_$get_ptr entry (ptr, fixed bin, bit (1), ptr, fixed bin (24), fixed bin (35)); /* Builtin */ dcl (abs, addr, addrel, bin, currentsize, divide, length, mod, size, substr) builtin; move_number: entry (p_position_ptr, p_abs, p_add, p_subtract, p_number, p_position_info_ptr, p_code); position = p_position; p_code, code = 0; /* An exclusive or is done over the input switches to check that one and only one is "1"b and the other two are "0"b. */ if (bin (p_abs) + bin (p_add) + bin (p_subtract)) ^= 1 then do; p_code = error_table_$inconsistent; return; end; else if p_abs then do; if (position.entry_number = 0 | position.search_tag ^= position_info.default_search_tag) then do; call go_to_first_entry (position, code); number = p_number - 1; add = "1"b; end; else do; number = p_number - position.entry_number; if number < 0 then do; add = "0"b; number = abs (number); end; else add = "1"b; end; end; else do; add = p_add; number = p_number; end; if add then do entry_number = 1 to number while (code = 0); call go_to_next_entry (position, code); end; else do entry_number = 1 to number while (code = 0); call go_to_previous_entry (position, code); end; if code ^= 0 then if code ^= error_table_$end_of_info then do; p_code = code; return; end; p_code = code; p_position = position; return; move_time: entry (p_position_ptr, p_abs, p_add, p_subtract, p_time, p_position_info_ptr, p_code); position = p_position; p_code, code = 0; if (bin (p_abs) + bin (p_add) + bin (p_subtract)) ^= 1 then do; p_code = error_table_$inconsistent; return; end; else if p_abs then do; call go_to_first_entry (position, code); time = p_time; add = "1"b; end; else if p_add then do; time = position.aep -> audit_entry.time + p_time; add = "1"b; end; else do; time = position.aep -> audit_entry.time - p_time; if time < 0 then time = 0; add = "0"b; end; if add then do entry_idx = 1 to MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE while (position.aep -> audit_entry.time < time & code = 0); call go_to_next_entry (position, code); end; else do entry_idx = 1 to MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE while (position.aep -> audit_entry.time > time & code = 0); call go_to_previous_entry (position, code); end; if entry_idx > MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE then code = error_table_$bad_file; if code ^= 0 then if code ^= error_table_$end_of_info then do; p_code = code; return; end; p_code = code; p_position = position; return; forward_search: entry (p_position_ptr, p_match_str, p_position_info_ptr, p_code); dcl (p_match_str, match_str) char (256) varying; dcl (forward, continue) bit (1) init ("1"b); dcl (match_begin, match_end) fixed bin(21); dcl do_first_entry bit (1); goto START; backward_search: entry (p_position_ptr, p_match_str, p_position_info_ptr, p_code); forward = "0"b; START: p_code, code = 0; position = p_position; match_str = p_match_str; do_first_entry = "1"b; do entry_idx = 1 to MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE while ((continue & (position.aep ^= p_position.aep)) | do_first_entry); do_first_entry = "0"b; if forward then call go_to_next_entry (position, code); else call go_to_previous_entry (position, code); if code ^= 0 then if code = error_table_$end_of_info then do; code = 0; if forward then call go_to_first_entry (position, code); else call go_to_last_entry (position, code); if code ^= 0 then continue = "0"b; end; else do; p_code = code; return; end; call search_file_ (addrel (addr (match_str), 1), 1, length (match_str), addr (position.aep -> audit_entry.string), 1, (position.aep -> audit_entry.entry_length), match_begin, match_end, code); if code ^= 1 then continue = "0"b; else match_str = ""; end; if entry_idx > MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE then code = error_table_$bad_file; if code = 0 then p_position = position; else if code = 1 then code = error_table_$nomatch; p_code = code; return; next: entry (p_position_ptr, p_position_info_ptr, p_code); p_code, code = 0; call go_to_next_entry (p_position, p_code); return; previous: entry (p_position_ptr, p_position_info_ptr, p_code); p_code, code = 0; call go_to_previous_entry (p_position, p_code); return; first: entry (p_position_ptr, p_position_info_ptr, p_code); p_code, code = 0; call go_to_first_entry (p_position, p_code); return; last: entry (p_position_ptr, p_position_info_ptr, p_code); p_code, code = 0; call go_to_last_entry (p_position, p_code); return; count_last: entry (p_position_ptr, p_position_info_ptr, p_code); p_code, code = 0; call go_to_first_entry (p_position, p_code); if p_code ^= 0 then return; do entry_idx = 1 to MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE while (p_code = 0); call go_to_next_entry (p_position, p_code); end; if entry_idx > MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE then p_code = error_table_$bad_file; if p_code = error_table_$end_of_info then p_code = 0; return; set_count: entry (p_position_ptr, p_position_info_ptr, p_code); p_code, code = 0; position = p_position; call go_to_first_entry (position, p_code); if p_code ^= 0 then return; do entry_idx = 1 to MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE while (position.aep ^= p_position.aep); call go_to_next_entry (position, p_code); end; if entry_idx > MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE then do; p_code = error_table_$bad_file; return; end; p_position = position; if position_info.any_tag then p_position.search_tag = ""; return; %page; go_to_next_entry: proc (p_position, p_code); dcl entry_idx fixed bin (35); dcl 1 p_position like position_template; dcl 1 position like position_template; dcl 1 last_position like position_template; dcl (code, p_code) fixed bin (35); dcl bit_count24 fixed bin (24); dcl file_char_array (0:position.component_max_char_index) char (1) based (position.component_ptr); dcl tag_match bit (1); p_code, code = 0; tag_match = "0"b; position = p_position; last_position = p_position; call go_to_last_entry (last_position, code); if (position.component_number = last_position.component_number) & (position.char_index = last_position.char_index) then do; p_code = error_table_$end_of_info; return; end; do entry_idx = 1 to MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE while ((position.component_number ^= last_position.component_number | position.char_index ^= last_position.char_index) & ^tag_match); position.char_index = position.char_index + (currentsize (position.aep -> audit_entry) * 4) + 7 - mod ((currentsize (position.aep -> audit_entry) * 4) + 7, 8); if position.char_index >= position.component_max_char_index then if position.component_number = position_info.max_component then do; if position_info.max_component ^= 0 then do; position.component_number = 0; position.component_ptr = position_info.audit_ptr; if position_info.current_component = 0 then position.component_max_char_index = position_info.audit_index; else do; call hcs_$status_mins (position.component_ptr, type, bit_count24, code); if code ^= 0 then do; p_code = code; return; end; call hcs_$status_mins (position.component_ptr, type, bit_count24, code); if code ^= 0 then do; p_code = code; return; end; position.component_max_char_index = divide (bit_count24, 9, 24, 0); position.component_max_char_index = position.component_max_char_index + 7 - mod (position.component_max_char_index + 7, 8); end; end; else position.component_max_char_index = position_info.audit_index - 1; position.char_index = (size (audit_file_header) * 4) + 7 - mod ((size (audit_file_header) * 4) + 7, 8); end; else do; position.component_number = position.component_number + 1; if position.component_number = position_info.current_component then do; position.char_index = 0; position.component_ptr = position_info.audit_ptr; position.component_max_char_index = position_info.audit_index - 1; end; else if position.component_number = position_info.max_component then do; position.char_index = 0; call msf_manager_$get_ptr (position_info.audit_fcb, position.component_number, "1"b, position.component_ptr, bit_count24, code); position.component_max_char_index = position_info.max_index; end; else do; position.char_index = 0; call msf_manager_$get_ptr (position_info.audit_fcb, position.component_number, "1"b, position.component_ptr, bit_count24, code); if code ^= 0 then do; p_code = code; return; end; position.component_max_char_index = divide (bit_count24, 9, 24, 0); position.component_max_char_index = position.component_max_char_index + 7 - mod (position.component_max_char_index + 7, 8); end; end; (subscriptrange): position.aep = addr (file_char_array (position.char_index)); call validate_entry (position, p_code); if p_code ^= 0 then return; if position_info.any_tag then tag_match = "1"b; else call set_tag_match (position.aep, position_info.default_search_tag, tag_match); end; if entry_idx > MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE then do; p_code = error_table_$bad_file; return; end; if tag_match then do; if (position.entry_number ^= 0 & position.search_tag = position_info.default_search_tag) then position.entry_number = position.entry_number + 1; else do; position.entry_number = 0; position.search_tag = ""; end; p_position = position; p_code = 0; end; else p_code = error_table_$end_of_info; end go_to_next_entry; %page; go_to_previous_entry: proc (p_position, p_code); dcl tag_match bit (1); dcl entry_idx fixed bin (35); dcl 1 position like position_template; dcl 1 p_position like position_template; dcl (code, p_code) fixed bin (35); dcl bit_count24 fixed bin (24); dcl file_char_array (0:position.component_max_char_index) char (1) based (position.component_ptr); p_code, code = 0; tag_match = "0"b; position = p_position; if (position.component_number = position_info.begin_component) & (position.char_index = position_info.begin_index) then do; p_code = error_table_$end_of_info; return; end; do entry_idx = 1 to MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE while ((position.component_number ^= position_info.begin_component | position.char_index ^= position_info.begin_index) & ^tag_match); position.char_index = position.char_index - (position.aep -> audit_entry.last_entry_length + 7 - mod (position.aep -> audit_entry.last_entry_length + 7, 8) + (size (audit_entry) * 4)); /* Check if the char_index has crossed a component boundary. If so reset char_index component_number, component_ptr, and component_max_char_index appropriately. */ if position.component_number = 0 & position.char_index < ((size (audit_file_header) * 4) + 7 - mod ((size (audit_file_header) * 4) + 7, 8)) /* The beginning of the zero-th component is after the header. */ then do; if position_info.file_limit then do; if position_info.max_component ^= position.component_number then do; position.component_number = position_info.max_component; call msf_manager_$get_ptr (position_info.audit_fcb, position.component_number, "1"b, position.component_ptr, bit_count24, code); if code ^= 0 then do; p_code = code; return; end; end; call hcs_$status_mins (position.component_ptr, type, bit_count24, code); if code ^= 0 then do; p_code = code; return; end; position.component_max_char_index = divide (bit_count24, 9, 24, 0); position.component_max_char_index = position.component_max_char_index + 7 - mod (position.component_max_char_index + 7, 8); end; else do; position.component_number = position_info.current_component; position.component_max_char_index = position_info.audit_index - 1; position.component_ptr = position_info.audit_ptr; end; position.char_index = position.component_max_char_index - (position.aep -> audit_entry.last_entry_length + 7 - mod (position.aep -> audit_entry.last_entry_length + 7, 8) + (size (audit_entry) * 4)); end; else if position.char_index < 0 then do; position.component_number = position.component_number - 1; call msf_manager_$get_ptr (position_info.audit_fcb, position.component_number, "1"b, position.component_ptr, bit_count24, code); if code ^= 0 then do; p_code = code; return; end; call hcs_$status_mins (position.component_ptr, type, bit_count24, code); if code ^= 0 then do; p_code = code; return; end; position.component_max_char_index = divide (bit_count24, 9, 24, 0); position.component_max_char_index = position.component_max_char_index + 7 - mod (position.component_max_char_index + 7, 8); position.char_index = position.component_max_char_index - (position.aep -> audit_entry.last_entry_length + 7 - mod (position.aep -> audit_entry.last_entry_length + 7, 8) + (size (audit_entry) * 4)); end; (subscriptrange): position.aep = addr (file_char_array (position.char_index)); call validate_entry (position, p_code); if p_code ^= 0 then return; if position_info.any_tag then tag_match = "1"b; else call set_tag_match (position.aep, position_info.default_search_tag, tag_match); end; if entry_idx > MAXIMUM_NUMBER_OF_ENTRIES_POSSIBLE then do; p_code = error_table_$bad_file; return; end; if tag_match then do; if (position.entry_number ^= 0 & position.search_tag = position_info.default_search_tag) then position.entry_number = position.entry_number - 1; else do; position.entry_number = 0; position.search_tag = ""; end; p_position = position; p_code = 0; end; else p_code = error_table_$end_of_info; end go_to_previous_entry; %page; go_to_last_entry: proc (p_position, p_code); dcl 1 p_position like position_template; dcl 1 position like position_template; dcl file_char_array (0:position.component_max_char_index) char (1) based (position.component_ptr); dcl bit_count24 fixed bin (24); dcl tag_match bit (1); dcl (p_code, code) fixed bin (35); /* The last_entry_length is initialized by audit_attach (called by the command attach_audit) to the value impossible_audit_entry_length. This value is declared in the audit_entry.incl.pl1 include file. */ p_code, code = 0; if position_info.last_entry_length = impossible_audit_entry_length then do; p_code = error_table_$empty_file; return; end; if position_info.audit_index = (size (audit_file_header) * 4) + 7 - mod (size (audit_file_header) * 4 + 7, 8) & position_info.file_limit then do; position.component_number = position_info.max_component; call msf_manager_$get_ptr (position_info.audit_fcb, position.component_number, "1"b, position.component_ptr, bit_count24, code); if code ^= 0 then do; p_code = code; return; end; end; else if position_info.audit_index = 0 then do; position.component_number = position_info.current_component - 1; call msf_manager_$get_ptr (position_info.audit_fcb, position.component_number, "1"b, position.component_ptr, bit_count24, code); if code ^= 0 then do; p_code = code; return; end; end; else do; position.component_number = position_info.current_component; position.component_ptr = position_info.audit_ptr; end; if (position_info.audit_index = 0 | (position_info.file_limit & (position_info.begin_component > position_info.current_component | (position_info.begin_component = position_info.current_component & position_info.begin_index > position_info.audit_index)))) then do; call hcs_$status_mins (position.component_ptr, type, bit_count24, code); if code ^= 0 then do; p_code = code; return; end; position.component_max_char_index = divide (bit_count24, 9, 24, 0); position.component_max_char_index = position.component_max_char_index + 7 - mod (position.component_max_char_index + 7, 8); end; else position.component_max_char_index = position_info.audit_index; if (position_info.audit_index = 0 | (position_info.file_limit & position_info.audit_index = (size (audit_file_header) * 4) + 7 - mod (size (audit_file_header) * 4 + 7, 8))) then position.char_index = position.component_max_char_index - (position_info.last_entry_length + 7 - mod (position_info.last_entry_length + 7, 8) + audit_entry_header_length); else position.char_index = position_info.audit_index - (position_info.last_entry_length + 7 - mod (position_info.last_entry_length + 7, 8) + audit_entry_header_length); (subscriptrange): position.aep = addr (file_char_array (position.char_index)); position.entry_number = 0; position.search_tag = ""; call validate_entry (position, p_code); if p_code ^= 0 then return; if position_info.any_tag then tag_match = "1"b; else call set_tag_match (position.aep, position_info.default_search_tag, tag_match); if ^tag_match then do; call go_to_previous_entry (position, code); if code ^= 0 then do; p_code = code; return; end; end; p_code = 0; p_position = position; end go_to_last_entry; %page; go_to_first_entry: proc (p_position, p_code); dcl 1 p_position like position_template; dcl 1 position like position_template; dcl (p_code, code) fixed bin (35); dcl tag_match bit (1); dcl bit_count24 fixed bin (24); dcl file_char_array (0:position.component_max_char_index) char (1) based (position.component_ptr); p_code, code = 0; position = p_position; if position_info.last_entry_length < 0 then do; p_code = error_table_$empty_file; return; end; if position.component_number ^= position_info.begin_component then do; position.component_number = position_info.begin_component; position.char_index = position_info.begin_index; if position_info.current_component = position_info.begin_component & position_info.begin_index < position_info.audit_index then position.component_ptr = position_info.audit_ptr; else do; call msf_manager_$get_ptr (position_info.audit_fcb, position.component_number, "1"b, position.component_ptr, bit_count24, code); if code ^= 0 then do; p_code = code; return; end; end; end; else position.char_index = position_info.begin_index; if (position_info.file_limit & (position_info.begin_component > position_info.current_component | (position_info.begin_component = 0 & position_info.begin_index >= position_info.audit_index))) | (^position_info.file_limit & position_info.current_component > 0) then do; call hcs_$status_mins (position.component_ptr, type, bit_count24, code); if code ^= 0 then do; p_code = code; return; end; position.component_max_char_index = divide (bit_count24, 9, 24, 0); position.component_max_char_index = position.component_max_char_index + 7 - mod (position.component_max_char_index + 7, 8); end; else position.component_max_char_index = position_info.audit_index; (subscriptrange): position.aep = addr (file_char_array (position.char_index)); call validate_entry (position, p_code); if p_code ^= 0 then return; if position_info.any_tag then tag_match = "1"b; else call set_tag_match (position.aep, position_info.default_search_tag, tag_match); if ^tag_match then do; call go_to_next_entry (position, p_code); if p_code ^= 0 then return; end; position.entry_number = 1; position.search_tag = position_info.default_search_tag; p_position = position; p_code = 0; end go_to_first_entry; %page; set_tag_match: proc (p_ptr, p_search_tag, p_tag_match); dcl p_ptr ptr; dcl p_search_tag char (32) varying; dcl p_tag_match bit (1); p_tag_match = (substr (p_ptr -> audit_entry.tag, 1, length (p_search_tag)) = p_search_tag); end set_tag_match; validate_entry: proc (p_position, p_code); /* parameters */ dcl 1 p_position like position_template; /* input */ dcl p_code fixed bin (35); /* input/output */ /* begin coding */ p_code = 0; if p_position.aep -> audit_entry.tag = "" then p_code = error_table_$bad_file; return; end validate_entry; %page; %include audit_entry; %include audit_position; %include audit_file_header; end audit_file_position_;  detach_audit.pl1 12/09/83 1014.2rew 12/09/83 0951.9 34749 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /* format: style2,ind3 */ detach_audit: dta: proc; /* This module turns off auditing for the calling process. The single parameter is the switchname of the switch attached via the audit_ module that is to be detached. Modified: 11/12/81 by Lindsey Spratt: changed the variable "whoami" to "MYNAME", making it an internal constant as well. 10/13/82 by Lindsey Spratt: Changed to destroy the new_iocb, which is no longer needed after the move_attach. Also, removed the set_safety_sw, as this is done by iox_$close. Changed to use error_table_$badopt when too many args are given, rather than a 0 error code. */ /* Automatic */ dcl nargs fixed bin; dcl tc fixed bin; dcl tp ptr; dcl blkptr ptr; dcl old_iocb ptr; dcl new_iocb ptr; dcl code fixed bin (35); /* Based */ dcl targ char (tc) based (tp); /* Constant */ dcl MYNAME char (12) init ("detach_audit") internal static options (constant); /* Entries */ dcl audit_$audit_close entry; dcl cu_$arg_count entry (fixed bin); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl ioa_$ioa_switch entry options (variable); dcl iox_$look_iocb entry (char (*), ptr, fixed bin (35)); dcl iox_$move_attach entry (ptr, ptr, fixed bin (35)); dcl iox_$detach_iocb entry (ptr, fixed bin (35)); dcl iox_$destroy_iocb entry (ptr, fixed bin (35)); dcl iox_$close entry (ptr, fixed bin (35)); dcl com_err_ entry options (variable); /* External */ dcl error_table_$badopt fixed bin (35) ext; call cu_$arg_count (nargs); if nargs > 1 then do; call com_err_ (error_table_$badopt, MYNAME, "Too many arguments.^/Usage: detach_audit {switchname}"); return; end; else if nargs = 1 then call cu_$arg_ptr (1, tp, tc, code); else do; tc = 8; alloc targ; targ = "user_i/o"; end; call iox_$look_iocb ((targ), old_iocb, code); if code ^= 0 then do; call com_err_ (code, MYNAME, "while looking for ^a", targ); return; end; if old_iocb -> iocb.close ^= audit_$audit_close then do; call com_err_ (0, MYNAME, "^a not attached via audit_", targ); return; end; blkptr = old_iocb -> iocb.attach_data_ptr; new_iocb = blkptr -> blk.auditing_iocb; call iox_$close (old_iocb, code); if code ^= 0 then do; call com_err_ (code, MYNAME, "while closing ^a switch", targ); return; end; call iox_$detach_iocb (old_iocb, code); if code ^= 0 then do; call ioa_$ioa_switch (new_iocb, "Couldn't detach ^a", targ); return; end; call iox_$move_attach (new_iocb, old_iocb, code); if code ^= 0 then do; call com_err_ (code, MYNAME, "while moving attachment from ^a to ^a", new_iocb -> iocb.name, targ); return; end; call iox_$destroy_iocb (new_iocb, code); if code ^= 0 then do; call com_err_ (code, MYNAME, "Unable to destroy the auditing iocb. Auditing was successfully detached for switch ""^a"", however.", targ); end; return; /* Include */ %include iocb; %include audit_block; end;  display_audit_file.pl1 09/26/88 1315.4rew 09/26/88 1313.6 430173 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1988 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(88-08-02,TLNguyen), approve(88-08-02,MCR7939), audit(88-09-14,Parisek), install(88-09-15,MR12.2-1110): The display_audit_file command will display an appropriate error message when a nonstandard pathname is specified for -ouput_file. 2) change(88-09-23,TLNguyen), approve(88-09-23,MCR7939), audit(88-09-23,Parisek), install(88-09-26,MR12.2-1120): Move lines of code such that expand_pathname_ is called first to get the output_file_dir and output_file_entry. Then call check_star_name_ given the output_file_entry, whose length is less or equal to 32 chars. END HISTORY COMMENTS */ /* format: style2,ind3 */ display_audit_file: daf: proc; /* This command produces formatted output from an audit file produced by the audit_ I/O module. The entries of the audit file which are displayed are chosen by determining the lowest and highest numbered entries which may be displayed as indicated by the positioning control arguments (-from, -to, -next, -last); then ascertaining which entries within this range have the correct string and class characteristics (as indicated by the -match, -exclude, and -class control arguments). The format of the output is determined by the -reverse, -line_length, -metering, -entry_numbers, and -class_identifiers control arguments. Additional format control is provided by the -append_nl, -no_append_nl, -insert_nl, and -no_insert_nl control arguments. The output may be directed to an output file by the -output_file control argument. Written 1/1/79 by Lindsey L. Spratt Modified: 11/26/79 by Lindsey Spratt: Use myname variable in calls to com_err_, to correct error reporting of duplicate args. 12/12/79 by Lindsey Spratt: Add -insert_nl, -no_insert_nl, -append_nl, -no_append_nl. Also fixed a bug in wrap_line on printing long lines which don't end in a new line. 05/01/80 by Lindsey Spratt: Spaces were being inserted at the beginning of each line of output, this was removed for "headerless" and "unwrapped" display. The ".audit" suffix is now assumed if not supplied. 10/27/80 by Lindsey Spratt: The -output_file control argument was added. The various ioa_ calls were changed to ioa_$ioa_switch calls to use the newly added output_iocb_ptr. The simplest nnl output case was modified to prevent ioa_ from stripping trailing whitespace. 09/09/81 by Lindsey Spratt: Added checks for non-zero codes after the attach and open calls for setting up the output file. This fixes bug 22. Also, made the argument to -class case insensitive and added some code to validate that the argument does identify a class, bug 20. Improved the unrecognized control argument error message, bug 18. 11/12/81 by Lindsey Spratt: Fixed spelling in an error message. Changed class validation to use an internal static constant array of valid classes, VALID_AUDIT_CLASS. 10/13/82 by Lindsey Spratt: Fixed bug where all of the "strings" were being placed in one long list, as opposed to separate lists for the -match, -exclude and -class control args. Added check to prevent the specification of the audit file as the output file. 10/15/82 by Lindsey Spratt: Added check of position entry number arguments to prevent size conditions. Added -str as a short name for -string. Added check for arguments following control arguments which require them. Changed -fm to produce an error message if the position specified is beyond the end of the file, rather than just selecting the last line of the file. */ /* Automatic */ dcl current_component_string pic "zzzzzzzzzz9"; dcl (match_begin, match_end) fixed bin; dcl switchname char (32); dcl output_file_entry char (32) init (""); dcl output_file_dir char (168) init (""); dcl pathname char (168) varying; dcl arg_number fixed bin (35); dcl bit_count fixed bin (24); dcl 1 position_info like position_info_template; dcl 1 position like position_template; dcl 1 begin_position like position_template; dcl 1 end_position like position_template; dcl (iocb_ptr, area_ptr, arg_ptr, old_string_list_ptr, chain_ptr, string_list_ptr, match_string_list_ptr, output_file_ptr, exclude_string_list_ptr, blkptr, match_class_string_list_ptr) ptr init (null); dcl output_file_attach_description char (256) varying; dcl output_iocb_ptr ptr; dcl code fixed bin (35); dcl arg_len fixed bin; dcl (nargs, argno, output_line_length) fixed bin; dcl class_idx fixed bin; dcl starname_type fixed bin (2); dcl (have_begin, have_path, have_end, do_last_position, continuation, want_begin_addr, want_end_addr, want_line_length, want_switchname, want_output_file, looking_for_string, found_string, string_sw, have_switchname, have_displayed, display, control_argument, reverse, match, exclude, class, processing_class_control_argument, class_identifiers, entry_numbers, metering, leader, insert_nl, header, use_force_append_nl, use_force_insert_nl, force_insert_nl, force_append_nl, append_nl) bit (1) init ("0"b); dcl 1 begin_arg, 2 value char (32) varying, 2 value_is_string bit (1), 2 abs bit (1), 2 add bit (1), 2 subtract bit (1); dcl 1 end_arg like begin_arg; /* Based */ dcl arg based (arg_ptr) char (arg_len); dcl area area based (area_ptr); dcl 1 string_list based (string_list_ptr), 2 next ptr, 2 string char (128) varying; /* Builtin */ dcl addr builtin; dcl addrel builtin; dcl bin builtin; dcl dim builtin; dcl divide builtin; dcl fixed builtin; dcl hbound builtin; dcl index builtin; dcl length builtin; dcl mod builtin; dcl null builtin; dcl rtrim builtin; dcl substr builtin; dcl translate builtin; dcl verify builtin; /* Condition */ dcl cleanup condition; /* Controlled */ /* Entry */ dcl check_star_name_ entry (char (*), bit (36) aligned, fixed bin (2), fixed bin (35)); dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); dcl get_line_length_$switch entry (ptr, fixed bin (35)) returns (fixed bin (17)); dcl unique_chars_ entry (bit (*)) returns (char (15)); dcl get_system_free_area_ entry () returns (ptr); dcl audit_file_position_$next entry (ptr, ptr, fixed bin (35)); dcl audit_file_position_$forward_search entry (ptr, char (*) varying, ptr, fixed bin (35)); dcl audit_file_position_$backward_search entry (ptr, char (*) varying, ptr, fixed bin (35)); dcl msf_manager_$open entry (char (*), char (*), ptr, fixed bin (35)); dcl msf_manager_$get_ptr entry (ptr, fixed bin, bit (1), ptr, fixed bin (24), fixed bin (35)); dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl com_err_ entry options (variable); dcl ioa_$ioa_switch entry options (variable); dcl ioa_$ioa_switch_nnl entry options (variable); dcl ioa_$rsnnl entry options (variable); dcl audit_file_position_$move_number entry (ptr, bit (1), bit (1), bit (1), fixed bin, ptr, fixed bin (35)); dcl audit_file_position_$move_time entry (ptr, bit (1), bit (1), bit (1), fixed bin (71), ptr, fixed bin (35)); dcl audit_file_position_$previous entry (ptr, ptr, fixed bin (35)); dcl audit_file_position_$first entry (ptr, ptr, fixed bin (35)); dcl audit_file_position_$count_last entry (ptr, ptr, fixed bin (35)); dcl pathname_ entry (char (*), char (*)) returns (char (168)); dcl search_file_ entry (ptr, fixed bin, fixed bin, ptr, fixed bin, fixed bin, fixed bin, fixed bin, fixed bin (35)); dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); dcl expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35)); dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); dcl current_entry_number pic "zzzz9v"; /* External */ dcl ( error_table_$unimplemented_version, error_table_$noarg, error_table_$bad_arg, error_table_$nomatch, error_table_$end_of_info, error_table_$zero_length_seg, error_table_$badopt ) fixed bin (35) ext; /* Constant */ dcl myname char (18) internal static options (constant) init ("display_audit_file"); dcl NL char (1) internal static options (constant) init (" "); dcl UPPERCASE_LETTERS init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ") internal static options (constant) char (26); dcl LOWERCASE_LETTERS init ("abcdefghijklmnopqrstuvwxyz") internal static options (constant) char (26); dcl VALID_AUDIT_CLASS (10) init ("I", "IL", "IC", "O", "OC", "E", "EL", "T", "TM", "TC") char (2) varying internal static options (constant); header = "1"b; output_line_length = 0; old_string_list_ptr = null; area_ptr = get_system_free_area_ (); output_file_attach_description = ""; output_iocb_ptr = iox_$user_output; want_output_file = "0"b; want_switchname = "0"b; looking_for_string = "0"b; found_string = "0"b; want_begin_addr = "0"b; want_end_addr = "0"b; want_line_length = "0"b; have_path = "0"b; have_begin = "0"b; have_end = "0"b; have_switchname = "0"b; match = "0"b; exclude = "0"b; class = "0"b; reverse = "0"b; entry_numbers = "0"b; class_identifiers = "0"b; metering = "0"b; leader = "0"b; insert_nl = "0"b; append_nl = "0"b; force_append_nl = "0"b; use_force_append_nl = "0"b; force_insert_nl = "0"b; use_force_insert_nl = "0"b; on cleanup call finish; /* Process the argument list. */ call cu_$arg_count (nargs, code); if code ^= 0 then do; call com_err_ (code, myname); call finish; return; end; do argno = 1 to nargs; call cu_$arg_ptr (argno, arg_ptr, arg_len, code); if code ^= 0 then do; call com_err_ (code, myname); call finish; return; end; string_sw = "0"b; /* Determine whether the current arg is a control argument, or an argument. The -string arg sets arg to the next argument in the argument list and forces its interpretation as a non-control argument by turning control_argument off and forces its interpretation as a string by turning string_sw on. Only -from, -last, -to, -next care about the string_sw. */ if arg = "-string" | arg = "-str" then do; argno = argno + 1; control_argument = "0"b; call cu_$arg_ptr (argno, arg_ptr, arg_len, code); if code ^= 0 then do; call com_err_ (code, myname); call finish; return; end; string_sw = "1"b; end; else if substr (arg, 1, 1) = "-" then control_argument = "1"b; else control_argument = "0"b; if ^control_argument then if looking_for_string then do; /* Get string for -match, -exclude, -class. */ if old_string_list_ptr ^= null then old_string_list_ptr -> string_list.next = string_list_ptr; old_string_list_ptr = string_list_ptr; if processing_class_control_argument then do; string_list.string = translate (arg, UPPERCASE_LETTERS, LOWERCASE_LETTERS); do class_idx = 1 to hbound (VALID_AUDIT_CLASS, 1) while (string_list.string ^= VALID_AUDIT_CLASS (class_idx)); end; if class_idx > hbound (VALID_AUDIT_CLASS, 1) then do; call com_err_ (error_table_$badopt, myname, "^/^a is not a valid class specifier. Valid specifiers (any mixture of upper and lower case) are: ^v(^a, ^)and ^a.", string_list.string, dim (VALID_AUDIT_CLASS, 1) - 1, VALID_AUDIT_CLASS); return; end; end; else string_list.string = arg; found_string = "1"b; alloc string_list; string_list.next = null; string_list.string = ""; end; else if want_switchname /* Get switchname following -switch. */ then do; switchname = arg; have_switchname = "1"b; want_switchname = "0"b; end; else if want_begin_addr /* Get arg for -from or -last. */ then do; have_begin = "1"b; want_begin_addr = "0"b; begin_arg.value = arg; begin_arg.value_is_string = string_sw; end; else if want_end_addr /* Get arg for -to or -next. */ then do; have_end = "1"b; want_end_addr = "0"b; end_arg.value = arg; end_arg.value_is_string = string_sw; end; else if want_line_length /* Get line length following -line_length. */ then do; want_line_length = "0"b; output_line_length = bin (arg); insert_nl = "1"b; end; else if want_output_file /* Get path for output file. */ then do; call expand_pathname_ (arg, output_file_dir, output_file_entry, code); if code ^= 0 then do; call com_err_ (code, myname, "^/Unable to expand the pathname ""^a"".", arg); call finish; return; end; want_output_file = "0"b; /* validate an user 's entryname for -of */ call check_star_name_ (output_file_entry, (CHECK_STAR_REJECT_WILD), starname_type, code); if code ^= 0 then do; call com_err_ (code, myname, "^a", arg); return; end; /* good file name for -of */ output_file_attach_description = "vfile_ " || arg; call iox_$attach_name (unique_chars_ ("0"b) || ".daf", output_iocb_ptr, (output_file_attach_description), null, code); if code ^= 0 then do; call com_err_ (code, myname, "^/Unable to attach to the output file, ^a.", arg); return; end; call iox_$open (output_iocb_ptr, Stream_output, "0"b, code); if code ^= 0 then do; call com_err_ (code, myname, "^/Unable to open the output file, ^a.", arg); call iox_$detach_iocb (output_iocb_ptr, code); return; end; end; else if ^have_path /* Get path for audit file. */ then do; have_path = "1"b; call expand_pathname_$add_suffix (arg, "audit", position_info.dirname, position_info.ename, code); if code ^= 0 then do; call com_err_ (code, myname, "^a", arg); call finish; return; end; end; else do; call com_err_ (error_table_$badopt, myname, "^/^a is not a known control argument.", arg); call finish; return; end; else do; /* Following is the basic control argument processing. */ call check_for_unfinished_control_argument (code); if code ^= 0 then do; call finish; return; end; if looking_for_string then do; old_string_list_ptr = null; processing_class_control_argument = "0"b; looking_for_string = "0"b; found_string = "0"b; free string_list_ptr -> string_list; string_list_ptr = null; end; if arg = "-from" | arg = "-fm" /* -from */ then if have_begin then do; DUPARG: call com_err_ (error_table_$bad_arg, myname, "^a may only be specified once per use of the command.", arg); call finish; return; end; else do; want_begin_addr = "1"b; begin_arg.abs = "1"b; begin_arg.add = "0"b; begin_arg.subtract = "0"b; end; else if arg = "-to" /* -to */ then if have_end then goto DUPARG; else do; want_end_addr = "1"b; end_arg.abs = "1"b; end_arg.add = "0"b; end_arg.subtract = "0"b; end; else if arg = "-next" /* -next */ then if have_end then goto DUPARG; else do; want_end_addr = "1"b; end_arg.abs = "0"b; end_arg.add = "1"b; end_arg.subtract = "0"b; end; else if arg = "-last" /* -last */ then if have_begin then goto DUPARG; else do; want_begin_addr = "1"b; begin_arg.abs = "0"b; begin_arg.add = "0"b; begin_arg.subtract = "1"b; end; else if arg = "-match" /* -match */ then if match then goto DUPARG; else do; looking_for_string = "1"b; match = "1"b; found_string = "0"b; alloc string_list in (area); match_string_list_ptr = string_list_ptr; string_list.string = ""; string_list.next = null; end; else if arg = "-exclude" | arg = "-ex" /* -exclude */ then if exclude then goto DUPARG; else do; exclude = "1"b; looking_for_string = "1"b; found_string = "0"b; alloc string_list in (area); exclude_string_list_ptr = string_list_ptr; string_list.string = ""; string_list.next = null; end; else if arg = "-class" /* -class */ then if class then goto DUPARG; else do; processing_class_control_argument = "1"b; looking_for_string = "1"b; found_string = "0"b; class = "1"b; alloc string_list in (area); match_class_string_list_ptr = string_list_ptr; string_list.string = ""; string_list.next = null; end; else if arg = "-switch" | arg = "-sw" /* -switch */ then want_switchname = "1"b; else if arg = "-reverse" | arg = "-rv" /* -reverse */ then reverse = "1"b; else if arg = "-entry_numbers" | arg = "-etn"/* -entry_numbers */ then entry_numbers = "1"b; else if arg = "-class_identifiers" | arg = "-cli" /* -class_identifiers */ then class_identifiers = "1"b; else if arg = "-metering" | arg = "-mt" /* -metering */ then metering = "1"b; else if arg = "-no_header" | arg = "-nhe" /* -no_header */ then header = "0"b; else if arg = "-line_length" | arg = "-ll" /* -line_length */ then want_line_length = "1"b; else if arg = "-no_append_nl" | arg = "-nanl" then do; force_append_nl = "0"b; use_force_append_nl = "1"b; end; else if arg = "-append_nl" | arg = "-anl" then do; force_append_nl = "1"b; use_force_append_nl = "1"b; end; else if arg = "-no_insert_nl" | arg = "-ninl" then do; force_insert_nl = "0"b; use_force_insert_nl = "1"b; end; else if arg = "-insert_nl" | arg = "-inl" then do; force_insert_nl = "1"b; use_force_insert_nl = "1"b; end; else if arg = "-output_file" | arg = "-of" then do; want_output_file = "1"b; end; else do; call com_err_ (error_table_$badopt, myname, "^/The control argument ""^a"" is not supported.", arg); call finish; return; end; end; end; /* End of control argument processing. */ call check_for_unfinished_control_argument (code); if code ^= 0 then do; call finish; return; end; if output_line_length = 0 /* output_line_length wasn't set by -line_length. */ then do; output_line_length = get_line_length_$switch (output_iocb_ptr, code); if code ^= 0 then output_line_length = 0; end; /* Set up the audit file to be displayed. Initialize position_info (used by audit_file_position_ entries) in a fashion appropriate to whether or not the file is known to be currently in use. */ if have_path then do; call msf_manager_$open (position_info.dirname, position_info.ename, position_info.audit_fcb, code); if code ^= 0 then do; call com_err_ (code, myname, "^a^[>^]^a", position_info.dirname, position_info.dirname ^= ">", position_info.ename); call finish; return; end; call msf_manager_$get_ptr (position_info.audit_fcb, 0, "1"b, audit_file_header_ptr, bit_count, code); if code ^= 0 then do; call com_err_ (code, myname); call finish; return; end; if audit_file_header.version = 0 then do; call com_err_ (error_table_$zero_length_seg, myname); call finish; return; end; else if audit_file_header.version ^= audit_file_header_version_1 then do; call com_err_ (error_table_$unimplemented_version, myname); call finish; return; end; position_info.audit_index = audit_file_header.audit_index; position_info.current_component = audit_file_header.current_component; if position_info.current_component > 0 then do; call msf_manager_$get_ptr (position_info.audit_fcb, position_info.current_component, "1"b, position_info.audit_ptr, bit_count, code); if code ^= 0 then do; current_component_string = position_info.current_component; call com_err_ (code, myname, "^a>^a", pathname, current_component_string); call finish; return; end; end; else position_info.audit_ptr = audit_file_header_ptr; position_info.default_search_tag = "I"; position_info.any_tag = "1"b; position_info.file_limit = audit_file_header.filled; position_info.max_component = audit_file_header.max_component; position_info.begin_component = audit_file_header.begin_component; position_info.begin_index = audit_file_header.begin_index; position_info.max_index = audit_file_header.max_index; position_info.last_entry_length = audit_file_header.last_entry_length; end; else do; call find_iocb (code); if code ^= 0 then do; call com_err_ (code, myname); call finish; return; end; blkptr = iocb_ptr -> iocb.attach_data_ptr; audit_file_header_ptr = blk.audit_file_header_ptr; position_info.max_component = audit_file_header.max_component; position_info.current_component = audit_file_header.current_component; position_info.audit_fcb = blk.audit_fcb; position_info.audit_index = audit_file_header.audit_index; position_info.dirname = blk.dirname; position_info.ename = blk.ename; position_info.audit_ptr = blk.audit_ptr; position_info.default_search_tag = "I"; position_info.any_tag = "1"b; position_info.file_limit = audit_file_header.filled; position_info.begin_component = audit_file_header.begin_component; position_info.begin_index = audit_file_header.begin_index; position_info.max_index = audit_file_header.max_index; position_info.last_entry_length = audit_file_header.last_entry_length; end; /* Compare the output_file to the audit_file, to ensure that they */ /* are not the same file. */ if output_file_dir ^= "" then do; call hcs_$initiate (output_file_dir, output_file_entry, "", 0, 0, output_file_ptr, code); if output_file_ptr ^= null then do; if output_file_ptr = audit_file_header_ptr then do; call com_err_ (error_table_$badopt, myname, "^/The output file and the audit file may not be the same file, ^a^[>^]^a.", output_file_dir, output_file_dir ^= ">", output_file_entry); call finish; return; end; call hcs_$terminate_noname (output_file_ptr, code); end; end; if (entry_numbers | class_identifiers | metering) then leader = "1"b; /* If header is off, leave it off (and don't print a header). Otherwise, set header on if leader is on, off if leader is off. */ if header then header = leader; /* Make heuristic decision about whether or not to insert newlines and whether or not to append newlines. Insert_nl is turned on if there is a leader and the lines have a finite length (i.e., the output isn't going to a file). */ if leader then if output_line_length ^= 0 then insert_nl, append_nl = "1"b; else append_nl = "1"b; /* If the user wants to force the state of either append_nl or insert_nl, do so now. */ if use_force_append_nl then append_nl = force_append_nl; if use_force_insert_nl then insert_nl = force_insert_nl; /* Initialize begin_position and end_position to insure valid results if audit_file_position_$first or audit_file_position_$count_last is called. */ begin_position.aep = null; begin_position.char_index = -1; begin_position.entry_number = -1; begin_position.search_tag = ""; begin_position.component_ptr = null; begin_position.component_number = -1; begin_position.component_max_char_index = -1; end_position = begin_position; /* Find the appropriate values for begin_position and end_position. The switches have_begin and have_end indicate, respecitvely, the setting of begin_arg and end_arg in the argument processing above. */ if have_begin then do; call audit_file_position_$count_last (addr (end_position), addr (position_info), code); begin_position = end_position; call get_position (begin_arg, begin_position, code); if code ^= 0 then do; call com_err_ (code, myname, "Attempt to set beginning of display failed."); call finish; return; end; if have_end then do; end_position = begin_position; call get_position (end_arg, end_position, code); if code ^= 0 then if code = error_table_$end_of_info then code = 0; else if code = error_table_$nomatch then do; call com_err_ (0, myname, "^/No match was found searching for the end position."); call finish; return; end; else do; call com_err_ (0, myname, "^/Attempt to locate the last entry of the display failed."); call finish; return; end; end; end; else do; call audit_file_position_$first (addr (begin_position), addr (position_info), code); if code ^= 0 then do; call com_err_ (code, myname, "Could not get first position. ^a", pathname_ (position_info.dirname, position_info.ename)); call finish; return; end; end_position = begin_position; if have_end then do; call get_position (end_arg, end_position, code); if code ^= 0 then if code = error_table_$end_of_info then code = 0; else if code = error_table_$nomatch then do; call com_err_ (0, myname, "^/No match was found searching for the end position."); call finish; return; end; else do; call com_err_ (0, myname, "^/Attempt to locate the last entry of the display failed."); call finish; return; end; end; else do; call audit_file_position_$count_last (addr (end_position), addr (position_info), code); if code ^= 0 then do; call com_err_ (code, myname, "Attempt to set end of display failed."); call finish; return; end; end; end; if reverse then do; /* Swap values of begin_position and end_position. */ position = end_position; end_position = begin_position; begin_position = position; end; position = begin_position; continuation = "0"b; if header then call ioa_$ioa_switch (output_iocb_ptr, "^[entry ^]^[ time cpu usage paging ^]^[class ^]", entry_numbers, metering, class_identifiers); if position.aep = end_position.aep then do_last_position = "1"b; else do_last_position = "0"b; have_displayed = "0"b; /* Continue processing entries as long as position in the closed interval defined by begin_position and end_position. Because of the reverse printing option, begin_position and end_position can be in any numeric relationship. Processing entries consists of checking if the entry at "position" should be displayed by referring to the string_check and class_check procedures, if necessary, calling display_entry if the entry should be displayed, and advancing the position in the appropriate direction, if position is not end_position. */ do while ((do_last_position | (position.aep ^= end_position.aep)) & code = 0); if match then do; call string_check ("1"b, position, display, code); if code ^= 0 then do; call com_err_ (code, myname, "While checking for match."); call finish; return; end; if ^display then goto NEXT_POSITION; end; if exclude then do; call string_check ("0"b, position, display, code); if code ^= 0 then do; call com_err_ (code, myname, "While checking for exclusion."); call finish; return; end; if ^display then goto NEXT_POSITION; end; if class then do; call class_check ("1"b, position, display); if ^display then goto NEXT_POSITION; end; have_displayed = "1"b; call display_entry (position, continuation, append_nl, insert_nl, leader); NEXT_POSITION: if ^do_last_position then if reverse then call audit_file_position_$previous (addr (position), addr (position_info), code); else call audit_file_position_$next (addr (position), addr (position_info), code); if (position.aep = end_position.aep) then do_last_position = ^do_last_position; end; if code ^= 0 then do; call com_err_ (code, myname); call finish; return; end; else if ^have_displayed then do; call com_err_ (0, myname, "No entries were selected."); call finish; return; end; call finish; return; /* Effective end of display_audit_file. */ get_position: proc (p_arg, p_position, p_code); /* p_arg is set up by the control argument processing of -from, -last, -to, and -next. This procedure determines whether the positioning is to be done by string, time, or entry number. It does any necessary conversion of p_arg.value, then calls the appropriate audit_file_position_ entry. */ dcl 1 p_arg like begin_arg; dcl 1 p_position like position_template; dcl 1 position like position_template; dcl p_code fixed bin (35); dcl time_of_day pic "9999v.9"; dcl hours fixed bin (17); dcl minutes fixed bin (9, 4); dcl arg_time_of_day fixed bin (71); dcl (value_is_string, value_is_time) bit (1); p_code = 0; value_is_string = p_arg.value_is_string; value_is_time = "0"b; position = p_position; if ^value_is_string then if verify (p_arg.value, "0123456789.") ^= 0 /* Is p_arg.value a string? */ then value_is_string = "1"b; else if index (p_arg.value, ".") ^= 0 /* Is p_arg.value a time? */ then if length (p_arg.value) > 1 then value_is_time = "1"b; else value_is_string = "1"b; if value_is_string then do; if p_arg.abs /* p_arg.value is a string to be matched. */ then call audit_file_position_$forward_search (addr (position), p_arg.value, addr (position_info), p_code); else if p_arg.add then call audit_file_position_$forward_search (addr (position), p_arg.value, addr (position_info), p_code); else call audit_file_position_$backward_search (addr (position), p_arg.value, addr (position_info), p_code); end; else if value_is_time then do; /* p_arg.value is a time. */ time_of_day = fixed (p_arg.value, 5, 1); hours = time_of_day / 100; minutes = time_of_day - hours * 100; if (minutes >= 60) | (hours >= 24) then do; p_code = error_table_$bad_arg; return; end; arg_time_of_day = (hours * 3.6e9) + (minutes * 6e7); call audit_file_position_$move_time (addr (position), p_arg.abs, p_arg.add, p_arg.subtract, arg_time_of_day, addr (position_info), p_code); end; else do; /* p_arg.value is an entry_number. */ arg_number = cv_dec_check_ ((p_arg.value), p_code); if p_code ^= 0 then return; if arg_number > 2 ** 17 then p_code = error_table_$badopt; else do; call audit_file_position_$move_number (addr (position), p_arg.abs, p_arg.add, p_arg.subtract, (arg_number), addr (position_info), p_code); end; end; p_position = position; end; string_check: proc (p_match, p_position, p_display, p_code); /* If the current entry contains a match for any of the regular expressions in the string_list indicated by p_match, then set p_display to p_match. Otherwise, set p_display to ^p_match. */ dcl 1 p_position like position_template; dcl (p_match, p_display) bit (1); dcl chain_ptr ptr; dcl (p_code, code) fixed bin (35); p_code = 0; p_display = ^p_match; if p_match then chain_ptr = match_string_list_ptr; else chain_ptr = exclude_string_list_ptr; do while (chain_ptr ^= null); call search_file_ (addrel (addr (chain_ptr -> string_list.string), 1), 1, length (chain_ptr -> string_list.string), addr (p_position.aep -> audit_entry.string), 1, (p_position.aep -> audit_entry.entry_length), match_begin, match_end, code); if code = 0 then do; p_display = ^p_display; return; end; else if code ^= 1 /* code = 1 -> match not found. */ then do; p_code = code; return; end; chain_ptr = chain_ptr -> string_list.next; end; end; class_check: proc (p_match, p_position, p_display); /* If the class identifier of the current entry is in the string_list indicated by p_match, then set p_display to p_match. Otherwise, set p_display to ^p_match. */ dcl 1 p_position like position_template; dcl (p_match, p_display) bit (1); p_display = ^p_match; if p_match then chain_ptr = match_class_string_list_ptr; else return; do while (chain_ptr ^= null); if substr (p_position.aep -> audit_entry.tag, 1, length (chain_ptr -> string_list.string)) = chain_ptr -> string_list.string then do; p_display = ^p_display; return; end; chain_ptr = chain_ptr -> string_list.next; end; end; display_entry: proc (p_position, p_continuation, p_append_nl, p_insert_nl, p_leader); /* This controls the displaying of an entry. If p_continuation then place an asterisk in the first column of the entry field (as opposed to the leader field). If p_append_nl then add a newline and turn on p_continuation when the last character of the entry is not a newline. If p_insert_nl then use wrap_line to print the entry. If p_leader then use make_leader_string. */ dcl (p_continuation, p_append_nl, p_insert_nl, p_leader) bit (1); dcl leader_string char (80) varying; dcl 1 p_position like position_template; if p_leader then call make_leader_string; if insert_nl then call wrap_line; else if append_nl then do; call ioa_$ioa_switch (output_iocb_ptr, "^[^a^x^;^s^]^[*^;^x^]^a", p_leader, leader_string, p_continuation, substr (p_position.aep -> audit_entry.string, 1, p_position.aep -> audit_entry.entry_length)); if p_position.aep -> audit_entry.entry_length = 0 then p_continuation = "1"b; else if substr (p_position.aep -> audit_entry.string, p_position.aep -> audit_entry.entry_length, 1) ^= NL then p_continuation = "1"b; else p_continuation = "0"b; end; else if p_leader then call ioa_$ioa_switch_nnl (output_iocb_ptr, "^a^x^va", leader_string, p_position.aep -> audit_entry.entry_length, p_position.aep -> audit_entry.string); else call iox_$put_chars (output_iocb_ptr, addr (p_position.aep -> audit_entry.string), (p_position.aep -> audit_entry.entry_length), code); make_leader_string: proc; /* This constructs the leader according to the settings of three switches; entry_numbers, metering, and class_identifiers. */ dcl time_of_day pic "9999v.9"; dcl cpu_usage pic "zzz9v.999"; dcl paging pic "zzzzz9v"; dcl hours fixed bin (17); dcl minutes fixed bin (3, 1); dcl return_string char (32); dcl return_string_len fixed bin; leader_string = ""; if entry_numbers then do; current_entry_number = position.entry_number; leader_string = current_entry_number || " "; end; if metering then if p_position.aep -> audit_entry.time = -1 then do; call ioa_$rsnnl ("^vx*^vx*^vx*^vx", return_string, return_string_len, divide (length (time_of_day) + 1, 2, 17, 0), divide (length (cpu_usage) + 3 + length (time_of_day) + 1, 2, 17, 0), divide (length (cpu_usage) + 3 + length (paging) + 1, 2, 17, 0), divide (length (paging) + 1, 2, 17, 0)); leader_string = leader_string || substr (return_string, 1, return_string_len); end; else do; hours = divide (p_position.aep -> audit_entry.time, 3600000000, 17, 0); minutes = mod (p_position.aep -> audit_entry.time, 3.6e9) / 6e7; if hours > 24 then hours = 98; time_of_day = hours * 100 + minutes; if p_position.aep -> audit_entry.virtual_time / 1e6 > 9999 then cpu_usage = 9999; else cpu_usage = p_position.aep -> audit_entry.virtual_time / 1e6; if p_position.aep -> audit_entry.paging > 99999 then paging = 99999; else paging = p_position.aep -> audit_entry.paging; leader_string = leader_string || time_of_day || " " || cpu_usage || " " || paging || " "; end; if class_identifiers then leader_string = leader_string || " " || p_position.aep -> audit_entry.tag || " "; end; wrap_line: proc; /* wrap_line formats the output of an entry. Newlines are inserted, and output is indented as necessary. Or, if the entry doesn't end in a newline. Indentation is necessary when the number of characters to the first newline (line_break) is greater than the output line length minus the length of the leader string minus 1 (allowable_entry_length). */ dcl (allowable_entry_length, char_index, len, line_break) fixed bin; char_index = 1; if p_leader then allowable_entry_length = output_line_length - length (leader_string) - 1; else allowable_entry_length = output_line_length - 1; continuation = p_continuation; char_index = 1; line_break = index (p_position.aep -> audit_entry.string, NL); if line_break > allowable_entry_length then do; /* Insert a new_line.*/ len = allowable_entry_length; call ioa_$ioa_switch (output_iocb_ptr, "^[^a^;^s^]^x^[*^;^x^]^a", leader, leader_string, continuation, substr (p_position.aep -> audit_entry.string, char_index, len)); continuation = "1"b; end; else if line_break > 0 then do; /* Print as is.*/ len = line_break; call ioa_$ioa_switch_nnl (output_iocb_ptr, "^[^a^;^s^]^x^[*^;^x^]^a", leader, leader_string, continuation, substr (p_position.aep -> audit_entry.string, char_index, len)); continuation = "0"b; end; else do; if p_position.aep -> audit_entry.entry_length - char_index + 1 > allowable_entry_length then len = allowable_entry_length; else len = p_position.aep -> audit_entry.entry_length - char_index + 1; if append_nl | p_position.aep -> audit_entry.entry_length - char_index + 1 > allowable_entry_length then do; call ioa_$ioa_switch (output_iocb_ptr, "^[^a^;^s^]^x^[*^;^x^]^a", leader, leader_string, continuation, substr (p_position.aep -> audit_entry.string, char_index, len)); continuation = "1"b; end; else do; call ioa_$ioa_switch_nnl (output_iocb_ptr, "^[^a^;^s^]^x^[*^;^x^]^a", leader, leader_string, continuation, substr (p_position.aep -> audit_entry.string, char_index, len)); continuation = "0"b; end; end; char_index = char_index + len; do while (char_index < p_position.aep -> audit_entry.entry_length); line_break = index (substr (p_position.aep -> audit_entry.string, char_index), NL); if line_break > allowable_entry_length then do; len = allowable_entry_length; call ioa_$ioa_switch (output_iocb_ptr, "^[^vx^;^s^]^x^[*^;^x^]^a", leader, length (rtrim (leader_string)), continuation, substr (p_position.aep -> audit_entry.string, char_index, len)); continuation = "1"b; end; else if line_break > 0 then do; len = line_break; call ioa_$ioa_switch_nnl (output_iocb_ptr, "^[^vx^;^s^]^x^[*^;^x^]^a", leader, length (rtrim (leader_string)), continuation, substr (p_position.aep -> audit_entry.string, char_index, len)); continuation = "0"b; end; else do; if p_position.aep -> audit_entry.entry_length - char_index + 1 > allowable_entry_length then len = allowable_entry_length; else len = p_position.aep -> audit_entry.entry_length - char_index + 1; if append_nl | p_position.aep -> audit_entry.entry_length - char_index + 1 > allowable_entry_length then do; call ioa_$ioa_switch (output_iocb_ptr, "^[^vx^;^s^]^x^[*^;^x^]^a", leader, length (rtrim (leader_string)), continuation, substr (p_position.aep -> audit_entry.string, char_index, len)); continuation = "1"b; end; else do; call ioa_$ioa_switch_nnl (output_iocb_ptr, "^[^vx^;^s^]^x^[*^;^x^]^a", leader, length (rtrim (leader_string)), continuation, substr (p_position.aep -> audit_entry.string, char_index, len)); continuation = "0"b; end; end; char_index = char_index + len; end; p_continuation = continuation; end; end; find_iocb: proc (p_code); /* Find an iocb for a switch currently using audit_. If a switchname was provided as an argument to daf, then use its iocb. Else, look at user_i/o to see if it is using audit_. If it isn't, walk through the attachments in order (using find_iocb_n) checking each for use of audit_. The first switch found using audit_ is returned. */ dcl (code, p_code) fixed bin (35); dcl iox_$user_io ptr ext; dcl attach_description char (32) varying based; dcl index fixed bin; dcl iox_$find_iocb_n entry (fixed bin, ptr, fixed bin (35)); dcl iox_$look_iocb entry (char (*), ptr, fixed bin (35)); code = 0; if have_switchname then do; call iox_$look_iocb (switchname, iocb_ptr, code); if code ^= 0 then do; p_code = code; return; end; end; else if substr (iox_$user_io -> iocb.attach_descrip_ptr -> attach_description, 1, 6) = "audit_" then iocb_ptr = iox_$user_io; else do; index = 1; call iox_$find_iocb_n (index, iocb_ptr, code); do while (code = 0); if iocb_ptr -> iocb.attach_data_ptr ^= null then if substr (iocb_ptr -> iocb.attach_descrip_ptr -> attach_description, 1, 6) = "audit_" then return; index = index + 1; call iox_$find_iocb_n (index, iocb_ptr, code); end; end; p_code = code; end; %page; check_for_unfinished_control_argument: proc (p_code); dcl p_code fixed bin (35); p_code = error_table_$noarg; if want_begin_addr then call com_err_ (p_code, myname, "^/ The ^[-last^;-from^] control argument must be followed by an address.", begin_arg.subtract); else if want_end_addr then call com_err_ (p_code, myname, "^/The ^[-to^;-next^] control argument must be followed by an address.", end_arg.abs); else if want_output_file then call com_err_ (p_code, myname, "^/The -output_file control argument must be followed by a pathname."); else if looking_for_string & ^found_string then call com_err_ (p_code, myname, "^/The ^[-class^;-match and -exclude^] control argument^[^;s^] must be followed by a ^[class identifier^;string^]." , processing_class_control_argument, processing_class_control_argument, processing_class_control_argument); else if want_switchname then call com_err_ (p_code, myname, "^/The -switch control argument must be followed by a switch name."); else if want_line_length then call com_err_ (p_code, myname, "^/The -line_length control argument must be followed by a line length."); else p_code = 0; end check_for_unfinished_control_argument; %page; finish: proc; if output_iocb_ptr ^= iox_$user_output then do; call iox_$close (output_iocb_ptr, code); call iox_$detach_iocb (output_iocb_ptr, code); end; end finish; %include audit_block; %include iocbx; %include iox_dcls; %include iox_modes; %include audit_position; %include audit_entry; %include audit_file_header; %include check_star_name; end; bull_copyright_notice.txt 08/30/05 1008.4r 08/30/05 1007.3 00020025 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull and Bull HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by Bull HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved