1 /****^  ***********************************************************
   2         *                                                         *
   3         * Copyright, (C) BULL HN Information Systems Inc., 1989   *
   4         *                                                         *
   5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   6         *                                                         *
   7         *********************************************************** */
   8 
   9 
  10 
  11 
  12 /****^  HISTORY COMMENTS:
  13   1) change(1989-04-06,Vu), approve(1989-04-06,MCR8095), audit(1989-04-25,Lee),
  14      install(1989-05-10,MR12.3-1040):
  15      - output modes are returned even if the input modes string contains only
  16        audit modes (ie. audit_input).
  17      - The following builtin functions: after, before, empty, max, rtrim are
  18        now declared explicitly.
  19   2) change(2016-01-15,Swenson), approve(2016-01-15,MCR10003):
  20      Fix to support 4-character time zone abbreviations.
  21                                                    END HISTORY COMMENTS */
  22 
  23 
  24 /* format: style2,ind3 */
  25 audit_:
  26 audit_attach:
  27    proc (p_iocb_ptr, p_option_array, p_com_err_sw, p_code);
  28 
  29 
  30 /* This program is the main driver for the "audit" module. It has entries
  31    for attachment (which also opens), for reading, writing, and detachment (which also precedes
  32    it with a close). The following I/O system calls are provided for this module:
  33 
  34    attach (open)    audit_$audit_attach
  35    close            audit_$audit_close
  36    detach           audit_$audit_detach
  37    get_chars        audit_$audit_get_chars
  38    get_line         audit_$audit_get_line
  39    put_chars        audit_$audit_put_chars
  40    control          audit_$audit_control
  41    modes            audit_$audit_modes
  42 
  43    Last Modified:
  44 
  45    12/01/78  Written by Lindsey L. Spratt  (from existing code by J. Stern, S. Webber, and R. Bratt)
  46    11/26/79  by  Lindsey L. Spratt  to support prompting in the editor.
  47    05/20/80  by  Lindsey L. Spratt  to fix -tc option and assume "audit" suffix.
  48    12/22/80  by  Lindsey L. Spratt: Change all mode string references from 256
  49                  char string to 512.
  50 03/20/81  by  Lindsey L. Spratt:  remove "audit_editor_prompt_terminator="
  51               mode.  Set default editor_prompt_string to
  52               "audit editor^[(^d)^]:^2x".
  53 08/05/81 by Lindsey Spratt: Changed modes entry to use the mode_string_$parse
  54             and mode_string_$delete entries to manipulate the mode strings.
  55             Changed all calls to iox entries to be calls instead of function
  56             references.  Changed from using the iocbx.incl.pl1 file to
  57             iocb.incl.pl1.  Changed entry sequences to be calls instead of
  58             functions, i.e. the returns (fixed bin(35)) was replaced by
  59             including "p_code" in the entry parameters.
  60 10/29/81 by Lindsey Spratt: Fixed conversion of ll= and pl= to only be
  61             invoked if the respective strings are actually present to be
  62             converted.  Also, added rtrimming of the unrecognized_modes string
  63             in the calls of the before and after builtins.
  64                  Added initialization of the blk pointers
  65             audit_file_header_ptr, temp_seg_ptr, work_area, audit_fcb,
  66             begin_ptr, and audit_ptr.  Added checks for null pointers and
  67             non-zero error codes to the detach entry.
  68 11/12/81 by Lindsey Spratt:  Changed to call hcs_$assign_linkage as a
  69             subroutine  instead of a function.
  70 06/01/82 by Lindsey Spratt:  Was not honoring the maximum length of the audit
  71             file when "adjusting" during the audit_detach operation, the
  72             current_component and (audit_index - 1) were being used instead of
  73             the max_component and max_index (set by the audit_file_size mode).
  74             The audit_detach entry now checks the audit_file_header.filled
  75             flag to determine if it should use the max component and index
  76             (file_limit = "1"b) or the current_component and audit_index (file_limit =
  77             "0"b).
  78 06/03/82 by Lindsey Spratt:  Changed the setting of the bit count in
  79             audit_detach to be the value of audit_index*9, instead of
  80             audit_index*9-9.
  81 06/08/82 by Lindsey Spratt:  Removed the code which always set
  82             audit_file_header.max_index to sys_info$max_seg_size*4 whenever
  83             attaching to an audit file.  The max_index and max_componenet
  84             values of the audit_file_header are now only set when initializing
  85             an empty audit file and when setting the audit_file_size mode.
  86             This makes max_index a reliable indicator of whether the "current"
  87             audit file is supposed to be circular or not.  The setting of the
  88             file_limit flag in blk.current_flags in audit_attach relies on
  89             this fact.
  90 06/09/82 by Lindsey Spratt: Added an any_other handler to audit_detach.
  91             Changed detach logic to not use the bit-count-setting feature of
  92             msf_manager_$adjust when adjusting the audit file, instead an
  93             explicit set_bc_seg is done (when appropriate) to the final
  94             component of the audit file.  All preceding components will have
  95             had their bit counts correctly set by the "next_component"
  96             operation of insert_line.
  97 10/13/82 by Lindsey Spratt:  Moved setting of safety_sw off into the
  98             audit_close entry.  This makes it possible for the standard
  99             process epilogue handler to cause audit files to have their safety
 100             switches turned off.  Previously, this was done in the
 101             audit_detach entry, which does not get invoked during process
 102             termination.
 103 02/10/83 by Lindsey Spratt:  Fixed audit_line to set
 104             audit_file_header.max_component to be the highest used component
 105             number in the non-file_limit (non-circular file) case.
 106             display_audit_file/audit_file_position_ relies on the
 107             max_component to know where the audit file ends (in some
 108             circumstances).  Fixed insert_line to set
 109             audit_file_header.max_index to equal audit_file_header.audit_index
 110             when working with a non-file_limit audit file.
 111 03/02/83 by Lindsey Spratt:  More fixes to make all portions of code respect
 112             the protocol that for "unlimited" (or non-circular) files
 113             afh.max_index always equals afh.audit_index and afh.max_component
 114             always equals afh.current_component.  For circular files,
 115             afh.max_index is > afh.audit_index when afh.max_component =
 116             afh.current_component, and afh.max_component is always >=
 117             afh.current_component.  Also, fixed audit_suspend mode to have no
 118             effect when audit is already suspended.
 119    */
 120 
 121 /* Parameters */
 122 
 123       dcl     (p_newmodes, p_oldmodes)
 124                                      char (*);
 125       dcl     p_real_order           char (*);
 126       dcl     p_code                 fixed bin (35);
 127       dcl     (p_iocb_ptr, buff_ptr, p_info_ptr)
 128                                      ptr;
 129       dcl     (actual_len, buff_len) fixed bin (21);
 130       dcl     p_option_array         (*) char (*) var;
 131       dcl     p_com_err_sw           bit (1) aligned;
 132       dcl     ptype                  fixed bin;
 133       dcl     n                      fixed bin (21);
 134       dcl     p_buff_ptr             ptr;
 135       dcl     (p_buff_len, p_actual_len)
 136                                      fixed bin (21);
 137 
 138 /* Entries */
 139 
 140       dcl     cpu_time_and_paging_   entry (fixed bin, fixed bin (71), fixed bin);
 141       dcl     get_temp_segment_      entry (char (*), ptr, fixed bin (35));
 142       dcl     release_temp_segment_  entry (char (*), ptr, fixed bin (35));
 143       dcl     decode_clock_value_    entry (fixed bin (71), fixed bin, fixed bin, fixed bin, fixed bin (71), fixed bin,
 144                                      char (4) aligned);
 145       dcl     audit_editor           entry (ptr, fixed bin (21), fixed bin (21), ptr, fixed bin (35));
 146       dcl     audit_editor$set_last_return_line_position
 147                                      entry (ptr);
 148       dcl     audit_file_position_$last
 149                                      entry (ptr, ptr, fixed bin (35));
 150       dcl     com_err_               entry options (variable);
 151       dcl     sub_err_               entry options (variable);
 152       dcl     expand_pathname_$add_suffix
 153                                      entry (char (*), char (*), char (*), char (*), fixed bin (35));
 154       dcl     ioa_$ioa_switch        entry options (variable);
 155       dcl     ioa_$ioa_switch_nnl    entry options (variable);
 156       dcl     date_time_             entry (fixed bin (71), char (*));
 157       dcl     user_info_$homedir     entry (char (*));
 158       dcl     hcs_$set_bc_seg        entry (ptr, fixed bin (24), fixed bin (35));
 159       dcl     hcs_$set_safety_sw_seg entry (ptr, bit (1), fixed bin (35));
 160       dcl     hcs_$status_mins       entry (ptr, fixed bin (2), fixed bin (24), fixed bin (35));
 161       dcl     hcs_$set_ips_mask      entry (fixed bin, fixed bin);
 162       dcl     hcs_$assign_linkage    entry (fixed bin, ptr, fixed bin (35));
 163       dcl     abbrev_$expanded_line  entry (ptr, fixed bin, ptr, fixed bin, ptr, fixed bin);
 164       dcl     msf_manager_$open      entry (char (*), char (*), ptr, fixed bin (35));
 165       dcl     msf_manager_$get_ptr   entry (ptr, fixed bin, bit (1), ptr, fixed bin (24), fixed bin (35));
 166       dcl     msf_manager_$adjust    entry (ptr, fixed bin, fixed bin (24), bit (3), fixed bin (35));
 167       dcl     msf_manager_$close     entry (ptr);
 168 
 169       dcl     mode_string_$parse     entry (char (*), ptr, ptr, fixed bin (35));
 170       dcl     mode_string_$delete    entry (ptr, (*) char (*), char (*), fixed bin (35));
 171       dcl     mode_string_$combine   entry (ptr, ptr, char (*), fixed bin (35));
 172 
 173 /* Constants */
 174 
 175       dcl     any_other              condition;
 176 
 177 /* Static Variables */
 178 
 179       dcl     SUFFIX                 char (32) varying init ("audit") internal static options (constant);
 180       dcl     sio_open_desc          char (20) varying init ("stream_input_output") static options (constant);
 181       dcl     myname                 char (6) static options (constant) init ("audit_");
 182       dcl     NL                     char (1) aligned static options (constant) init ("
 183 ");
 184       dcl     AUDIT_MODE_NAMES       (12) char (32)
 185                                      init ("audit_suspend", "audit_input", "audit_output", "audit_edit", "audit_trace",
 186                                      "audit_use_editor_prompt", "audit_editor_prompt_string", "audit_epstr",
 187                                      "audit_file_size", "audit_meter", "audit_transparent", "audit_trigger")
 188                                      internal static options (constant);
 189 
 190 /* Based */
 191 
 192       dcl     mode_str               char (512) varying based;
 193       dcl     aut_input_string       char (actual_len) based (buff_ptr);
 194       dcl     param_output_string    char (p_buff_len) based (p_buff_ptr);
 195       dcl     param_input_string     char (p_actual_len) based (p_buff_ptr);
 196 
 197 /* Automatic Variables */
 198 
 199       dcl     out_ptr                ptr;
 200       dcl     type                   fixed bin (2);
 201       dcl     bit_count24            fixed bin (24);
 202       dcl     mode_idx               fixed bin (17);
 203       dcl     records                fixed bin;
 204       dcl     newmodes               char (64) varying;
 205       dcl     unrecognized_modes     char (512);
 206       dcl     order                  char (32);
 207       dcl     (audited_iocb, blkptr, auditing_iocb)
 208                                      ptr;
 209       dcl     device                 char (32);
 210       dcl     i                      fixed bin;
 211       dcl     (tc, mask)             fixed bin;
 212       dcl     ename                  char (32);
 213       dcl     time                   char (8);
 214       dcl     dirname                char (168);
 215       dcl     tactual_len            fixed bin (21);
 216       dcl     extend                 bit (1);
 217       dcl     request                char (1);
 218       dcl     set_last_return_line_position
 219                                      bit (1) init ("0"b);
 220       dcl     ab_buf                 char (512);
 221       dcl     ab_len                 fixed bin;
 222       dcl     temp_area              area (2048);
 223 
 224 /* External Variables */
 225 
 226       dcl     sys_info$max_seg_size  fixed bin (24) ext;
 227       dcl     error_table_$bad_mode_value
 228                                      fixed bin (35) ext;
 229       dcl     error_table_$bad_mode_syntax
 230                                      fixed bin (35) ext;
 231       dcl     error_table_$long_record
 232                                      fixed bin (35) ext;
 233       dcl     error_table_$empty_file
 234                                      fixed bin (35) ext;
 235       dcl     error_table_$noarg     fixed bin (35) ext;
 236       dcl     error_table_$unimplemented_version
 237                                      fixed bin (35) ext;
 238       dcl     error_table_$not_detached
 239                                      fixed bin (35) ext;
 240       dcl     error_table_$noentry   fixed bin (35) ext;
 241       dcl     error_table_$bad_arg   fixed bin (35) ext;
 242 
 243 /* Builtins */
 244 
 245       dcl     string                 builtin;
 246       dcl     currentsize            builtin;
 247       dcl     clock                  builtin;
 248       dcl     mod                    builtin;
 249       dcl     (substr, addr, null, divide, hbound, index, length, size)
 250                                      builtin;
 251       dcl     (after, before, empty, max, rtrim)
 252                                      builtin;
 253 
 254 
 255 /* ^L */
 256 
 257 /* attach --- subroutine to attach and open the audit module */
 258 
 259 
 260 
 261 /* Look at option array and collect data */
 262 
 263       ename = "";
 264       audited_iocb = p_iocb_ptr;
 265       extend = "1"b;
 266       if hbound (p_option_array, 1) < 1
 267       then
 268          do;
 269             if p_com_err_sw
 270             then call com_err_ (error_table_$bad_arg, (myname), "No device name given.");
 271             p_code = error_table_$bad_arg;
 272             return;
 273          end;
 274       device = p_option_array (1);                          /* device name must be first option */
 275       call iox_$find_iocb (device, auditing_iocb, p_code);
 276       if p_code ^= 0
 277       then
 278          do;
 279             if p_com_err_sw
 280             then call com_err_ (p_code, (myname), "^a", device);
 281             return;
 282          end;
 283       do i = 2 to hbound (p_option_array, 1);               /* now search the options */
 284          if p_option_array (i) = "-tc" | p_option_array (i) = "-truncate"
 285          then extend = "0"b;
 286          else if p_option_array (i) = "-pn" | p_option_array (i) = "-pathname"
 287          then
 288             do;
 289                i = i + 1;
 290                if i > hbound (p_option_array, 1)
 291                then
 292                   do;
 293                      if p_com_err_sw
 294                      then call
 295                              com_err_ (error_table_$noarg, (myname),
 296                              "^/A pathname must be given with the the -pathname control argument.");
 297                      p_code = error_table_$noarg;
 298                      return;
 299                   end;
 300                call expand_pathname_$add_suffix ((p_option_array (i)), (SUFFIX), dirname, ename, p_code);
 301                if p_code ^= 0
 302                then
 303                   do;
 304                      if p_com_err_sw
 305                      then call com_err_ (p_code, (myname), "^a", p_option_array (i));
 306                      return;
 307                   end;
 308             end;
 309          else
 310             do;
 311                if p_com_err_sw
 312                then call com_err_ (error_table_$bad_arg, (myname), "^/Unsupported option ^a.", p_option_array (i));
 313                p_code = error_table_$bad_arg;
 314                return;
 315             end;
 316       end;
 317       if ename = ""
 318       then
 319          do;
 320             call date_time_ (clock, time);                  /* get time for default file name */
 321             ename = time || ".audit";
 322             call user_info_$homedir (dirname);              /* get default dirname */
 323          end;
 324       call hcs_$set_ips_mask (0, mask);                     /* enter critical code */
 325       if audited_iocb -> iocb.attach_descrip_ptr ^= null ()
 326       then
 327          do;
 328             call hcs_$set_ips_mask (mask, 0);
 329             if p_com_err_sw
 330             then call com_err_ (error_table_$not_detached, (myname));
 331             p_code = error_table_$not_detached;
 332             return;
 333          end;
 334       call hcs_$assign_linkage (size (blk), blkptr, p_code);
 335       if blkptr = null ()
 336       then
 337          do;                                                /* can't get storage for data */
 338             call hcs_$set_ips_mask (mask, 0);
 339             if p_com_err_sw
 340             then call com_err_ (p_code, (myname));
 341             return;
 342          end;
 343       audited_iocb -> iocb.attach_descrip_ptr = addr (blk.attach);
 344       audited_iocb -> iocb.attach_data_ptr = blkptr;
 345       audited_iocb -> iocb.detach_iocb = audit_detach;
 346       audited_iocb -> iocb.open = iox_$err_no_operation;
 347       audited_iocb -> iocb.close = audit_close;             /* Now fill in some stuff in the block */
 348       tc = index (device, " ");
 349       if tc = 0
 350       then tc = length (device);
 351       blk.attach = "audit_ " || substr (device, 1, tc);
 352       do i = 2 to hbound (p_option_array, 1);
 353          blk.attach = blk.attach || " ";
 354          blk.attach = blk.attach || p_option_array (i);
 355       end;
 356       blk.auditing_iocb = auditing_iocb;                    /* fill in target iocb pointer */
 357       blk.default_iocb = audited_iocb;
 358 
 359 
 360 /* Now the code to open the stream as well */
 361 
 362       blk.dirname = dirname;
 363       blk.ename = ename;
 364       blk.audit_file_header_ptr = null;
 365       blk.audit_fcb = null;
 366       blk.audit_ptr = null;
 367       blk.begin_ptr = null;
 368       blk.temp_seg_ptr = null;
 369       blk.work_space = null;
 370       audited_iocb -> iocb.get_line = audit_get_line;
 371       audited_iocb -> iocb.control = audit_control;
 372       audited_iocb -> iocb.put_chars = audit_put_chars;
 373       audited_iocb -> iocb.get_chars = audit_get_chars;
 374       audited_iocb -> iocb.open_descrip_ptr = addr (sio_open_desc);
 375       audited_iocb -> iocb.open_data_ptr = blkptr;
 376       audited_iocb -> iocb.modes = audit_modes;
 377       audited_iocb -> iocb.position = audit_position;
 378 
 379       call msf_manager_$open (blk.dirname, blk.ename, blk.audit_fcb, p_code);
 380       if p_code ^= 0
 381       then if p_code = error_table_$noentry
 382            then
 383               do;
 384                  call msf_manager_$get_ptr (blk.audit_fcb, 0, "1"b, blk.audit_ptr, bit_count24, p_code);
 385                  if p_code ^= 0
 386                  then
 387                     do;
 388                        call hcs_$set_ips_mask (mask, 0);
 389                        if p_com_err_sw
 390                        then call
 391                                com_err_ (p_code, (myname),
 392                                "While attempting to get a pointer to component 0 of the audit file.");
 393                        return;
 394                     end;
 395 INIT_AUDIT_FILE:
 396                  audit_file_header_ptr = blk.audit_ptr;
 397                  blk.audit_file_header_ptr = blk.audit_ptr;
 398                  audit_file_header.last_entry_length = impossible_audit_entry_length;
 399                  audit_file_header.filled = "0"b;
 400                  audit_file_header.current_component = 0;
 401                  audit_file_header.unused1 = "0"b;
 402                  audit_file_header.pad2 = 0;
 403                  audit_file_header.begin_component = 0;
 404                  audit_file_header.begin_index =
 405                     (4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8);
 406                  blk.begin_ptr = blk.audit_ptr;
 407                  audit_file_header.version = audit_file_header_version_1;
 408                  audit_file_header.last_entry_length = -1;
 409                  call truncate_audit_file;
 410                  audit_file_header.max_component = audit_file_header.current_component;
 411                  audit_file_header.max_index = audit_file_header.audit_index;
 412               end;
 413            else
 414               do;
 415                  call hcs_$set_ips_mask (mask, 0);
 416                  if p_com_err_sw
 417                  then call
 418                          com_err_ (p_code, (myname), "While attempting to open audit file ^a^[>^]^a .", blk.dirname,
 419                          blk.dirname ^= ">", blk.ename);
 420                  return;
 421               end;
 422       else if extend
 423       then
 424          do;
 425             call msf_manager_$get_ptr (blk.audit_fcb, 0, "1"b, audit_file_header_ptr, bit_count24, p_code);
 426             if p_code ^= 0
 427             then
 428                do;
 429                   call hcs_$set_ips_mask (mask, 0);
 430                   if p_com_err_sw
 431                   then call com_err_ (p_code, (myname), "While attempting to get pointer to component 0 of audit file.");
 432                   return;
 433                end;
 434             if audit_file_header.version = 0
 435             then
 436                do;
 437                   blk.audit_ptr = audit_file_header_ptr;
 438                   go to INIT_AUDIT_FILE;
 439                end;
 440             else if audit_file_header.version ^= audit_file_header_version_1
 441             then
 442                do;
 443                   call hcs_$set_ips_mask (mask, 0);
 444                   if p_com_err_sw
 445                   then call com_err_ (p_code, (myname));
 446                   p_code = error_table_$unimplemented_version;
 447                   return;
 448                end;
 449             call
 450                msf_manager_$get_ptr (blk.audit_fcb, audit_file_header.current_component, "1"b, blk.audit_ptr, bit_count24,
 451                p_code);
 452             if p_code ^= 0
 453             then
 454                do;
 455                   call hcs_$set_ips_mask (mask, 0);
 456                   if p_com_err_sw
 457                   then call com_err_ (p_code, (myname), "While attempting to get pointer to audit file.");
 458                   return;
 459                end;
 460             call
 461                msf_manager_$get_ptr (blk.audit_fcb, audit_file_header.begin_component, "1"b, blk.begin_ptr, bit_count24,
 462                p_code);
 463             if p_code ^= 0
 464             then
 465                do;
 466                   call hcs_$set_ips_mask (mask, 0);
 467                   if p_com_err_sw
 468                   then call
 469                           com_err_ (p_code, (myname), "While attempting to get pointer  to component ^d of audit file.",
 470                           audit_file_header.begin_component);
 471                   return;
 472                end;
 473             blk.current_flags.file_limit =
 474                audit_file_header.max_index > audit_file_header.audit_index
 475                | audit_file_header.max_component > audit_file_header.current_component;
 476          end;
 477       else
 478          do;
 479             call msf_manager_$get_ptr (blk.audit_fcb, 0, "1"b, blk.audit_ptr, bit_count24, p_code);
 480             if p_code ^= 0
 481             then
 482                do;
 483                   call hcs_$set_ips_mask (mask, 0);
 484                   if p_com_err_sw
 485                   then call
 486                           com_err_ (p_code, (myname), "While attempting to get pointer to component ^d of audit file.",
 487                           audit_file_header.current_component);
 488                   return;
 489                end;
 490             audit_file_header_ptr = blk.audit_ptr;
 491             blk.audit_file_header_ptr = blk.audit_ptr;
 492             audit_file_header.current_component = 0;
 493             call
 494                msf_manager_$adjust (blk.audit_fcb, 0,
 495                ((4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8)) * 9, "110"b, p_code);
 496             if p_code ^= 0
 497             then
 498                do;
 499                   call hcs_$set_ips_mask (mask, 0);
 500                   if p_com_err_sw
 501                   then call com_err_ (p_code, (myname), "While attempting to adjust audit file.");
 502                   return;
 503                end;
 504             call truncate_audit_file;
 505             audit_file_header.begin_index = audit_file_header.audit_index;
 506             audit_file_header.begin_component = 0;
 507             audit_file_header.max_component = audit_file_header.current_component;
 508             audit_file_header.max_index = audit_file_header.audit_index;
 509             audit_file_header.filled = "0"b;
 510             blk.begin_ptr = blk.audit_ptr;
 511          end;
 512       blk.audit_file_header_ptr = audit_file_header_ptr;
 513       blk.current_flags.read_audit = "1"b;
 514       blk.current_flags.write_audit = "1"b;
 515       blk.trigger = "!";
 516       blk.current_flags.edit = "1"b;
 517       blk.current_flags.use_editor_prompt = "1"b;
 518       blk.editor_prompt_string = "audit editor^[(^d)^]:^2x";
 519 
 520       blk.work_space = null;
 521       blk.work_space_len = 0;
 522 
 523       call hcs_$set_safety_sw_seg (blk.audit_file_header_ptr, "1"b, p_code);
 524                                                             /* 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. */
 525 
 526       call get_temp_segment_ ("audit_", blk.temp_seg_ptr, p_code);
 527       if p_code ^= 0
 528       then
 529          do;
 530             call hcs_$set_ips_mask (mask, 0);
 531             if p_com_err_sw
 532             then call com_err_ (p_code, (myname), "While attempting to get temp seg.");
 533             return;
 534          end;                                               /* Now propagate through all appropriate IOCB's */
 535       call iox_$propagate (audited_iocb);
 536       call hcs_$set_ips_mask (mask, 0);
 537       p_code = 0;
 538       return;
 539 ^L
 540 
 541 audit_detach:
 542    entry (p_iocb_ptr, p_code);
 543       p_code = 0;
 544       call hcs_$set_ips_mask (0, mask);
 545       blkptr = p_iocb_ptr -> iocb.attach_data_ptr;
 546       p_iocb_ptr -> iocb.open_descrip_ptr = null ();
 547       p_iocb_ptr -> iocb.open_data_ptr = null ();
 548       p_iocb_ptr -> iocb.attach_descrip_ptr, p_iocb_ptr -> iocb.attach_data_ptr = null ();
 549       p_iocb_ptr -> iocb.detach_iocb = iox_$err_not_attached;
 550       p_iocb_ptr -> iocb.open = iox_$err_not_attached;
 551       call iox_$propagate (p_iocb_ptr);
 552 
 553       on any_other
 554          begin;
 555             call force_audit_suspension;
 556             goto RETURN;
 557          end;
 558 
 559       if blkptr = null
 560       then return;
 561       else if blk.audit_file_header_ptr ^= null
 562       then
 563          do;
 564             audit_file_header_ptr = blk.audit_file_header_ptr;
 565             if ^(blk.current_flags.file_limit
 566                & (audit_file_header.begin_component > audit_file_header.current_component
 567                | (audit_file_header.begin_component = audit_file_header.current_component
 568                & audit_file_header.begin_index >= audit_file_header.audit_index)))
 569             then
 570                do;
 571                   call hcs_$set_bc_seg (blk.audit_ptr, audit_file_header.audit_index * 9, p_code);
 572                   if p_code ^= 0
 573                   then goto RETURN;
 574 
 575 /* Can't use the bit count setting feature of msf_manager_$adjust because it
 576 will attempt to set the bit counts of the preceding components to max_length,
 577 which is not the correct value.  In any event, their bit counts have already
 578 been set. */
 579 
 580                   call
 581                      msf_manager_$adjust (blk.audit_fcb, audit_file_header.current_component,
 582                      9 * audit_file_header.audit_index, "011"b, p_code);
 583                   if p_code ^= 0
 584                   then goto RETURN;
 585                end;
 586          end;
 587       if blk.temp_seg_ptr ^= null
 588       then
 589          do;
 590             call release_temp_segment_ ("audit_", blk.temp_seg_ptr, p_code);
 591             if p_code ^= 0
 592             then goto RETURN;
 593          end;
 594 
 595       if blk.audit_fcb ^= null
 596       then call msf_manager_$close (blk.audit_fcb);
 597 RETURN:
 598       revert any_other;
 599       call hcs_$set_ips_mask (mask, 0);
 600       return;
 601 
 602 audit_close:
 603    entry (p_iocb_ptr, p_code);
 604 
 605       audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr;
 606       blkptr = p_iocb_ptr -> iocb.attach_data_ptr;
 607       if blk.audit_file_header_ptr ^= null
 608       then call hcs_$set_safety_sw_seg (blk.audit_file_header_ptr, "0"b, p_code);
 609                                                             /* 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.*/
 610       call hcs_$set_ips_mask (0, mask);
 611       audited_iocb -> iocb.open_descrip_ptr = null ();
 612       audited_iocb -> iocb.detach_iocb = audit_detach;
 613       call iox_$propagate (audited_iocb);
 614       call hcs_$set_ips_mask (mask, 0);
 615       p_code = 0;
 616       return;
 617 
 618 /* ^L */
 619 
 620 /* The following are dummy entries that pass on the given request */
 621 
 622 audit_get_chars:
 623    entry (p_iocb_ptr, p_buff_ptr, p_buff_len, p_actual_len, p_code);
 624       audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr;
 625       blkptr = audited_iocb -> iocb.attach_data_ptr;
 626       auditing_iocb = blk.auditing_iocb;
 627       call iox_$get_chars (auditing_iocb, p_buff_ptr, p_buff_len, p_actual_len, p_code);
 628       if p_code ^= 0
 629       then return;
 630       if blk.current_flags.read_audit
 631       then call audit_line ("IC", param_input_string);
 632       p_code = 0;
 633       return;
 634 
 635 audit_modes:
 636    entry (p_iocb_ptr, p_newmodes, p_oldmodes, p_code);
 637       audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr;
 638       blkptr = audited_iocb -> iocb.attach_data_ptr;
 639       auditing_iocb = blk.auditing_iocb;
 640       audit_file_header_ptr = blk.audit_file_header_ptr;
 641       if blk.current_flags.trace
 642       then call audit_line ("TM", rtrim (p_newmodes) || NL);
 643       unrecognized_modes = "";
 644       if length (rtrim (p_newmodes)) = 0
 645       then
 646          do;
 647             call iox_$modes (blk.auditing_iocb, p_newmodes, p_oldmodes, p_code);
 648             return;
 649          end;
 650 
 651       call mode_string_$parse (p_newmodes, addr (temp_area), mode_string_info_ptr, p_code);
 652       if p_code ^= 0
 653       then return;
 654 
 655       if mode_string_info.version ^= mode_string_info_version_2
 656       then call
 657               sub_err_ (error_table_$unimplemented_version, myname, "s", null, 0,
 658               "^/Unable to use the mode_string_info structure.  Expecting version ^d,
 659 received version ^d.", mode_string_info_version_2, mode_string_info.version);
 660       if mode_string_info.number > 0
 661       then if mode_string_info.modes (1).version ^= mode_value_version_3
 662            then call
 663                    sub_err_ (error_table_$unimplemented_version, myname, "s", null, 0,
 664                    "^/Unable to use the mode_value structure. Expecting version ^d,
 665 received version ^d.", mode_value_version_3, mode_string_info.modes (1).version);
 666 
 667 MODE_LOOP:
 668       do mode_idx = 1 to mode_string_info.number;
 669          newmodes = mode_string_info.modes (mode_idx).mode_name;
 670          if index (newmodes, "audit_") = 1
 671          then if newmodes = "audit_suspend"
 672               then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep
 673                    then
 674                       do;
 675                          p_code = error_table_$bad_mode_syntax;
 676                          return;
 677                       end;
 678                    else if mode_string_info.modes (mode_idx).boolean_value
 679                    then
 680                       do;
 681                          if ^blk.suspend
 682                          then call suspend_auditing ("", null);
 683                       end;
 684                    else
 685                       do;
 686                          string (blk.current_flags) = string (blk.saved_flags);
 687                          blk.suspend = "0"b;
 688                       end;
 689 
 690               else if blk.suspend
 691               then call
 692                       ioa_$ioa_switch (auditing_iocb,
 693                       "audit_: auditing suspended, no audit_ modes operations allowed except ^^audit_suspend");
 694               else if newmodes = "audit_input"
 695               then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep
 696                    then
 697                       do;
 698                          p_code = error_table_$bad_mode_syntax;
 699                          return;
 700                       end;
 701                    else blk.current_flags.read_audit = mode_string_info.modes (mode_idx).flags.boolean_value;
 702               else if newmodes = "audit_transparent"
 703               then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep
 704                    then
 705                       do;
 706                          p_code = error_table_$bad_mode_syntax;
 707                          return;
 708                       end;
 709                    else if mode_string_info.modes (mode_idx).flags.boolean_value
 710                    then blk.default_iocb = auditing_iocb;
 711                    else blk.default_iocb = audited_iocb;
 712 
 713               else if newmodes = "audit_file_size"
 714               then if mode_string_info.modes (mode_idx).flags.boolean_valuep
 715                    then
 716                       do;
 717                          p_code = error_table_$bad_mode_syntax;
 718                          return;
 719                       end;
 720                    else if mode_string_info.modes (mode_idx).flags.char_valuep
 721                    then if mode_string_info.modes (mode_idx).char_value = "unlimited"
 722                         then
 723                            do;
 724                               blk.begin_ptr = audit_file_header_ptr;
 725                               audit_file_header.begin_component = 0;
 726                               audit_file_header.begin_index =
 727                                  size (audit_file_header) * 4 + 7 - mod (size (audit_file_header) * 4 + 7, 8);
 728                               audit_file_header.max_index = audit_file_header.audit_index;
 729                               audit_file_header.max_component = audit_file_header.current_component;
 730                               audit_file_header.filled = "0"b;
 731                               blk.current_flags.file_limit = "0"b;
 732                            end;
 733                         else
 734                            do;
 735                               p_code = error_table_$bad_mode_value;
 736                               return;
 737                            end;
 738 
 739                    else
 740                       do;
 741                          records = mode_string_info.modes (mode_idx).numeric_value;
 742                          if records <= 0
 743                          then
 744                             do;
 745                                p_code = error_table_$bad_mode_value;
 746                                return;
 747                             end;
 748                          audit_file_header.max_component = divide (records, 256, 17, 0);
 749                          audit_file_header.max_index = 4096 * (records - audit_file_header.max_component * 256);
 750                          blk.current_flags.file_limit = "1"b;
 751                       end;
 752 
 753               else if newmodes = "audit_output"
 754               then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep
 755                    then
 756                       do;
 757                          p_code = error_table_$bad_mode_syntax;
 758                          return;
 759                       end;
 760                    else blk.current_flags.write_audit = mode_string_info.modes (mode_idx).flags.boolean_value;
 761               else if newmodes = "audit_edit"
 762               then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep
 763                    then
 764                       do;
 765                          p_code = error_table_$bad_mode_syntax;
 766                          return;
 767                       end;
 768                    else blk.current_flags.edit = mode_string_info.modes (mode_idx).flags.boolean_value;
 769               else if newmodes = "audit_trace"
 770               then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep
 771                    then
 772                       do;
 773                          p_code = error_table_$bad_mode_syntax;
 774                          return;
 775                       end;
 776                    else blk.current_flags.trace = mode_string_info.modes (mode_idx).flags.boolean_value;
 777               else if newmodes = "audit_meter"
 778               then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep
 779                    then
 780                       do;
 781                          p_code = error_table_$bad_mode_syntax;
 782                          return;
 783                       end;
 784                    else blk.current_flags.meter = mode_string_info.modes (mode_idx).flags.boolean_value;
 785               else if newmodes = "audit_trigger"
 786               then if ^mode_string_info.modes (mode_idx).flags.char_valuep
 787                    then
 788                       do;
 789                          p_code = error_table_$bad_mode_syntax;
 790                          return;
 791                       end;
 792                    else blk.trigger = mode_string_info.modes (mode_idx).char_value;
 793               else if newmodes = "audit_use_editor_prompt"
 794               then if ^mode_string_info.modes (mode_idx).flags.boolean_valuep
 795                    then
 796                       do;
 797                          p_code = error_table_$bad_mode_syntax;
 798                          return;
 799                       end;
 800                    else blk.current_flags.use_editor_prompt = mode_string_info.modes (mode_idx).flags.boolean_value;
 801               else if newmodes = "audit_editor_prompt_string" | newmodes = "audit_epstr"
 802               then if ^mode_string_info.modes (mode_idx).flags.char_valuep
 803                    then
 804                       do;
 805                          p_code = error_table_$bad_mode_syntax;
 806                          return;
 807                       end;
 808                    else blk.editor_prompt_string = mode_string_info.modes (mode_idx).char_value;
 809       end MODE_LOOP;
 810       call mode_string_$delete (mode_string_info_ptr, AUDIT_MODE_NAMES, unrecognized_modes, p_code);
 811       if unrecognized_modes ^= "" & unrecognized_modes ^= "."
 812       then
 813          do;
 814 
 815             /*** It is necessary to convert ll=NN and pl=NN, which mode_string_ produces,
 816 into llNN and plNN, which is the only form the tty_ dim currently understands.
 817 Hopefully, any other io module under audit_ which gets ll=  and pl= modes will
 818 also understand the other forms.
 819 */
 820             if index (unrecognized_modes, "ll=") > 0
 821             then unrecognized_modes =
 822                     before (rtrim (unrecognized_modes), "ll=") || "ll" || after (rtrim (unrecognized_modes), "ll=");
 823             if index (unrecognized_modes, "pl=") > 0
 824             then unrecognized_modes =
 825                     before (rtrim (unrecognized_modes), "pl=") || "pl" || after (rtrim (unrecognized_modes), "pl=");
 826 
 827             call iox_$modes (blk.auditing_iocb, (unrecognized_modes), p_oldmodes, p_code);
 828          end;
 829 
 830 /**** vp: tr phx19369 , display old modes when input modes are only audit modes ****/
 831 
 832          else call iox_$modes (blk.auditing_iocb, "", p_oldmodes, p_code);
 833 
 834       return;
 835 
 836 
 837 
 838 audit_get_line:
 839    entry (p_iocb_ptr, p_buff_ptr, p_buff_len, p_actual_len, p_code);
 840       dcl     file_char_array        (0:sys_info$max_seg_size * 4) char (1) based (buff_ptr);
 841       audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr;
 842       blkptr = audited_iocb -> iocb.attach_data_ptr;
 843       auditing_iocb = blk.auditing_iocb;
 844       buff_ptr = p_buff_ptr;
 845       buff_len = p_buff_len;
 846 GET_LINE:
 847       if blk.work_space ^= null
 848       then
 849          do;                                                /* set up input_string on temp_seg. */
 850             buff_ptr = blk.work_space;
 851             actual_len = blk.work_space_len;
 852             buff_len = sys_info$max_seg_size * 4;           /* if input_string bigger than p_string, fill p_string and return long_record */
 853                                                             /* if input_string smaller than p_string, fill p_string and return. */
 854             if actual_len > p_buff_len
 855             then
 856                do;
 857                   p_actual_len = p_buff_len;
 858                   param_input_string = substr (aut_input_string, 1, p_buff_len);
 859                   blk.work_space = addr (file_char_array (p_buff_len));
 860                   blk.work_space_len = actual_len - p_buff_len;
 861                   p_code = error_table_$long_record;
 862                   return;
 863                end;
 864             else
 865                do;
 866                   p_actual_len = actual_len;
 867                   param_input_string = aut_input_string;
 868                   blk.work_space = null;
 869                   blk.work_space_len = 0;
 870                   p_code = 0;
 871                   return;
 872                end;
 873          end;
 874 
 875       else
 876          do;
 877             call iox_$get_line (auditing_iocb, p_buff_ptr, p_buff_len, p_actual_len, p_code);
 878             if p_code ^= 0
 879             then if p_code = error_table_$long_record
 880                  then
 881                     do;
 882                        blk.work_space = blk.temp_seg_ptr;
 883                        blk.work_space_len = sys_info$max_seg_size * 4;
 884                        buff_len = blk.work_space_len;
 885                        buff_ptr = blk.work_space;
 886                        actual_len = p_buff_len;
 887                        substr (aut_input_string, 1, actual_len) = substr (param_input_string, 1, p_actual_len);
 888                        buff_ptr = addr (file_char_array (actual_len));
 889                        buff_len = buff_len - actual_len;
 890                        call iox_$get_line (auditing_iocb, buff_ptr, buff_len, actual_len, p_code);
 891                        if p_code ^= 0
 892                        then return;
 893                        buff_ptr = blk.temp_seg_ptr;
 894                        actual_len = actual_len + p_actual_len;
 895                        buff_len = blk.work_space_len;
 896                        blk.work_space_len = actual_len;
 897                     end;
 898                  else return;
 899 
 900             else actual_len = p_actual_len;
 901 MORE_GET_LINE:
 902             if ^(blk.current_flags.edit & (actual_len > 2))
 903             then
 904                do;
 905                   if blk.current_flags.read_audit
 906                   then call audit_line ("IL", aut_input_string);
 907                end;
 908             else if (substr (aut_input_string, actual_len - 2, 1) = blk.trigger)
 909             then
 910                do;
 911                   request = substr (aut_input_string, actual_len - 1, 1);
 912                   if request = "."
 913                   then
 914                      do;
 915                         if blk.current_flags.read_audit & (blk.default_iocb ^= blk.auditing_iocb)
 916                         then call audit_line ("IL", aut_input_string);
 917                         call
 918                            ioa_$ioa_switch (blk.default_iocb, "audit ^[input^]^[/^]^[output^]",
 919                            blk.current_flags.read_audit, blk.current_flags.read_audit & blk.current_flags.write_audit,
 920                            blk.current_flags.write_audit);
 921                         substr (aut_input_string, 1, actual_len - 2) = substr (aut_input_string, 1, actual_len - 3) || NL;
 922                         actual_len = actual_len - 2;
 923                      end;
 924                   else if request = "?"
 925                   then
 926                      do;
 927                         if blk.current_flags.read_audit & (blk.default_iocb ^= blk.auditing_iocb)
 928                         then call audit_line ("IL", aut_input_string);
 929                         call ioa_$ioa_switch (blk.default_iocb, "REQUESTS:");
 930                         call ioa_$ioa_switch (blk.default_iocb, "^a. -> who am I", blk.trigger);
 931                         call ioa_$ioa_switch (blk.default_iocb, "^a? -> what can I do", blk.trigger);
 932                         call ioa_$ioa_switch (blk.default_iocb, "^ae -> enter editor", blk.trigger);
 933                         call
 934                            ioa_$ioa_switch (blk.default_iocb, "^aE -> enter editor, process input line as edit requests",
 935                            blk.trigger);
 936                         call ioa_$ioa_switch (blk.default_iocb, "^aa -> abbrev expand input line", blk.trigger);
 937                         call ioa_$ioa_switch (blk.default_iocb, "^ar -> replay input line", blk.trigger);
 938                         call
 939                            ioa_$ioa_switch (blk.default_iocb, "^at -> transparent input line (do not log)", blk.trigger);
 940                         call ioa_$ioa_switch (blk.default_iocb, "^ad -> delete line", blk.trigger);
 941                         call ioa_$ioa_switch (blk.default_iocb, "^an -> no operation", blk.trigger);
 942                         call
 943                            ioa_$ioa_switch (blk.default_iocb, "NOTE:  above requests recognized only in audit_edit mode");
 944                         substr (aut_input_string, 1, actual_len - 2) = substr (aut_input_string, 1, actual_len - 3) || NL;
 945                         actual_len = actual_len - 2;
 946                      end;
 947                   else if request = "r"
 948                   then
 949                      do;
 950                         call ioa_$ioa_switch_nnl (blk.default_iocb, "^a", substr (aut_input_string, 1, actual_len - 3));
 951                         call
 952                            iox_$get_line (auditing_iocb, addr (file_char_array (actual_len - 3)),
 953                            buff_len - actual_len + 3, tactual_len, p_code);
 954                         if p_code ^= 0
 955                         then if p_code ^= error_table_$long_record
 956                              then return;
 957                              else if blk.work_space ^= null
 958                              then return;
 959                              else
 960                                 do;
 961                                    blk.work_space = blk.temp_seg_ptr;
 962                                    blk.work_space_len = sys_info$max_seg_size * 4;
 963                                    buff_ptr = blk.temp_seg_ptr;
 964                                    buff_len = blk.work_space_len;
 965                                    actual_len = tactual_len + actual_len - 3;
 966                                    substr (aut_input_string, 1, actual_len) = substr (param_input_string, 1, actual_len);
 967 
 968                                    buff_ptr = addr (file_char_array (actual_len));
 969                                    buff_len = buff_len - actual_len;
 970                                    call iox_$get_line (default_iocb, buff_ptr, buff_len, tactual_len, p_code);
 971                                    if p_code ^= 0
 972                                    then return;
 973                                    buff_ptr = blk.temp_seg_ptr;
 974                                    buff_len = blk.work_space_len;
 975                                    actual_len = actual_len + tactual_len;
 976                                    blk.work_space_len = actual_len;
 977                                 end;
 978                         else actual_len = actual_len + tactual_len - 3;
 979                         goto MORE_GET_LINE;
 980                      end;
 981                   else if request = "e" | request = "E"
 982                   then
 983                      do;
 984                         if blk.current_flags.read_audit & (blk.default_iocb ^= blk.auditing_iocb)
 985                         then call audit_line ("IL", aut_input_string);
 986                         blk.work_space = null;
 987                         call audit_editor (buff_ptr, buff_len, actual_len, audited_iocb, p_code);
 988                         if p_code ^= 0
 989                         then if p_code = error_table_$empty_file
 990                              then call ioa_$ioa_switch (blk.default_iocb, "audit_: Can't edit, the audit file is empty.");
 991                              else call ioa_$ioa_switch (blk.default_iocb, "audit_: Error attempting to use editor.");
 992                         else
 993                            do;
 994                               set_last_return_line_position = "1"b;
 995                               if blk.current_flags.read_audit
 996                               then call audit_line ("EL", aut_input_string);
 997                            end;
 998                      end;
 999                   else if request = "a"
1000                   then
1001                      do;
1002                         if blk.current_flags.read_audit & (blk.default_iocb ^= blk.auditing_iocb)
1003                         then call audit_line ("IL", aut_input_string);
1004                         substr (aut_input_string, 1, actual_len - 2) = substr (aut_input_string, 1, actual_len - 3) || NL;
1005                         actual_len = actual_len - 2;
1006                         call abbrev_$expanded_line (buff_ptr, (actual_len), addr (ab_buf), 512, out_ptr, ab_len);
1007                         if ab_len > 512
1008                         then if ab_len > buff_len
1009                              then
1010                                 do;
1011                                    buff_ptr = blk.temp_seg_ptr;
1012                                    buff_len = ab_len;
1013                                    actual_len = ab_len;
1014                                    buff_ptr -> aut_input_string = out_ptr -> aut_input_string;
1015                                    free out_ptr -> aut_input_string;
1016                                 end;
1017                              else
1018                                 do;
1019                                    buff_len = ab_len;
1020                                    actual_len = ab_len;
1021                                    buff_ptr -> aut_input_string = out_ptr -> aut_input_string;
1022                                    free out_ptr -> aut_input_string;
1023                                 end;
1024                         else if ab_len > buff_len
1025                         then
1026                            do;
1027                               buff_ptr = blk.temp_seg_ptr;
1028                               buff_len = ab_len;
1029                               actual_len = ab_len;
1030                               aut_input_string = substr (ab_buf, 1, ab_len);
1031                            end;
1032                         else
1033                            do;
1034                               actual_len = ab_len;
1035                               substr (aut_input_string, 1, ab_len) = substr (ab_buf, 1, ab_len);
1036                            end;
1037                      end;
1038                   else if request = "d"
1039                   then
1040                      do;
1041                         blk.work_space = null;
1042                         blk.work_space_len = 0;
1043                         buff_ptr = p_buff_ptr;
1044                         buff_len = p_buff_len;
1045                         actual_len = 0;
1046                         goto GET_LINE;
1047                      end;
1048                   else if request = "n"
1049                   then
1050                      do;
1051                         if blk.current_flags.read_audit & (blk.default_iocb ^= blk.auditing_iocb)
1052                         then call audit_line ("IL", aut_input_string);
1053                         actual_len = actual_len - 2;
1054                         substr (aut_input_string, actual_len, 1) = NL;
1055                      end;
1056                   else if request = "t"
1057                   then
1058                      do;
1059                         actual_len = actual_len - 2;
1060                         substr (aut_input_string, actual_len, 1) = NL;
1061                      end;
1062                   else if blk.current_flags.read_audit
1063                   then call audit_line ("IL", aut_input_string);
1064                end;
1065             else if blk.current_flags.read_audit
1066             then call audit_line ("IL", aut_input_string);
1067 
1068             if actual_len > p_buff_len
1069             then
1070                do;
1071                   p_actual_len = p_buff_len;
1072                   param_input_string = substr (aut_input_string, 1, p_buff_len);
1073                   blk.work_space = addr (file_char_array (p_buff_len));
1074                   blk.work_space_len = actual_len - p_buff_len;
1075                   p_code = error_table_$long_record;
1076                   return;
1077                end;
1078             else
1079                do;
1080                   p_actual_len = actual_len;
1081                   param_input_string = substr (aut_input_string, 1, actual_len);
1082                   blk.work_space = null;
1083                   blk.work_space_len = 0;
1084                   p_code = 0;
1085                   return;
1086                end;
1087             p_code = 0;
1088             return;
1089          end;
1090 
1091 
1092 audit_put_chars:
1093    entry (p_iocb_ptr, p_buff_ptr, p_buff_len, p_code);
1094       audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr;
1095       blkptr = audited_iocb -> iocb.attach_data_ptr;
1096       auditing_iocb = blk.auditing_iocb;
1097       call iox_$put_chars (auditing_iocb, p_buff_ptr, p_buff_len, p_code);
1098       if p_code ^= 0
1099       then return;
1100       if blk.current_flags.write_audit
1101       then call audit_line ("OC", param_output_string);
1102       p_code = 0;
1103       return;
1104 
1105 
1106 audit_position:
1107    entry (p_iocb_ptr, ptype, n, p_code);
1108       audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr;
1109       blkptr = audited_iocb -> iocb.attach_data_ptr;
1110       auditing_iocb = blk.auditing_iocb;
1111       call iox_$position (auditing_iocb, ptype, n, p_code);
1112       return;
1113 
1114 
1115 audit_control:
1116    entry (p_iocb_ptr, p_real_order, p_info_ptr, p_code);
1117 
1118       audited_iocb = p_iocb_ptr -> iocb.actual_iocb_ptr;
1119       blkptr = audited_iocb -> iocb.attach_data_ptr;
1120       audit_file_header_ptr = blk.audit_file_header_ptr;
1121       if blk.current_flags.trace
1122       then call audit_line ("TC", p_real_order || NL);
1123       order = p_real_order;
1124       if substr (order, 1, 6) = "audit_"
1125       then
1126          do;
1127             order = substr (order, 7);
1128             if order = "truncate"
1129             then
1130                do;
1131                   audit_file_header.current_component = 0;
1132                   call
1133                      msf_manager_$adjust (blk.audit_fcb, 0,
1134                      ((4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8)) * 9, "110"b,
1135                      p_code);
1136                   call truncate_audit_file;
1137                   audit_file_header.begin_index = audit_file_header.audit_index;
1138                   audit_file_header.begin_component = 0;
1139                   audit_file_header.filled = "0"b;
1140                   blk.begin_ptr = blk.audit_ptr;
1141                end;
1142             else if order = "modes"
1143             then
1144                do;
1145                   p_info_ptr -> mode_str = mode_string (p_code);
1146                end;
1147             else
1148                do;
1149                   call iox_$control (blk.auditing_iocb, p_real_order, p_info_ptr, p_code);
1150                   return;
1151                end;
1152          end;
1153       else if order = "io_call"
1154       then if p_info_ptr -> io_call_info.order_name = "audit_modes"
1155            then
1156               do;
1157                  call p_info_ptr -> io_call_info.report ("audit modes: ^a", mode_string (p_code));
1158                  return;
1159               end;
1160            else
1161               do;
1162                  call iox_$control (blk.auditing_iocb, p_real_order, p_info_ptr, p_code);
1163                  return;
1164               end;
1165       else if order = "resetread" | order = "abort"
1166       then
1167          do;
1168             blk.work_space = null;
1169             blk.work_space_len = 0;
1170             call iox_$control (blk.auditing_iocb, p_real_order, p_info_ptr, p_code);
1171             return;
1172          end;
1173       else
1174          do;
1175             call iox_$control (blk.auditing_iocb, p_real_order, p_info_ptr, p_code);
1176             return;
1177          end;
1178       p_code = 0;
1179       return;
1180 
1181 /* ^L */
1182 
1183 audit_line:
1184    proc (p_tag, p_string);
1185       dcl     1 position             like position_template;
1186       dcl     1 previous_position    like position_template;
1187       dcl     1 position_info        like position_info_template;
1188       dcl     bytes_required         fixed bin (24);
1189       dcl     max_entry_size         fixed bin (24);
1190       dcl     room_for_insertion     fixed bin (24);
1191       dcl     trim_entry             bit (1) init ("0"b);
1192       dcl     p_tag                  char (*);
1193       dcl     p_string               char (*);
1194 
1195       call hcs_$set_ips_mask (0, mask);
1196 
1197       on any_other
1198          begin;
1199             call force_audit_suspension;
1200             goto RETURN;
1201          end;
1202 
1203       audit_file_header_ptr = blk.audit_file_header_ptr;
1204       position.aep = null;
1205       bytes_required = length (p_string) + 7 - mod (length (p_string) + 7, 8) + (4 * size (audit_entry));
1206 
1207       call set_max_entry_size;
1208       if bytes_required > max_entry_size
1209       then
1210          do;
1211             bytes_required = max_entry_size;
1212             trim_entry = "1"b;
1213          end;
1214 
1215       call get_room_for_insertion;
1216       do while (bytes_required > room_for_insertion);
1217          call adjust_indices;
1218          call get_room_for_insertion;
1219       end;
1220 
1221       call set_position_info;
1222 
1223       call insert (p_tag, p_string);
1224       if set_last_return_line_position
1225       then
1226          do;
1227             set_last_return_line_position = "0"b;
1228             call audit_editor$set_last_return_line_position (addr (position));
1229          end;
1230 
1231 RETURN:
1232       revert any_other;
1233       call hcs_$set_ips_mask (mask, 0);
1234       return;
1235 
1236 set_max_entry_size:
1237    proc;
1238       if ^blk.current_flags.file_limit
1239       then max_entry_size = sys_info$max_seg_size * 4;
1240       else if audit_file_header.max_component > 1
1241       then max_entry_size = sys_info$max_seg_size * 4;
1242       else if audit_file_header.max_component = 1
1243       then max_entry_size =
1244               max (audit_file_header.max_index,
1245               sys_info$max_seg_size * 4
1246               - ((4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8)));
1247       else max_entry_size =
1248               audit_file_header.max_index
1249               - ((4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8));
1250    end;
1251 
1252 get_room_for_insertion:
1253    proc;
1254       if ^blk.current_flags.file_limit
1255       then room_for_insertion = sys_info$max_seg_size * 4 - audit_file_header.audit_index;
1256       else if (audit_file_header.begin_component = audit_file_header.current_component)
1257               & (audit_file_header.begin_index >= audit_file_header.audit_index) & audit_file_header.filled
1258       then room_for_insertion = audit_file_header.begin_index - audit_file_header.audit_index;
1259       else if audit_file_header.current_component = audit_file_header.max_component
1260       then room_for_insertion = audit_file_header.max_index - audit_file_header.audit_index;
1261       else room_for_insertion = sys_info$max_seg_size * 4 - audit_file_header.audit_index;
1262    end;
1263 
1264 adjust_indices:
1265    proc;
1266       if ^blk.current_flags.file_limit
1267       then call next_component (audit_file_header.current_component, audit_file_header.audit_index, blk.audit_ptr);
1268       else if audit_file_header.begin_component = audit_file_header.current_component
1269               & audit_file_header.begin_index >= audit_file_header.audit_index & audit_file_header.filled
1270       then
1271          do;
1272             position.aep = addr (blk.begin_ptr -> file_char_array (audit_file_header.begin_index));
1273             call hcs_$status_mins (blk.begin_ptr, type, bit_count24, p_code);
1274             if audit_file_header.begin_index + (4 * currentsize (position.aep -> audit_entry)) + 7
1275                - mod ((4 * currentsize (position.aep -> audit_entry)) + 7, 8) >= divide (bit_count24, 9, 24, 0)
1276             then call next_component (audit_file_header.begin_component, audit_file_header.begin_index, blk.begin_ptr);
1277             else audit_file_header.begin_index =
1278                     audit_file_header.begin_index + (4 * currentsize (position.aep -> audit_entry)) + 7
1279                     - mod ((4 * currentsize (position.aep -> audit_entry)) + 7, 8);
1280          end;
1281       else call next_component (audit_file_header.current_component, audit_file_header.audit_index, blk.audit_ptr);
1282    end;
1283 
1284 next_component:
1285    proc (p_component_number, p_component_index, p_component_ptr);
1286       dcl     p_component_number     fixed bin (17);
1287       dcl     p_component_index      fixed bin (24);
1288       dcl     p_component_ptr        ptr;
1289 
1290       call hcs_$set_bc_seg (blk.audit_ptr, audit_file_header.audit_index * 9, p_code);
1291       if p_component_number = audit_file_header.max_component & blk.current_flags.file_limit
1292       then
1293          do;
1294             p_component_number = 0;
1295             p_component_index = (4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8);
1296             p_component_ptr = audit_file_header_ptr;
1297             audit_file_header.filled = "1"b;
1298          end;
1299       else
1300          do;
1301             p_component_number = p_component_number + 1;
1302             if ^blk.current_flags.file_limit
1303             then audit_file_header.max_component = p_component_number;
1304             p_component_index = 0;
1305             call msf_manager_$get_ptr (blk.audit_fcb, p_component_number, "1"b, p_component_ptr, bit_count24, p_code);
1306          end;
1307    end;
1308 
1309 set_position_info:
1310    proc;
1311       position_info.last_entry_length = audit_file_header.last_entry_length;
1312       position_info.max_component = audit_file_header.max_component;
1313       position_info.max_index = audit_file_header.max_index;
1314       position_info.begin_component = audit_file_header.begin_component;
1315       position_info.begin_index = audit_file_header.begin_index;
1316       position_info.current_component = audit_file_header.current_component;
1317       position_info.audit_index = audit_file_header.audit_index;
1318       position_info.audit_fcb = blk.audit_fcb;
1319       position_info.audit_ptr = blk.audit_ptr;
1320       position_info.default_search_tag = "";
1321       position_info.any_tag = "1"b;
1322       position_info.dirname = blk.dirname;
1323       position_info.ename = blk.ename;
1324       position_info.file_limit = audit_file_header.filled;
1325       position.char_index = audit_file_header.audit_index;
1326       position.component_number = audit_file_header.current_component;
1327       position.component_ptr = blk.audit_ptr;
1328       if position.component_number = audit_file_header.max_component & blk.current_flags.file_limit
1329       then position.component_max_char_index = audit_file_header.max_index;
1330       else position.component_max_char_index = sys_info$max_seg_size * 4;
1331       position.search_tag = "";
1332       position.entry_number = 0;
1333    end;
1334 
1335 insert:
1336    proc (p_tag, p_string);
1337       dcl     p_string               char (*);
1338       dcl     p_tag                  char (*);
1339       dcl     virtual_time           fixed bin (71);
1340       dcl     paging                 fixed bin;
1341       dcl     dev_paging             fixed bin;
1342       dcl     month                  fixed bin;
1343       dcl     day                    fixed bin;
1344       dcl     year                   fixed bin;
1345       dcl     dow                    fixed bin;
1346       dcl     zone                   char (4) aligned;
1347       dcl     file_char_array        (0:sys_info$max_seg_size * 4) char (1) unaligned based (blk.audit_ptr);
1348       position.aep = addr (file_char_array (audit_file_header.audit_index));
1349 
1350       if blk.current_flags.meter
1351       then
1352          do;
1353             call cpu_time_and_paging_ (paging, virtual_time, dev_paging);
1354             previous_position = position;
1355             call audit_file_position_$last (addr (previous_position), addr (position_info), p_code);
1356             if p_code = 0
1357             then
1358                do;
1359                   previous_position.aep -> audit_entry.virtual_time = virtual_time - blk.virtual_time;
1360                   previous_position.aep -> audit_entry.paging = paging - blk.paging;
1361                end;
1362 
1363             call decode_clock_value_ (clock, day, month, year, position.aep -> audit_entry.time, dow, zone);
1364             blk.virtual_time = virtual_time;
1365             blk.paging = paging;
1366          end;
1367       else position.aep -> audit_entry.time = -1;
1368 
1369       position.aep -> audit_entry.last_entry_length = audit_file_header.last_entry_length;
1370       if trim_entry
1371       then p_string = substr (p_string, 1, bytes_required - (4 * size (position.aep -> audit_entry)));
1372       position.aep -> audit_entry.entry_length = length (p_string);
1373       position.aep -> audit_entry.tag = p_tag;
1374       position.aep -> audit_entry.string = p_string;
1375       position.aep -> audit_entry.virtual_time = -1;
1376       position.aep -> audit_entry.paging = -1;
1377       audit_file_header.last_entry_length = position.aep -> audit_entry.entry_length;
1378       audit_file_header.audit_index = audit_file_header.audit_index + 4 * currentsize (position.aep -> audit_entry);
1379       audit_file_header.audit_index = audit_file_header.audit_index + 7 - mod (audit_file_header.audit_index + 7, 8);
1380       if ^blk.current_flags.file_limit
1381       then audit_file_header.max_index = audit_file_header.audit_index;
1382       return;
1383    end;
1384 
1385    end audit_line;
1386 
1387 /* ^L */
1388 
1389 force_audit_suspension:
1390    proc;
1391       dcl     1 info                 aligned,
1392 %include cond_info;
1393 
1394       dcl     find_condition_info_   entry (ptr, ptr, fixed bin (35));
1395 
1396       call find_condition_info_ (null (), addr (info), p_code);
1397       call suspend_auditing (info.condition_name, info.loc_ptr);
1398    end force_audit_suspension;
1399 
1400 suspend_auditing:
1401    proc (condition, p_ptr);
1402       dcl     condition              char (32) varying;
1403       dcl     p_ptr                  ptr;
1404       if blk.suspend
1405       then return;
1406       blk.suspend = "1"b;
1407       string (blk.saved_flags) = string (blk.current_flags);
1408       string (blk.current_flags) = "0"b;
1409       if condition ^= ""
1410       then call ioa_$ioa_switch (p_iocb_ptr, "audit_: ^a on audit file by ^p, auditing suspended.", condition, p_ptr);
1411       return;
1412    end suspend_auditing;
1413 
1414 mode_string:
1415    proc (p_code) returns (char (512) varying);
1416       dcl     p_code                 fixed bin (35);
1417       dcl     modes                  char (512);
1418       dcl     mode_idx               fixed bin (17);
1419 
1420       audit_file_header_ptr = blk.audit_file_header_ptr;
1421       modes = "";
1422       number_of_modes = 10;
1423       alloc mode_string_info in (temp_area);
1424       mode_string_info.version = mode_string_info_version_2;
1425 MODE_LOOP:
1426       do mode_idx = 1 to hbound (mode_string_info.modes, 1);
1427          mode_value_ptr = addr (mode_string_info.modes (mode_idx));
1428          mode_value.flags = "0"b;
1429          mode_value.boolean_value = "0"b;
1430          mode_value.char_value = "";
1431          mode_value.numeric_value = 0;
1432          goto MODE (mode_idx);
1433 
1434 MODE (1):
1435          mode_value.mode_name = "audit_input";
1436          mode_value.flags.boolean_valuep = "1"b;
1437          mode_value.boolean_value = blk.current_flags.read_audit;
1438          goto NEXT_MODE;
1439 
1440 MODE (2):
1441          mode_value.mode_name = "audit_output";
1442          mode_value.flags.boolean_valuep = "1"b;
1443          mode_value.boolean_value = blk.current_flags.write_audit;
1444          goto NEXT_MODE;
1445 
1446 MODE (3):
1447          mode_value.mode_name = "audit_edit";
1448          mode_value.flags.boolean_valuep = "1"b;
1449          mode_value.boolean_value = blk.current_flags.edit;
1450          goto NEXT_MODE;
1451 
1452 MODE (4):
1453          mode_value.mode_name = "audit_trace";
1454          mode_value.flags.boolean_valuep = "1"b;
1455          mode_value.boolean_value = blk.current_flags.trace;
1456          goto NEXT_MODE;
1457 
1458 MODE (5):
1459          mode_value.mode_name = "audit_meter";
1460          mode_value.flags.boolean_valuep = "1"b;
1461          mode_value.boolean_value = blk.current_flags.meter;
1462          goto NEXT_MODE;
1463 
1464 MODE (6):
1465          mode_value.mode_name = "audit_transparent";
1466          mode_value.flags.boolean_valuep = "1"b;
1467          mode_value.boolean_value = (blk.default_iocb = blk.auditing_iocb);
1468          goto NEXT_MODE;
1469 
1470 MODE (7):
1471          mode_value.mode_name = "audit_trigger";
1472          mode_value.flags.char_valuep = "1"b;
1473          mode_value.char_value = blk.trigger;
1474          goto NEXT_MODE;
1475 
1476 MODE (8):
1477          mode_value.mode_name = "audit_file_size";
1478          if blk.current_flags.file_limit
1479          then
1480             do;
1481                mode_value.flags.numeric_valuep = "1"b;
1482                mode_value.numeric_value =
1483                   (audit_file_header.max_component * 256) + divide (audit_file_header.max_index, 4096, 17, 0);
1484             end;
1485          else
1486             do;
1487                mode_value.flags.char_valuep = "1"b;
1488                mode_value.char_value = "unlimited";
1489             end;
1490          goto NEXT_MODE;
1491 
1492 MODE (9):
1493          mode_value.mode_name = "audit_use_editor_prompt";
1494          mode_value.flags.boolean_valuep = "1"b;
1495          mode_value.boolean_value = blk.current_flags.use_editor_prompt;
1496          goto NEXT_MODE;
1497 
1498 MODE (10):
1499          mode_value.mode_name = "audit_editor_prompt_string";
1500          mode_value.flags.char_valuep = "1"b;
1501          mode_value.char_value = blk.editor_prompt_string;
1502          goto NEXT_MODE;
1503 
1504 NEXT_MODE:
1505       end MODE_LOOP;
1506 
1507       call mode_string_$combine (mode_string_info_ptr, null, modes, p_code);
1508 
1509       return (modes);
1510 
1511    end mode_string;
1512 
1513 truncate_audit_file:
1514    proc;
1515 
1516 /* This program always sets up afh and blk.audit_ptr for
1517    afh.current_component = 0.
1518 */
1519 
1520       audit_file_header_ptr = blk.audit_file_header_ptr;
1521       call msf_manager_$get_ptr (blk.audit_fcb, 0, "1"b, blk.audit_ptr, bit_count24, p_code);
1522       if p_code ^= 0
1523       then
1524          do;
1525             call com_err_ (p_code, "audit_");
1526             return;
1527          end;
1528       audit_file_header.audit_index = (4 * size (audit_file_header)) + 7 - mod ((4 * size (audit_file_header)) + 7, 8);
1529       audit_file_header.last_entry_length = impossible_audit_entry_length;
1530    end truncate_audit_file;
1531 
1532 /* ^L */
1533 
1534 %include audit_block;
1535 %page;
1536 %include audit_entry;
1537 %page;
1538 %include audit_file_header;
1539 %page;
1540 %include audit_position;
1541 %page;
1542 %include io_call_info;
1543 %page;
1544 %include iocb;
1545 %page;
1546 %include iox_dcls;
1547 %page;
1548 %include mode_string_info;
1549    end;