1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    * Copyright (c) 1972 by Massachusetts Institute of        *
  6    * Technology and Honeywell Information Systems, Inc.      *
  7    *                                                         *
  8    *********************************************************** */
  9 
 10 
 11 /* format: style2,ind3 */
 12 attach_audit:
 13 ata:
 14    proc;
 15 
 16 /*  This module turns on auditing for the calling process. IF
 17    no arguments are given, it generates default switchnames, and audit_
 18    is set up with no arguments.
 19 
 20    Written  1/1/79  by  Lindsey L. Spratt
 21    Modified:
 22    11/26/79  by  Lindsey L. Spratt to implement the -modes control argument.
 23 06/05/81  by  Lindsey Spratt: Changed error message for non-zero code when
 24               trying to attach audit_ to the old switch to give the attach
 25               description being attempted.  Changed the error code from
 26               bad_arg to badopt when more than one mode string is specified.
 27 09/09/81 by Lindsey Spratt: Added a check of arguments being placed in the
 28             attach description "ad".  This allows more elegant error reporting
 29             than the "argerr" produced by audit_. This fixes bug 9.
 30 11/12/81 by Lindsey Spratt: Made all error messages start with a newline.
 31             Changed the argument index variable from "i" to "arg_idx".
 32 */
 33 
 34 /*  Automatic  */
 35 
 36       dcl     nargs                  fixed bin;
 37       dcl     arg_idx                fixed bin;
 38       dcl     tp                     ptr;
 39       dcl     tc                     fixed bin;
 40       dcl     (code, code1)          fixed bin (35);
 41       dcl     ad                     char (128) varying;
 42       dcl     mode_string            char (256) varying init ("");
 43       dcl     old_modes              char (256) init ("");
 44       dcl     (old_switch, new_switch)
 45                                      char (32);
 46       dcl     (old_iocb, new_iocb)   ptr;
 47       dcl     (have_old_iocb, have_new_iocb)
 48                                      bit (1);
 49       dcl     time                   char (16);
 50 
 51 /*  Based  */
 52 
 53       dcl     targ                   char (tc) based (tp);
 54 
 55 /* Builtins */
 56 
 57       dcl     clock                  builtin;
 58       dcl     codeptr                builtin;
 59       dcl     rtrim                  builtin;
 60       dcl     substr                 builtin;
 61 
 62 /* Constant */
 63 
 64       dcl     MYNAME                 char (12) init ("attach_audit") internal static options (constant);
 65 
 66 /*  Entries  */
 67 
 68       dcl     date_time_             entry (fixed bin (71), char (*));
 69       dcl     cu_$arg_count          entry (fixed bin);
 70       dcl     cu_$arg_ptr            entry (fixed bin, ptr, fixed bin, fixed bin (35));
 71       dcl     com_err_               entry options (variable);
 72 
 73 
 74 /* External */
 75 
 76       dcl     error_table_$badopt    fixed bin (35) ext;
 77 
 78 
 79       have_old_iocb = "0"b;
 80       have_new_iocb = "0"b;
 81 
 82       ad = " ";
 83       call cu_$arg_count (nargs);
 84 
 85 
 86       do arg_idx = 1 to nargs;
 87          call cu_$arg_ptr (arg_idx, tp, tc, code);
 88          if code ^= 0
 89          then
 90             do;
 91                call com_err_ (code, MYNAME, "^/Unable to get argument ^d.", arg_idx);
 92                return;
 93             end;
 94 
 95          if index (targ, "-") = 1
 96          then if targ = "-modes"
 97               then if mode_string = ""
 98                    then
 99                       do;
100                          arg_idx = arg_idx + 1;
101                          call cu_$arg_ptr (arg_idx, tp, tc, code);
102                          if code ^= 0
103                          then
104                             do;
105                                call com_err_ (code, MYNAME, "^/No mode string followed the -modes control argument.");
106                                return;
107                             end;
108                          mode_string = targ;
109                       end;
110                    else
111                       do;
112                          call com_err_ (error_table_$badopt, MYNAME, "^/Only one mode string may be given.");
113                          return;
114                       end;
115               else if targ = "-pn" | targ = "-pathname" | targ = "-tc" | targ = "-truncate"
116               then ad = ad || targ || " ";
117               else
118                  do;
119                     call com_err_ (error_table_$badopt, MYNAME, "^/^a is not a known control argument.", targ);
120                     return;
121                  end;
122          else if arg_idx = 1
123          then
124             do;
125                old_switch = targ;
126                call iox_$look_iocb (old_switch, old_iocb, code);
127                if code ^= 0
128                then
129                   do;
130                      call com_err_ (code, MYNAME, "^/Unable to find the switch named ^a.", old_switch);
131                      return;
132                   end;
133                have_old_iocb = "1"b;
134             end;
135          else if arg_idx ^= 2
136          then ad = ad || targ || " ";
137          else if have_old_iocb
138          then
139             do;
140                new_switch = targ;
141                call iox_$find_iocb (new_switch, new_iocb, code);
142                if code ^= 0
143                then
144                   do;
145                      call com_err_ (code, MYNAME, "^/Unable to find or create the new switch named ^a.", new_switch);
146                      return;
147                   end;
148                have_new_iocb = "1"b;
149             end;
150          else ad = ad || targ || " ";
151       end;
152 
153       if ^have_new_iocb
154       then
155          do;
156             call date_time_ (clock, time);
157             new_switch = "audit_i/o." || substr (time, 11, 6);
158             call iox_$find_iocb (new_switch, new_iocb, code);
159             if code ^= 0
160             then
161                do;
162                   call
163                      com_err_ (code, MYNAME, "^/Unable to find or create the new switch with default switchname ^a.",
164                      new_switch);
165                   return;
166                end;
167          end;
168 
169       if ^have_old_iocb
170       then
171          do;
172             old_switch = "user_i/o";
173             call iox_$look_iocb (old_switch, old_iocb, code);
174             if code ^= 0
175             then
176                do;
177                   call com_err_ (code, MYNAME, "^/Unable to find the switch to be audited ^a.", old_switch);
178                   return;
179                end;
180          end;
181 
182       ad = "audit_ " || rtrim (new_switch) || " " || ad;
183 
184       call iox_$move_attach (old_iocb, new_iocb, code);
185       if code ^= 0
186       then
187          do;
188             call com_err_ (code, MYNAME, "^/Unable to move attachment from ^a to ^a", old_switch, new_switch);
189             return;
190          end;
191 
192       call iox_$attach_ptr (old_iocb, (ad), codeptr (attach_audit), code);
193       if code ^= 0
194       then
195          do;
196             call iox_$detach_iocb (old_iocb, code1);
197             call iox_$move_attach (new_iocb, old_iocb, code1);
198             call
199                com_err_ (code, MYNAME, "^/Unable to attach audit_ to switch ^a, using the attach description ""^a"".",
200                old_switch, ad);
201             return;
202          end;
203       call iox_$modes (old_iocb, (mode_string), old_modes, code);
204       return;
205 
206 /*  Include  */
207 
208 %include iox_dcls;
209    end;