1 %title '10BACKUP Program To Read DECsystem-10 Backup Tapes' %ident '10BACKUP v2.4' ! ! ! ! Well our DECsystem-10 is being shipped out the door. It is going ! to be hard to produce further test tapes for this program. It also ! looks as though I might not continue working with VAXes as a ! DG MV20000 is being wheeled in. Maybe my next project will be a ! program to read VMS Backup tapes under AOS? ! Paul Nankervis ! 27th February, 1986. ! ! ! ! 10BACKUP was written at LaTrobe University when it was realised ! that after our aging KI10 processor was decommissioned, there ! would still be a large number of user tapes around that had been ! written by the DECsystem-10 BACKUP utility. 10BACKUP solves this ! problem by allowing these tape to be read directly onto the VAX, ! even after the DECsystem-10 is gone. ! ! This version of 10BACKUP was set up and tested under VMS V4.2 using ! a TE16 attached to a VAX 11/780 processor. All test tapes were ! produced using BACKUP under TOPS-10 6.03A using a TU40 attached ! to a KI10 processor. ! ! ! ! ! DEC-10 backup tapes contain fixed length 2720 byte records ! written in DEC-10 core dump format. This program is an attempt ! at understanding the format of these records. ! ! This program uses interchange mode (ignores Disk and UFD info) ! to read DEC-10 backup tapes. (and maybe TOPS-20 Dumper tapes.) ! If you have any suggestions or would like any program changes ! then please drop me a line to let me know. I would appreciate ! any feedback so send SPR's to:- ! Paul Nankervis ! Computer Centre ! La Trobe University ! BUNDOORA, 3083 ! AUSTRALIA ! Phone: Australia (03) 478 3122 Ext 2515 ! ! This program can read its tape input from an RMS file or ! from a foreign mounted tape. If the input is found to be from ! a foreign mounted tape then QIO's are used otherwise RMS is ! called to do the input. The module BIO handles all the tape ! input. For performance BIO multi-buffers its input when using ! QIO's. ! ! Normally the program would directly access the tape using QIO's:- ! ! $ MOUNT/FOREIGN MSA0: 68SURVEY MYTAPE ! $ RUN 10BACKUP ! /TAPE MYTAPE: ! /DIRECTORY ALPHA.*,*YZ.FOR ! ..... ! /REWIND ! /SSNAME "My Save Set" ! /INTERCHANGE OFF ! /EXCLUDE DEVE:[10,*] ! /DIR *.DAT,*.FOR ! ..... ! /REWIND ! /OUTPUT_DEFAULT DUA0:[CCPN] ! /LIST_OUTPUT LPA0: ! /SHOW ! /RESTORE DSKB:[10,75]AB*YZ.FOR ! /EXIT ! $ DISMOUNT MYTAPE: ! $ ! ! ! The program can read its input from an RMS file if need be. This ! is normally only useful for debugging the program:- ! ! $ MOUNT/FOREIGN MTA0:/BLOCK=2720/RECORD=2720 ! $ COPY MTA0: 10TAPE.DAT ! $ RUN 10BACKUP ! /TAPE 10TAPE.DAT ! /DIR ! ..... ! /REWIND ! /RESTORE *MN*.FOR ! /EXIT ! $ ! ! ! When the program reaches the end of input during the processing ! of a save set it assumes that another tape volume must follow. ! In this case it will prompt the user for the name of the next ! tape device if running as an interactive job or reading from an ! RMS file. If reading from a tape in a batch job a message will ! be sent via OPCOM asking the operators to load the next volume. ! ! 10BACKUP prompts for its commands using a '/'. The commands may ! be in lower case and may be abbreviated. They must be seperated ! from any parameters by at least one space or tab character. ! Parameters may be enclosed in double quotes (") in order to preserve ! any special spacing or lowercase characters. ! ! Normally when running 10BACKUP the TAPE command is used as the first ! command to set up access to the tape. After that option setting ! commands such as SSNAME, SIXBIT, OUTPUT_DEFAULT would be used to set ! up any special options. Then RESTORE or DIRECTORY commands may be ! used to actually access the tape. ! ! The commands implemented are:- ! ! CHECKSUM OFF | ON ! DIRECTORY [file-names] ! EXCESS_ERRORS error-count ! EXCLUDE_FILES [file-names] ! EXIT ! HELP [topic...] ! INTERCHANGE OFF | ON ! LIST_OUTPUT file-name ! OUTPUT_DEFAULT [output-default-file-spec] ! RESTORE [file-names] ! REWIND ! SHOW ! SIXBIT record-size ! SKIP file-count ! SSNAME [save-set-name] ! TAPE device-name ! ! ! When running in SIXBIT mode 10BACKUP will produce fixed length ! output records containing the ASCII equivalent of assumed SIXBIT ! input. Each DEC-10 word is broken up into six sixbit characters ! which are converted to ASCII by adding decimal 32. In this way ! every bit of the DEC-10 words can be captured in a VAX file. Naturally ! any binary information in the file which was not SIXBIT would have ! to be converted to the desired format by a user program. ! ! ! ! The source modules that make up the 10BACKUP program are:- ! ! 10BACKUP.BAS the main line program. ! BIO.MAR contains tape and file IO routines. ! BUR.MAR is a set of macro utility routines. ! C36.MAR contains 36 bit conversion routines. ! BMS.MSG contains the error message definitions. ! 10BACKUP.RNH Runoff input to build the help library. ! ! The program can be compiled and linked in the following manner:- ! ! $ BASIC 10BACKUP ! $ MACRO BIO ! $ MACRO BUR ! $ MACRO C36 ! $ MESSAGE BMS ! $ LINK/NOTRACE 10BACKUP,BIO,BUR,C36,BMS ! $ RUNOFF 10BACKUP.RNH ! $ LIBRARY/CREATE/HELP 10BACKUP 10BACKUP ! ! ! ! ! There are a couple of extensions that can be made to this program. ! Some favourites include: ! a) Use VAX CLI command interface. ! b) Handle DATE-75 dates. ! c) Handle device formats other than TM10 (see module C36). ! d) Write of backup tapes? ! e) Better file wildcarding. ! f) Check command parameters better. ! ! ! ! ! ! ! ! ! %page !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ! ! This is 10BACKUP's mainline to get commands and decide what ! to do with them. ! ! The magic variable in the program is tape_status. It defines ! what state the tape is in according to the following table:- ! ! tape_status condition ! ! -1 the tape device is not open for access ! 0 tape is normal and ready for reads ! 1 reserved ! 2 retryable error detected (internal to process_tape) ! 3 fatal error occured in last tape access ! 4 have reached the end of the tape ! ! option type = explicit !This helps debugging. ! ! ! First declare a couple of important constants:- ! declare string constant & program_version = "10BACKUP v2.4", & help_library = "SYSPUB:10BACKUP.HLB", & command_prompt = "/" ! ! ! Declare error status codes:- ! external long constant & rms$_eof, bms_unrecmd, bms_notape, & bms_sixbitsize, bms_endorerr, bms_helperr, & bms_paronoff, bms_extrapar, bms_listerr, & bms_paramerr, bms_ambigcom ! ! ! Declare external functions:- ! external long function & lib$get_input, ots$cvt_ti_l, process_tape, & bur_get_help, bio_tape_init, bio_tape_rewind,& bio_tape_skip, bio_tape_close ! ! Declare local variables:- ! declare & long tape_status, & string ssname, & string exclude_files, & string output_default, & long sixbit_size, & long checksum_flag, & long interchange_flag, & long excess_errors, & long list_file, & string list_output, & long finished, & long status_code, & long skip_count, & long cmd_verb_size, & string cmd_input, & string cmd_parameters ! ! ! ! Now for some code, ! ! First initialise everything:- ! print program_version ! Who are we? print tape_status = -1% ! No tape device (yet). ssname = '' ! No particular save set (ie all save sets). exclude_files = '' ! No files to be excluded. output_default = '' ! No special output defaults. sixbit_size = 0% ! Use ascii restore mode (not sixbit). checksum_flag = -1% ! Checksums on by default. interchange_flag = -1% ! Start in interchange mode. excess_errors = 5% ! Maximum of 5 consecutive tape errors by default. list_file = 0% ! Directory listing unit. list_output = '' ! It's filename. nomargin #list_file ! Rotten BASIC and it's margins. ! ! ! Now loop around executing commands:- ! finished = 0% ! until finished status_code = lib$get_input( cmd_input, command_prompt ) if status_code and 1% then ! Seperate command from parameters. cmd_input = edit$(cmd_input,445%) cmd_verb_size = instr(1%,cmd_input,' ') if cmd_verb_size then !extract parameters cmd_parameters = right(cmd_input,cmd_verb_size+1%) if left(cmd_parameters,1%) = '"' then cmd_parameters = right(cmd_parameters,2%) if right(cmd_parameters,len(cmd_parameters)) = '"' then cmd_parameters = left(cmd_parameters,len(cmd_parameters)-1%) end if end if cmd_verb_size = cmd_verb_size - 1% else cmd_parameters = '' cmd_verb_size = len(cmd_input) end if ! Check to see what command we got. select left(cmd_input,cmd_verb_size) case '' ! Ignore nothing. case left('CHECKSUM',cmd_verb_size) select cmd_parameters case 'ON' checksum_flag = -1% case 'OFF' checksum_flag = 0% case else call bur_wrtmsg( bms_paramerr, cmd_parameters, "CHECKSUM" ) call bur_wrtmsg( bms_paronoff ) end select case left('DIRECTORY',cmd_verb_size) if tape_status = 0% then call bur_chkerr( process_tape( tape_status, 0%, & ssname, edit$(cmd_parameters,39%), exclude_files, & output_default, sixbit_size, checksum_flag, & interchange_flag, excess_errors, list_file ) ) else if tape_status < 0% then call bur_wrtmsg( bms_notape ) else call bur_wrtmsg( bms_endorerr ) end if end if case left('EXCESS_ERRORS',cmd_verb_size) if cmd_verb_size > 3% then if cmd_parameters = '' then excess_errors = 5% else status_code = ots$cvt_ti_l( cmd_parameters, excess_errors ) if (status_code and 1%) = 0% then call bur_wrtmsg( bms_paramerr, cmd_parameters, "EXCESS_ERRORS" ) call bur_wrtmsg( status_code ) end if end if else call bur_wrtmsg( bms_ambigcom, left(cmd_input,cmd_verb_size) ) end if case left('EXCLUDE_FILES',cmd_verb_size) exclude_files = edit$(cmd_parameters,39%) case left('EXIT',cmd_verb_size) if cmd_parameters = '' then finished = -1% else call bur_wrtmsg( bms_extrapar, cmd_parameters ) end if case left('HELP',cmd_verb_size) status_code = bur_get_help( cmd_parameters, help_library, -1% ) if (status_code and 1%) = 0% then call bur_wrtmsg( bms_helperr, help_library ) call bur_wrtmsg( status_code ) end if case left('INTERCHANGE',cmd_verb_size) select cmd_parameters case 'ON' interchange_flag = -1% case 'OFF' interchange_flag = 0% case else call bur_wrtmsg( bms_paramerr, cmd_parameters, "INTERCHANGE" ) call bur_wrtmsg( bms_paronoff ) end select case left('LIST_OUTPUT',cmd_verb_size) if list_file <> 0% then close #list_file list_file = 0% end if list_output = cmd_parameters if list_output <> '' then list_file = 1% on error goto 900 open list_output for output as file #list_file, & recordsize 160% on error goto 0 end if nomargin #list_file case left('OUTPUT_DEFAULT',cmd_verb_size) output_default = edit$(cmd_parameters,39%) case left('RESTORE',cmd_verb_size) if cmd_verb_size > 2% then if tape_status = 0% then call bur_chkerr( process_tape( tape_status, -1%, & ssname, edit$(cmd_parameters,39%), exclude_files, & output_default, sixbit_size, checksum_flag, & interchange_flag, excess_errors, list_file ) ) else if tape_status < 0% then call bur_wrtmsg( bms_notape ) else call bur_wrtmsg( bms_endorerr ) end if end if else call bur_wrtmsg( bms_ambigcom, left(cmd_input,cmd_verb_size) ) end if case left('REWIND',cmd_verb_size) if cmd_parameters = '' then if tape_status >= 0% then call bur_chkerr( bio_tape_rewind ) tape_status = 0% else call bur_wrtmsg( bms_notape ) end if else call bur_wrtmsg( bms_extrapar, cmd_parameters ) end if case left('SHOW',cmd_verb_size) if cmd_verb_size > 1% then if cmd_parameters = '' then print print ' Tape Status: '; select tape_status case -1% print 'No tape specified' case 0% print 'Ready for processing' case 3% print 'Processing aborted' case 4% print 'At end of tape' case else print 'Unknown' end select print ' SSNAME: '; ssname print ' Exclude_Files: '; exclude_files print 'Output_Default: '; output_default print ' Sixbit_Size:'; sixbit_size print ' Checksum: '; if checksum_flag then print 'ON' else print 'OFF' end if print ' Interchange: '; if interchange_flag then print 'ON' else print 'OFF' end if print ' Excess_Errors:'; excess_errors print ' List_Output: '; list_output print else call bur_wrtmsg( bms_extrapar, cmd_parameters ) end if else call bur_wrtmsg( bms_ambigcom, left(cmd_input,cmd_verb_size) ) end if case left('SIXBIT',cmd_verb_size) status_code = ots$cvt_ti_l( cmd_parameters, sixbit_size ) if status_code and 1% then if sixbit_size < 0% or sixbit_size > 32763% then call bur_wrtmsg( bms_sixbitsize ) sixbit_size = 0% ! Use ASCII mode then. end if else call bur_wrtmsg( bms_paramerr, cmd_parameters, "SIXBIT" ) call bur_wrtmsg( status_code ) end if case left('SKIP',cmd_verb_size) if tape_status = 0% then status_code = ots$cvt_ti_l( cmd_parameters, skip_count ) if status_code and 1% then status_code = bio_tape_skip( skip_count ) if status_code and 1% then tape_status = 0% else if status_code = rms$_eof then tape_status = 4% else tape_status = 3% call bur_wrtmsg( status_code ) end if end if else call bur_wrtmsg( bms_paramerr, cmd_parameters, "SKIP" ) call bur_wrtmsg( status_code ) end if else if tape_status < 0% then call bur_wrtmsg( bms_notape ) else call bur_wrtmsg( bms_endorerr ) end if end if case left('SSNAME',cmd_verb_size) ssname = cmd_parameters case left('TAPE',cmd_verb_size) if tape_status >= 0% then call bur_chkerr( bio_tape_close ) end if status_code = bio_tape_init(cmd_parameters) if status_code and 1% then tape_status = 0% else tape_status = -1% call bur_wrtmsg( status_code ) end if case else ! What was that? call bur_wrtmsg( bms_unrecmd, cmd_input ) end select ! Command is processed. ! ! otherwise we got an error reading the command, is it EOF? ! else if status_code = rms$_eof then finished = -1% else ! Unexpected status call bur_chkerr( status_code ) end if end if 3 next ! ! We have finished, close the tape if it is still open. ! if tape_status >= 0% then call bur_chkerr( bio_tape_close ) tape_status = -1% end if ! ! Exit with the worst program status code encountered. ! call bur_exit 900 ! ! ! Trap to here if basic error opening listing file. ! call bur_wrtmsg( bms_listerr, list_output ) list_file = 0% list_output = '' resume 3 ! end ! End of mainline. 3000 function long process_tape( long tape_status, long restore_flag, & string ssname, string select_files, string exclude_files, & string output_default, long sixbit_size, long checksum_flag, & long interchange_flag, long excess_errors, long list_file ) ! ! ! This module does the actual tape processing. It searches the tape ! for the correct save-set and prints directory information for and ! optionally restores selected files. It is the workhorse of 10BACKUP. ! option type = explicit ! Our little debugging aid. ! ! ! Declare status codes. ! external long constant & rms$_eof, ss$_normal, ss$_parity, & ss$_dataoverun, & bms_nossend, bms_nosstart, bms_ssnotfnd, & bms_endnoss, bms_endssfile, bms_fileinfile, & bms_midfile, bms_eofnofile, bms_noname, & bms_seqerr, bms_gotrptblk, bms_norptblk, & bms_ignrptblk, bms_excesserrors,bms_chksumerr, & bms_baddatasize,bms_badblocktype,bms_badrecsize,& bms_filerdwerr, bms_noopen, bms_nofilesel ! ! Declare some external routines. ! external long function & lib$get_input, sys$fao, file_match, & bur_flag_set, bio_tape_init, bio_tape_rewind,& bio_tape_read, bio_tape_close, bio_tape_skip, & bio_next_volume,bio_file_init external string function & bur_get_ascii, bur_get_sixbit ! ! ! Now set up the parameters describing a BACKUP block, ! these were gleaned from our documentation on BACKUP ! (which was written in 1976 for TOPS-10 6.03A). ! ! Set valid codes for record types (for g$type):- ! declare integer constant & t$lbl = 1%, & t$beg = 2%, & t$end = 3%, & t$fil = 4%, & t$ufd = 5%, & t$eov = 6%, & t$com = 7%, & t$con = 8%, & t$max = 8% ! ! ! ! Set up g$flag bit definitions:- ! declare integer constant & gf$eof = 0%, & gf$rpt = 1%, & gf$nch = 2%, & gf$sof = 3% ! ! ! ! Set up overhead block types:- ! declare integer constant & o$name = 1%, & o$file = 2%, & o$dirt = 3%, & o$sysn = 4%, & o$ssnm = 5% ! ! ! Define tape block data locations:- ! (Each 36 bit word is stored in a quadword) ! ! WRDSIZ describes how many of our BASIC integers it ! takes to map out a quadword. ! declare integer constant wrdsiz = 2% ! declare integer constant & g$type = 0%, & g$seq = g$type + wrdsiz, & g$rtnm = g$seq + wrdsiz, & g$flag = g$rtnm + wrdsiz, & g$chk = g$flag + wrdsiz, & g$siz = g$chk + wrdsiz, & g$lnd = g$siz + wrdsiz, & g$future= g$lnd + wrdsiz, & g$cust = g$future + 4% * wrdsiz, & g$vary = g$cust + wrdsiz, & g$data = g$vary + 20% * wrdsiz ! ! ! ! Set up t$lbl varying word definitions:- ! declare integer constant & l$date = g$vary, & l$fmt = l$date + wrdsiz, & l$bver = l$fmt + wrdsiz, & l$mon = l$bver + wrdsiz, & l$sver = l$mon + wrdsiz, & l$apr = l$sver + wrdsiz, & l$dev = l$apr + wrdsiz, & l$mtch = l$dev + wrdsiz, & l$rlnm = l$mtch + wrdsiz, & l$dstr = l$rlnm + wrdsiz ! ! ! ! Set up t$beg, t$con, and t$end varying word definitions:- ! declare integer constant & s$date = g$vary, & s$fmt = s$date + wrdsiz, & s$bver = s$fmt + wrdsiz, & s$mon = s$bver + wrdsiz, & s$sver = s$mon + wrdsiz, & s$apr = s$sver + wrdsiz, & s$dev = s$apr + wrdsiz, & s$mtch = s$dev + wrdsiz ! ! ! ! Set up t$fil varying word definitions:- ! declare integer constant & f$pchk = g$vary, & f$rdw = f$pchk + wrdsiz, & f$pth = f$rdw + wrdsiz ! ! ! ! Set up o$file block offsets:- ! declare integer constant & a$fhln = wrdsiz, & a$flgs = a$fhln + wrdsiz, & a$writ = a$flgs + wrdsiz, & a$alls = a$writ + wrdsiz, & a$mode = a$alls + wrdsiz, & a$leng = a$mode + wrdsiz, & a$bsiz = a$leng + wrdsiz, & a$vers = a$bsiz + wrdsiz ! ! ! Declare local functions:- ! declare long function & sb_search, print_sys declare string function sb_text declare & long sb_type, & long sb_length ! ! ! Declare local variables:- ! declare & long sel_ss, & long in_ss, & long in_file, & long write_file, & long done, & long ss_count, & long file_count, & long status_code, & long rms_status, & long b_wrd(1087), & long select_flag, & string ss_name, & string file_name, & string file_type, & long file_size, & long file_rdw, & long file_alq, & long file_date(1), & long write_date(1), & long attr_sb, & long name_sb, & long name_sblen, & long sfd_level, & string last_ufd, & string file_disk, & string file_ufd, & string file_sfd, & long retries, & long block_seq, & long block_length, & long block_address, & long block_chk(1), & long block_chksum(1), & long print_length, & string operator_reply ! ! Map out fixed length print buffer. ! map (print_buffer) & string print_buffer = 132 ! ! ! ! First thing to do is to initialize the local variables. ! in_ss = 0% !Not yet inside a save set. ss_count = 0% !No save sets selected so far. file_count = 0% !No files selected so far. ! if restore_flag then print #list_file, 'Restore of '; else print #list_file, 'Directory of '; end if if select_files <> '' then print #list_file, "files '"; select_files; "' from "; end if if ssname <> '' then print #list_file, "save set '"; ssname; "'"; else print #list_file, "all save sets"; end if if exclude_files <> '' then print #list_file, " excluding files '"; exclude_files; "'"; end if print #list_file print #list_file ! done = 0% ! until done !Loop until done. ! ! Read a tape block then decide what to do with it. ! gosub read_tape ! ! First check to see if we got a block OK: ! if tape_status then if in_ss and ( tape_status = 4% ) then gosub next_volume else done = -1% ! error or end of tape. end if ! ! OK, we got a block, decide what to do with it: ! else if block_length > 0% then select b_wrd(g$type) case t$fil if in_ss = 0% then call bur_wrtmsg( bms_nosstart ) block_seq = b_wrd(g$seq) ss_name = '' gosub start_ss end if if sel_ss then gosub check_seq gosub t$fil_block end if case t$beg if in_ss then call bur_wrtmsg( bms_nossend ) gosub end_ss end if if done = 0% then !Check haven't finished. ss_name = sb_text( o$ssnm, g$data, b_wrd(g$lnd) ) gosub start_ss end if case t$con if in_ss then gosub check_seq gosub ss_block else ss_name = sb_text( o$ssnm, g$data, b_wrd(g$lnd) ) gosub start_ss end if case t$end if in_ss then if sel_ss then gosub check_seq gosub end_ss gosub ss_block end if in_ss = 0% else call bur_wrtmsg( bms_endnoss ) end if case t$lbl if in_ss or ssname = '' then if in_ss and sel_ss then gosub check_seq end if gosub t$lbl_block end if case else if in_ss and sel_ss then gosub check_seq end if end select else if in_ss or ssname = '' then print #list_file print #list_file, '*** Tape Mark ***' print #list_file end if end if end if ! next ! ! if in_ss then call bur_wrtmsg( bms_nossend ) gosub end_ss end if ! if tape_status <> 3% then if ss_count = 0% and ssname <> '' then call bur_wrtmsg( bms_ssnotfnd, ssname ) else if file_count = 0% and select_files <> '' then call bur_wrtmsg( bms_nofilesel, select_files ) else print #list_file, "Total of"; file_count; "file"; if file_count <> 1% then print #list_file, "s"; end if print #list_file, " in"; ss_count; "save set"; if ss_count <> 1% then print #list_file, "s"; end if print #list_file end if end if end if ! ! Well that was easy, we are finished. ! process_tape = ss$_normal exit function start_ss: ! ! ! Handle block containing the start of save set. ! Decide whether we want the save set etc: ! in_ss = -1% if ssname = '' or ssname = ss_name then gosub ss_block block_seq = b_wrd(g$seq) sel_ss = -1% ss_count = ss_count + 1% last_ufd = '' !No UFD so far. else in_ss = 0% sel_ss = 0% status_code = bio_tape_skip( 1% ) if (status_code and 1%) = 0% then done = 0% if status_code = rms$_eof then tape_status = 4% else tape_status = 3% call bur_wrtmsg( status_code ) end if end if end if ! return end_ss: ! ! ! End of save set detected. ! Finish with the save set, check we are not ! still processing a file etc: ! if in_file then call bur_wrtmsg( bms_endssfile ) gosub end_file end if in_ss = 0% if ssname <> '' then done = -1% !Finish if specific save set processed. end if ! return t$fil_block: ! ! ! ! Handle a t$fil block. If block contains start of file then set up ! the file. Next check for any file data and finally check for end of ! file. A file can start, contain data, and end all in the same tape ! block. The bits in g$flag describe whats going on: ! ! ! ! ! Check for start of file. if bur_flag_set( b_wrd(g$flag), gf$sof by value ) then if in_file then ! New file - check if expected. call bur_wrtmsg( bms_fileinfile ) gosub end_file end if gosub start_file ! Go find file name - attributes etc. end if ! ! ! if b_wrd(g$siz) > 0% then ! If data in block use it. if in_file = 0% then call bur_wrtmsg( bms_midfile ) gosub start_file end if if b_wrd(f$rdw) <> file_rdw then call bur_wrtmsg( bms_filerdwerr ) end if file_rdw = b_wrd(f$rdw) + b_wrd(g$siz) if write_file then ! Write data to file. if sixbit_size > 0% then call bur_write_sixbit( b_wrd(g$siz), & b_wrd(g$data+b_wrd(g$lnd)*wrdsiz), sixbit_size ) else call bur_write_ascii( b_wrd(g$siz), & b_wrd(g$data+b_wrd(g$lnd)*wrdsiz) ) end if end if end if ! ! ! ! Check for end of file. if bur_flag_set( b_wrd(g$flag), gf$eof by value ) then if in_file then ! File end - check we have a file. gosub end_file else call bur_wrtmsg( bms_eofnofile ) end if ! File end but no file? end if ! ! return start_file: ! ! ! ! Have got a t$fil record containing start of file:- ! Extract file name and attributes from block and ! see if file is to be selected. ! ! name_sb = sb_search( o$name, g$data, b_wrd(g$lnd) ) if name_sb >= 0% then ! Find name block and get name. name_sblen = sb_length - 1% file_name = sb_text( 2%, name_sb+wrdsiz, name_sblen ) file_type = sb_text( 3%, name_sb+wrdsiz, name_sblen ) if interchange_flag = 0% then gosub get_ufd ! Get UFD info if needed. end if else file_disk = '' file_ufd = '' file_name = '' ! Oops, no name block? file_type = '' call bur_wrtmsg( bms_noname ) end if ! ! ! Now see if the file is to be selected:- ! in_file = -1% file_rdw = 0% write_file = 0% ! Assume not restoring file. ! select_flag = -1% if select_files <> '' then if file_match( file_name, file_type, select_files, & interchange_flag, file_disk, file_ufd ) = 0% then select_flag = 0% end if end if if select_flag then if exclude_files <> '' then if file_match( file_name, file_type, exclude_files, & interchange_flag, file_disk, file_ufd ) then select_flag = 0% end if end if end if ! if select_flag then gosub select_file end if ! ! return get_ufd: ! ! ! ! Get Disk and UFD information for a file. ! file_disk = sb_text( 1%, name_sb+wrdsiz, name_sblen ) + ':' if file_disk <> ':' then file_ufd = '[' + sb_text( 32%, name_sb+wrdsiz, name_sblen ) sfd_level = pos( file_ufd, '_', 1% ) if sfd_level then file_ufd = left( file_ufd, sfd_level-1% ) + ',' + & right( file_ufd, sfd_level+1% ) end if sfd_level = 33% while sfd_level file_sfd = sb_text( sfd_level, name_sb+wrdsiz, name_sblen ) if file_sfd <> '' then file_ufd = file_ufd + ',' + file_sfd sfd_level = sfd_level + 1% else sfd_level = 0% end if next file_ufd = file_ufd + ']' else file_disk = '' file_ufd = '' end if ! ! return end_file: ! ! ! Finish with the current file. ! if write_file then call bio_file_close ! Tidy up and close current file. end if in_file = 0% ! return select_file: ! ! ! Get file attributes and print directory information. ! Open output file etc. ! ! ! if interchange_flag = 0% then if file_disk+file_ufd <> last_ufd then last_ufd = file_disk + file_ufd print #list_file, space$(46%); last_ufd end if end if ! attr_sb = sb_search( o$file, g$data, b_wrd(g$lnd) ) if attr_sb >= 0% then ! Find attribute block and get atributes. file_size = b_wrd(attr_sb+a$leng) if b_wrd(attr_sb+a$mode) > 1% then ! .IOASL file_size = file_size * 5% end if call bur_get_date( file_date(0%), b_wrd(attr_sb+a$writ) ) call bur_chkerr( sys$fao( '!10AS.!4AS !10UL !17%D', & print_length, print_buffer, file_name, file_type, & (file_size+639%)/640% by value, file_date(0%) ) ) else file_size = 0% file_date(0%) = 0% file_date(1%) = 0% call bur_chkerr( sys$fao( '!10AS.!4AS *** no attribute information ***', & print_length, print_buffer, file_name, file_type ) ) end if print #list_file, left$(print_buffer,print_length) ! Print directory information. ! file_count = file_count + 1% if restore_flag then gosub open_file end if ! ! return open_file: ! ! ! ! Open the output file ready for restoration. ! if sixbit_size > 0% then file_alq = ( (file_size+4%)/5%*6% + 511% ) / 512% else file_alq = ( file_size + 511% ) / 512% end if if file_alq < 0% then file_alq = 0% ! Check initial file size looks valid. end if ! status_code = bio_file_init( rms_status, file_name+'.'+file_type, & output_default, file_alq, file_date(0%) ) if status_code and 1% then write_file = -1% ! We are restoring this file. else call bur_wrtmsg( bms_noopen, file_name+'.'+file_type ) call bur_wrtmsg( status_code, rms_status ) end if ! ! return check_seq: ! ! ! ! Increment & check sequence number. If wrong sequence number ! in a save set record then something has gone wrong. ! block_seq = block_seq + 1% ! Increment sequence number. if b_wrd(g$seq) <> block_seq then call bur_wrtmsg( bms_seqerr ) block_seq = b_wrd(g$seq) end if ! return ss_block: ! ! ! ! Print info from a t$beg, t$con or t$end record. ! print #list_file, select b_wrd(g$type) case t$beg print #list_file, "Start of Save Set: "; case t$con print #list_file, "Continuation of Save Set: "; case t$end print #list_file, "End of Save Set: "; end select print #list_file, sb_text( o$ssnm, g$data, b_wrd(g$lnd) ) print #list_file, "Volume"; b_wrd(g$rtnm);"written by System: "; & sb_text( o$sysn, g$data, b_wrd(g$lnd) ) status_code = print_sys( s$date, s$dev, s$mtch ) print #list_file ! ! return t$lbl_block: ! ! ! ! Print info from a t$lbl record. ! print #list_file print #list_file, "Volume"; b_wrd(g$rtnm); " of tape: "; & bur_get_sixbit( 1%, b_wrd(l$rlnm) ) status_code = print_sys( l$date, l$dev, l$mtch ) print #list_file ! ! return read_tape: ! ! ! ! Read tape blocks until we get a goodun:- ! (or give up) ! This means if we get an error we should keep reading until ! we get a good block which must have its repeat block flag set. ! retries = 0% tape_status = 2% until tape_status <> 2% gosub read_a_block select tape_status case 0% if retries > 0% then if block_length > 0% and & bur_flag_set( b_wrd(g$flag), gf$rpt by value ) then call bur_wrtmsg( bms_gotrptblk ) else call bur_wrtmsg( bms_norptblk ) end if else if bur_flag_set( b_wrd(g$flag), gf$rpt by value ) then call bur_wrtmsg( bms_ignrptblk ) tape_status = 2% end if end if case 2% call bur_wrtmsg( status_code ) retries = retries + 1% if retries >= excess_errors and excess_errors > 0% then call bur_wrtmsg( bms_excesserrors ) tape_status = 3% end if case 3% call bur_wrtmsg( status_code ) end select next ! return read_a_block: ! ! ! ! Read a tape block. Check that it seems Ok, unpack it etc. ! Returned is tape_status containing one of:- ! -1 tape device is not open for access ! 0 normal, tape is open for reading ! 1 * reserved ! 2 * retryable error detected ! 3 fatal (or unknown) error detected ! 4 reached end of tape ! * not returned from this routine ! status_code = bio_tape_read( block_length, block_address ) ! if status_code and 1% then if block_length = 2720% then call c36_unpack( 544% by value, block_address by value, b_wrd(0%) ) call bio_tape_free_buff ! Allow tape buffer to be reused. if b_wrd(g$type) >= 0% and b_wrd(g$type) <= t$max then if b_wrd(g$lnd) >= 0% and b_wrd(g$siz) >= 0% and & b_wrd(g$lnd)+b_wrd(g$siz) <= 512% then if checksum_flag and ( bur_flag_set( b_wrd(g$flag), gf$nch by value ) = 0% ) then block_chk(0%) = b_wrd(g$chk) block_chk(1%) = b_wrd(g$chk+1%) b_wrd(g$chk), b_wrd(g$chk+1%) = 0% call c36_chksum( 544% by value, b_wrd(0%), block_chksum(0%) ) if block_chksum(0%) = block_chk(0%) and & block_chksum(1%) = block_chk(1%) then tape_status = 0% else status_code = bms_chksumerr tape_status = 2% end if ! Crummy check sum. else tape_status = 0% end if else status_code = bms_baddatasize tape_status = 2% end if ! g$lnd or g$siz is bad. else status_code = bms_badblocktype tape_status = 2% end if ! g$type is bad. else if block_length = 0% then tape_status = 0% else status_code = bms_badrecsize tape_status = 2% end if ! Tape block size is bad. end if else select status_code case rms$_eof tape_status = 4% case ss$_parity, ss$_dataoverun tape_status = 2% case else tape_status = 3% end select end if ! return next_volume: ! ! ! We have reached the end of the tape and are still inside ! a Save Set. The best thing to do is ask for another tape ! volume:- ! ! print #list_file print #list_file, "*** End of Tape ***" print #list_file print "Another tape volume is required to continue processing of Save Set" operator_reply = "" status_code = bio_next_volume( tape_status, operator_reply ) if operator_reply <> "" then print "Operator Reply: "; operator_reply end if if status_code and 1% then print "10BACKUP is continuing processing of Save Set on new tape volume" else if status_code <> rms$_eof then call bur_wrtmsg( status_code ) else if tape_status >= 0% then tape_status = 3% end if end if call bur_wrtmsg( bms_nossend ) gosub end_ss done = -1% end if ! ! return ! ! ! Function to print date written, system name, device name etc. ! ! def long print_sys( long o_date, long o_dev, long o_mtch ) ! call bur_get_date( write_date(0%), b_wrd(o_date) ) call bur_chkerr( sys$fao( 'Written on: !AS at: !17%D using: !AS BPI', & print_length, print_buffer, & bur_get_sixbit( 1%, b_wrd(o_dev) ), & write_date(0%), & mid(' 200 556 80016006250',(b_wrd(o_mtch) and 7%)*4%-3%,4%) ) ) print #list_file, left$(print_buffer,print_length) ! end def ! ! ! Function to get ascii text from a particular overhead block:- ! Locate the overhead block and pass its contents back as an ! ascii string. ! def string sb_text( long sb_find, long sb_position, long sb_words ) sb_position = sb_search( sb_find, sb_position, sb_words ) if sb_position > 0% then ! Get text from block. sb_text = bur_get_ascii( sb_length-1%, b_wrd(sb_position+wrdsiz) ) else sb_text = '' ! Could not find block. end if ! end def ! ! ! Function to locate a particular sub-block:- ! Sub-blocks contain overhead information written into ! the data area of the block. eg an o$name block. ! If the sub-block is found we return its location and implicitly ! return sb_length to say how big it is. If sub-the block is not ! found we return -1. ! def long sb_search( long sb_find, long sb_position, long sb_words ) while sb_words > 0% ! Loop until we give up. call c36_hfwd( b_wrd(sb_position), sb_type, sb_length ) if sb_type = sb_find then sb_search = sb_position ! Found the block, say where. sb_words = 0% else if sb_length > 0% then sb_words = sb_words - sb_length if sb_words > 0% then sb_position = sb_position + sb_length * wrdsiz else sb_search = -1% ! Sub-Block not found. end if else sb_search = -1% ! Sub-Block not found. sb_words = 0% end if end if next ! end def end function 5000 function long file_match( string file_name, string file_type, & string select_files, long interchange_flag, & string file_disk, string file_ufd ) ! ! ! This module checks to see if a particular file should be selected. ! If the file is to be selected 1 is returned, otherwise 0. ! Basically the file name and type are search for in the selected files ! list. Function PATTERN_MATCH is called to see if the file name or ! file type matches any of the names and types in the select_files ! list. ! option type = explicit ! ! ! Declare internal functions:- ! declare long function pattern_match declare & long data_pos, & long pattern_pos, & long star_pos ! ! ! Declare internal variables:- ! declare & long select_flag, & long filename_end, & long delim1_pos, & long delim2_pos, & long delim3_pos, & string disk_item, & string ufd_item, & string filename, & string item ! ! disk_item = '' !Init disk name - it is sticky accross the spec. ufd_item = '' !Init the UFD - also sticky. select_flag = 0% filename_end = 0% ! until filename_end > len(select_files) or select_flag ! ! First get the filename from the list. Note that UFD's contain ! commas which do not seperate list items. This part also extracts ! the UFD information seperate to the file name. ! delim1_pos = pos(select_files,',',filename_end+1%) if delim1_pos = 0% then delim1_pos = len(select_files) + 1% end if ! delim2_pos = pos(select_files,'[',filename_end+1%) if delim2_pos <> 0% and delim2_pos < delim1_pos then delim3_pos = pos(select_files,']',delim2_pos) if delim3_pos = 0% then delim1_pos = len(select_files) + 1% ufd_item = right(select_files,delim2_pos)+']' filename = seg$(select_files,filename_end+1%,delim2_pos-1%) else if delim3_pos > delim1_pos then delim1_pos = pos(select_files,',',delim3_pos) if delim1_pos = 0% then delim1_pos = len(select_files) + 1% end if end if ufd_item = seg$(select_files,delim2_pos,delim3_pos) filename = seg$(select_files,filename_end+1%,delim2_pos-1%) + & seg$(select_files,delim3_pos+1%,delim1_pos-1%) end if else filename = seg$(select_files,filename_end+1%,delim1_pos-1%) end if ! filename_end = delim1_pos select_flag = 1% ! ! Now check for a disk spec. ! delim1_pos = pos(filename,':',1%) if delim1_pos then disk_item = left(filename,delim1_pos) filename = right(filename,delim1_pos+1%) end if ! ! If interchange is off verify the file has the ! right disk and UFD. ! if interchange_flag = 0% then if disk_item <> '' then if pattern_match(file_disk,disk_item) = 0% then select_flag = 0% end if end if if select_flag then if ufd_item <> '' then if pattern_match(file_ufd,ufd_item) = 0% then select_flag = 0% end if end if end if end if ! ! Check if the file type (extension) is right. ! delim1_pos = pos(filename,'.',1%) if delim1_pos then item = right(filename,delim1_pos+1%) filename = left(filename,delim1_pos-1%) if pattern_match(file_type,item) = 0% then select_flag = 0% end if end if ! ! See if the file has the right name. ! if select_flag then if filename <> '' then if pattern_match(file_name,filename) = 0% then select_flag = 0% end if end if end if ! next ! Look at each filename in the list. ! ! file_match = select_flag exit function ! ! ! ! Function to handle wildcard pattern matches for file names. ! If the match_data matches the pattern then a 1 is returned ! otherwise a 0 is returned. This routine is given some data ! and a pattern to match. The pattern may contain any number ! of * characters for wildcarding. Examples are: ! ! Pattern Data Match ! ======= ==== ===== ! ! BILL FRED No ! * FRED Yes ! *ED FRED Yes ! BI*ED FRED No ! FR*ED FRED Yes ! *b*d*f bdf Yes ! *b*d*f abcdef Yes ! *b*d*f adcbef No ! ! ! def long pattern_match( string match_data, string pattern ) ! pattern_match = 0% star_pos = pos( pattern, '*', 1% ) if star_pos then if left( pattern, star_pos-1% ) = left( match_data, star_pos-1% ) then data_pos = star_pos pattern_pos = star_pos + 1% while star_pos star_pos = pos( pattern, '*', pattern_pos ) if star_pos then data_pos = pos( match_data, seg$( pattern, pattern_pos, star_pos-1% ), data_pos ) if data_pos then data_pos = data_pos + ( star_pos - pattern_pos - 1% ) pattern_pos = star_pos + 1% else star_pos = 0% end if else if len(match_data) - data_pos >= len(pattern) - pattern_pos then if right(match_data,len(match_data)-len(pattern)+pattern_pos) = right(pattern,pattern_pos) then pattern_match = 1% end if end if end if next end if else if pattern = match_data then pattern_match = 1% end if end if ! ! end def end function