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 /****^  HISTORY COMMENTS:
 13   1) change(1986-01-01,GWMay), approve(), audit(), install():
 14      old history comments.
 15      Coded February 1969, R C Daley.
 16      25 March 1970, R H Campbell.
 17      9/77 by Noel I. Morris to use tape_mult_.
 18      11/9/77 by Steve Herbst
 19      Changed to call command_query_ for tape labels 02/28/80 S. Herbst
 20      17 October 1980 by G. Palter to use preattached switches if requested.
 21      Fixed to retry correctly after open fails 06/02/81 S. Herbst
 22      84Feb01 by Art Beattie to allow longer tape labels to be used.
 23      1984-03-25, BIM: Use async mode in tape_mult_
 24      9 May 1985 by G. Palter to not try error_count/unmounts for preattached
 25      switches.
 26   2) change(1986-06-05,GWMay), approve(1986-07-07,MCR7445),
 27      audit(1986-11-20,GDixon), install(1986-11-21,MR12.0-1223):
 28      Moved call for "error_count" tally out of the write loop in wrbufout. The
 29      result will be that the tape will continue to spin until the entire buffer
 30      is emptied rather that synchonizing after each write. This should improve
 31      dump time.
 32      MCR7320 - added a command loop so that the operator may enter a new tape
 33      label id after a bad mount.  This way if the wrong tape gets mounted, the
 34      operator can deny the mount and give a correct tape id without stopping
 35      the dump.
 36   3) change(2018-08-21,Swenson), approve(2018-08-21,MCR10048),
 37      audit(2018-08-22,GDixon), install(2018-08-27,MR12.6g-0015):
 38      Added support for volume pools to hierarchy backup commands.
 39                                                    END HISTORY COMMENTS */
 40 
 41 ^L
 42 /* format: style2,idind30,indcomtxt */
 43 
 44 bk_output:
 45      procedure;
 46 
 47           dcl     uptr                          ptr;        /* ptr to user seg, or junk if we get a fault */
 48           dcl     temp                          fixed bin,  /* Temporary storage. */
 49                   code                          fixed bin (35),
 50                   attach_descrip                char (168),
 51                   buffer                        pointer,    /* Pointer to output line buffer. */
 52                   line                          character (132);
 53                                                             /* Output line buffer. */
 54 
 55           dcl     answer                        char (64) aligned varying;
 56           dcl     error_rnt                     entry variable options (variable);
 57           dcl     requested                     char(32);
 58           dcl     comment                       char(32);
 59           dcl     volname                       char(32);
 60           dcl     volume_pool_path              char(168);
 61 
 62           dcl     (primary_dump_tape, secondary_dump_tape)
 63                                                 static character (64),
 64                                                             /* Tape labels. */
 65                   (iocbp1, iocbp2)              ptr static,
 66                   mounted                       static bit (1) initial (""b),
 67                                                             /* Flag to show tape mounted. */
 68                   two_tapes                     bit (1) static,
 69                   blanks                        char (4) static init (""),
 70                                                             /* To reset tape label */
 71                   s                             character (1) static;
 72                                                             /* To make comments plural. */
 73 
 74           dcl     1 header                      static,     /* Backup logical record header */
 75                     2 zz1                       character (32) initial (" z z z z z z z z z z z z z z z z"),
 76                     2 english                   character (56)
 77                                                 initial ("This is the beginning of a backup logical record."),
 78                     2 zz2                       character (32) initial (" z z z z z z z z z z z z z z z z"),
 79                     2 hdrcnt                    fixed binary,
 80                     2 segcnt                    fixed binary;
 81 
 82           dcl     end_of_tape_encountered       static options (constant) char (24) initial ("End of tape encountered.");
 83 
 84           declare parse_tape_reel_name_         entry (char (*), char (*)),
 85                   backup_map_$error_line        entry options (variable),
 86                   backup_map_$fs_error_line     entry (fixed bin (35), char (*), char (*), char (*)),
 87                   (
 88                   backup_map_$on_line,
 89                   backup_map_$tapes
 90                   )                             entry (pointer, fixed binary);
 91 
 92 %include iox_dcls;
 93 
 94           dcl     com_err_                      entry options (variable);
 95           dcl     sub_err_                      entry options (variable);
 96           dcl     command_query_                entry options (variable);
 97           dcl     ioa_                          entry options (variable);
 98           dcl     ioa_$rsnnl                    entry options (variable);
 99           dcl     manage_volume_pool_$allocate entry (ptr, entry options (variable), char (*), char (*), char (*),
100                   fixed bin (35));
101           dcl     manage_volume_pool_$get_pool_path entry (ptr, entry, char(*), fixed bin(35));
102           dcl     error_table_$action_not_performed
103                                                 fixed bin (35) ext static,
104                   error_table_$dev_nt_assnd     fixed bin (35) ext static,
105                   error_table_$device_end       fixed bin (35) ext static;
106 
107 
108           dcl     (addr, addrel, divide, length, min, null, mod, rtrim, unspec)
109                                                 builtin;
110 
111 %include query_info;
112 
113 %include iox_modes;
114 
115 %include bk_ss_;
116 
117 %include backup_control;
118 ^L
119 output_init:
120      entry (ntapes, wstat);                                 /* entry to initialize backup output procedure */
121           dcl     ntapes                        fixed bin;  /* 1 or 2 tapes */
122 
123           if bk_ss_$no_output
124           then do;                                          /* No output */
125                     wstat = 0;                              /* Error code to zero */
126                     go to exit;                             /* Quit */
127                end;
128 
129           buffer = addr (line);                             /* Set up pointer to output line buffer. */
130           if bk_ss_$preattached
131           then do;                                          /* caller has requested we use a specific I/O switch */
132                     mounted = "1"b;                         /* make sure I/O gets done */
133                     two_tapes = "0"b;                       /* act as if only a single tape is being made */
134                     s = " ";
135                     iocbp1 = bk_ss_$data_iocb;
136                     wstat = 0;
137                end;
138           else if mounted
139           then wstat = 0;                                   /* reset status code */
140           else do;                                          /* Mount a new set of tapes. */
141                     if ntapes > 1 & ^bk_ss_$sub_entry
142                     then do;                                /* Decide how many tapes to use. */
143                               two_tapes = "1"b;             /* Use two. */
144                               s = "s";                      /* Make comments plural. */
145                          end;
146                     else if ntapes = 1
147                     then do;
148                               two_tapes = ""b;              /* Use one. */
149                               s = " ";                      /* Make comments singular. */
150                          end;
151                     call mount (wstat);                     /* mount first dump tape(s) */
152                end;
153           if bk_ss_$mapsw
154           then /* Are we writing a map? */
155                if wstat = 0
156                then do;                                     /* Yes, did we succeed in attaching the tape(s)? */
157                          if two_tapes
158                          then /* Are we writing two tapes? */
159                               call ioa_$rsnnl ("Primary tape label: ^a, secondary tape label: ^a.", line, temp,
160                                    primary_dump_tape, secondary_dump_tape);
161                          else call ioa_$rsnnl ("Tape label: ^a.", line, temp, primary_dump_tape);
162                          call backup_map_$tapes (buffer, temp);
163                                                             /* Write the comment in the map. */
164                     end;
165           go to exit;
166 
167 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
168 
169 output_finish:
170      entry;                                                 /* to terminate backup dump */
171 
172           if bk_ss_$no_output
173           then go to exit;                                  /* No output so quit. */
174 
175           buffer = addr (line);                             /* Set up pointer to output line buffer. */
176           if bk_ss_$preattached
177           then ;                                            /* nothing to do here */
178           else if bk_ss_$holdsw
179           then do;
180                     call iox_$control (iocbp1, "error_count", addr (temp), code);
181                     if code ^= 0
182                     then do;                                /* All OK? */
183 flush_error:
184                               call backup_map_$fs_error_line (code, "bk_output", "", "");
185 unmo:
186                               call unmount;                 /* Unmount the tape anyway. */
187                          end;
188                     if mounted
189                     then if two_tapes
190                          then do;                           /* Is the other tape mounted? */
191                                    call iox_$control (iocbp2, "error_count", addr (temp), code);
192                                    if code ^= 0
193                                    then go to flush_error;  /* OK? */
194                               end;
195                end;
196           else call unmount;                                /* unmount any reel(s) still mounted */
197           go to exit;
198 
199 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
200 
201 wr_tape:
202      entry (lblptr, lblcnt, segptr, segcnt, wstat);         /* to write next backup record on tape */
203 
204           dcl     lblptr                        pointer,    /* pointer to preamble area */
205                   lblcnt                        fixed binary,
206                                                             /* length of preamble in words */
207                   segptr                        pointer,    /* pointer to segment (if any) */
208                   segcnt                        fixed binary,
209                                                             /* length of segment (if any) in words */
210                   wstat                         fixed bin (35);
211                                                             /* status code (returned) */
212 
213           uptr = segptr;                                    /* copy this arg so we can mung it if err */
214           if bk_ss_$no_output
215           then do;                                          /* No output */
216                     wstat = 0;                              /* Zero error code */
217                     go to exit;
218                end;
219 
220           if ^mounted
221           then do;
222                     wstat = error_table_$dev_nt_assnd;
223                     go to exit;
224                end;
225           wstat = 0;
226           buffer = addr (line);                             /* Set up pointer to output line buffer. */
227           header.hdrcnt = lblcnt;                           /* pick up preamble length */
228           header.segcnt = segcnt;                           /* and segment length */
229 retry:
230           call wrout (addr (header), 32);                   /* write out backup logical record header */
231           if code = error_table_$device_end
232           then go to enderr;                                /* Check end of reel */
233           if code ^= 0
234           then go to tsterr;
235           temp = header.hdrcnt + 32 + 255;                  /* adjust to write preamble thru next higher block */
236           temp = temp - mod (temp, 256) - 32;               /* 32 words are already written. */
237           call wrout (lblptr, temp);                        /* write out preamble thru next higher 256-word block */
238           if code = error_table_$device_end
239           then go to enderr;                                /* Check end of reel */
240           if code ^= 0
241           then go to tsterr;
242           if header.segcnt > 0
243           then do;                                          /* Is there any segment to write? */
244                     temp = header.segcnt;
245                     call wrbufout (uptr, temp);             /* write out segment thru next higher 256-word block */
246                     if code = error_table_$device_end
247                     then go to enderr;                      /* Check end of reel */
248                     if code ^= 0
249                     then go to tsterr;
250                end;
251 exit:
252           return;                                           /* exit to caller */
253 enderr:
254           call backup_map_$on_line (addr (end_of_tape_encountered), length (end_of_tape_encountered));
255           go to unm;                                        /* Go get new reel */
256 tsterr:
257           call backup_map_$fs_error_line (code, "bk_output", "", "");
258 
259 unm:
260           if bk_ss_$preattached
261           then do;                                          /* preattached => not using tapes => can't unmount anything */
262                     wstat = code;
263                     go to exit;
264                end;
265 
266           call unmount;                                     /* unmount current tape(s) */
267           call output_init (-1, wstat);                     /* mount next reel(s) */
268           if wstat = 0
269           then go to retry;
270           go to exit;                                       /* go to exit to caller on operator message */
271 
272 query_for_tape:
273           procedure (type, label, Squit_the_dump);
274           dcl     type                          character (*),
275                                                             /* Type of tape (primary or secondary). */
276                   label                         character (64),
277                                                             /* The label. */
278                   Squit_the_dump                bit (1) aligned;
279 
280                unspec (query_info) = "0"b;
281                query_info.version = query_info_version_4;
282                query_info.suppress_name_sw = "1"b;
283                query_info.question_iocbp, query_info.answer_iocbp = null;
284                call command_query_ (addr (query_info), answer, bk_ss_$myname, "Type ^a dump tape label:", type);
285                label = answer;
286 
287                if label = "quit" | label = "q"
288                     then Squit_the_dump = "1"b;
289 
290           return;
291 end query_for_tape;
292 
293 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
294 
295 get_label:
296      procedure (type, label, Squit_the_dump);               /* Procedure to read label typed on console. */
297           dcl     type                          character (*),
298                                                             /* Type of tape (primary or secondary). */
299                   label                         character (64),
300                                                             /* The label. */
301                   Squit_the_dump                bit (1) aligned;
302 
303 
304           Squit_the_dump = "0"b;
305 
306           code = 0;
307           if bk_ss_$sub_entry then
308                error_rnt = sub_err_;
309           else
310                error_rnt = com_err_;
311 
312           if bk_ss_$volume_pool_ptr = null () then
313                call query_for_tape(type, label, Squit_the_dump);
314           else do;
315                requested = "*";
316                comment = bk_ss_$myname;
317                volname = "";
318                call manage_volume_pool_$get_pool_path(bk_ss_$volume_pool_ptr, error_rnt, volume_pool_path, code);
319                if code ^= 0 then
320                     volume_pool_path = "[unknown]";
321 
322                call manage_volume_pool_$allocate(bk_ss_$volume_pool_ptr, error_rnt, requested, comment, volname, code);
323                if code ^= 0 then do;
324                     call error_rnt(code, "bk_output", "Unable to allocate tape from volume pool ^a", volume_pool_path);
325                     call query_for_tape(type, label, Squit_the_dump);
326                     end;
327                else
328                     call ioa_ ("^a: Allocated tape ^a from volume pool ^a", bk_ss_$myname, volname, volume_pool_path);
329                label = volname;
330           end;
331 
332           if ^Squit_the_dump then do;
333                     if ^bk_ss_$debugsw
334                     then /* caller wants privilege */
335                          label = rtrim (label) || ",sys";
336           end;
337           return;
338      end get_label;
339 
340 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
341 
342 mount:
343      procedure (mount_status);                              /* internal procedure to mount first or next reel(s) */
344           dcl     mount_status                  fixed bin (35);
345           dcl     Squit_the_dump                bit (1) aligned;
346 
347           mount_status = 0;
348           mounted = "0"b;
349           Squit_the_dump = "0"b;
350           iocbp1, iocbp2 = null;
351 
352           do while (^mounted & ^Squit_the_dump);
353                if bk_ss_$sub_entry
354                then /* get first tape label from tape_entry */
355                     call bk_ss_$control_ptr -> backup_control.tape_entry (primary_dump_tape);
356                else /* else read it from the terminal */
357                     call get_label ("primary", primary_dump_tape, Squit_the_dump);
358 
359                call mount_tape (Squit_the_dump, iocbp1, "bk_output_1", primary_dump_tape, mount_status);
360           end;                                              /* Do we need another tape? */
361           if two_tapes & mounted & mount_status = 0
362           then do;
363                     mounted = "0"b;
364                     do while (^mounted & ^Squit_the_dump);
365                          call get_label ("secondary", secondary_dump_tape, Squit_the_dump);
366 
367                          call mount_tape (Squit_the_dump, iocbp2, "bk_output_2", secondary_dump_tape, mount_status);
368                     end;
369                end;
370           return;
371 
372 
373 mount_tape:
374      proc (Squit, Piocb, switch_name, tape_id, code);
375 
376           dcl     Squit                         bit (1) aligned,
377                   Piocb                         ptr,
378                   switch_name                   char (11),
379                   tape_id                       char (64),
380                   code                          fixed bin (35);
381 
382           code = 0;
383 
384           if Squit
385           then do;
386                     code = error_table_$action_not_performed;
387                     call backup_map_$error_line (code, "bk_output", "Aborted tape mount.");
388                     if iocbp1 ^= null
389                     then do;
390                               call iox_$close (iocbp1, (0));
391                               call iox_$detach_iocb (iocbp1, (0));
392                          end;
393                     return;
394                end;
395 
396           call parse_tape_reel_name_ (tape_id, attach_descrip);
397           call iox_$attach_name (switch_name, Piocb, "tape_mult_ " || attach_descrip || " -write", null (), code);
398                                                             /* null refptr to use user-supplied tape_mult_ */
399           if code ^= 0
400           then call backup_map_$fs_error_line (code, "bk_output", tape_id, "");
401           else do;
402                     call iox_$open (Piocb, Stream_output, "0"b, code);
403                     if code = 0
404                     then mounted = "1"b;
405                     else do;
406                               call backup_map_$fs_error_line (code, "bk_output", tape_id, "");
407                               code = 0;
408                               call iox_$detach_iocb (Piocb, code);
409                               if code ^= 0
410                               then call backup_map_$fs_error_line (code, "bk_output", tape_id, "");
411                          end;
412                end;
413           if code = 0
414           then call iox_$modes (Piocb, "async", (""), (0));
415 
416           return;
417      end mount_tape;
418      end mount;
419 
420 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
421 
422 wrbufout:
423      proc (wrptr, wrcnt);                                   /* internal proc to write user seg to tape */
424           dcl     wrptr                         ptr;
425           dcl     wrcnt                         fixed bin;
426           dcl     ttbuf                         (words_to_write) fixed bin (35) aligned based;
427           dcl     zzbuf                         (1024) fixed bin (35) aligned based;
428           dcl     xptr                          ptr;
429           dcl     words_to_go                   fixed bin;
430           dcl     words_to_write                fixed bin;
431           dcl     save_err_label                label;
432           dcl     EC                            fixed bin (35);
433                                                             /* control order puts count of errors here */
434 
435           save_err_label = bk_ss_$err_label;                /* remember err recovery location */
436           bk_ss_$err_label = wbo_clean;                     /* and set up to recover here */
437 
438           words_to_go = wrcnt;
439 wbo_retry:                                                  /* come here from wbo_clean */
440           xptr = wrptr;
441           do while (words_to_go > 0);
442 
443                words_to_write = min (1024, words_to_go);    /* one page at most */
444                                                             /* then copy a page of users seg */
445                if wrptr ^= bk_ss_$sp
446                then do;                                     /* if not already recovering from an error */
447                          if words_to_write ^= 1024
448                          then /* if not copying whole page */
449                               unspec (bk_ss_$sp -> zzbuf) = ""b;
450                                                             /* clear the buffer */
451                          bk_ss_$error = 9;                  /* then copy the user's page */
452                          bk_ss_$sp -> ttbuf = xptr -> ttbuf;/* if fault then will go to wbo_clean */
453                          bk_ss_$error = 0;                  /* make faults fatal again */
454                     end;
455 
456                words_to_write = 256 * divide (words_to_write + 255, 256, 17, 0);
457                                                             /* write mod 256 */
458                call iox_$put_chars (iocbp1, bk_ss_$sp, words_to_write * 4, code);
459                if two_tapes & code = 0                      /* two_tapes is only true when not preattached */
460                then call iox_$put_chars (iocbp2, bk_ss_$sp, words_to_write * 4, code);
461                if code ^= 0
462                then go to wbo_ret;
463 
464                xptr = addrel (xptr, words_to_write);        /* step thru user's seg */
465                words_to_go = words_to_go - words_to_write;  /* account for stuff just written */
466           end;
467 
468 wbo_ret:
469           if ^bk_ss_$preattached & (code = 0)               /* preattached => not using tapes => no error_count order */
470           then do;
471                     call iox_$control (iocbp1, "error_count", addr (EC), code);
472 
473                     if two_tapes & code = 0
474                     then call iox_$control (iocbp2, "error_count", addr (EC), code);
475                end;
476 
477           bk_ss_$err_label = save_err_label;                /* restore error recovery location */
478           return;                                           /* and return */
479 
480 wbo_clean:                                                  /* This handles faults taken on user's seg */
481           unspec (bk_ss_$sp -> zzbuf) = ""b;                /* clear it */
482           wrptr = bk_ss_$sp;                                /* Forget user seg, set flag thatwr're recovering */
483           bk_ss_$err_label = save_err_label;                /* We are no longer interested in faults */
484 
485           go to wbo_retry;                                  /* Go write zeroes onto tape as needed */
486 
487      end wrbufout;
488 
489 /* -------------------------------------------------------- */
490 
491 wrout:
492      procedure (wrptr, wrcnt);                              /* internal procedure to write on current tape(s) */
493           dcl     wrptr                         pointer,    /* write workspace pointer */
494                   wrcnt                         fixed binary;
495                                                             /* no. of words to write */
496           call iox_$put_chars (iocbp1, wrptr, wrcnt * 4, code);
497           if two_tapes
498           then if code = 0
499                then /* Even if two don't bother if previous in error. */
500                     call iox_$put_chars (iocbp2, wrptr, wrcnt * 4, code);
501                                                             /* Write second tape. */
502      end wrout;
503 
504 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
505 
506 unmount:
507      procedure;                                             /* internal procedure to unmount current reel(s) */
508           if ^mounted
509           then return;
510 
511           call iox_$close (iocbp1, code);
512           if code ^= 0
513           then call backup_map_$fs_error_line (code, "bk_output", primary_dump_tape, "");
514           call iox_$detach_iocb (iocbp1, code);
515           if code ^= 0
516           then call backup_map_$fs_error_line (code, "bk_output", primary_dump_tape, "");
517           if two_tapes
518           then do;                                          /* Is another tape attached? */
519                     call iox_$close (iocbp2, code);
520                     if code ^= 0
521                     then /* Give error comment if close not OK. */
522                          call backup_map_$fs_error_line (code, "bk_output", secondary_dump_tape, "");
523                     call iox_$detach_iocb (iocbp2, code);
524                     if code ^= 0
525                     then /* Give error comment if detach not OK. */
526                          call backup_map_$fs_error_line (code, "bk_output", secondary_dump_tape, "");
527                end;
528           call backup_map_$tapes (addr (blanks), 4);        /* Reset label info in map header */
529           mounted = "0"b;
530           iocbp1, iocbp2 = null;
531 
532      end unmount;
533      end bk_output;