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 /* This command is used to restore storage system files to a
 12    consistent state after detecting an interrupted operation */
 13 vfa:
 14 vfile_adjust:
 15      proc (pathname_arg);
 16           seg_ptr, fcb_ptr, iocb_ptr = null;
 17           call cu_$arg_count (n_args);                      /* number of args with which command was invoked */
 18           if n_args <= 0                                    /* must specify at least the pathname */
 19           then code = error_table_$noarg;
 20           else if n_args > 3                                /* limit of permissible args */
 21           then code = error_table_$too_many_args;
 22           else code = 0;
 23           call check_code;                                  /* aborts if error detected */
 24           call get_file_base;                               /* gets first seg ptr */
 25           if (seg_ptr -> header.file_code ^= seq_code) & (seg_ptr -> header.file_code ^= blk_code)
 26                & (seg_ptr -> header.file_code ^= indx_code)
 27           then call adj_uns_file;                           /* makes the adjustment */
 28           else call adj_struc_file;                         /* takes care of structured files */
 29           call check_code;
 30 cleanup:
 31           if fcb_ptr ^= null                                /* free the msf control block */
 32           then call msf_manager_$close (fcb_ptr);
 33           else if seg_ptr ^= null                           /* was single segment file */
 34           then call hcs_$terminate_noname (seg_ptr, code);
 35           if iocb_ptr ^= null                               /* file was opened for adjustment */
 36           then do;                                          /* close file and free I/O switch */
 37                     call iox_$close (iocb_ptr, code);
 38                     call iox_$detach_iocb (iocb_ptr, code);
 39                end;
 40           return;                                           /* end of main file adjustment routine */
 41 
 42 check_code:
 43      proc;                                                  /* aborts if error detected */
 44           if code = 0
 45           then return;
 46           call com_err_ (code, "vfile_adjust");             /* signal the error */
 47           go to cleanup;                                    /* don't leave  a mess */
 48      end check_code;
 49 
 50 get_file_base:
 51      proc;                                                  /* finds first file component and sets seg_ptr */
 52           call expand_path_ (addr (pathname_arg), length (pathname_arg), addr (d_name), addr (e_name), code);
 53                                                             /* separate directory and entry names */
 54           call check_code;
 55           call hcs_$status_long (d_name, e_name, 1, addr (branch_info), null, code);
 56           call check_code;
 57           if branch_info.type = "10"b                       /* directory or msf */
 58           then if branch_info.bit_count = "0"b              /* directory */
 59                then code = error_table_$dirseg;
 60                else do;                                     /* get ptr to base of msf */
 61                          call msf_manager_$open ((d_name), (e_name), fcb_ptr, code);
 62                                                             /* creates control block */
 63                          call check_code;                   /* abort on error */
 64                          call msf_manager_$get_ptr (fcb_ptr, 0, "0"b, seg_ptr, bc, code);
 65                                                             /* pointer to base of file */
 66                          if seg_ptr ^= null
 67                          then code = 0;                     /* reset spurious code */
 68                     end;
 69           else do;                                          /* get ptr to base of segment */
 70                     call hcs_$initiate (d_name, e_name, "", 0, 1, seg_ptr, code);
 71                     if seg_ptr ^= null
 72                     then code = 0;                          /* no error if pointer returned */
 73                end;
 74           call check_code;
 75      end get_file_base;
 76 
 77 adj_struc_file:
 78      proc;                                                  /* adjusts all structured files */
 79           if n_args > 1                                     /* no args permitted for structured files */
 80           then code = error_table_$too_many_args;
 81           call check_code;
 82           call check_file_lock;                             /* may unlock file */
 83           call attach_unique_sw;                            /* need I/O switch to open and close */
 84           call iox_$open (iocb_ptr, 7 /* sequential_update */, "0"b, code);
 85                                                             /* adjustment will automatically be made if necessary */
 86      end adj_struc_file;
 87 
 88 adj_uns_file:
 89      proc;                                                  /* handles adjustments to unstructured files */
 90           if n_args <= 1                                    /* a control option must be specified */
 91           then code = error_table_$noarg;
 92           call cu_$arg_ptr (2, opt1_ptr, opt1_len, code);
 93           call check_code;
 94           if n_args > 2
 95           then do;                                          /* pick up second optional arg */
 96                     call cu_$arg_ptr (3, opt2_ptr, opt2_len, code);
 97                     call check_code;
 98                end;
 99           if n_args = 2
