%TITLE 'DUMPER-32 - Read BACKUP-10/DUMPER-20 Tapes' MODULE DUMPER (IDENT = '1.0.001', LANGUAGE (BLISS32) , MAIN = DUMPER_MAIN, ADDRESSING_MODE (EXTERNAL = GENERAL) ) = BEGIN ! !++ ! FACILITY: ! ! DUMPER-32, Tape utility ! ! ABSTRACT: ! ! DUMPER-32 is a program to read BACKUP-10 tapes from the DECsystem-10s and ! DUMPER-20 tapes from the DECSYSTEM-20s. This program will read tapes only ! and restore the information to disk. It will not write BACKUP-10 or ! DUMPER-20 tapes. ! ! AUTHORS: ! ! Robert C. McQueen ! ! CREATION DATE: 23-April-1985 ! ! MODIFICATION HISTORY: !-- ! ! TABLE OF CONTENTS: ! %SBTTL 'Revision History' !++ ! Start of Version 1. ! ! 1.0.000 By: Robert C. McQueen On: 23-Apr-1985 ! Create this Module. ! ! 1.0.001 By: Nick Bush On: 30-Jul-1985 ! Fix a problem with match file specification routine. ! ! [IU-7] By: James A. Harvey On: 15-DEC-1987 ! Add /REMOVE_LSNS qualifier. /REMOVE_LSNS is the default. ! ! [IU-8] By: James A. Harvey On: 15-DEC-1987 ! Add /BINARY qualifier. ! ! [IU-17] By: James A. Harvey On: 05-Jan-1988 ! Make the /SSNAME qualifier work properly. !-- ! ! INCLUDE FILES: ! LIBRARY 'SYS$LIBRARY:STARLET'; LIBRARY 'SYS$LIBRARY:XPORT'; ![~library_declaration~]... REQUIRE 'PARMAC'; ! ! Kill XPORT defs that get in the way ! UNDECLARE %QUOTE $BYTE; REQUIRE 'DUMPER_SYMBOLS'; ![~require_declaration~]... ! ! Forward routines: ! FORWARD ROUTINE MATCH_SINGLE_FILE, ! Match a single file spec MATCH_STRING; ! Match a string (field of file spec) FORWARD ROUTINE ![IU-17] INIT_NOQUOTE_SSNAME; ![IU-17] To make /SSNAME work. ! ! MACROS: ! ! Parse tables ! MACRO PARAMETER_INPUT_FILE = (KEY_WORD = INPUTS, ! This is the input file parameter STORAGE = INPUT_FILE_DESC, ! Here is the descriptor for where to put the name MAX_LENGTH = FILE_NAME_SIZE, ! Up to size of name RMS likes MAX_COUNT = 1, ! Only one parameter ROUTINE_NAME = PAR$PARSE_FILE, ! This is a file specification FLAGS = (STORAGE_IS_DESCRIPTOR, ! Store a descriptor TAKES_VALUE)) ! Takes a value %, ! End of PARAMETER_INPUT_FILE PARAMETER_OUTPUT_FILE = (KEY_WORD = OUTPUTS, ! This is the output file parameter STORAGE = OUTPUT_FILE_DESC, ! Here is the descriptor for where to put the name MAX_LENGTH = FILE_NAME_SIZE, ! Up to size of name RMS likes MAX_COUNT = 1, ! Only one parameter ROUTINE_NAME = PAR$PARSE_FILE, ! This is a file specification FLAGS = (STORAGE_IS_DESCRIPTOR, ! Store a descriptor TAKES_VALUE)) ! Takes a value %, ! End of PARAMETER_OUTPUT_FILE GLOBAL_QUALIFIERS = (KEY_WORD = BINARY), ![IU-8] Add /BINARY. (KEY_WORD = BLOCKING_FACTOR, ! Number of records per block MAX_LENGTH = %UPVAL, ! Stored in a longword MAX_COUNT = 1, ! Only one per command STORAGE = QUAL_BLOCKING_FACTOR, ! Store it here ROUTINE_NAME = PAR$PARSE_INTEGER,! Routine to parse value FLAGS = (TAKES_VALUE)), ! This needs a value (KEY_WORD = CREATEDIRECTORY), ! Create the directories (KEY_WORD = DEBUG), ! Debugging flag (KEY_WORD = DENSITY, ! Tape density MAX_LENGTH = %UPVAL, ! Store in a longword MAX_COUNT = 1, ! Only one value STORAGE = QUAL_DENSITY, ! Store value here ROUTINE_NAME = PAR$PARSE_KEYWORD, ! Parse a keyword ROUTINE_ARGS = KEYWORD_TABLE_POINTER (DENSITY), ! Point at table FLAGS = (TAKES_VALUE)), ! Needs a value (KEY_WORD = FORMAT, ! The tape format keyword MAX_LENGTH = %UPVAL, ! Longword storage MAX_COUNT = 1, ! Only one value STORAGE = QUAL_FORMAT, ! Store value here ROUTINE_NAME = PAR$PARSE_KEYWORD, ! This takes keyword values ROUTINE_ARGS = KEYWORD_TABLE_POINTER (FORMAT), ! Point at keyword table FLAGS = (TAKES_VALUE)), ! Must have a value (KEY_WORD = LIST, ! /LIST qualifier MAX_LENGTH = FILE_NAME_SIZE, ! May be size of file name MAX_COUNT = 1, ! But only one STORAGE = LIST_FILE_DESC, ! Point at descriptor for storage ROUTINE_NAME = PAR$PARSE_FILE, ! This takes a file spec FLAGS = (TAKES_VALUE, ! This qual takes a value STORAGE_IS_DESCRIPTOR)), ! And is stored via descriptor (KEY_WORD = LOG, ! /LOG[={FILES, DIRECTORIES, ALL}] MAX_LENGTH = %UPVAL, ! Fits in normal value MAX_COUNT = 1, ! Only one argument STORAGE = QUAL_LOG, ! Type of logging to perform ROUTINE_ARGS = KEYWORD_TABLE_POINTER (LOG), ! Point at table of keywords ROUTINE_NAME = PAR$PARSE_KEYWORD, ! This is a keyword FLAGS = (TAKES_VALUE)), ! This takes a value (KEY_WORD = REMOVE_LSNS), ![IU-7] Add /REMOVE_LSNS (KEY_WORD = REWIND), ! Whether to rewind first (KEY_WORD = SELECT, ! Which files to select MAX_LENGTH = 255, ! Allow long strings MAX_COUNT = 255, ! And lots of files STORAGE = QUAL_SELECT, ! Store them here ROUTINE_NAME = PAR$PARSE_STRING, ! Routine to get value FLAGS = (TAKES_VALUE, ! This qual takes a value CAN_BE_LIST, ! This can be a list STORAGE_IS_DESCRIPTOR)), ! And is a bunch of descriptors (KEY_WORD = SKIP, ! Number of savesets to skip MAX_LENGTH = %UPVAL, ! Store in longword MAX_COUNT = 1, ! Only one occurance STORAGE = QUAL_SKIP, ! Store value here ROUTINE_NAME = PAR$PARSE_INTEGER,! Parse off value FLAGS = (TAKES_VALUE)), ! Needs a value (KEY_WORD = SSNAME, ! Save set name MAX_LENGTH = 255, ! Allow long saveset names MAX_COUNT = 1, ! But only one at a time STORAGE = QUAL_SSNAME_DESC, ! Store it here ROUTINE_NAME = PAR$PARSE_STRING, ! Routine to get value FLAGS = (TAKES_VALUE, ! Definitely needs a value STORAGE_IS_DESCRIPTOR)) ! String descriptor %, ! End of GLOBAL_QUALIFIERS DENSITY_KEYWORD = ! Density to use while reading (KEY_WORD = DEFAULT, VALUE = MT$K_DEFAULT), ! Drives default density (KEY_WORD = 800, VALUE = MT$K_NRZI_800), ! 800 BPI (KEY_WORD = 1600, VALUE = MT$K_PE_1600), ! 1600 BPI (KEY_WORD = 6250, VALUE = MT$K_GCR_6250) ! 6250 BPI %, ! End of DENSITY_KEYWORD ! FORMAT_KEYWORD = ! Args for tape format (KEY_WORD = BACKUP, ! /FORMAT=BACKUP VALUE = FORMAT$K_BACKUP), ! BACKUP non-interchange tape (KEY_WORD = DUMPER, ! /FORMAT=DUMPER VALUE = FORMAT$K_DUMPER), ! DUMPER non-interchange tape (KEY_WORD = INTERCHANGE, ! /FORMAT=INTERCHANGE VALUE = FORMAT$K_INTERCHANGE) ! BACKUP/DUMPER interchange format %, ! End of FORMAT_KEYWORD ! LOG_KEYWORD = (KEY_WORD = ALL, ! /LOG=ALL VALUE = LOG$K_ALL), ! Type message for everything (KEY_WORD = DIRECTORIES, ! /LOG=DIRECTORIES VALUE = LOG$K_DIRECTORIES), ! Type message only when directory ! changes. Interesting only if ! not interchange mode (KEY_WORD = FILES, ! /LOG=FILES VALUE = LOG$K_FILES) ! Message on each file %; ! End of LOG_KEYWORD ! ! Helper macros ! MACRO KEYWORD_TABLE_POINTER (TABLE_NAME) = ! Generate keyword table pointer UPLIT (%NAME('KEY$K_',TABLE_NAME,'_MAX') + 1, ! Number of keywords %NAME(TABLE_NAME,'_KEY_TABLE')) %; ! Address of table ! ! EQUATED SYMBOLS: ! LITERAL FILE_NAME_SIZE = NAM$C_MAXRSS; ! Maximum length of a file name ![~bind_declaration~] ! ! OWN STORAGE: ! ![~own_declaration~] GLOBAL INPUT_FILE_DESC : $BBLOCK [DSC$K_D_BLN] PRESET ([DSC$W_LENGTH] = 0, [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), OUTPUT_FILE_DESC : $BBLOCK [DSC$K_D_BLN] PRESET ([DSC$W_LENGTH] = 0, [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), QUAL_BLOCKING_FACTOR, QUAL_DENSITY, QUAL_FORMAT, LIST_FILE_DESC : $BBLOCK [DSC$K_D_BLN] PRESET ([DSC$W_LENGTH] = 0, [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0), QUAL_LOG, QUAL_SELECT : BLOCKVECTOR [255, DSC$K_D_BLN, BYTE] INITIAL ( REP 255 OF ( WORD (0), BYTE (DSC$K_DTYPE_T), BYTE (DSC$K_CLASS_D), LONG (0))), QUAL_SKIP, QUAL_SSNAME_DESC : $BBLOCK [DSC$K_D_BLN] PRESET ([DSC$W_LENGTH] = 0, [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0); ![IU-17]++ OWN ! This can only be seen in this module. It is used by MATCH_SSNAME. NOQUOTE_SSNAME_DESC : $BBLOCK [DSC$K_D_BLN] PRESET ([DSC$W_LENGTH] = 0, [DSC$B_DTYPE] = DSC$K_DTYPE_T, [DSC$B_CLASS] = DSC$K_CLASS_D, [DSC$A_POINTER] = 0); ![IU-17]-- ! ! EXTERNAL REFERENCES: ! ![~external_declarations~]... %SBTTL 'Parse table expansion' ! ! The following are the expansions of the parse tables for DUMPER. ! $PAR_BUILD_KEY_TABLE (TRUE, DENSITY, %QUOTE DENSITY_KEYWORD); $PAR_BUILD_KEY_TABLE (TRUE, FORMAT, %QUOTE FORMAT_KEYWORD); $PAR_BUILD_KEY_TABLE (TRUE, LOG, %QUOTE LOG_KEYWORD); $PAR_BUILD_QUAL_TABLE (TRUE, GQ, %QUOTE GLOBAL_QUALIFIERS); $PAR_BUILD_PARM_BLOCK (TRUE, INPUT_FILE, %QUOTE PARAMETER_INPUT_FILE); $PAR_BUILD_PARM_BLOCK (TRUE, OUTPUT_FILE, %QUOTE PARAMETER_OUTPUT_FILE); %SBTTL 'DUMPER_MAIN - Main routine' ROUTINE DUMPER_MAIN = !++ ! FUNCTIONAL DESCRIPTION: ! ! This is the main routine for DUMPER-32. It will cause the various ! modules to be initialized and then call the correct routine to process ! a command. ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION_CODES: ! ! [~description_or_none~] ! ! SIDE EFFECTS: ! ! None !-- BEGIN LOCAL STATUS; ! Holds status results from called routines EXTERNAL ROUTINE PAR$INIT_QUALIFIER_TABLE, ! Parser routine to initialize qualifiers PAR$PARSE_QUALIFIERS, ! Parse routine for qualifiers PAR$INIT_PARAMETER_BLOCK, ! Parser routine to initialze a parameter PAR$PARSE_PARAMETER, ! Parse routine for parameters LIST_OPEN, ! Open listing file LIST_CLOSE, ! Close listing file DRIVER_PROCESS_COMMAND; ! Main driver routine to actually do command ! ! Start by calling parser to get the command info ! STATUS = PAR$INIT_QUALIFIER_TABLE ( ! Initialize the table GQ_QUAL_TABLE, ! of global qualifiers GQ_QUAL_VALUE_CNTS, ! and the counts QUAL$K_GQ_MAX); ! this is how many we have IF NOT .STATUS ! If it failed, THEN RETURN .STATUS; ! Just give up STATUS = PAR$PARSE_QUALIFIERS ( ! Now parse off the qualifiers GQ_QUAL_TABLE, ! from this table GQ_QUAL_VALUE_CNTS, ! store counts here QUAL$K_GQ_MAX); ! there are this many qualifiers in the table IF NOT .STATUS ! If it failed, THEN RETURN .STATUS; ! Just give up STATUS = PAR$INIT_PARAMETER_BLOCK ( ! Now get the input file parameter INPUT_FILE_PARM_BLOCK); ! scratch it first IF NOT .STATUS ! If it failed, THEN RETURN .STATUS; ! Just give up STATUS = PAR$PARSE_PARAMETER ( ! Parse the parameter which specifies INPUT_FILE_PARM_BLOCK, ! where to read the save set INPUT_FILE_PARM_VALUE_CNT); ! Count of files here IF NOT .STATUS ! If it failed, THEN RETURN .STATUS; ! Just give up ! ! Now check if we are supposed to restore files or just list the tape ! IF .GQ_QUAL_VALUE_CNTS [GQ$K_LIST_QUAL_INDEX] LSS 0 ! If /LIST not given THEN BEGIN STATUS = PAR$INIT_PARAMETER_BLOCK ( ! Must get output file spec OUTPUT_FILE_PARM_BLOCK); ! so initialize the block IF NOT .STATUS ! If an error THEN RETURN .STATUS; ! Then punt STATUS = PAR$PARSE_PARAMETER ( ! Otherwise, parse the OUTPUT_FILE_PARM_BLOCK, ! output file parameter OUTPUT_FILE_PARM_VALUE_CNT); ! put count here (better be one) IF NOT .STATUS ! If we can't THEN RETURN .STATUS ! Just give up END; ![IU-17]++ ! Fixup descriptor for saveset name without quotes if necessary. ! INIT_NOQUOTE_SSNAME (); ![IU-17]-- ! ! Open any listing file ! STATUS = LIST_OPEN (); ! Open it up IF NOT .STATUS ! If not, THEN RETURN .STATUS; ! Just give up ! ! We now have all the info we need to process the command. Go do it ! STATUS = DRIVER_PROCESS_COMMAND (); ! Process it IF NOT .STATUS ! If we couldn't, THEN BEGIN LIST_CLOSE (); ! Close the listing file RETURN .STATUS ! and exit with failing status END; ! ! All done, close the listing file (if any) and return. ! RETURN LIST_CLOSE () END; %SBTTL 'MATCH_FILESPEC - Determine if file is desired' GLOBAL ROUTINE MATCH_FILESPEC ( ! Match filespec against selection list FILE_SPEC : REF $BBLOCK [] ! Descriptor for file spec ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called to determine if a file should be restored or ! skipped. It will match the file specification from the tape against ! the (possibly wildcarded) file specifications from the user's /SELECT ! qualifier. If the file spec matches, it will return true, otherwise ! it will return false. ! ! FORMAL PARAMETERS: ! ! FILE_SPEC The descriptor for the file specification from the tape ! ! IMPLICIT INPUTS: ! ! QUAL_SELECT Array of file specifications from /SELECT ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION_CODES: ! ! True if file specification matches, therefore file should be restored ! False if file specification does not match, therefore file should be skipped ! ! SIDE EFFECTS: ! ! None !-- BEGIN IF .GQ_QUAL_VALUE_CNTS [GQ$K_SELECT_QUAL_INDEX] LSS 0 ! If no selection THEN RETURN TRUE; ! we always match INCR SELECT_INDEX FROM 0 ! Start with first selection spec TO .GQ_QUAL_VALUE_CNTS [GQ$K_SELECT_QUAL_INDEX] - 1 ! To last one DO BEGIN IF MATCH_SINGLE_FILE (.FILE_SPEC, ! If the desired spec matches QUAL_SELECT [.SELECT_INDEX, 0, 0, 0, 0]) ! this selection THEN RETURN TRUE ! Then we are done, restore it END; ! ! If we fall out of loop, nothing matched ! RETURN FALSE ! Don't restore this one END; %SBTTL 'EXTRACT_FIELDS - Extract the fields of a file specification' GLOBAL ROUTINE EXTRACT_FIELDS( ! Extract file spec fields STRING_DESC : REF $BBLOCK [], ! Descriptor for string RESULT : REF BLOCKVECTOR [FLD$K_LENGTH, DSC$K_S_BLN, BYTE] ! Result ) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will return pointers to the various part of the file ! specification. ! ! FORMAL PARAMETERS: ! ! STRING_DESC - Descriptor to the file specification string ! RESULT - Block vector containing the addresses and lengths of the ! various items in the file specification. ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION_CODES: ! ! None ! ! SIDE EFFECTS: ! ! None !-- BEGIN LOCAL CH, ! Random character CUR_FIELD, ! Current field of name STRING_PTR, ! Pointer to field of string STRING_LEN, ! Length of field in string TEMP_PTR; ! Temp pointer STRING_PTR = .STRING_DESC [DSC$A_POINTER]; ! Point at string STRING_LEN = .STRING_DESC [DSC$W_LENGTH]; ! Get length IF .STRING_LEN LEQ 0 ! If nothing at all THEN RETURN; ! Just return ! ! Check for a device name ! TEMP_PTR = CH$FIND_CH( ! Check if we have a device name .STRING_LEN, ! in the string. It must be .STRING_PTR, %C':'); ! Terminated by a colon IF NOT CH$FAIL(.TEMP_PTR) ! If we found a colon THEN BEGIN RESULT [FLD$K_DEVICE, DSC$A_POINTER] = .STRING_PTR; ! Save pointer RESULT [FLD$K_DEVICE, DSC$W_LENGTH] = CH$DIFF( ! and length .TEMP_PTR, ! of device .STRING_PTR); ! name string STRING_PTR = CH$PLUS(.TEMP_PTR,1); ! Now point at start STRING_LEN = .STRING_LEN - ! of next field (.RESULT [FLD$K_DEVICE, DSC$W_LENGTH] + ! and save remaining 1) ! string length END; ! ! Check for a directory name. ! IF .STRING_LEN LEQ 0 ! If nothing left, THEN RETURN; ! We are done now IF CH$RCHAR(.STRING_PTR) EQL %C'[' OR ! If we start a directory CH$RCHAR(.STRING_PTR) EQL %C'<' ! with either character THEN BEGIN CH = CH$RCHAR_A (STRING_PTR); ! Get open character RESULT [FLD$K_DIRECT, DSC$A_POINTER] = .STRING_PTR; ! Save start STRING_LEN = .STRING_LEN - 1; ! Count it TEMP_PTR = CH$FIND_CH( ! Search for closing character .STRING_LEN, ! in what is left of .STRING_PTR, ! the string (IF .CH EQL %C'[' ! for corresponding THEN %C']' ! closing ELSE %C'>')); ! delimiter IF CH$FAIL(.TEMP_PTR) ! If we can't find it THEN RETURN; ! just return, this is a broken spec RESULT [FLD$K_DIRECT, DSC$W_LENGTH] = CH$DIFF( ! Get length .TEMP_PTR, .STRING_PTR); ! of directory name STRING_PTR = CH$PLUS(.TEMP_PTR, 1); ! Set pointer to next field STRING_LEN = .STRING_LEN - ! And remaining lengh also (.RESULT [FLD$K_DIRECT, DSC$W_LENGTH] + 1); ! after dir is removed END; ! ! Check for file name - it ends with "." or ";" or end of string ! IF .STRING_LEN LEQ 0 ! If nothing left THEN RETURN; ! just return now RESULT [FLD$K_NAME, DSC$A_POINTER] = .STRING_PTR; ! Always have a name ! if we get here at all CUR_FIELD = FLD$K_NAME; ! Current field is name TEMP_PTR = CH$FIND_CH( ! Check if we have a "." .STRING_LEN, ! trailing the name .STRING_PTR, %C'.'); ! to start the extension IF NOT CH$FAIL(.TEMP_PTR) ! If we found a dot THEN BEGIN RESULT [FLD$K_NAME, DSC$W_LENGTH] = CH$DIFF( ! then save length .TEMP_PTR, .STRING_PTR); ! of name STRING_PTR = CH$PLUS(.TEMP_PTR, 1); ! Point at start of extension STRING_LEN = .STRING_LEN - ! Get remaining length (.RESULT [FLD$K_NAME, DSC$W_LENGTH] + 1); ! of string CUR_FIELD = FLD$K_EXT; ! No saving extension RESULT [FLD$K_EXT, DSC$A_POINTER] = .STRING_PTR; ! Save start of extension END; ! ! Now handle generation, setting length of extension or file name also ! IF .STRING_LEN LEQ 0 ! If nothing left, THEN RETURN; ! Just return TEMP_PTR = CH$FIND_CH( ! Check for semi-colon .STRING_LEN, ! to start version number .STRING_PTR, %C';'); ! in standard VMS form IF CH$FAIL(.TEMP_PTR) ! If no semi-colon, THEN TEMP_PTR = CH$FIND_CH( ! then try for .STRING_LEN, ! TOPS-20 style with .STRING_PTR, %C'.'); ! another period IF NOT CH$FAIL(.TEMP_PTR) ! If we found it, THEN BEGIN RESULT [.CUR_FIELD, DSC$W_LENGTH] = CH$DIFF( ! Length of previous .TEMP_PTR, .STRING_PTR); ! field is now known RESULT [FLD$K_VERSION, DSC$A_POINTER] = CH$PLUS( ! Save start .TEMP_PTR,1); ! Of version number RESULT [FLD$K_VERSION, DSC$W_LENGTH] = .STRING_LEN - ! And length (.RESULT [.CUR_FIELD, DSC$W_LENGTH] + 1); ! of the number RETURN END; ! ! If we didn't have a version (generation) number, last field ends at end of ! string. ! RESULT [.CUR_FIELD, DSC$W_LENGTH] = .STRING_LEN; RETURN ! All done END; %SBTTL 'MATCH_SINGLE_FILE - Match a pair of filespecs' ROUTINE MATCH_SINGLE_FILE ( ! Check if two file specs match FILE_SPEC : REF $BBLOCK [], ! Full spec to match TEMPLATE_SPEC : REF $BBLOCK ! Spec to match against ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called from MATCH_FILESPEC to determine if the ! file specification matches the template specification. It will ! handle full wildcarded templates using both "*" and "%". ! ! FORMAL PARAMETERS: ! ! FILE_SPEC Descriptor for file specification ! TEMPLATE_SPEC Descriptor for template specification ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION_CODES: ! ! True if file spec fits template ! False if file spec does not fit template ! ! SIDE EFFECTS: ! ! None !-- BEGIN LOCAL STRING_FIELDS : BLOCKVECTOR[FLD$K_LENGTH, DSC$K_S_BLN, BYTE] ! Fields INITIAL(REP FLD$K_LENGTH OF (REP DSC$K_S_BLN OF BYTE (0))), ! in string PATTERN_FIELDS : BLOCKVECTOR[FLD$K_LENGTH, DSC$K_S_BLN, BYTE] ! Fields INITIAL(REP FLD$K_LENGTH OF (REP DSC$K_S_BLN OF BYTE (0))); ! in pattern ! ! Main logic of routine ! EXTRACT_FIELDS (.FILE_SPEC, STRING_FIELDS); ! Pull apart file spec EXTRACT_FIELDS (.TEMPLATE_SPEC, PATTERN_FIELDS); ! And pattern (template) ! ! Now match up the various fields. ! INCR CUR_FIELD FROM 0 TO FLD$K_LENGTH - 1 DO BEGIN IF NOT CH$FAIL(.STRING_FIELDS [.CUR_FIELD, DSC$A_POINTER]) AND! If both ! string have NOT CH$FAIL(.PATTERN_FIELDS [.CUR_FIELD, DSC$A_POINTER]) ! the field THEN IF NOT MATCH_STRING ( ! Check if strings match .STRING_FIELDS [.CUR_FIELD, DSC$W_LENGTH], ! in any .STRING_FIELDS [.CUR_FIELD, DSC$A_POINTER], ! way .PATTERN_FIELDS [.CUR_FIELD, DSC$W_LENGTH], ! allowing .PATTERN_FIELDS [.CUR_FIELD, DSC$A_POINTER]) ! full wildcards THEN RETURN FALSE; ! If no match, whole spec fails END; RETURN TRUE ! File spec matches END; %SBTTL 'MATCH_STRING - Match a string against a pattern' ROUTINE MATCH_STRING ( ! Match string against wild-card pattern STRING_LENGTH, ! Length of string to be matched STRING_POINTER, ! Character pointer to string to be matched PATTERN_LENGTH, ! Length of pattern PATTERN_POINTER ! Character pointer to pattern ) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called to match a field of a file spec against ! the wild-card pattern for that field. It the field fits the pattern, ! it will return true, otherwise it returns false. It handles both ! "*" as zero or more characters and "%" as any single character. ! ! FORMAL PARAMETERS: ! ! STRING_LENGTH Length of string to be matched ! STRING_POINTER Character pointer to string to be matched ! PATTERN_LENGTH Length of pattern ! PATTERN_POINTER Character pointer to pattern ! ! IMPLICIT INPUTS: ! ! None ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION_CODES: ! ! True if string fits pattern, false otherwise ! ! SIDE EFFECTS: ! ! None !-- BEGIN LOCAL PAT_CHAR, ! Character from pattern STR_CHAR, ! Character from string SUB_PAT_PTR, ! Substring pointer for pattern SUB_PAT_LEN, ! Length of pattern substring SUB_PAT_PTR_INI, ! Initial substring pattern pointer SUB_PAT_LEN_INI, ! Initial substring length SUB_PAT_END_PTR; ! Pointer to end of substring ! ! Do some quick checks first for some of the common flavors of wildcard. ! WHILE TRUE DO ! Keep looking till we escape BEGIN IF .PATTERN_LENGTH EQL 0 ! If no pattern, THEN RETURN .STRING_LENGTH EQL 0; ! then match only succeeds if string is null IF .PATTERN_LENGTH EQL 1 AND ! If single character pattern CH$RCHAR (.PATTERN_POINTER) EQL %C'*' ! is fully wild THEN RETURN TRUE; ! then we match anything ! ! Set up to handle the fancier cases ! ! ! Skip non-wild characters which match ! PAT_CHAR = -1; ! ensure initial conditions STR_CHAR = -1; ! are true WHILE .PATTERN_LENGTH GTR 0 AND ! As long as we have data left .STRING_LENGTH GTR 0 AND ! in both string and pattern .PAT_CHAR EQL .STR_CHAR ! and characters match DO BEGIN PAT_CHAR = CH$RCHAR_A (PATTERN_POINTER); ! Get pattern character PATTERN_LENGTH = .PATTERN_LENGTH - 1; ! Count it STR_CHAR = CH$RCHAR_A (STRING_POINTER); ! Get string character STRING_LENGTH = .STRING_LENGTH - 1; ! Count it also SELECTONE .PAT_CHAR OF ! Check for special case pattern characters SET [%C'%'] : ! Single wild character? PAT_CHAR = .STR_CHAR; ! Yes, always matches [%C'*'] : ! Full wild? PAT_CHAR = -%C'*'; ! Yes, ensure we fall out [OTHERWISE] : ! Anything else IF .PAT_CHAR NEQ .STR_CHAR ! Must match exactly THEN RETURN FALSE; ! or string does not match TES END; ! WHILE .PATTERN_LENGTH GTR 0 ... ! ! Here if we have either run out of pattern or source or have hit an asterisk !in the pattern ! IF .PAT_CHAR NEQ -%C'*' ! If not full wild THEN IF .STRING_LENGTH LEQ 0 ! If no string left THEN RETURN .PATTERN_LENGTH LEQ 0; ! Then match only if pattern ran out IF .PAT_CHAR EQL -%C'*' ! If we hit an asterisk THEN BEGIN ! ! Here to handle an asterisk in the pattern. Find the next non-asterisk !character in the pattern and then look for the substring we need. ! SUB_PAT_PTR = CH$FIND_NOT_CH ( ! Look for character .PATTERN_LENGTH, .PATTERN_POINTER, %C'*'); ! which is not a * IF CH$FAIL (.SUB_PAT_PTR) ! If all *'s left THEN RETURN TRUE; ! Then all done, string matches ! ! We have pointer to first non-* character. Update the pattern pointer and !length, since runs of *'s are the same as one. ! PATTERN_LENGTH = .PATTERN_LENGTH - ! Update the length CH$DIFF (.SUB_PAT_PTR, .PATTERN_POINTER); ! To account for PATTERN_POINTER = .SUB_PAT_PTR; ! amount we skipped ! ! Now find the next asterisk (if any) in the pattern. ! SUB_PAT_END_PTR = CH$FIND_CH ( ! Look for .PATTERN_LENGTH, .PATTERN_POINTER, %C'*'); ! next asterisk IF CH$FAIL (.SUB_PAT_END_PTR) ! If no more, THEN SUB_PAT_END_PTR = ! point past end of string CH$PLUS (.PATTERN_POINTER, .PATTERN_LENGTH); ! for end pointer SUB_PAT_LEN = ! Get length of CH$DIFF (.SUB_PAT_END_PTR, .SUB_PAT_PTR); ! Pattern substring ! ! We now have the pattern substring pointer and length. Search for it within !the source string. ! STRING_POINTER = CH$PLUS(.STRING_POINTER, -1); ! Back up over character STRING_LENGTH = .STRING_LENGTH + 1; ! that corresponds to "*" SUB_PAT_PTR_INI = .SUB_PAT_PTR; ! Save initial pointer SUB_PAT_LEN_INI = .SUB_PAT_LEN; ! and length WHILE .SUB_PAT_LEN GTR 0 ! As long as we have something DO BEGIN IF .SUB_PAT_LEN GTR .STRING_LENGTH ! If we have more pattern THEN RETURN FALSE; ! than string, can't match PAT_CHAR = CH$RCHAR_A (SUB_PAT_PTR); ! Get pattern character SUB_PAT_LEN = .SUB_PAT_LEN - 1; ! Count it STR_CHAR = CH$RCHAR_A (STRING_POINTER); ! Get string character STRING_LENGTH = .STRING_LENGTH - 1; ! Count it also IF NOT (.PAT_CHAR EQL .STR_CHAR OR ! If character doesn't .PAT_CHAR EQL %C'%') ! match at all THEN BEGIN STRING_POINTER = ! Readjust string pointer CH$PLUS (.STRING_POINTER, ! Back to where sub-pattern .SUB_PAT_LEN - .SUB_PAT_LEN_INI + 1); ! Started STRING_LENGTH = .STRING_LENGTH + ! Fix length also (.SUB_PAT_LEN - .SUB_PAT_LEN_INI + 1); ! to be correct SUB_PAT_LEN = .SUB_PAT_LEN_INI; ! Then start pattern over SUB_PAT_PTR = .SUB_PAT_PTR_INI; ! from where we started END END; ! WHILE .SUB_PAT_LEN GTR 0 ! ! When the WHILE loop completes, we have matched a portion of the source !string with the pattern between the asterisks. Now advance to the next !piece. ! PATTERN_POINTER = .SUB_PAT_PTR; ! Save new pointer PATTERN_LENGTH = .PATTERN_LENGTH - .SUB_PAT_LEN_INI; ! Fix length END; ! IF .PAT_CHAR EQL -%C'*' END ! WHILE TRUE END; %SBTTL 'INIT_NOQUOTE_SSNAME - Initialize saveset name stored without quotes' ROUTINE INIT_NOQUOTE_SSNAME ! Initialize saveset name stored without quotes. = ![IU-17]++ Entire routine added for edit IU-17. !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called once, after the command is parsed and before ! DUMPER_PROCESS_COMMAND is called. It initializes NOQUOTE_SSNAME_DESC ! as a null string pointer. If a /SSNAME qualifier was given, and the ! saveset name was specified with quotes, it sets NOQUOTE_SSNAME_DESC ! as a string descriptor to the part of the saveset name not containing ! the quotes. This descriptor is used by MATCH_SSNAME when trying to ! match saveset names. Otherwise there would be no way to specify saveset ! names that are not quoted but contain embedded spaces (saveset names ! like this are quite easily specified to TOPS-20 DUMPER for example, ! but cannot be specified using DUMPER-32's SSNAME qualifier - it always ! store the quotes). ! ! FORMAL PARAMETERS: ! ! None ! ! IMPLICIT INPUTS: ! ! GQ_QUAL_VALUE_CNTS, QUAL_SSNAME_DESC ! ! IMPLICIT OUTPUTS: ! ! Initializes NOQUOTE_SSNAME_DESC in OWN storage. ! ! COMPLETION_CODES: ! ! True. ! ! SIDE EFFECTS: ! ! None !-- BEGIN LOCAL STRING_LEN, STRING_PTR; ! First assume we won't even use this... NOQUOTE_SSNAME_DESC [DSC$W_LENGTH] = 0; NOQUOTE_SSNAME_DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; NOQUOTE_SSNAME_DESC [DSC$B_CLASS] = DSC$K_CLASS_D; NOQUOTE_SSNAME_DESC [DSC$A_POINTER] = 0; ! We won't if /SSNAME wasn't specified. IF .GQ_QUAL_VALUE_CNTS [GQ$K_SSNAME_QUAL_INDEX] LSS 0 THEN RETURN TRUE; ! We won't if a null name or name of length 1 was given. IF .QUAL_SSNAME_DESC [DSC$W_LENGTH] LSS 2 THEN RETURN TRUE; ! Otherwise, we only setup the descriptor if the saveset name given ! both begins and ends with quote marks. STRING_LEN = .QUAL_SSNAME_DESC [DSC$W_LENGTH]; STRING_PTR = .QUAL_SSNAME_DESC [DSC$A_POINTER]; IF (CH$RCHAR(CH$PTR(.STRING_PTR,0)) EQL %C'"') AND (CH$RCHAR(CH$PTR(.STRING_PTR,.STRING_LEN-1)) EQL %C'"') THEN BEGIN NOQUOTE_SSNAME_DESC [DSC$W_LENGTH] = .STRING_LEN - 2; NOQUOTE_SSNAME_DESC [DSC$A_POINTER] = .STRING_PTR + 1; END; RETURN TRUE; END; ![IU-17]-- %SBTTL 'MATCH_SSNAME - Compare saveset names' GLOBAL ROUTINE MATCH_SSNAME ( ! Compare saveset names. SSNAME_DESC : REF $BBLOCK [] ! Save set name to check. ) = ![IU-17]++ Entire routine added for edit IU-17. !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine compares the saveset name passed (gotten from the tape ! being read) to the saveset name that the user specified with the ! /SSNAME qualifier. It actually performs two comparisions, first ! with the user's actual /SSNAME value, then, if that comparison ! indicates no match, and the /SSNAME value was a string surrounded ! by quotes, with the /SSNAME value without the quotes. This is ! done because it is possible to specify an unquoted saveset name ! containing embedded spaces to TOPS-20 DUMPER, but not to DUMPER-32, ! since quotes must be used with the /SSNAME qualifier if the name ! contains embedded blanks, and the parser always stores the quotes. ! This comparison routine gives the effect of treating quoted and ! unquoted saveset names as equal. All comparisons are case-blind. ! ! FORMAL PARAMETERS: ! ! SSNAME_DESC The descriptor for the saveset name from the tape block ! to be compared to the saveset name specified by the ! /SSNAME qualifier. ! ! IMPLICIT INPUTS: ! ! QUAL_SSNAME_DESC, the user-specified saveset name to look for. ! NOQUOTE_SSNAME_DESC, same as above but without including quotes. ! ! IMPLICIT OUTPUTS: ! ! None ! ! COMPLETION_CODES: ! ! True If the saveset name matched either QUAL_SSNAME_DESC ! or NOQUOTE_SSNAME_DESC. ! ! False For no error, but no match. ! ! Other Some VMS error condition code for library routine errors. ! This indicates an internal error in DUMPER-32. ! ! SIDE EFFECTS: ! ! None !-- BEGIN LOCAL STATUS; ! Status of comparison (0 = match, +/- 1 = no match). EXTERNAL ROUTINE STR$CASE_BLIND_COMPARE; ! String library comparison routine. IF .QUAL_SSNAME_DESC [DSC$A_POINTER] EQL 0 THEN RETURN TRUE; ! No /SSNAME matches anything. STATUS = STR$CASE_BLIND_COMPARE ( .SSNAME_DESC, ! Compare name they passed QUAL_SSNAME_DESC); ! with /SSNAME value. IF .STATUS EQL 0 ! Zero indicates equal. THEN RETURN TRUE; IF ABS(.STATUS) NEQ 1 ! +/- 1 means not-equal. THEN RETURN .STATUS; ! Otherwise STR$ detected error. IF .NOQUOTE_SSNAME_DESC [DSC$A_POINTER] EQL 0 THEN RETURN FALSE; ! If no alternate say no match. STATUS = STR$CASE_BLIND_COMPARE ( .SSNAME_DESC, ! Compare name they passed NOQUOTE_SSNAME_DESC); ! with /SSNAME value, no quotes. IF .STATUS EQL 0 ! Zero indicates equal. THEN RETURN TRUE; IF ABS(.STATUS) NEQ 1 ! +/- 1 means not-equal. THEN RETURN .STATUS; ! Otherwise STR$ detected error. RETURN FALSE; ! If still here, we didn't match. END; ![IU-17]-- %SBTTL 'End of DUMPER.BLI' END ! End of module ELUDOM