1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 
 13 /* format: style4,delnl,insnl,ifthenstmt,ifthen,indnoniterend,indend,^indproc */
 14 /* format: off */
 15 on_line_salvager:
 16      proc (a_dp, a_code);
 17 
 18 /* Modified by Kobziar on 12-6-73 to delete only user from acl in dump */
 19 /* Modified by Kobizar on 12-3-74 to give all users access under AI */
 20 /* Modified by R. Bratt on 06/03/76 to call find_$finished */
 21 /* Last modified by Greenberg 07/26/76 to terminate processes cleanly, also cleaned up AST length getting */
 22 /* Modified by S. Barr 9/76 to use new hash table format. */
 23 /* Modified by Greenberg 11/18/76 for setting AIM out of service. */
 24 /* Modified by S. Barr 4/77 to force rebuild. */
 25 /* Rewritten by S. Barr 7/77 to fix bugs and to call the new salvager primatives. */
 26 /* Rewritten 7/77 by S. Barr for multiprocess salvaging. */
 27 /* Modified 6/79 by Mike Grady for stack 0 sharing */
 28 /* Modified 10 Aug 1981, W. Olin Sibert, to handle errors while creating dump copies */
 29 /* Modified 25 February 1985, Keith Loepere, to use the real internal get_pathname_. */
 30 
 31 dcl  a_dp pointer parameter;
 32 dcl  a_code fixed bin (35) parameter;
 33 
 34 dcl  dir_name char (168);
 35 dcl  ename char (32);
 36 dcl  path_name char (168) var;
 37 dcl  set_sw fixed bin (35);
 38 dcl  (i, l) fixed bin;
 39 dcl  (root, old_modify) bit (1);
 40 dcl  entry_time char (24);
 41 dcl  (dir_name_len, save_level) fixed bin (17);
 42 dcl  code fixed bin (35);
 43 dcl  salvlp ptr;                                            /* ptr to salv_data$lock. */
 44 
 45 dcl  unlock_parent bit (1) aligned;
 46 dcl  rb (3) fixed bin (6) init (7, 7, 7);
 47 
 48 dcl  1 args aligned like salv_args;
 49 
 50 dcl  pds$process_group_id char (32) aligned external static;
 51 dcl  pds$process_dir_name char (32) aligned external static;
 52 dcl  pds$ fixed bin external static;
 53 dcl  pds$processid bit (36) aligned external static;
 54 dcl  pds$stack_0_ptr pointer external static;
 55 
 56 dcl  error_table_$argerr fixed bin (35) external static;
 57 dcl  error_table_$mylock fixed bin (35) external static;
 58 dcl  error_table_$root fixed bin (35) external static;
 59 dcl  error_table_$salv_pdir_procterm fixed bin (35) external static;
 60 
 61 dcl  date_time_ entry (fixed bin (71), char (*));
 62 dcl  get_pathname_                      entry (fixed bin (17), char (*) varying, fixed bin (35));
 63 dcl  level$get entry (fixed bin);
 64 dcl  level$set entry (fixed bin);
 65 dcl  lock$dir_unlock entry (pointer);
 66 dcl  lock$unlock_fast entry (ptr);
 67 dcl  lock$lock_fast entry (ptr);
 68 dcl  salvager$online entry (ptr);
 69 dcl  salv_directory$online_salvage entry (ptr, ptr, ptr, fixed bin (35));
 70 dcl  salv_dump_copy entry (pointer, fixed bin, char (*));
 71 dcl  salv_err_msg entry options (variable);
 72 dcl  set_privileges$dir_priv_off entry (fixed bin (35));
 73 dcl  set_privileges$dir_priv_on entry (fixed bin (35));
 74 dcl  sum$getbranch_root_my entry (pointer, bit (36) aligned, pointer, fixed bin (35));
 75 dcl  syserr entry options (variable);
 76 dcl  syserr$error_code entry options (variable);
 77 dcl  vtoc_attributes$get_info entry (bit (36) aligned, bit (36) aligned, fixed bin, ptr, fixed bin (35));
 78 
 79 dcl  typelock bit (36) aligned options (constant) static init ("1"b);
 80 
 81 dcl  WHOAMI char (32) internal static options (constant) init ("on_line_salvager");
 82 
 83 dcl  cleanup condition;
 84 
 85 dcl  (addr, clock, index, length, max, ptr, rel, reverse, segno, substr) builtin;
 86 
 87 ^L
 88 
 89           a_code = 0;
 90           dp = a_dp;
 91           if rel (dp) ^= "0"b then do;
 92                a_code = error_table_$argerr;
 93                return;
 94                end;
 95 
 96           root, unlock_parent = "0"b;
 97 
 98 /* salv_data lock prevents two processes from online salvaging at the same time.  (Output would be mixed up.) */
 99 
