1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29 start_dump: proc;
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46 dcl (m, n, i) fixed bin;
47
48 dcl (line, p, sp, ap) ptr;
49
50 dcl string based char (n);
51
52 dcl substring based char (n) aligned;
53
54 dcl dump_in_progress static bit (1);
55 dcl dumper_initialized static bit (1) init ("0"b);
56
57 dcl type static fixed bin,
58 pid fixed bin (35),
59 (map_name, err_name) char (32),
60 device char (16),
61 mode char (6),
62 dump_dir char (168),
63 efpath char (168) aligned,
64 dir char (168) aligned,
65 dir_name char (168),
66 error_string char (32),
67 rings (3) fixed bin (6),
68 rb (3) fixed bin (5),
69 unique_chars_ entry (bit (*) aligned) returns (char (15) aligned);
70
71 dcl static_map_name char (32) int static;
72 dcl time_now fixed bin (52),
73 char1 char (1) based;
74
75 dcl chname static fixed bin (71);
76
77 dcl code fixed bin;
78
79
80 dcl efl_name char (32);
81
82 dcl errsw bit (1) aligned;
83
84 dcl cleanup condition;
85
86 dcl start_dump$wakeup_dump external;
87
88 dcl backup_map_$beginning_line entry (fixed bin (52), ptr, fixed bin),
89 backup_dump$abort_on_tape_errors entry (fixed bin),
90 backup_util$get_real_name entry (ptr, ptr, fixed bin, fixed bin),
91 bk_output$output_finish entry;
92
93 dcl (error_table_$noarg,
94 error_table_$no_dir,
95 error_table_$argerr,
96 error_table_$ioname_not_found,
97 error_table_$namedup) ext fixed bin (35);
98
99 dcl bk_arg_reader_$dump_arg_reader entry (fixed bin, ptr, fixed bin);
100
101 dcl timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71)),
102 timer_manager_$reset_alarm_wakeup entry (fixed bin (71)),
103 copy_seg_ entry (char (*), char (*), char (*), char (*), char (*), bit (1) aligned, fixed binary),
104 clock_ entry (fixed bin (52)),
105 convert_date_to_binary_ entry (char (*), fixed bin (52), fixed bin),
106 cu_$arg_list_ptr entry (ptr),
107 cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin),
108 cv_dec_ entry (char (*) aligned) returns (fixed bin (35)),
109 get_group_id_$get_process_id_ entry (fixed bin (35)),
110 ios_$attach entry (char (*), char (*), char (*), char (*), bit (72) aligned),
111 ios_$detach entry (char (*), char (*), char (*), bit (72) aligned),
112 ios_$get_at_entry_ entry (char (*), char (*), char (*), char (*), fixed bin),
113 ios_$order entry (char (*), char (*) aligned, ptr, bit (72) aligned),
114 ios_$read entry (char (*), ptr, fixed bin, fixed bin, fixed bin, bit (72) aligned),
115 ios_$seek entry (char (*), char (*), char (*), fixed bin, bit (72) aligned),
116 (ipc_$create_ev_chn, ipc_$delete_ev_chn) entry (fixed bin (71), fixed bin),
117 ipc_$decl_ev_call_chn entry (fixed bin (71), ptr, ptr, fixed bin, fixed bin),
118 dprint_ entry (char (*) aligned, char (*), ptr, fixed bin),
119 (com_err_, ioa_, ioa_$rs, listen_$start) entry options (variable);
120
121 dcl hphcs_$pxss_set_timax entry (fixed bin (35), fixed bin (35));
122
123
124 dcl hcs_$append_branchx entry (char (*) aligned, char (*), fixed bin (5), (3) fixed bin (6),
125 char (*) aligned, fixed bin (1), fixed bin (1), fixed bin (24), fixed bin),
126 hcs_$set_ring_brackets entry (char (*) aligned, char (*), (3) fixed bin (5), fixed bin),
127 hcs_$add_acl_entries entry (char (*) aligned, char (*), ptr, fixed bin, fixed bin),
128 get_group_id_$tag_star returns (char (32) aligned),
129 cu_$level_get returns (fixed bin),
130 get_wdir_ returns (char (168) aligned);
131
132 dcl 1 sysd_acl aligned,
133 2 aclname char (32) init ("*.SysDaemon.*"),
134 2 aclmode bit (36) init ("101"b),
135 2 zeropad bit (36) init (""b),
136 2 aclcode fixed bin (35) init (0);
137
138 dcl (addr, index, length, max, null, unspec, substr) builtin;
139
140
141 %include bk_ss_;
142 %include dprint_arg;
143 %include io_status;
144
145 type = 0;
146 bk_ss_$myname = "start_dump";
147 bk_ss_$datesw = ""b;
148 bk_ss_$dtdsw = "1"b;
149 go to examine_arguments;
150
151
152
153 catchup_dump: entry;
154
155 type = 2;
156 bk_ss_$myname = "catchup_dump";
157 bk_ss_$dtdsw = ""b;
158 bk_ss_$datesw = "1"b;
159 call convert_date_to_binary_ ("2400.", bk_ss_$date, code);
160 bk_ss_$date = bk_ss_$date - 172800000000;
161 go to examine_arguments;
162
163
164
165
166 complete_dump: entry;
167
168 type = 1;
169 bk_ss_$myname = "complete_dump";
170 bk_ss_$dtdsw, bk_ss_$datesw = ""b;
171
172 examine_arguments: call cu_$arg_list_ptr (ap);
173
174 on cleanup call bk_output$output_finish;
175
176 bk_ss_$control_name = "";
177 bk_ss_$operator = "";
178 bk_ss_$tapesw = "1"b;
179 bk_ss_$holdsw = "1"b;
180 bk_ss_$wakeup_interval = 3600000000;
181 code = 0;
182
183
184 error_string = "Control file path required.";
185 m = 1;
186 call cu_$arg_ptr (m, p, n, code);
187 if code ^= 0 then do;
188 arg_error: call com_err_ (code, bk_ss_$myname, error_string);
189 go to final;
190 end;
191
192 if n = 0 then do;
193 noarg: code = error_table_$noarg;
194 go to arg_error;
195 end;
196
197 if p -> char1 = "-" then go to arg_reader;
198 if substr (p -> string, n-4, 5) ^= ".dump"
199 then bk_ss_$control_name = p -> string || ".dump";
200 else bk_ss_$control_name = p -> string;
201
202 error_string = "Operator name required.";
203 m = 2;
204 call cu_$arg_ptr (m, p, n, code);
205 if code ^= 0 then go to arg_error;
206 if n = 0 then go to noarg;
207 if p -> char1 = "-" then go to arg_reader;
208
209 bk_ss_$operator = p -> string;
210
211 error_string = "";
212 m = 3;
213 call cu_$arg_ptr (m, p, n, code);
214 if code ^= 0 then
215 if code ^= error_table_$noarg then go to arg_error;
216 else do;
217 bk_ss_$ntapes = 1;
218 code = 0;
219 go to args_done;
220 end;
221
222 if p -> char1 = "-" then go to arg_reader;
223 if p -> string = "2" then bk_ss_$ntapes = 2;
224 else bk_ss_$ntapes = 1;
225
226
227 if bk_ss_$myname = "complete_dump" then m = 4;
228 else do;
229 call cu_$arg_ptr (4, p, n, code);
230 if code ^= 0
231 then if code ^= error_table_$noarg
232 then go to arg_error;
233 else do;
234 code = 0;
235 go to args_done;
236 end;
237
238 if p -> char1 = "-" then go to arg_reader;
239
240 bk_ss_$wakeup_interval = cv_dec_ ((p -> string));
241 if bk_ss_$wakeup_interval <= 0 then go to interval_error;
242 if bk_ss_$wakeup_interval > 360 then do;
243 interval_error: call ioa_ ("^a: Improper wakeup interval, ^d", bk_ss_$myname, bk_ss_$wakeup_interval);
244 go to final;
245 end;
246 bk_ss_$wakeup_interval = bk_ss_$wakeup_interval * 60000000;
247 m = 5;
248 end;
249
250 arg_reader:
251 call bk_arg_reader_$dump_arg_reader (m, ap, code);
252 if code ^= 0 then go to final;
253 args_done:
254
255 if bk_ss_$restart_dumpsw & ^bk_ss_$no_primary then
256 call backup_util$get_real_name (addr (bk_ss_$restart_path), addr (bk_ss_$restart_path),
257 bk_ss_$restart_plen, code);
258
259 if bk_ss_$control_name = "" | bk_ss_$operator = "" then do;
260 code = error_table_$argerr;
261 call com_err_ (code, bk_ss_$myname, "Missing control file or operator name");
262 go to final;
263 end;
264
265 sp = addr (status);
266 line = addr (dump_dir);
267 call ios_$attach ("dump_control", "file_", bk_ss_$control_name, "r", sp -> status_bits);
268 if status.code ^= 0 then do;
269 call com_err_ (status.code, bk_ss_$myname, "ios_$attach for ^a", bk_ss_$control_name);
270 go to final;
271 end;
272
273 if type ^= 1 then do;
274 call ipc_$create_ev_chn (chname, code);
275 if code ^= 0 then do;
276 call com_err_ (code, bk_ss_$myname, "ipc_$create_ev_chn");
277 go to final;
278 end;
279 call ipc_$decl_ev_call_chn (chname, addr (start_dump$wakeup_dump), null, 1, code);
280 if code ^= 0 then do;
281 call com_err_ (code, bk_ss_$myname, "ipc_$decl_ev_call_chn");
282 go to final;
283 end;
284 end;
285
286 if (^bk_ss_$debugsw) & (type = 2) then do;
287 call get_group_id_$get_process_id_ (pid);
288 call hphcs_$pxss_set_timax (pid, 7000000);
289 end;
290
291 dump_in_progress = "1"b;
292 dumper_initialized = "1"b;
293 go to over;
294
295
296
297
298 wakeup_dump: entry;
299
300 sp = addr (status);
301 if dump_in_progress then do;
302
303 call ioa_ ("wakeup_dump: Dump pass presently in progress; this call ignored.");
304
305 call listen_$start;
306 go to restart_IO;
307 end;
308
309 call timer_manager_$reset_alarm_wakeup (chname);
310 bk_ss_$myname = "wakeup_dump";
311 dump_in_progress = "1"b;
312 line = addr (dump_dir);
313 call ioa_ ("^/Dumper waking up.");
314
315 over: call clock_ (time_now);
316
317 call ios_$seek ("dump_control", "read", "first", 0, sp -> status_bits);
318 if status.code ^= 0 then do;
319 call com_err_ (status.code, bk_ss_$myname, "ios_$seek for ^a", bk_ss_$control_name);
320 go to stop;
321 end;
322
323 map_name, static_map_name = unique_chars_ (""b) || ".dump.map";
324 rings (1), rings (2), rings (3) = max ((cu_$level_get ()), 4);
325 dir = get_wdir_ ();
326 call hcs_$append_branchx (dir, map_name, 01011b, rings, (get_group_id_$tag_star ()), 0, 0, 0, code);
327 if (code = 0) | (code = error_table_$namedup)
328 then call hcs_$add_acl_entries (dir, map_name, addr (sysd_acl), 1, code);
329 call ios_$attach ("map", "file_", map_name, "w", sp -> status_bits);
330 if status.code ^= 0 then do;
331 call com_err_ (status.code, bk_ss_$myname, "ios_$attach for ^a", map_name);
332 go to stop;
333 end;
334
335
336 call ioa_$rs ("Dump control file: ^a, operator: ^a.", dump_dir, n, bk_ss_$control_name, bk_ss_$operator);
337
338 bk_ss_$mapsw = "1"b;
339 call backup_map_$beginning_line (time_now, line, n);
340
341 next: call ios_$read ("dump_control", line, 0, length (dump_dir), n, sp -> status_bits);
342
343 if status.code ^= 0 then do;
344 call com_err_ (status.code, bk_ss_$myname, "ios_$read for ^a", bk_ss_$control_name);
345 go to done;
346 end;
347
348 n = n - 1;
349 call ioa_ ("^/^a", line -> substring);
350
351 if substr (dump_dir, 1, length (">")) = ">" then do;
352
353 bk_ss_$save_path = line -> substring;
354 bk_ss_$save_plen = n;
355 bk_ss_$pathsw = "1"b;
356 if bk_ss_$restart_dumpsw then do;
357 if ^bk_ss_$no_primary then call backup_util$get_real_name
358 (addr (bk_ss_$save_path), addr (bk_ss_$save_path), bk_ss_$save_plen, code);
359 if substr (bk_ss_$save_path, 1, bk_ss_$save_plen) ^= substr (bk_ss_$restart_path, 1, bk_ss_$save_plen) then go to check_end;
360
361 if bk_ss_$save_plen < bk_ss_$restart_plen then
362 if substr (bk_ss_$restart_path, bk_ss_$save_plen + 1, 1) ^= ">" then go to check_end;
363
364
365 end;
366
367 call backup_dump$abort_on_tape_errors (code);
368 if code ^= 0 then
369 go to ended;
370 end;
371
372 check_end:
373 if ^ status.bits.end_of_data then
374 go to next;
375
376 done: call finish_maps (0);
377 bk_ss_$mapsw = ""b;
378 if type = 2 then do;
379 if bk_ss_$no_contin then go to ended;
380 bk_ss_$holdsw = ""b;
381 if bk_ss_$tapesw then
382 call bk_output$output_finish ();
383 call ioa_ ("^/Catchup_dump has finished; start_dump will be called.");
384 type = 0;
385 bk_ss_$myname = "start_dump";
386 bk_ss_$dtdsw = "1"b;
387 bk_ss_$holdsw = "1"b;
388 bk_ss_$datesw = ""b;
389 if ^bk_ss_$debugsw then call hphcs_$pxss_set_timax (pid, 0);
390 go to over;
391 end;
392
393 call ioa_ ("^/Dump finished.");
394 if type ^= 1 then do;
395 call timer_manager_$alarm_wakeup (time_now + bk_ss_$wakeup_interval, "00"b, chname);
396 call ioa_ ("Dumper going to sleep.^/");
397
398 restart_IO: call ios_$order ("user_i/o", "start", null, sp -> status_bits);
399
400 if status.code ^= 0 then
401 call com_err_ (status.code, bk_ss_$myname, "ios_$order on user_i/o");
402 dump_in_progress = ""b;
403 bk_ss_$myname = "";
404 return;
405 end;
406
407 go to ended;
408
409
410
411
412 end_dump: entry;
413
414 bk_ss_$myname = "end_dump";
415
416 if ^dumper_initialized then do;
417 call com_err_ (0, bk_ss_$myname, "Dumper not initialized; ""end_dump"" ignored.");
418 return;
419 end;
420
421 sp = addr (status);
422
423 ended: bk_ss_$mapsw = ""b;
424
425 bk_ss_$holdsw = ""b;
426 if bk_ss_$tapesw then
427 call bk_output$output_finish ();
428 call finish_maps (1);
429
430 stop: call ios_$detach ("dump_control", "", "", sp -> status_bits);
431
432 if status.code ^= 0 then
433 call com_err_ (status.code, bk_ss_$myname, "ios_$detach for ^a", bk_ss_$control_name);
434 if type ^= 1 then do;
435 call ipc_$delete_ev_chn (chname, code);
436 if code ^= 0 then do;
437 call com_err_ (code, bk_ss_$myname, "ipc_$delete_ev_chn");
438 go to final;
439 end;
440 end;
441
442
443 final: bk_ss_$myname = "";
444
445 dumper_initialized = "0"b;
446
447 return;
448
449
450
451 finish_maps: proc (detsw);
452
453 dcl detsw fixed bin;
454 dcl (have_error_file, have_map) bit (1) aligned init ("0"b);
455
456 sp = addr (status);
457 dir = get_wdir_ ();
458 call ios_$detach ("map", "", "", sp -> status_bits);
459 if status.code ^= 0 then
460 if status.code ^= error_table_$ioname_not_found then
461 call com_err_ (status.code, bk_ss_$myname, "ios_$detach for ^a", map_name);
462 else;
463 else have_map = "1"b;
464
465 if detsw = 0 then if type ^= 1 then go to skip_errfile;
466
467 call ios_$get_at_entry_ ("err_file", device, err_name, mode, status.code);
468 if status.code ^= 0 then if status.code ^= error_table_$ioname_not_found
469 then call com_err_ (status.code, bk_ss_$myname, "ios_$get_at_entry_ for err_file");
470 else;
471 else do;
472 call ios_$detach ("err_file", "", "", sp -> status_bits);
473 if status.code ^= 0 then if status.code ^= error_table_$ioname_not_found then
474 call com_err_ (status.code, bk_ss_$myname, "ios_$detach for ^a", err_name);
475 else;
476 else do;
477 have_error_file = "1"b;
478 i = index (dir, " ");
479 efpath = substr (dir, 1, i-1) || ">" || err_name;
480 rb (1), rb (2), rb (3) = max ((cu_$level_get ()), 4);
481 call hcs_$set_ring_brackets (efpath, "", rb, code);
482 if code ^= 0 then call com_err_ (code, bk_ss_$myname, "hcs_$set_ring_brackets for err file");
483 end;
484 end;
485
486
487
488 skip_errfile: if ^bk_ss_$dprintsw then return;
489 dpap = addr (dprint_arg_buf);
490 unspec (dprint_arg) = "0"b;
491 dprint_arg.version = dprint_arg_version_9;
492 dprint_arg.copies = 1;
493 dprint_arg.delete = 1;
494 dprint_arg.queue = bk_ss_$dprint_queue;
495 dprint_arg.pt_pch = 1;
496 dprint_arg.notify = 0;
497 dprint_arg.output_module = 1;
498 dprint_arg.lmargin = 0;
499 dprint_arg.line_lth = -1;
500 dprint_arg.page_lth = -1;
501 dprint_arg.top_label = "";
502 dprint_arg.bottom_label = "";
503 dprint_arg.form_name = "";
504 dprint_arg.chan_stop_path = "";
505 if bk_ss_$dprint_heading_setsw then dprint_arg.heading = bk_ss_$dprint_heading;
506 else
507 dprint_arg.heading = " for " || substr (bk_ss_$control_name, 1, length (dprint_arg.heading) - length (" for "));
508 if bk_ss_$dprint_request_type_setsw then dprint_arg.request_type = bk_ss_$dprint_request_type;
509 else dprint_arg.request_type = "";
510 if have_error_file then do;
511 efl_name = err_name;
512 dir_name = dir;
513 if ^bk_ss_$debugsw then call copy_seg_ (dir_name, efl_name, ">udd>SysDaemon>error_file", efl_name,
514 bk_ss_$myname, errsw, code);
515 if code ^= 0 & code ^= error_table_$no_dir then call
516 com_err_ (code, bk_ss_$myname, "copy of error file");
517 if bk_ss_$dprint_destination_setsw then dprint_arg.destination = bk_ss_$dprint_destination;
518 else dprint_arg.destination = "ERROR FILE";
519 call dprint_ (dir, err_name, dpap, code);
520 if code ^= 0 then call com_err_ (code, bk_ss_$myname, "Unable to dprint ^a>^a", dir, err_name);
521 end;
522 if ^have_map then return;
523 if type = 0 then do;
524 dprint_arg.destination = "INCREMENTAL";
525 DPRINT: if bk_ss_$dprint_destination_setsw then dprint_arg.destination = bk_ss_$dprint_destination;
526 call dprint_ (dir, static_map_name, dpap, code);
527 if code ^= 0 then
528 call com_err_ (code, bk_ss_$myname, "Unable to dprint ^a>^a", dir, static_map_name);
529 end;
530 else if type = 2 then do;
531 if bk_ss_$dprint_destination_setsw then dprint_arg.destination = bk_ss_$dprint_destination;
532 else dprint_arg.destination = "CATCHUP MAP";
533 go to DPRINT;
534 end;
535 else do;
536 if bk_ss_$dprint_destination_setsw then dprint_arg.destination = bk_ss_$dprint_destination;
537 else dprint_arg.destination = "COMPLETE MAP";
538 dprint_arg.copies = bk_ss_$ntapes;
539 go to DPRINT;
540 end;
541
542 end finish_maps;
543
544 end start_dump;