100           then if opt1_arg = "-set_bc"                      /* indicates setting to last non-zero byte */
101                then call adjust_bit_count_ (d_name, e_name, "1"b /* last byte */, bc, code);
102                                                             /* does the work */
103                else if opt1_arg = "-use_nl"                 /* indic trunc after last complete line */
104                then call trunc_at_line;
105                else if opt1_arg = "-set_nl"                 /* indic newline to be appended if not there */
106                then call append_line;
107                else call get_use_bc;                        /* option must be "-use_bc" */
108           else call get_use_bc;                             /* use existing bit count to truncate */
109           return;                                           /* unstructured file has  been adjusted */
110 
111 trunc_at_line:
112      proc;                                                  /* truncates file after last new-line char */
113           call prep_uns_file;                               /* positions to last line */
114           call iox_$put_chars (iocb_ptr, (null), 0, code);  /* truncates the file */
115      end trunc_at_line;
116 
117 prep_uns_file:
118      proc;                                                  /* sets position to last line of file or eof */
119           call adjust_bit_count_ (d_name, e_name, "1"b, bc, code);
120                                                             /* first set bit count to last non-zero byte */
121           call check_code;
122           call attach_unique_sw;                            /* attaches uniquely named I/O switch with "-extend" option */
123           call iox_$open (iocb_ptr, 3 /* stream_input_output */, "0"b, code);
124                                                             /* file must be opened */
125           call check_code;
126           call iox_$position (iocb_ptr, 0, 0, code);        /* positions just past last newline char */
127      end prep_uns_file;
128 
129 append_line:
130      proc;                                                  /* puts newline char at eof if none already there */
131           call prep_uns_file;                               /* position past last newline */
132           call iox_$get_chars (iocb_ptr, addr (dummy_buffer), 1, rec_len, code);
133                                                             /* get next character */
134           if code ^= error_table_$end_of_info
135           then do;                                          /* must append a newline char */
136                     call iox_$position (iocb_ptr, 1, 0, code);
137                                                             /* go to end of file */
138                     call iox_$put_chars (iocb_ptr, addr (newline), 1, code);
139                end;
140           else code = 0;                                    /* already ends in newline */
141      end append_line;
142 
143 get_use_bc:
144      proc;                                                  /* checks option and truncates at existing bitcount  */
145           if opt1_arg ^= "-use_bc"                          /* no other option will do */
146           then code = error_table_$bad_arg;
147           else if branch_info.type ^= "10"b                 /* single segment case */
148           then do;
149                     if n_args > 2                           /* msf component number specified */
150                     then if opt2_arg ^= "0"
151                          then code = error_table_$bad_arg;
152                          else call hcs_$truncate_seg (seg_ptr, divide (fixed (bit_count) + 35, 36, 18, 0), code);
153                end;
154           else do;                                          /* get tail num and truncate */
155                     if n_args = 2                           /* n not given--default is last non-zero component */
156                     then call get_last_nz_comp;
157                     else call get_comp_n;                   /* picks up specified component-num arg */
158                     call check_code;
159                     call msf_manager_$adjust (fcb_ptr, n_tail, bc, "011"b, code);
160                                                             /* does the truncation */
161                end;
162           return;                                           /* end main routine for handling "-use_bc" option */
163 
164 get_last_nz_comp:
165      proc;                                                  /* finds last non-empty msf component or comp 0 if none */
166 
167           do n_tail = 1 repeat n_tail + 1 while (code = 0); /* find last msf comp */
168                call msf_manager_$get_ptr (fcb_ptr, n_tail, "0"b, seg_ptr, bc, code);
169                                                             /* pointer to next component */
170           end;
171 
172           n_recs = 0;                                       /* last comp+1 has no recs */
173 
174           do n_tail = n_tail - 2 to 0 by -1 while (n_recs = 0);
175                                                             /* find last non-empty comp */
176                call msf_manager_$get_ptr (fcb_ptr, n_tail, "0"b, seg_ptr, bc, code);
177                                                             /* ptr to preceding comp */
178                call hcs_$fs_get_path_name (seg_ptr, d_name, d_len, e_name, code);
179                                                             /* need path for hcs_$status_ */
180                call hcs_$status_ (d_name, e_name, 0, addr (branch_info), null /* no names */, code);
181                                                             /* gets n_recs */
182           end;
183 
184           n_tail = n_tail + 1;                              /* loop decrements once too often */
185 
186      end get_last_nz_comp;
187 
188 get_comp_n:
189      proc;                                                  /* sets n_tail to specified component number */
190           n_tail = cv_dec_check_ (opt2_arg, code);          /* validates conversion */
191           call check_code;
192           call msf_manager_$get_ptr (fcb_ptr, n_tail, "0"b, seg_ptr, bc, code);
193                                                             /* n'th comp info */
194      end get_comp_n;
195 
196      end get_use_bc;
197 
198      end adj_uns_file;
199 
200 attach_unique_sw:
201      proc;                                                  /* attaches I/O switch with "-extend" control option */
202           call iox_$attach_ioname (unique_chars_ ("0"b), iocb_ptr, "vfile_ " || pathname_arg || " -extend", code);
203           call check_code;
204      end attach_unique_sw;
205 
206 check_file_lock:
207      proc;                                                  /* may reset file lock */
208           lock_word = seg_ptr -> header.lock_word;          /* copy the file lock to examine it */
209           call set_lock_$lock (lock_word, 0, code);
210           if code ^= 0
211           then if code = error_table_$locked_by_this_process
212                then do;                                     /* warn user about danger of recursive use of vfile_ */
213                          call command_query_ (addr (query_info), answer, "vfile_adjust",
214                               "Warning--file locked
215 by this process.  Resuming a previous invocation
216 of vfile_ after adjustment may produce unpredictable
217 errors.  Close the I/O switch or issue a new_proc to be safe.
218 Do you still wish to adjust the file?"
219                               );                            /* let user decide */
220                          if answer = "no"
221                          then go to cleanup;                /* forget the whole thing */
222                          seg_ptr -> header.lock_word = bit (-1);
223                                                             /* lock becomes invalid */
224                     end;
225      end check_file_lock;
226 
227 /* declarations for entire program */
228           dcl     hcs_$status_long       entry (char (*) aligned, char (*) aligned, fixed (1), ptr, ptr, fixed (35));
229           dcl     hcs_$initiate          entry (char (*) aligned, char (*) aligned, char (*) aligned, fixed (1), fixed (2),
230                                          ptr, fixed (35));
231           dcl     hcs_$terminate_noname  entry (ptr, fixed (35));
232           dcl     lock_word              bit (36) aligned;
233           dcl     seq_code               static internal fixed init (83711);
234           dcl     blk_code               static internal fixed init (22513);
235           dcl     indx_code              static internal fixed init (7129);
236           dcl     hcs_$truncate_seg      entry (ptr, fixed (18), fixed (35));
237           dcl     error_table_$end_of_info
238                                          external fixed (35);
239           dcl     iox_$put_chars         entry (ptr, ptr, fixed (21), fixed (35));
240           dcl     iox_$position          entry (ptr, fixed, fixed, fixed (35));
241           dcl     iox_$get_chars         entry (ptr, ptr, fixed (21), fixed (21), fixed (35));
242           dcl     rec_len                fixed (21);
243           dcl     newline                char (1) aligned static internal init ("
244 ");
245           dcl     dummy_buffer           char (1) aligned;
246           dcl     pathname_arg           char (*);
247           dcl     opt1_arg               char (opt1_len) based (opt1_ptr);
248           dcl     opt2_arg               char (opt2_len) based (opt2_ptr);
249           dcl     (opt1_len, opt2_len)   fixed;
250           dcl     (opt1_ptr, opt2_ptr)   ptr;
251           dcl     cu_$arg_ptr            entry (fixed, ptr, fixed, fixed (35));
252           dcl     (fcb_ptr, iocb_ptr)    ptr;
253           dcl     cu_$arg_count          entry (fixed);
254           dcl     n_args                 fixed;
255           dcl     code                   fixed (35);
256           dcl     (error_table_$noarg, error_table_$dirseg, error_table_$too_many_args, error_table_$bad_arg,
257                   error_table_$locked_by_this_process)
258                                          external fixed (35);
259           dcl     (null, fixed, bit, divide, addr)
260                                          builtin;
261           dcl     msf_manager_$close     entry (ptr);
262           dcl     iox_$close             entry (ptr, fixed (35));
263           dcl     iox_$open              entry (ptr, fixed, bit (1) aligned, fixed (35));
264           dcl     iox_$detach_iocb       entry (ptr, fixed (35));
265           dcl     com_err_               entry options (variable);
266           dcl     expand_path_           entry (ptr, fixed, ptr, ptr, fixed (35));
267           dcl     msf_manager_$open      entry (char (*) aligned, char (*) aligned, ptr, fixed (35));
268           dcl     msf_manager_$get_ptr   entry (ptr, fixed, bit (1), ptr, fixed (24), fixed (35));
269           dcl     d_name                 char (168) aligned;
270           dcl     e_name                 char (32) aligned;
271           dcl     seg_ptr                ptr;
272           dcl     bc                     fixed (24);
273           dcl     1 header               based (seg_ptr),
274                     2 file_code          fixed (35),
275                     2 lock_word          bit (36) aligned;
276           dcl     adjust_bit_count_      entry (char (168) aligned, char (32) aligned, bit (1) aligned, fixed (24),
277                                          fixed (35));
278           dcl     n_tail                 fixed;
279           dcl     msf_manager_$adjust    entry (ptr, fixed, fixed (24), bit (3), fixed (35));
280           dcl     hcs_$fs_get_path_name  entry (ptr, char (*) aligned, fixed, char (*) aligned, fixed (35));
281           dcl     hcs_$status_           entry (char (*) aligned, char (*) aligned, fixed (1), ptr, ptr, fixed (35));
282           dcl     d_len                  fixed;
283           dcl     1 branch_info          aligned,
284                   ( 2 type               bit (2),
285                     2 nnames             fixed (15),
286                     2 nrp                bit (18),
287                     2 dtm                bit (36),
288                     2 dtu                bit (36),
289                     2 mode               bit (5),
290                     2 pad                bit (13),
291                     2 n_recs             fixed (17)
292                     )                    unaligned,
293                     2 words1             (3) fixed,
294                     2 pad1               bit (12) unal,
295                     2 bit_count          bit (24) unal,
296                     2 words2             (2) fixed;
297           dcl     cv_dec_check_          entry (char (*), fixed (35)) returns (fixed (35));
298           dcl     set_lock_$lock         entry (bit (36) aligned, fixed, fixed (35));
299           dcl     command_query_         entry options (variable);
300           dcl     1 query_info           aligned,
301                     2 version            fixed init (2),
302                     2 yes_or_no_sw       bit (1) unal init ("1"b),
303                     2 suppress_name_sw   bit (1) unal init ("0"b),
304                     2 code               fixed (35),
305                     2 query_code         fixed (35);
306           dcl     answer                 char (12) var;
307           dcl     iox_$attach_ioname     entry (char (*), ptr, char (*), fixed (35));
308           dcl     unique_chars_          entry (bit (*)) returns (char (15));
309      end vfile_adjust;