%TITLE 'DUMPER_DRIVER - Driving module for DUMPER-32' MODULE DRIVER (IDENT = '1.0.001', ADDRESSING_MODE(EXTERNAL=GENERAL), LANGUAGE(BLISS32)) = BEGIN !++ ! FACILITY: ! ! DUMPER-32, user mode. ! ! ABSTRACT: ! ! This module contains the high-level driver for listing and restoring ! both BACKUP-10 and DUMPER-20 tapes. It does the processing which ! is common to both formats of tape. ! ! AUTHORS: ! ! Nick Bush, Robert McQueen ! ! CREATION DATE: 7-May-1985 ! ! MODIFICATION HISTORY: !-- ! ! TABLE OF CONTENTS: ! %SBTTL 'Revision History' !++ ! Start of Version 1. ! ! 1.0.000 By: Authors On: 7-May-1985 ! Create this Module. ! ! [IU-11] By: James A. Harvey, IUPUI On: 16-Dec-1987 ! In LIST_SAVE_SET, check for the read-record routine returning ! FALSE (0) and don't consider it an error. The DUMPER-format ! read-record routine returns FALSE for filler and continued ! saveset records to indicate that they do not need to be pro- ! cessed. ! ! [IU-14] By: James A. Harvey, IUPUI On: 05-Jan-1988 ! Fix RESTORE_FILE somewhat so that it ignores records that it ! is supposed to ignore and doesn't try to treat them as data ! (i.e., filler records, action after tape volume switch, etc.). ! ! [IU-20] By: James A. Harvey, IUPUI On: 08-JAN-1988 ! DUMPER-32 now handles a volume switch on a TOPS-20 DUMPER tape ! OK if it is restoring a file and the file is continued across ! the volume switch, but it still barfs if it is simply searching ! for a saveset or file when the volume switch occurs. Add code ! to DRIVER_PROCESS_COMMAND and RESTORE_SAVE_SET to handle volume ! switches. Also fix more problems with DUMPER exiting with a ! status of FALSE. ! ! [IU-22] By: James A. Harvey, IUPUI On: 14-JAN-1988 ! Fix still more problems with status equal to FALSE. This happens ! if a record is to be ignored, so force the next record to be read ! the next time around. ! ! [IU-23] By: James A. Harvey, IUPUI On: 15-JAN-1988 ! Allow /SKIP=0. This positions to the beginning of the current ! saveset on a labeled DUMPER tape, which seems to be what it ! does on a labeled BACKUP tape. ! ! [IU-25] By: James A. Harvey, IUPUI On: 15-JAN-1988 ! More fixes to /SKIP and /SNAME. ! ! [IU-27] By: James A. Harvey, IUPUI On: 18-Jan-1988 ! More fixes for labeled DUMPER tapes and DUMPER tapes with file ! marks between the savesets. !-- FORWARD ROUTINE CHECK_SAVE_SET_RECORD, RESTORE_SAVE_SET, LIST_SAVE_SET, RESTORE_FILE; ! ! INCLUDE FILES: ! LIBRARY 'SYS$LIBRARY:STARLET'; REQUIRE 'DUMPER_SYMBOLS'; ! ! OWN STORAGE: ! OWN TAPE_RECORD : REF DEC_36_BIT_RECORD, ! Pointer to current record TAPE_RECORD_SIZE, ! Size of current record TAPE_RECORD_INDEX, ! Index into current record SAVE_SET_FOUND : BYTE, ! Flag that a save set has been found SAVE_SET_ALL : BYTE, ! Restore all savesets on tape SAVE_SET_SINGLE : BYTE, ! Just restore first saveset we find PROCESS_VECTOR : REF VECTOR[, LONG] FIELD (ROUTINE_DISPATCH); ! Address ! of vector of routines to process records %SBTTL 'DRIVER_PROCESS_COMMAND - Process a users command' GLOBAL ROUTINE DRIVER_PROCESS_COMMAND = ! Process a single command !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called by the command parser to process the command ! received from the user. When this routine is called, all parameters ! and qualifier values have already been stored in their permanent storage ! locations. This routine will perform the requested action (either ! listing the contents of the tape or restoring the files), and return ! when the action is finished. ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! QUAL_xxxx, INPUT_FILE_DESC, OUTPUT_FILE_DESC ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION_CODES: ! ! SS$_NORMAL, or error status ! ! SIDE EFFECTS: ! ! Does lots and lots of I/O !-- BEGIN LOCAL STATUS, ! Random status values MORE_SAVE_SETS : BYTE INITIAL (TRUE); ! Flag to keep looking for save sets; EXTERNAL GQ_QUAL_VALUE_CNTS : VECTOR [], ! For detecting existance of qualifier QUAL_SSNAME_DESC : $BBLOCK [], ! Save set name qualifier argument INPUT_FILE_DESC, ! Where to get input QUAL_BLOCKING_FACTOR, ! Number of records per tape block QUAL_SKIP, ! Number of save set to skip QUAL_FORMAT; ! Tape format EXTERNAL ROUTINE STR$COMPARE_MULTI, ! Compare string case blind DUMPER_INITIALIZATION, ! Initialization for dumper tapes BACKUP_INITIALIZATION, ! Initialization for backup tapes TAPE_IO_OPEN, ! Open the tape device TAPE_IO_NEXT_VOLUME, ![IU-20] Switch tape volumes TAPE_IO_SKIP_FILE; ![IU-27] Skip a file mark EXTERNAL LITERAL GQ$K_LIST_QUAL_INDEX, GQ$K_SSNAME_QUAL_INDEX, GQ$K_SKIP_QUAL_INDEX, ![IU-23] DMPR_END_OF_VOLUME; ![IU-20] Code for need volume switch. ! ! Call the proper initialization routine based on tape format. ! IF .QUAL_FORMAT EQL FORMAT$K_DUMPER ! If this is a DUMPER tape THEN PROCESS_VECTOR = DUMPER_INITIALIZATION () ! Get correct vector ELSE PROCESS_VECTOR = BACKUP_INITIALIZATION (); ! Otherwise, this is a ! format handled by BACKUP; ! ! Set up SAVE_SET_xxx based of SSNAME qualifier ! IF .GQ_QUAL_VALUE_CNTS [GQ$K_SSNAME_QUAL_INDEX] GEQ 0 AND ! If we got the switch .QUAL_SSNAME_DESC [DSC$W_LENGTH] GTR 0 ! And it had an argument THEN BEGIN SAVE_SET_SINGLE = FALSE; ! Not just first save set we find SAVE_SET_ALL = (STR$COMPARE_MULTI ( ! Restore all if QUAL_SSNAME_DESC, ! we have some form of %ASCID'ALL', ! SSNAME=ALL TRUE) EQL 0); ! in any case END ELSE BEGIN ! ! Single save set if restore, all if LIST ! SAVE_SET_SINGLE = (.GQ_QUAL_VALUE_CNTS [GQ$K_LIST_QUAL_INDEX] LSS 0); SAVE_SET_ALL = NOT .SAVE_SET_SINGLE; ! Always opposite of SINGLE END; ! ! Default blocking factor ! IF .QUAL_BLOCKING_FACTOR EQL 0 THEN QUAL_BLOCKING_FACTOR = 1; ! ! Open up the saveset device (or file?). ! STATUS = TAPE_IO_OPEN ( ! Open the tape device INPUT_FILE_DESC, ! tape name .QUAL_BLOCKING_FACTOR, ! blocking factor .PROCESS_VECTOR [BLOCK_SIZE]); ! Block size IF NOT .STATUS ! If we can't THEN RETURN .STATUS; ! Give up ![IU-23] IF .QUAL_SKIP NEQ 0 ! If we need to skip some IF .GQ_QUAL_VALUE_CNTS [GQ$K_SKIP_QUAL_INDEX] GEQ 0 ![IU-23] Allow /SKIP=0 THEN BEGIN ! ! Skip the required number of save sets. ! TAPE_RECORD = 0; ![IU-25] No record yet. STATUS = (.PROCESS_VECTOR [SKIP_SAVE_SET]) ( ! Call format routine .QUAL_SKIP, ! To skip this many save sets TAPE_RECORD); ! And return first tape record (if any) IF NOT .STATUS ! If we can't THEN RETURN .STATUS; ! Just give up now END ELSE TAPE_RECORD = 0; ! Otherwise just remember we have no record ! ! Now that we are set up to get data from the tape, find the first saveset !we need to restore. ! WHILE .MORE_SAVE_SETS DO ! As long as we need to look more BEGIN ! ! Get a record first ! IF .TAPE_RECORD EQL 0 ! If we don't have a record THEN BEGIN ![IU-20] Be smart here. STATUS = (.PROCESS_VECTOR [READ_RECORD]) ( ! Get a record from the tape FORWARD_BLOCK, ! Must start at physical record boundary TAPE_RECORD); ! Store buffer here IF .STATUS EQL SS$_ENDOFFILE ![IU-27] DUMPER tape with file marks? THEN ![IU-27] BEGIN ![IU-27] Yes, skip a file. STATUS = TAPE_IO_SKIP_FILE (1); ![IU-27] IF NOT .STATUS ![IU-27] Check for error. THEN ![IU-27] RETURN .STATUS; ![IU-27] STATUS = FALSE ![IU-27] No record. END; ![IU-27] IF .STATUS EQL DMPR_END_OF_VOLUME ![IU-20] Need volume switch? THEN ![IU-20] Yes. BEGIN ![IU-20] So why not do it? STATUS = TAPE_IO_NEXT_VOLUME (); ![IU-20] Do it. IF NOT .STATUS ![IU-20] Check for error. THEN ![IU-20] RETURN .STATUS; ![IU-20] Gee, hope it ain't FALSE... STATUS = FALSE ![IU-20] Ignore, but no error. END ![IU-20] END; ![IU-20] IF .STATUS ! If we got one THEN BEGIN STATUS = CHECK_SAVE_SET_RECORD (); ! Check if we want to start here IF .STATUS ! If we should handle it THEN BEGIN IF (.GQ_QUAL_VALUE_CNTS [GQ$K_LIST_QUAL_INDEX] GEQ 0) ! /LIST? THEN STATUS = LIST_SAVE_SET () ! List out the save set ELSE STATUS = RESTORE_SAVE_SET ();! Then start restoring from here IF NOT .STATUS ! If something failed THEN RETURN .STATUS; ! Give up SAVE_SET_FOUND = TRUE; ! We have restored one now END ELSE BEGIN STATUS = ! If we don't want (.PROCESS_VECTOR [SKIP_SAVE_SET]) ( ! this one, skip it 1, ! Just one save set TAPE_RECORD); ! new record goes here (if any) IF NOT .STATUS AND ! If fatal error (.STATUS NEQ SS$_ENDOFFILE) ! (EOF isn't) THEN RETURN .STATUS ! Just let caller worry END; ! ! Here after handling a save set. If we only wanted the first one we saw and !have restored one, or if we wanted a specific one and have restored it, then !we are done. Otherwise, we need to keep trying. ! MORE_SAVE_SETS = NOT (.SAVE_SET_FOUND AND NOT .SAVE_SET_ALL); END ELSE ! ! Here if we got an error reading the tape. ! ![IU-20] RETURN .STATUS ! *****Punt IF .STATUS NEQ FALSE ![IU-20] FALSE is NOT AN ERROR!!!!!! THEN ![IU-20] RETURN .STATUS ![IU-20] ELSE ![IU-21] .STATUS EQL FALSE means to TAPE_RECORD = 0 ![IU-21] ignore the record... END; ! ! If we fall out of the loop, return ok ! RETURN SS$_NORMAL END; %SBTTL 'CHECK_SAVE_SET_RECORD - Check if we should restore this save set' ROUTINE CHECK_SAVE_SET_RECORD = ! Check if save set should be restored !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called to check if a save set starting at the current ! record should be restored. The current record has already been read ! into the tape buffer. It will call the proper low level routine to ! perform the record decoding and format specific checks, and will then ! decide whether to restore the record. ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! TAPE_RECORD Pointer to record from tape ! PROCESS_VECTOR Pointer to processing routine vector ! SAVE_SET_xxxx Save set related flags ! QUAL_xxxx Qualifier values ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION_CODES: ! ! TRUE if save set should be restored ! FALSE if save set should be skipped ! Other false value if an error occurs ! ! SIDE EFFECTS: ! ! None !-- BEGIN LOCAL STATUS; ! Status values EXTERNAL LITERAL GQ$K_LIST_QUAL_INDEX, ! Index for /LIST qualifier DMPR_NOT_SAVE_SET; ! Not a save set status EXTERNAL GQ_QUAL_VALUE_CNTS : VECTOR []; ! ! Here if we have some real record to process ! STATUS = (.PROCESS_VECTOR [CHECK_SAVE_SET]) ( ! Call low level to check TAPE_RECORD); ! tape record for save set items IF NOT .STATUS AND ! If low level doesn't like it .STATUS NEQ FALSE AND ! and not just because it didn't match .STATUS NEQ DMPR_NOT_SAVE_SET ! or because it isn't a save set THEN RETURN FALSE; ! punt ! ! Here if we did not get an error while parsing the save set header. !If we want all save sets or the first one encountered, we will return this !one. If not, we must skip this save set. ! IF .STATUS OR ! If low level said yes (.STATUS NEQ DMPR_NOT_SAVE_SET) AND ! or this was a save set (.SAVE_SET_ALL OR ! and we want them all or (.SAVE_SET_SINGLE AND NOT .SAVE_SET_FOUND)) ! want first one and this is it THEN RETURN TRUE ! Process this save set ELSE ! ! If we didn't want this one, check if it is just because it is not a save !set record and we are listing the tape ! RETURN (.STATUS EQL DMPR_NOT_SAVE_SET) AND (.GQ_QUAL_VALUE_CNTS [GQ$K_LIST_QUAL_INDEX] GEQ 0); END; %SBTTL 'RESTORE_SAVE_SET - Restore a whole save set' ROUTINE RESTORE_SAVE_SET = ! Routine to restore a save set !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called when it is determined that a save set should ! be restored. It will process the entire save set, restoring all ! desired files. When this routine is called, the ! save set header should be in the tape buffer. ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! TAPE_RECORD Pointer to record from tape ! PROCESS_VECTOR Pointer to processing routine vector ! SAVE_SET_xxxx Save set related flags ! QUAL_xxxx Qualifier values ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION_CODES: ! ! True value if save set restored okay ! False value if an error occurred ! ! SIDE EFFECTS: ! ! None !-- BEGIN EXTERNAL ROUTINE ![IU-20] TAPE_IO_NEXT_VOLUME; ![IU-20] EXTERNAL LITERAL DMPR_END_OF_SAVE_SET, ! Status for end of save set DMPR_END_OF_VOLUME; ![IU-20] Means we need vol switch. LOCAL STATUS; ! Routine call status values STATUS = TRUE; ![IU-21] In case we already have a tape record. ! ! We will loop looking for files to restore within this save set. ! WHILE TRUE DO ! Loop until we return BEGIN IF .TAPE_RECORD EQL 0 ! If we need a record THEN BEGIN STATUS = (.PROCESS_VECTOR [READ_RECORD]) ( ! Get the next record FORWARD_RECORD, ! From next spot TAPE_RECORD); ! Store pointer here IF .STATUS EQL SS$_ENDOFFILE ![IU-27] DUMPER tape with file marks? THEN ![IU-27] BEGIN ![IU-27] Yes. TAPE_RECORD = 0; ![IU-27] No record. RETURN DMPR_END_OF_SAVE_SET ![IU-27] End of saveset. END; ![IU-27] IF .STATUS EQL DMPR_END_OF_VOLUME ![IU-20] Need volume switch?? THEN ![IU-20] Yes, so do it. BEGIN ![IU-20] STATUS = TAPE_IO_NEXT_VOLUME (); ![IU-20] IF NOT .STATUS ![IU-20] Thank GOD, a routine that THEN ![IU-20] doesn't return FALSE!!! RETURN .STATUS; ![IU-20] Failed, return the error. STATUS = FALSE ![IU-20] OK, INGORE THE RECORD. END; ![IU-20] IF NOT .STATUS ! If we can't, AND .STATUS NEQ FALSE ![IU-20] Sigh. Status FALSE is NOT AN ERROR!!!! THEN RETURN .STATUS; ! Give up END; IF .STATUS ![IU-20] FALSE means ignore rec. THEN ![IU-20] BEGIN STATUS = (.PROCESS_VECTOR [PROCESS_FILE]) ( ! Check if this is start TAPE_RECORD); ! of a file to restore IF (NOT .STATUS AND .STATUS NEQ FALSE) OR ! fatal error? .STATUS EQL DMPR_END_OF_SAVE_SET ! Or just end of this save set THEN RETURN .STATUS; ! Yes, pass it back IF .STATUS ! If we are to start restoring here THEN BEGIN ! ! We are supposed to restore this file. ! STATUS = RESTORE_FILE (); ! Restore this file IF NOT .STATUS ! If a fatal error occurred THEN RETURN .STATUS; ! give up END END ![IU-20] I think this matches.. ELSE ![IU-21] Else we ignore the TAPE_RECORD = 0 ![IU-21] record... END END; %SBTTL 'RESTORE_FILE - Restore a single file' ROUTINE RESTORE_FILE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called to restore a single file. It will call the ! the proper low level routines (format specific) to process the data ! from the file. When this routine is called, the file header data ! must have already been processed by calling the PROCESS_FILE entry ! and the file header record must still be the current tape buffer. ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! TAPE_RECORD Pointer to record from tape ! PROCESS_VECTOR Pointer to processing routine vector ! SAVE_SET_xxxx Save set related flags ! QUAL_xxxx Qualifier values ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION_CODES: ! ! True value if no error detected ! False value if error detected (status code) ! ! SIDE EFFECTS: ! ! None !-- BEGIN EXTERNAL LITERAL DMPR_END_OF_VOLUME; ! Status which indicates end of this volume EXTERNAL ROUTINE TAPE_IO_NEXT_VOLUME; ! Routine to switch tapes LOCAL STATUS; ! Routine call status values ! ! The file is already open (from the PROCESS_FILE call). We will just !write data. ! WHILE TRUE DO ! Until we return out of loop BEGIN STATUS = TRUE; ![IU-14] Start this out as TRUE. IF .TAPE_RECORD EQL 0 ! If we need a new record THEN BEGIN STATUS = (.PROCESS_VECTOR [READ_RECORD]) ( ! Read next record FORWARD_RECORD, ! unblock as needed TAPE_RECORD); ! Store pointer here IF .STATUS EQL DMPR_END_OF_VOLUME ! If we need next volume THEN BEGIN ![IU-14] STATUS = TAPE_IO_NEXT_VOLUME (); ! Get the next tape IF NOT .STATUS ![IU-14] THEN ![IU-14] RETURN .STATUS; ![IU-14] STATUS = FALSE ![IU-14] Ignore EOV record. END ![IU-14] ![IU-14] IF NOT .STATUS ! If we couldn't, ELSE IF (NOT .STATUS) AND (.STATUS NEQ FALSE) ![IU-14] .STATUS EQL FALSE IS NOT AN ERROR. THEN RETURN .STATUS ! give up END; ! ! Now process the data ! ![IU-14] But only if STATUS is NEQ FALSE. If it's FALSE, ignore the record! IF .STATUS ![IU-14] THEN ![IU-14] BEGIN ![IU-14] STATUS = (.PROCESS_VECTOR [PROCESS_DATA]) ( ! Handle this record TAPE_RECORD); ! In format dependent manner IF .STATUS EQL SS$_ENDOFFILE ! If done with this file THEN RETURN TRUE; ! just return happy IF NOT .STATUS ! If something else failed THEN RETURN .STATUS; ! we must give up END ![IU-14] ELSE ![IU-21] TAPE_RECORD = 0 ![IU-21] END END; %SBTTL 'LIST_SAVE_SET - List out an entire save set' ROUTINE LIST_SAVE_SET = ! Process a save set for /LIST !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called to list a single save set. ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! TAPE_RECORD Current tape record ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION_CODES: ! ! True if all ok, false error status on error ! ! SIDE EFFECTS: ! ! None !-- BEGIN LOCAL STATUS; EXTERNAL LITERAL DMPR_END_OF_VOLUME, ! Status which indicates end of this volume DMPR_END_OF_SAVE_SET; EXTERNAL ROUTINE TAPE_IO_NEXT_VOLUME; ! Fetch next tape routine WHILE TRUE DO BEGIN STATUS = (.PROCESS_VECTOR [LIST_RECORD]) (TAPE_RECORD); ! List the record IF NOT .STATUS OR .STATUS EQL DMPR_END_OF_SAVE_SET ! If error or done THEN RETURN .STATUS; IF .TAPE_RECORD EQL 0 ! If we need another record THEN BEGIN STATUS = (.PROCESS_VECTOR [READ_RECORD]) ( ! Read next record FORWARD_RECORD, ! No blocking TAPE_RECORD); ! Store pointer here IF .STATUS EQL SS$_ENDOFFILE ![IU-27] DUMPER tape with file marks? THEN ![IU-27] BEGIN ![IU-27] TAPE_RECORD = 0; ![IU-27] No more record. RETURN DMPR_END_OF_SAVE_SET ![IU-27] Say end of saveset. END; ![IU-27] IF .STATUS EQL DMPR_END_OF_VOLUME ! Need new tape? THEN STATUS = TAPE_IO_NEXT_VOLUME (); ! Yes, get it ![IU-11] IF NOT .STATUS ! If we got an error IF (NOT .STATUS AND .STATUS NEQ FALSE) ![IU-11] .STATUS EQL FALSE IS NOT AN ERROR. THEN RETURN .STATUS ! Then just give up END END END; END ! End of module ELUDOM