100           call level$get (save_level);
101           set_sw = 1;
102 
103           salvlp = addr (salv_data$lock);
104           on cleanup
105                begin;
106                     if salvlp -> lock.pid = pds$processid then call lock$unlock_fast (salvlp);
107                     call level$set (save_level);
108                     if set_sw = 0 then call set_privileges$dir_priv_off ((0));
109                     if unlock_parent then call lock$dir_unlock (ptr (ep, 0));
110                     end;
111 
112           call lock$lock_fast (salvlp);
113 
114 /* Get ptr to branch and lock parent directory. */
115 
116           root = "0"b;
117           call sum$getbranch_root_my (dp, typelock, ep, code);
118           if code = 0 then unlock_parent = "1"b;
119           else if code = error_table_$root then root = "1"b;
120           else if code ^= error_table_$mylock then
121                call syserr$error_code (CRASH, code, "^a: error from sum on ^p", WHOAMI, dp);
122 
123 /* Get pathname and print salvage message. */
124 
125           path_name, dir_name, ename = "";
126           call get_pathname_ (segno (dp), path_name, code);
127           if code ^= 0 then call syserr$error_code (CRASH, code, "^a: Getting pathname of ^p", WHOAMI, dp);
128 
129           i = index (reverse (path_name), ">");
130           l = length (path_name);
131           dir_name_len = max (l - i, 1);
132           if dir_name_len = 1 then dir_name_len = 0;
133           dir_name = substr (path_name, 1, dir_name_len);
134           ename = substr (path_name, l + 2 - i, i - 1);
135 
136           call date_time_ (clock (), entry_time);
137 
138           args.pathname = path_name;
139           call salvager$online (addr (args));
140           call syserr (ANNOUNCE, "^a: Begin salvaging of directory ^a for ^a", WHOAMI, args.pathname,
141                pds$process_group_id);
142 
143 /* Put out the first message */
144 
145           call salv_err_msg (SALV_JUST_LOG, "^a:Begin salvaging of directory ^a for ^a", entry_time, args.pathname,
146                pds$process_group_id);
147 
148           call get_dumps;
149           old_modify = (dir.modify ^= "0"b);
150           dir.modify = "0"b;
151 
152           call salv_directory$online_salvage (addr (args), ep, dp, a_code);
153 
154           if unlock_parent then call lock$dir_unlock (ptr (ep, 0));
155           call salv_err_msg (SALV_ANNOUNCE, "on_line_salvager: salvaging completed.");
156 
157           call lock$unlock_fast (salvlp);
158 
159 /* Terminate user's process if the process directory was salvaged. */
160 
161           if old_modify & (substr (args.pathname, 1, 16) = ">process_dir_dir" | substr (args.pathname, 1, 4) = ">pdd")
162           then if ename = substr (pds$process_dir_name, 18, 15) then do;
163                     call salv_err_msg (SALV_LOG, "on_line_salvager: user process ^a terminated because of bad process directory",
164                          pds$process_group_id);
165                     a_code = error_table_$salv_pdir_procterm;
166                                                             /* Cause verify lock to terminate the process */
167                     end;
168 
169           return;
170 
171 
172 ^L
173 /* * Copy the stack and the directory into segments in >dumps.  The validation level is temporarily set to zero for
174    * these copies.  No dump is made for a bad root directory, since it would have to be used in order to find >dump.
175    * No dump is made for level 1 directories, since the root is locked.
176    * No dump is made for the directory dumps itself or for any directories in its subtree.
177    *      stack               <date/time>stack
178    *      directory           <date/time>name
179 */
180 
181 get_dumps:
182      proc;
183 
184 dcl  cname_prefix char (11);
185 
186 /* The root and level 1 directories get a null dir_name from fs_get$path_name */
187 
188           if dir_name = "" | substr (args.pathname, 1, 6) = ">dumps" then return;
189 
190           call level$set (0);                               /* to copy dir */
191           call set_privileges$dir_priv_on (set_sw);         /* allow access to copy data into >dumps */
192 
193           cname_prefix =
194                substr (entry_time, 1, 2) || substr (entry_time, 4, 2) || substr (entry_time, 7, 2) || "."
195                || substr (entry_time, 11, 6) || ".";
196 
197           call vtoc_attributes$get_info ((entry.uid), (entry.pvid), (entry.vtocx), addr (sc_info), code);
198           if code ^= 0 then
199                call syserr$error_code (LOG, code, "^a: cannot get activation info on ^p", WHOAMI, dp);
200           else call salv_dump_copy (dp, sc_info.csl, cname_prefix || ename);
201 
202           call salv_dump_copy (pds$stack_0_ptr, 16384, cname_prefix || "stack");
203           call salv_dump_copy (addr (pds$), 4096, cname_prefix || "pds");
204 
205           call level$set (save_level);
206           if set_sw = 0 then call set_privileges$dir_priv_off ((0));
207 
208           return;
209      end get_dumps;
210 
211 /* format: style2 */
212 %page;
213 %include quota_cell;
214 %page;
215 %include salv_args;
216 %page;
217 %include salvager_severities;
218 %page;
219 %include dir_header;
220 %page;
221 %include dir_entry;
222 %page;
223 %include salv_data;
224 %page;
225 %include sc_info;
226 %page;
227 %include syserr_constants;
228 %page;
229 %include hc_lock;
230 
231 /*^L*/
232 
233 /* BEGIN MESSAGE DOCUMENTATION
234 
235    Message:
236    on_line_salvager: lock error ERROMESSAGE
237 
238    S: $crash
239 
240    T: $run
241 
242    M: The on line salvager could not lock its data base.
243    $err
244 
245    A: $inform
246    $recover
247    Be sure that a dump is taken.
248 
249    Message:
250    on_line_salvager: error from sum on PPPPP ERRORMESSAGE
251 
252    S: $crash
253 
254    T: $run
255 
256    M: The on line salvager could not access the branch for a sdirectory
257    to be salvaged.
258    $err
259 
260    A: $inform
261    $recover
262 
263    Message:
264    on_line_salvager: cannot get activation info on PPPPP ERRORMESSAGE
265 
266    S: $info
267 
268    T: $run
269 
270    M: The on line salvager could not determine the length of a directory to be
271    salvaged. A truncated copy will be made in >dumps.
272 
273    A: $inform
274 
275    Message:
276    on_line_salvager: Getting pathname of PPPPP
277 
278    S: $crash
279 
280    T: $run
281 
282    M: The on line  salvager cannot obtain the pathname of a directory to be
283    salvaged.
284    $err
285 
286    A: Take a dump.
287    $inform
288    $recover
289 
290    END MESSAGE DOCUMENTATION */
291      end on_line_salvager;