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 
 12 
 13 
 14 /****^  HISTORY COMMENTS:
 15   1) change(1986-06-05,GWMay), approve(1985-12-23,MCR7320),
 16      audit(1986-11-19,GDixon), install(1986-11-21,MR12.0-1223):
 17      Modified the process loop to abort when a fatal error is returned from the
 18      recursive dump subroutine. This way the program will not continue dumping
 19      with the next line in the control file. Added the entry
 20      backup_dump$abort_on_tape_errors to provide a means of returning the
 21      error code from a bad tape mount or write.
 22   2) change(1987-03-03,GWMay), approve(1987-03-03,MCR7627),
 23      audit(1987-03-13,Farley), install(1987-03-30,MR12.1-1018):
 24      added switch in the condition handling routine so that when writing to
 25      the map, all conditions are passed back to the default handler.
 26   3) change(2018-08-21,Swenson), approve(2018-08-21,MCR10048),
 27      audit(2018-08-22,GDixon), install(2018-08-27,MR12.6g-0015):
 28      Added support for volume pools to hierarchy backup commands.
 29                                                    END HISTORY COMMENTS */
 30 
 31 
 32 /* Hierarchy dumper */
 33 
 34 /* Created:  February 1969 by R. C. Daley */
 35 /* Modified: 29 June 1970 by R. H. Campbell */
 36 /* Modified: 6 May 1976 by R. Bratt for pv dump */
 37 /* Modified: 2 November 1977 by Steve Herbst to add backup_dump_ */
 38 /* Modified: 3 August 1979 by Steve Herbst to add bk_ss_$no_primary */
 39 /* Modified: 28 January 1980 by S. Herbst to add missing options to the map */
 40 /* Modified: 6 November 1980 by G. Palter for version 3 backup_control structure */
 41 /* Modified: 30 December 1980 by Steve Herbst to read control file and implement cross-dumping */
 42 /* Modified: 4 August 1981 by G. Palter to fix interaction of cross-dumping and incremental/catchup/complete dumper */
 43 /* Modified: July 1982 by G. Palter to add features for IMFT support of AIM: enforce a maximum access class for dumping,
 44    refuse to dump upgraded directories, and check a user's effective access to each branch before dumping */
 45 /* Modified February 1983 by E. N. Kittlitz for 256K segs */
 46 /* Modified August 1983 by Robert Coren to enforce a minimum access class for dumping */
 47 /* Modified November 1983 by Robert Coren to copy "upgrade_to_user_auth" flag */
 48 /* Modified 1985-03-21, BIM: fixed prehistoric busted condition handler.
 49    phx18650 -- does not reset transparency switches.
 50    phx17329 -- mishandling empty acls.
 51    phx17310 -- unitialized variables in cross-dumping.
 52    phx16651 -- rqovers on the map do not always get to level 2.
 53    phx13714 -- catching command_error conditions */
 54 
 55 
 56 /* format: style4,delnl,insnl,ifthenstmt,ifthen */
 57 
 58 
 59 backup_dump:
 60      procedure ();
 61 
 62 dcl  Sfatal_error bit (1) aligned;
 63 dcl  Stape_entry bit (1) aligned;
 64 dcl  (i, id_length, n) fixed bin,                           /* Temporary storage. */
 65      (a_code, code, saved_code) fixed bin (35),             /* Status codes */
 66      (old_trans_sw, ts) fixed bin (2),                      /* To save previous transparent switch settings. */
 67      vers char (13) init ("21 March 1985") aligned int static options (constant),
 68                                                             /* version of dumper */
 69      calendar char (16) aligned,                            /* Temporary for time conversion. */
 70      ap ptr,                                                /* Pointer to argument list */
 71      p ptr,
 72      sp ptr,
 73      control_ptr ptr,                                       /* ptr to backup_dump_ control structure */
 74      path_index fixed bin,
 75      tchar (168) char (1) based,                            /* test character array */
 76      saved_dtd fixed bin (52);
 77 
 78 dcl  old_256K_switch bit (2) aligned;
 79 dcl  (cross_dump_path, cross_dump_dn, dn, dump_dir, temp_dn) char (168);
 80 dcl  cross_dump_en char (32);
 81 dcl  text_line char (300);
 82 
 83 dcl  NL char (1) int static options (constant) init ("
 84 ");
 85 dcl  type fixed bin (2),
 86      btcnt fixed bin (24);                                  /* Arguments for status_minf call */
 87 
 88 dcl  init static bit (1) initial ("1"b),                    /* Static storage. */
 89      control_file_sw bit (1),                               /* Reading requests from a control file */
 90      linep static ptr;                                      /* Pointer to ID line buffer. */
 91 
 92 dcl  id static char (300);                                  /* Name, version of dumper and arguments. */
 93 
 94 dcl  error_table_$noaccess fixed bin (35) external;         /* Status */
 95 dcl  error_table_$noarg fixed bin (35) external;
 96 dcl  error_table_$no_s_permission fixed bin (35) external;
 97 dcl  error_table_$root fixed bin (35) external;
 98 dcl  sys_info$seg_size_256K fixed bin (19) external;
 99 
100 dcl  backup_control_mgr_$initiate entry (pointer, fixed binary (35)),
101      backup_control_mgr_$terminate entry (pointer),
102      backup_dump_recurse entry (char (168), char (32), bit (1) aligned, bit (1) aligned, fixed bin (35)),
103      backup_dump_recurse$set_directory_dtd entry (char (*) aligned, fixed bin (52)),
104      backup_map_$beginning_line entry (fixed bin (52), ptr, fixed bin),
105      backup_map_$fs_error_line entry (fixed bin (35), char (*), char (*), char (*)),
106      backup_map_$directory_line entry (ptr, fixed bin),
107      backup_map_$terminal_line entry (fixed bin (52), fixed bin (35)),
108      backup_util$get_real_name entry (ptr, ptr, fixed bin, fixed bin (35)),
109      bk_output$output_init entry (fixed bin, fixed bin (35)),
110      bk_output$output_finish entry;
111 
112 dcl  absolute_pathname_ entry (char (*), char (*), fixed bin (35)),
113      bk_arg_reader_$dump_arg_reader entry (fixed bin, ptr, fixed bin (35)),
114      clock_ entry (fixed bin (52)),
115      com_err_ entry options (variable),
116      cu_$arg_count entry (fixed bin),
117      cu_$arg_list_ptr entry (ptr),
118      date_time_ entry (fixed bin (52), char (*) aligned),
119      expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)),
120      hcs_$fs_search_get_wdir entry (ptr, fixed bin),
121      hcs_$status_minf
122           entry (char (*) aligned, char (*) aligned, fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)),
123      hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)),
124      hcs_$set_256K_switch entry (bit (2) aligned, bit (2) aligned, fixed bin (35)),
125      hcs_$set_max_length_seg ext entry (ptr, fixed bin (19), fixed bin (35)),
126      hcs_$terminate_noname entry (ptr, fixed bin (35)),
127      hcs_$truncate_seg entry (ptr, fixed bin, fixed bin (35)),
128      (ioa_$rs) entry options (variable);                    /* Variable arguments. */
129 
130 dcl  ios_$attach entry (char (*), char (*), char (*), char (*), bit (72) aligned);
131 dcl  ios_$detach entry (char (*), char (*), char (*), bit (72) aligned);
132 dcl  ios_$read entry (char (*), ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned);
133 
134 dcl  hphcs_$fs_get_trans_sw entry (fixed bin (2), fixed bin (2));
135 
136 dcl  (
137      hphcs_$suspend_quota,
138      hphcs_$restore_quota
139      ) external entry;
140 dcl terminate_file_ external entry (ptr, fixed bin(24), bit(*), fixed bin(35));
141 
142 dcl  cleanup condition;
143 dcl  any_other condition;
144 
145 dcl  (addr, index, length, max, min, null, reverse, rtrim, substr) builtin;
146 
147 /*^L*/
148 
149 %include bk_ss_;
150 %page;
151 %include backup_preamble_header;
152 %page;
153 %include backup_control;
154 %page;
155 %include io_status;
156 
157 /*^L*/
158 
159           bk_ss_$sub_entry = "0"b;
160           Stape_entry = "0"b;
161           if bk_ss_$myname = " " then bk_ss_$myname = "backup_dump";
162           go to common;
163 
164 abort_on_tape_errors:
165      entry (tape_code);
166 
167 dcl  tape_code fixed bin;
168 
169           tape_code = 0;
170           bk_ss_$sub_entry = "0"b;
171           Stape_entry = "1"b;
172           control_file_sw = "0"b;       /* control file is read by caller */
173           go to have_args;
174 
175 backup_dump_:
176      entry (control_ptr, a_code);
177 
178           bk_ss_$sub_entry = "1"b;
179           Stape_entry = "0"b;
180           a_code = 0;
181 
182           bk_ss_$control_ptr = null();
183           old_256K_switch = ""b;                            /* initialize for cleanup */
184           old_trans_sw = -1;                                /* leaves the switches alone */
185           on condition (cleanup) begin;
186                call hcs_$set_256K_switch (old_256K_switch, (""b), (0));
187                if ^bk_ss_$debugsw then do;
188                     call hphcs_$fs_get_trans_sw (old_trans_sw, (0));
189                     call hphcs_$restore_quota;              /* Restore the quota */
190                end;
191                if bk_ss_$control_ptr ^= null then
192                     call backup_control_mgr_$terminate (control_ptr);
193                call terminate_file_ (bk_ss_$volume_pool_ptr, 0, TERM_FILE_TERM, (0));
194           end;
195 
196           call backup_control_mgr_$initiate (control_ptr, a_code);
197           if a_code ^= 0 then return;
198 
199           if bk_ss_$control_ptr -> backup_control.debug_sw then do;
200                bk_ss_$debugsw = "1"b;
201                bk_ss_$trimsw = "0"b;
202           end;
203           else bk_ss_$debugsw = "0"b;
204           bk_ss_$mapsw = bk_ss_$control_ptr -> backup_control.map_sw;
205           bk_ss_$no_reload = bk_ss_$control_ptr -> backup_control.no_reload_sw;
206           bk_ss_$holdsw = bk_ss_$control_ptr -> backup_control.hold_sw;
207           bk_ss_$preattached = bk_ss_$control_ptr -> backup_control.preattached;
208           if bk_ss_$preattached then bk_ss_$data_iocb = bk_ss_$control_ptr -> backup_control.data_iocb;
209           bk_ss_$sub_entry_errfile = bk_ss_$control_ptr -> backup_control.error_file;
210           bk_ss_$caller_handles_conditions = bk_ss_$control_ptr -> backup_control.caller_handles_conditions;
211 
212           bk_ss_$enforce_max_access_class = bk_ss_$control_ptr -> backup_control.enforce_max_access_class;
213           if bk_ss_$enforce_max_access_class then
214                bk_ss_$maximum_access_class = bk_ss_$control_ptr -> backup_control.maximum_access_class;
215 
216           bk_ss_$enforce_min_access_class = bk_ss_$control_ptr -> backup_control.enforce_min_access_class;
217           if bk_ss_$enforce_min_access_class then
218                bk_ss_$minimum_access_class = bk_ss_$control_ptr -> backup_control.minimum_access_class;
219 
220           bk_ss_$dont_dump_upgraded_dirs = bk_ss_$control_ptr -> backup_control.dont_dump_upgraded_dirs;
221           if bk_ss_$dont_dump_upgraded_dirs then
222                bk_ss_$maximum_dir_access_class = bk_ss_$control_ptr -> backup_control.maximum_dir_access_class;
223 
224           bk_ss_$check_effective_access = bk_ss_$control_ptr -> backup_control.check_effective_access;
225           if bk_ss_$check_effective_access then do;
226                bk_ss_$user_id = bk_ss_$control_ptr -> backup_control.user_for_access_check.id;
227                bk_ss_$user_authorization = bk_ss_$control_ptr -> backup_control.user_for_access_check.authorization;
228                bk_ss_$user_ring = bk_ss_$control_ptr -> backup_control.user_for_access_check.ring;
229           end;
230 
231           bk_ss_$upgrade_to_user_auth = bk_ss_$control_ptr -> backup_control.upgrade_to_user_auth;
232 
233           do i = 1 to bk_ss_$control_ptr -> backup_control.request_count;
234                bk_ss_$control_ptr -> backup_control.found (i) = "0"b;
235                bk_ss_$control_ptr -> backup_control.loaded (i) = "0"b;
236                bk_ss_$control_ptr -> backup_control.status_code (i) = 0;
237                bk_ss_$control_ptr -> backup_control.error_name (i) = "";
238           end;
239 
240           bk_ss_$myname = "backup_dump_";
241           go to common;
242 
243 
244 idump:
245      entry;
246 
247           bk_ss_$sub_entry = "0"b;
248           Stape_entry = "0"b;
249           bk_ss_$myname = "idump";
250 
251 common:
252           cross_dump_path, cross_dump_dn, cross_dump_en = "";
253 
254 
255 /*        read in arguments and set switches                */
256 
257           control_file_sw = "0"b;                           /* not yet told of control file in our arguments */
258 
259           if bk_ss_$sub_entry then do;                      /* if backup_dump_, get first pathname */
260                do i = 1 to bk_ss_$control_ptr -> backup_control.request_count;
261                     call absolute_pathname_ (bk_ss_$control_ptr -> backup_control.path (i), dn, code);
262                     if code = 0 & dn = ">" then code = error_table_$root;
263                     if code ^= 0 then do;
264                          a_code, bk_ss_$control_ptr -> backup_control.status_code (i) = code;
265                          go to RETURN_FROM_BACKUP_DUMP;
266                     end;
267                end;
268                bk_ss_$save_path = bk_ss_$control_ptr -> backup_control.path (1);
269                path_index, bk_ss_$path_index = 1;
270                bk_ss_$pathsw = "1"b;
271                bk_ss_$save_plen = length (rtrim (bk_ss_$save_path));
272           end;
273           else do;                                          /* else read command argument */
274                call cu_$arg_count (i);                      /* Get the number of input arguments */
275                if i ^= 0 then do;                           /* Don't bother if no args */
276                     call cu_$arg_list_ptr (ap);             /* Get pointer to argument list */
277                     call bk_arg_reader_$dump_arg_reader (1, ap, code);
278                                                             /* Do the work */
279                     if code ^= 0 then return;
280                     if bk_ss_$control_name ^= "" & bk_ss_$myname = "backup_dump" then do;
281                          call ios_$attach ("dump_control", "file_", bk_ss_$control_name, "r",
282                               addr (status) -> status_bits);
283                          if status.code ^= 0 then do;
284                               call com_err_ (status.code, bk_ss_$myname, "Attaching control file ^a", bk_ss_$control_name)
285                                    ;
286                               return;
287                          end;
288 READ_CONTROL:
289                          call ios_$read ("dump_control", addr (dump_dir), 0, length (dump_dir), n,
290                               addr (status) -> status_bits);
291                          if status.code ^= 0 then do;
292 READ_ERROR:
293                               call com_err_ (status.code, bk_ss_$myname, "Reading control file ^a", bk_ss_$control_name);
294                               return;
295                          end;
296                          if substr (dump_dir, n, 1) = NL then
297                               substr (dump_dir, n) = "";
298                          else substr (dump_dir, n + 1) = "";
299                          if substr (dump_dir, 1, 1) ^= ">" then
300                               if status.end_of_data then
301                                    return;
302                               else go to READ_CONTROL;
303 
304                          i = index (dump_dir, "=");
305                          if i ^= 0 then do;
306                               cross_dump_path = substr (dump_dir, i + 1);
307                               substr (dump_dir, i) = "";
308                               if substr (cross_dump_path, 1, 1) ^= ">" then
309                                    cross_dump_path =
310                                         substr (dump_dir, 1, length (dump_dir) + 1 - index (reverse (dump_dir), ">"))
311                                         || cross_dump_path;
312                               if bk_ss_$mapsw then
313                                    text_line =
314                                         "(Cross-dumping " || rtrim (dump_dir) || " to " || rtrim (cross_dump_path) || ")";
315                               call expand_pathname_ (cross_dump_path, cross_dump_dn, cross_dump_en, code);
316                               if code ^= 0 then do;
317                                    call com_err_ (code, bk_ss_$myname, "Cross-dump path ^a", cross_dump_path);
318                                    return;
319                               end;
320                          end;
321                          else cross_dump_path, cross_dump_dn, cross_dump_en = "";
322 
323                          bk_ss_$pathsw = "1"b;
324                          bk_ss_$save_path = dump_dir;
325                          bk_ss_$save_plen = n;
326                          control_file_sw = "1"b;
327                     end;
328 
329                     else if ^bk_ss_$pathsw then do;
330                          call com_err_ (error_table_$noarg, bk_ss_$myname, "No absolute pathname specified.");
331                          return;
332                     end;
333                     else do;
334 have_args:
335                          cross_dump_path, cross_dump_dn, cross_dump_en = "";
336                          call absolute_pathname_ (substr (bk_ss_$save_path, 1, bk_ss_$save_plen), dn, code);
337                          if code = 0 & dn = ">" then code = error_table_$root;
338                          if code ^= 0 then do;
339                               call com_err_ (code, "backup_dump", "^a", substr (bk_ss_$save_path, 1, bk_ss_$save_plen));
340                               return;
341                          end;
342                     end;
343                end;
344                else if bk_ss_$myname = "backup_dump" then do;
345                     call com_err_ (error_table_$noarg, "backup_dump", "No pathname specified.");
346                     return;
347                end;
348           end;
349 
350 /*        initialization                */
351 
352           Sfatal_error = "0"b;
353           old_256K_switch = ""b;                            /* initialize for cleanup */
354           old_trans_sw = -1;                                /* passing this back in has no effect */
355           if ^bk_ss_$sub_entry then
356                on cleanup
357                     begin;                                  /* need a cleanup handler */
358                     call hcs_$set_256K_switch (old_256K_switch, (""b), (0));
359                                                             /* ignore code */
360                     if ^bk_ss_$debugsw then do;
361                          call hphcs_$fs_get_trans_sw (old_trans_sw, (0));
362                          call hphcs_$restore_quota;                   /* Restore the quota */
363                     end;
364                end;
365           call hcs_$set_256K_switch ("11"b, old_256K_switch, (0));
366                                                             /* ignore code */
367           if init then do;
368                call hcs_$make_seg ("", "dump_seg", "", 01011b, bk_ss_$sp, code);
369                call hcs_$set_max_length_seg (bk_ss_$sp, sys_info$seg_size_256K, code);
370                call hcs_$make_seg ("", "dump_area", "", 01011b, bk_ss_$areap, code);
371                call hcs_$make_seg ("", "dump_preamble", "", 01011b, bk_ss_$hp, code);
372                linep = addr (id);                           /* Set up pointer to identification line. */
373                bk_ss_$areap -> h.dumper_id,                 /* Insert dumper ID into preamble headers. */
374                     bk_ss_$hp -> h.dumper_id = "Backup_dump " || vers;
375                init = ""b;
376           end;
377 
378           if bk_ss_$restart_dumpsw then do;                 /* Check for restart branch */
379                call hcs_$status_minf (bk_ss_$restart_path, "", 0, type, btcnt, code);
380                if code ^= 0 then do;
381                     if bk_ss_$sub_entry then
382                          a_code = code;
383                     else call com_err_ (code, bk_ss_$myname, "^a", bk_ss_$restart_path);
384                     go to RETURN_FROM_BACKUP_DUMP;
385                end;
386           end;
387 
388 /*        Start the dump .... first get absolute path name of starting directory                    */
389 
390 start:    bk_ss_$writing_map = "0"b;
391           call clock_ (bk_ss_$save_time);                   /* Get the current time. */
392 
393           if ^bk_ss_$pathsw then do;                        /* Was a path name supplied? */
394                call hcs_$fs_search_get_wdir (addr (bk_ss_$save_path), bk_ss_$save_plen);
395                if bk_ss_$save_plen = 0 then do;             /* Is there a current working directory? */
396                     code = error_table_$noaccess;
397                     if bk_ss_$sub_entry then
398                          a_code = code;
399                     else call com_err_ (code, bk_ss_$myname, "working directory");
400                                                             /* Gripe. */
401                     go to RETURN_FROM_BACKUP_DUMP;
402                end;
403           end;
404           if bk_ss_$sub_entry then
405                bk_ss_$no_primary = bk_ss_$control_ptr -> backup_control.no_primary_sw (bk_ss_$path_index);
406 
407           if ^bk_ss_$no_primary then do;
408                call backup_util$get_real_name (addr (bk_ss_$save_path), addr (bk_ss_$save_path), bk_ss_$save_plen, code);
409                if bk_ss_$restart_dumpsw then
410                     call backup_util$get_real_name (addr (bk_ss_$restart_path), addr (bk_ss_$restart_path),
411                          bk_ss_$restart_plen, code);
412           end;
413 
414           id_length = 0;
415 
416 /*        Report switch settings                  */
417 
418           if bk_ss_$mapsw then do;                          /* Is a map output desired? */
419                call append (rtrim (bk_ss_$myname));         /* set name into id line */
420                call append (vers);                          /* and version */
421                if bk_ss_$tapesw then                        /* Report tape option. */
422                     if bk_ss_$ntapes = 1 then
423                          call append ("1tape");             /* How many tapes? */
424                     else call append ("2tapes");            /* Both. */
425                else call append ("notape");                 /* No tape output enabled. */
426                call append ("map");                         /* Report map option */
427                if bk_ss_$holdsw then
428                     call append ("hold");                   /* Report tape hold option. */
429                else call append ("nohold");
430                if bk_ss_$onlysw then
431                     call append ("only");                   /* Report whether hierarchy dump */
432                else call append ("sweep");
433                if bk_ss_$dtdsw then call append ("dtd");    /* Report dtd setting. */
434                if bk_ss_$datesw then do;                    /* Report date value. */
435                     call date_time_ (bk_ss_$date, calendar);/* Convert the time value. */
436                     call append (calendar);
437                end;
438                if ^(bk_ss_$dtdsw | bk_ss_$datesw) then call append ("all");
439                                                             /* Are both off? */
440                if bk_ss_$debugsw then call append ("debug");/* Report debug mode setting */
441                if bk_ss_$err_onlinesw then call append ("error_on");
442                if bk_ss_$no_contin then call append ("nocontin");
443                                                             /* stop after catchup dump */
444                if bk_ss_$no_output then call append ("nooutput");
445                                                             /* no tape or map (bug if ON) */
446                if bk_ss_$no_primary then call append ("noprimary");
447                                                             /* do not use primary paths */
448                if bk_ss_$restart_dumpsw then call append ("restart");
449                                                             /* restarting previous dump */
450                if bk_ss_$pvsw then do;
451                     call append ("pvname = " || rtrim (bk_ss_$pvname));
452                end;
453           end;
454           if bk_ss_$tapesw then do;
455                call bk_output$output_init (bk_ss_$ntapes, code);
456                                                             /* initialize output if tape option ON */
457                if code ^= 0 then do;
458                     call backup_map_$fs_error_line (code, "bk_output$output_init", "Initialization", "");
459                     if Stape_entry then tape_code = code;
460                     else if bk_ss_$sub_entry then a_code = code;
461 
462                     go to RETURN_FROM_BACKUP_DUMP;
463                end;
464           end;
465           call backup_map_$beginning_line (bk_ss_$save_time, linep, id_length);
466                                                             /* Write and type the beginning time. */
467           if ^(bk_ss_$tapesw | bk_ss_$mapsw) then go to RETURN_FROM_BACKUP_DUMP;
468                                                             /* OK? */
469 
470 /*        Dump header and first directory                   */
471 
472           bk_ss_$namesw = "1"b;                             /* tell dump to dump only this record */
473           if ^bk_ss_$debugsw then do;                       /* for real not debug */
474                call hphcs_$suspend_quota;                   /* dumper runs quota inhibited */
475                call hphcs_$fs_get_trans_sw (11b, old_trans_sw);
476                                                             /* Transparent use, modification. */
477           end;
478           on any_other call idump_signal;
479 
480 /* First dump branch of starting directory to get names and ACLs */
481 
482           do;
483                p = addr (bk_ss_$save_path);                 /* Get pointer to starting pathname */
484                do i = bk_ss_$save_plen to 1 by -1 while (p -> tchar (i) ^= ">");
485                end;                                         /* Find last ">" */
486                bk_ss_$hp -> h.dname = substr (bk_ss_$save_path, 1, max (1, i - 1));
487                bk_ss_$hp -> h.dlen = max (1, i - 1);
488                bk_ss_$ename = substr (bk_ss_$save_path, i + 1, bk_ss_$save_plen - i);
489 
490                if bk_ss_$mapsw then do;
491                     if cross_dump_path ^= "" then do;
492                          call backup_map_$directory_line (addr (text_line), length (rtrim (text_line)));
493                          temp_dn = cross_dump_dn;
494                     end;
495                     else temp_dn = bk_ss_$hp -> h.dname;
496                     call backup_map_$directory_line (addr (temp_dn), length (rtrim (temp_dn)));
497                end;
498                if ^bk_ss_$pvsw then do;                     /* dump branch - except in pv dump case */
499                     call hcs_$status_minf (bk_ss_$hp -> h.dname, bk_ss_$ename, 1, type, btcnt, code);
500                     if code ^= 0 & code ^= error_table_$no_s_permission then do;
501                          call backup_map_$fs_error_line (code, "status_minf", (bk_ss_$hp -> h.dname), (bk_ss_$ename));
502                          if bk_ss_$sub_entry then bk_ss_$control_ptr -> backup_control.status_code (path_index) = code;
503                          go to dumped;
504                     end;
505                     call backup_dump_recurse (cross_dump_dn, cross_dump_en, "1"b, Sfatal_error, code);
506                     if Sfatal_error then go to error;       /* D U M P   T H E   B R A N C H */
507                     if type = 1 then do;                    /* If terminal node was a segment ... */
508                          if code = 1 then code = 0;         /* Code of 1 is normal return for single entry. */
509                          go to dumped;                      /* Clean up and leave. */
510                     end;
511                end;
512           end;
513 
514 /*        Now dump the rest of the subtree                  */
515 
516           if bk_ss_$sub_entry then saved_code = bk_ss_$control_ptr -> backup_control.status_code (path_index);
517 
518           do;
519                saved_dtd = bk_ss_$hp -> h.dtd;              /* needed to set DTD of the dir later (maybe) */
520                bk_ss_$hp -> h.dname = bk_ss_$save_path;     /* Now dump everything else */
521                bk_ss_$hp -> h.dlen = bk_ss_$save_plen;      /* .. */
522                bk_ss_$namesw = ""b;                         /* set for entire dump */
523                if bk_ss_$restart_dumpsw then bk_ss_$rlen = bk_ss_$save_plen + 1;
524                                                             /* Set starting length of name for recursion in restart */
525 
526                call backup_dump_recurse (cross_dump_dn, cross_dump_en, "0"b, Sfatal_error, code);
527                if Sfatal_error then go to error;            /* D U M P   S U B T R E E */
528 
529                call backup_dump_recurse$set_directory_dtd (bk_ss_$hp -> h.dname, saved_dtd);
530           end;
531 
532 dumped:
533           if bk_ss_$sub_entry then do;                      /* if backup_dump_, get the next pathname */
534                if saved_code = 0 & bk_ss_$control_ptr -> backup_control.status_code (path_index) ^= 0 then
535                     bk_ss_$control_ptr -> backup_control.error_name (path_index) =
536                          "(in subtree) " ||
537                          substr (bk_ss_$control_ptr -> backup_control.error_name (path_index), 1,
538                          length (bk_ss_$control_ptr -> backup_control.error_name (path_index)) - length ( "(in subtree)" ));
539                path_index, bk_ss_$path_index = path_index + 1;
540                if path_index <= bk_ss_$control_ptr -> backup_control.request_count then do;
541                     bk_ss_$save_path = bk_ss_$control_ptr -> backup_control.path (path_index);
542                     bk_ss_$save_plen = length (rtrim (bk_ss_$save_path));
543                     cross_dump_path = bk_ss_$control_ptr -> backup_control.new_path (path_index);
544                     revert any_other;
545                     if ^bk_ss_$debugsw then do;                       /* Turn on quota, turn off trans sw if possible */
546                          call hphcs_$restore_quota;                   /* Restore the quota */
547                          call hphcs_$fs_get_trans_sw (old_trans_sw, ts);
548                                                                       /* Restore previous settings. */
549                     end;
550                     go to start;
551                end;
552           end;
553           else if control_file_sw then                      /* get next control file entry */
554                if ^status.end_of_data then do;
555                     revert any_other;
556                     if ^bk_ss_$debugsw then do;                       /* Turn on quota, turn off trans sw if possible */
557                          call hphcs_$restore_quota;                   /* Restore the quota */
558                          call hphcs_$fs_get_trans_sw (old_trans_sw, ts);
559                                                                       /* Restore previous settings. */
560                     end;
561                     go to READ_CONTROL;
562                end;
563                else call ios_$detach ("dump_control", "", "", addr (status) -> status_bits);
564                                                             /* Cleanup and exit           */
565 error:
566           if Sfatal_error then do;
567                if Stape_entry then tape_code = code;
568 
569                if bk_ss_$sub_entry then
570                     a_code = code;
571                else call com_err_ (code, bk_ss_$myname, "
572 Unable to continue dumping.");
573           end;
574 
575           revert any_other;
576           if ^bk_ss_$debugsw then do;                       /* Turn on quota, turn off trans sw if possible */
577                call hphcs_$restore_quota;                   /* Restore the quota */
578                call hphcs_$fs_get_trans_sw (old_trans_sw, ts);
579                                                             /* Restore previous settings. */
580           end;
581           if bk_ss_$tapesw then call bk_output$output_finish ();
582                                                             /* Shutdown output proceedure */
583           call clock_ (bk_ss_$save_time);                   /* Get time of stopping. */
584           call backup_map_$terminal_line (bk_ss_$save_time, code);
585                                                             /* Write the trailer line. */
586           call hcs_$truncate_seg (bk_ss_$sp, 0, code);      /* Free unused pages in buffer segments. */
587           call hcs_$truncate_seg (bk_ss_$areap, 1023, code);/* Save first page of preamble segments. */
588           call hcs_$truncate_seg (bk_ss_$hp, 1023, code);   /* .. */
589           if (bk_ss_$myname = "backup_dump") | (bk_ss_$myname = "idump") then bk_ss_$myname = "";
590 
591 RETURN_FROM_BACKUP_DUMP:
592           call hcs_$set_256K_switch (old_256K_switch, (""b), (0));
593                                                             /* ignore code */
594           if bk_ss_$sub_entry then                          /* possibly copy info back to older structure */
595                call backup_control_mgr_$terminate (control_ptr);
596           return;
597 
598 /*^L*/
599 
600 append:
601      procedure (string);                                    /* Append string to identification line. */
602 
603 dcl  string character (*) aligned;                          /* What to append. */
604           if id_length < length (id) then do;               /* Is there room in buffer? */
605                id_length = id_length + 1;                   /* Count it. */
606                substr (id, id_length, 1) = " ";             /* Prepend a blank. */
607                i = min (length (id) - id_length, length (string));
608                                                             /* Don't overflow. */
609                substr (id, id_length + 1, i) = string;      /* Append this string. */
610                id_length = id_length + i;                   /* Count length. */
611           end;
612      end append;
613 
614 /*^L*/
615 
616 /* Entry upon recieving an unclaimed signal */
617 
618 idump_signal:
619      procedure;
620 
621 dcl  save_error fixed binary,                               /* Space to save error location code. */
622      is_temp fixed bin,
623      is_code fixed bin (35),
624      is_linep pointer,                                      /* Pointer to line buffer. */
625      is_line character (300);                               /* Line for formatting output messages. */
626 
627 declare  continue_to_signal_ entry (fixed binary (35));
628 declare  find_condition_info_ entry (pointer, pointer, fixed binary (35));
629 declare  1 CI aligned like condition_info;
630 
631           if bk_ss_$sub_entry & bk_ss_$caller_handles_conditions
632              | bk_ss_$writing_map then do;
633                call continue_to_signal_ ((0));
634                return;
635           end;                                              /* caller has any_other handler (for IMFT daemon usage) */
636 
637           CI.version = condition_info_version_1;
638           call find_condition_info_ (null (), addr (CI), (0));
639           if ^(CI.condition_name = "seg_fault_error" | CI.condition_name = "no_read_permission"
640                | CI.condition_name = "record_quota_overflow"/* null pages ... */
641                | CI.condition_name = "out_of_bounds"        /* joker changed maxl */
642                | CI.condition_name = "not_in_read_bracket"  /* etc. */
643                | CI.condition_name = "page_fault_error" /* disk problems */) then do;
644                call continue_to_signal_ ((0));              /* Not our problem */
645                return;
646           end;
647 
648 /**** If we get here, we have a condition that could possibly have
649       happened while referencing a segment that we were dumping.
650       Check to see if we were dumping a segment. (bk_ss_$error ^= 0)
651       If not, we continue to signal anyway, since it is a problem
652       with the dumper and not just a joker nailing a segment we are dumping. */
653 
654           save_error = bk_ss_$error;                        /* Save copy of error location code. */
655           bk_ss_$error = 0;                                 /* Indicate future errors fatal. */
656           is_linep = addr (is_line);                        /* Get pointer to line buffer. */
657           if save_error ^= 0 then do;                       /* If error is not fatal at this time */
658                if bk_ss_$mapsw then do;                     /* Are we to report in the map? */
659                     call ioa_$rs ("Non-fatal ^a at ^d: ^a>^a", is_line, is_temp, CI.condition_name, save_error,
660                          bk_ss_$hp -> h.dname, bk_ss_$hp -> h.ename);
661                     call backup_map_$directory_line (is_linep, is_temp);
662                end;
663                if bk_ss_$wasnt_known then do;               /* Should we terminate this segment? */
664                     bk_ss_$wasnt_known = ""b;               /* Clear indicator for safety. */
665                     bk_ss_$error = 1;                       /* Enable error recovery attempt. */
666                     call hcs_$terminate_noname (bk_ss_$segptr, is_code);
667                                                             /* Terminate this segment. */
668                     bk_ss_$error = 0;                       /* Disable error recovery. */
669                end;
670                go to bk_ss_$err_label;                      /* attempt to recover with non-local go to */
671           end;
672           call continue_to_signal_ ((0));                   /* No internal error recovery */
673           return;
674 
675 %include condition_info;
676      end idump_signal;
677 
678 %include terminate_file;
679      end backup_dump;