Relay-Version: version nyu B notes v1.6 5/10/89; site acf4.NYU.EDU From: timcc@csv.viccol.edu.au (Tim Cook) Date: 28 Jun 89 19:59 EDT Date-Received: 29 Jun 89 11:30 EDT Subject: VMS TAR part 1 of 10 Message-ID: <522@csv.viccol.edu.au> Path: acf4!cmcl2!husc6!cs.utexas.edu!csd4.milw.wisc.edu!lll-winken!uunet!murtoa.cs.mu.oz.au!viccol!timcc Newsgroups: comp.os.vms Organization: Computer Services, Victoria College, Melbourne Lines: 435 $! ------------------ CUT HERE ----------------------- $! $! This archive created by VMS_SHARE Version 7.0-006 1-MAY-1989 $! On 28-JUN-1989 18:52:49.80 By timcc@viccol.edu.au (Tim Cook) $! $! This VMS_SHARE Written by: $! Andy Harper, Kings College London UK $! $! Acknowledgements to: $! James Gray - Original VMS_SHARE $! Michael Bednarek - Original Concept and implementation $! $!+ THIS PACKAGE DISTRIBUTED IN 10 PARTS, TO KEEP EACH PART $! BELOW 30 BLOCKS $! $! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER $! AND EXECUTE AS A COMMAND PROCEDURE ( @name ) $! $! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING: $! 1. AAAREADME.1ST;1 $! 2. BUILD_TAR.COM;1 $! 3. LIBFILATT.MAR;1 $! 4. LIBIFERR.MAR;1 $! 5. LIBITMLST.MAR;1 $! 6. LIBPARSE.MAR;1 $! 7. TAR.HLP;1 $! 8. TAR.MMS;1 $! 9. TAR.PAS;1 $! 10. TARMSG.MSG;1 $! 11. TAR_EXTRACT.PAS;1 $! 12. TAR_LIST.PAS;1 $! 13. TAR_WRITE.PAS;1 $! 14. VCDEFS.PAS;1 $! $f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID")) $e="write sys$error ""%UNPACK"", " $w="write sys$output ""%UNPACK"", " $ if f$trnlnm("SHARE_LOG") then $ w = "!" $ if f$getsyi("version") .ges. "4.4" then $ goto START $ e "-E-OLDVER, Must run at least VMS 4.4" $ exit 44 $UNPACK: SUBROUTINE ! P1=filename, P2=checksum $ if f$search(P1) .eqs. "" then $ goto file_absent $ e "-W-EXISTS, File ''P1' exists. Skipped." $ delete/nolog 'f'* $ exit $file_absent: $ if f$parse(P1) .nes. "" then $ goto dirok $ dn=f$parse(P1,,,"DIRECTORY") $ w "-I-CREDIR, Creating directory ''dn'." $ create/dir 'dn' $ if $status then $ goto dirok $ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped." $ delete/nolog 'f'* $ exit $dirok: $ w "-I-PROCESS, Processing file ''P1'." $ define/user sys$output nl: $ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1' PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET( SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name"); buff:=CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(buff)) ;LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION( BEGINNING_OF(buff));g:=0;LOOP EXITIF MARK(NONE)=END_OF(buff);x:= ERASE_CHARACTER(1);IF g = 0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x= "V" THEN APPEND_LINE;MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF; IF x="+" THEN g:=1;ERASE_LINE;ENDIF;ELSE IF x="-" THEN g:=0;ENDIF;ERASE_LINE; ENDIF;ENDLOOP;p:="`";POSITION(BEGINNING_OF(buff));LOOP r:=SEARCH(p,FORWARD); EXITIF r=0;POSITION(r);ERASE(r);COPY_TEXT(ASCII(INT(ERASE_CHARACTER(3)))); ENDLOOP;o:=GET_INFO(COMMAND_LINE,"output_file");WRITE_FILE(buff,o); ENDPROCEDURE;Unpacker;EXIT; $ delete/nolog 'f'* $ CHECKSUM 'P1' $ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT $ e "-E-CHKSMFAIL, Checksum of ''P1' failed." $ ENDSUBROUTINE $START: $ create/nolog 'f' XVMS TAR X XSubmitted by: Tim Cook, Computer Services, Victoria College, Melbourne X Australia. X XOperating System: VAX/VMS V5.0 or higher XSource Language: Pascal, MACRO-32 XMemory Required: Not a lot. XKeywords: TAR, tape, archive, UNIX X XAbstract: X VMS TAR is a utility that emulates the UNIX tar, or Tape ARchive X utility, which is used to store a set of files in a single file, usually X on an offline medium, such as 9-track tape. X X VMS TAR automatically performs conversion of files to and from the UNIX X file format, and converts between UNIX and VMS file protections and X modification times. X X A help source file is included with VMS TAR. X X--------------------- XInstallation: X XTo compile VMS TAR, either run the MMS script to build the target TAR.EXE X($ MMS/DESC=TAR.MMS TAR.EXE), or execute BUILD_TAR.COM, which was created by XMMS. X XTo install VMS TAR: X X 1. Move TAR.EXE to where you want to store it (or leave it with the X sources). X X 2. Define either SYS$TIME_ZONE or TAR_TIMEZONE to an appropriate value (s Vee X the Caveats section in TAR.HLP). X X 3. Edit TAR.CLD so that it points DCL to where you have put TAR.EXE, then X add the TAR verb to your command table. You can either add it to your X process command table (lost when you log out) by entering: X X $ SET COMMAND TAR.CLD X X or you can add it to the system default table with the following X commands (you have to be privileged to do this): X X $ SET COMMAND TAR.CLD /TABLE=SYS$LIBRARY:DCLTABLES - X /OUTPUT=SYS$COMMON:`091SYSLIB`093DCLTABLES X $ INSTALL REPLACE SYS$LIBRARY:DCLTABLES X X--------------- XCopyright: X XVMS TAR is (c) Copyright 1989 Victoria College Computer Services, as it was Xwritten on their time, but as I don't see them making a quid on it, the righ Vt Xto redistribute and reuse any of its code is hereby granted. For your Xconscience' sake, you should always credit the original author in reused Xsource. X XMiscellaneous: X XI originally wrote VMS TAR out of need in early 1988. Since then I have see Vn Xat least three versions of TAR for VMS (all released to the world before min Ve). XI thought my version was still worth the effort of maintaining and enhancing Xbecause it has functionality and proper meshing with VMS and DCL. None of t Vhe XTARs I have seen have both these properties. X XMost of the features of VMS TAR were added later though, so there has been a Xlot of opportunity for bugs to creep in. If you get any bugs you are Xunsatisfied with, send details of them to: X X`009Tim Cook X`009Computer Services X`009Victoria College X`009Burwood`0093125 X`009Australia X X or X X`009timcc@viccol.edu.au X X (UUCP heads can try `123backbone`125!uunet!viccol.edu.au!timcc) X XI can't guarantee that they will be looked at promptly, but I am willing to Xfix the fixable. $ CALL UNPACK AAAREADME.1ST;1 68570587 $ create/nolog 'f' X$ PASCAL /NOLIST/OBJECT=VCDEFS.OBJ VCDEFS.PAS X$ PASCAL /NOLIST/OBJECT=TAR.OBJ TAR.PAS X$ PASCAL /NOLIST/OBJECT=TAR.OBJ TAR.PAS X$ PASCAL /NOLIST/OBJECT=TAR_WRITE.OBJ TAR_WRITE.PAS X$ PASCAL /NOLIST/OBJECT=TAR_EXTRACT.OBJ TAR_EXTRACT.PAS X$ PASCAL /NOLIST/OBJECT=TAR_LIST.OBJ TAR_LIST.PAS X$ MESSAGE /NOLIST/OBJECT=TARMSG.OBJ TARMSG.MSG X$ PASCAL /NOLIST/OBJECT=VCDEFS.OBJ VCDEFS.PAS X$ MACRO /NOLIST/OBJECT=LIBFILATT.OBJ LIBFILATT.MAR X$ MACRO /NOLIST/OBJECT=LIBIFERR.OBJ LIBIFERR.MAR X$ MACRO /NOLIST/OBJECT=LIBITMLST.OBJ LIBITMLST.MAR X$ MACRO /NOLIST/OBJECT=LIBPARSE.OBJ LIBPARSE.MAR X$ LINK /TRACE/NOMAP/EXEC=TAR.EXE/NOTRACE TAR.OBJ, TAR_WRITE.OBJ, TAR_EXTRACT V.OBJ, TAR_LIST.OBJ, TARMSG.OBJ, VCDEFS.OBJ, LIBFILATT.OBJ, LIBIFERR.OBJ, LIB VITMLST.OBJ, LIBPARSE.OBJ $ CALL UNPACK BUILD_TAR.COM;1 1612255508 $ create/nolog 'f' X`009.TITLE`009lib_file_attributes X`009.IDENT`009/1-001/ X;___________________________________________________________________________ V__ X; FACILITY:`009LIB, Local General Utility Library X; X; ABSTRACT:`009A routine to return certain FAB and XAB fields for an RMS fil Ve. X;`009`009The routine uses the VMS item_list_3 data type to pass X;`009`009requested items. X; X; RESTRICTION: Does not read or write any length data associated with each X;`009`009item. This may produce unexpected results when an item is X;`009`009requested using a data type of the incorrect size. X; X; ENVIRONMENT:`009Runs at any access mode, AST reentrant. X;___________________________________________________________________________ V__ X; Author:`009Tim Cook, 24-FEB-1988 X; X X`009$LIBDEF X`009$SSDEF X`009$DSCDEF X`009$NAMDEF X`009$XABDATDEF X`009$XABFHCDEF X`009$XABPRODEF X`009$XABSUMDEF X`009$XABALLDEF X X`009file_name = 4 X`009pascal_file_var = 8 X`009item_list = 12 X`009min_arguments = 3 X X`009byte_size = 1 X`009word_size = 2 X`009longword_size = 4 X`009quadword_size = 8 X X`009item_code = 2 X`009buffer_address = 4 X`009retlength_address = 8 X`009item_length = 12 X X`009min_item = 1 X X;`009`009FAB fields X`009rms__alq = 1`009`009; Alocation quantity (blocks) X`009rms__bks = 2`009`009; Bucket size X`009rms__bls = 3`009`009; Magnetic tape block size X`009rms__deq = 4`009`009; Default file extension quantity X`009rms__dev = 5`009`009; Device characteristics X`009rms__fac = 6`009`009; File access X`009rms__fop = 7`009`009; File-processing options X`009rms__fsz = 8`009`009; Fixed length control area size X`009rms__gbc = 9`009`009; Global buffer count X`009rms__ifi = 10`009`009; Internal file identifier X`009rms__mrn = 11`009`009; Maximum record number X`009rms__mrs = 12`009`009; Maximum record size X`009rms__org = 13`009`009; File organization X`009rms__rat = 14`009`009; Record attributes X`009rms__rfm = 15`009`009; Record format X`009rms__sdc = 16`009`009; Secondary device characteristics X`009rms__shr = 17`009`009; File sharing X`009rms__sts = 18`009`009; Completion status code X`009rms__stv = 19`009`009; Status value (I/O chan if succ. OPEN) X`009rms__xab = 20`009`009; Extended attribute block address X X;`009`009XABDAT fields X`009rms__bdt = 21`009`009; Backup date and time X`009rms__cdt = 22`009`009; Creation date and time X`009rms__edt = 23`009`009; Expiration date and time X`009rms__rdt = 24`009`009; Revision date and time X`009rms__rvn = 25`009`009; Revision number X X;`009`009XABFHC fields X`009rms__ebk = 26`009`009; End-of-file block X`009rms__ffb = 27`009`009; First free byte in the end-of-file block X`009rms__lrl = 28`009`009; Longest record length X`009rms__sbn = 29`009`009; Starting logical block number X`009rms__verlimit = 30`009; Version limit X X;`009`009XABPRO fields X`009rms__grp = 31`009`009; Group number of file owner X`009rms__mbm = 32`009`009; Member number of file owner X`009rms__mtacc = 33`009`009; Magnetic tape accessibility X`009rms__pro = 34`009`009; File protection X`009rms__uic = 35`009`009; User Identification Code X X;`009`009XABSUM fields X`009rms__noa = 36`009`009; Number of allocation areas defined X`009rms__nok = 37`009`009; Number of keys defined X`009rms__pvn = 38`009`009; Prologue version number X X;`009`009XABALL fields X`009rms__aid = 39`009`009; Area identification number X`009rms__aln = 40`009`009; Alignment boundary type X`009rms__a_alq = 41`009`009; Area allocation quantity X`009rms__aop = 42`009`009; Allocation options X`009rms__bkz = 43`009`009; Area bucket size X`009rms__a_deq = 44`009`009; Area default extension quantity X`009rms__loc = 45`009`009; Area position X`009rms__rfi = 46`009`009; Related file identifier X`009rms__vol = 47`009`009; Related volume number X X;`009`009Block addresses X`009rms__fabadr = 48`009; Address of FAB X`009rms__xabdatadr = 49`009; Address of XABDAT X`009rms__xabfhcadr = 50`009; Address of XABFHC X`009rms__xabproadr = 51`009; Address of XABPRO X`009rms__xabsumadr = 52`009; Address of XABSUM X`009rms__xaballadr = 53`009; Address of XABALL X X`009max_item = 53 X X`009.PSECT`009_fa_data NOEXE, RD, WRT, NOSHR, PIC, LONG X Xfab: X`009$FAB`009XAB = xabdat Xxabdat: X`009$XABDAT NXT = xabfhc Xxabfhc: X`009$XABFHC NXT = xabpro Xxabpro: X`009$XABPRO`009NXT = xabsum Xxabsum: X`009$XABSUM`009NXT = xaball Xxaball: X`009$XABALL X X X`009.PSECT`009_fa_code EXE, NOWRT, SHR, PIC, CON, REL X X`009.ENTRY`009lib_file_attributes `094M X X`009CMPB`009(AP), #min_arguments X`009BGEQU`009args_ok X`009MOVL`009#SS$_INSFARG, R0`009; Insufficient call arguments X`009RET X Xargs_ok: X`009TSTL`009pascal_file_var(AP) X`009BNEQ`009file_var`009`009; Given file_var, so use it X X`009MOVAB`009fab, R2`009`009`009; Pointer to FAB being used X`009MOVL`009file_name(AP), R0 X`009JSB`009G`094STR$ANALYZE_SDESC_R1 X`009CMPL`009R0, #NAM$C_MAXRSS X`009BLEQU`009filename_ok X`009MOVL`009#LIB$_INVFILSPE, R0`009; Invalid file specification X`009RET Xfilename_ok: X`009MOVB`009R0, FAB$B_FNS(R2) X`009MOVL`009R1, FAB$L_FNA(R2) X`009PUSHL`009#0`009`009`009; success routine X`009PUSHL`009#0`009`009`009; error routine X`009PUSHL`009R2`009`009`009; FAB address X`009CALLS`009#3, SYS$OPEN X`009BLBS`009R0, open_ok X`009RET X Xfile_var: X`009PUSHL`009pascal_file_var(AP) X`009CALLS`009#1, G`094PAS$FAB X`009MOVL`009R0, R2 X`009MOVAB`009xabdat, FAB$L_XAB(R2) X`009PUSHL`009#0`009`009`009; success routine X`009PUSHL`009#0`009`009`009; error routine X`009PUSHL`009R2`009`009`009; FAB address X`009CALLS`009#3, SYS$DISPLAY X`009BLBS`009R0, open_ok X`009RET X`009 Xopen_ok: X X; Process item_list X X`009SUBL3`009#item_length, item_list(AP), R3`009; Points to -1th item Xitem_loop: X`009ADDL`009#item_length, R3`009; Shift pointer to next item X`009TSTL`009(R3)`009`009`009; Item list terminated by X`009BNEQ`00910$`009`009`009; null longword X`009BRW`009no_more_items X10$:`009CASEW`009item_code(R3), #min_item, #max_item X X; pc$ represents the contents of PC after the execution of the CASE instruct Vion X Xpc$:`009.WORD`009alq - pc$`009`009; FAB fields X`009.WORD`009bks - pc$`009 X`009.WORD`009bls - pc$ X`009.WORD`009deq - pc$ X`009.WORD`009dev - pc$ X`009.WORD`009fac - pc$ X`009.WORD`009fop - pc$ X`009.WORD`009fsz - pc$ X`009.WORD`009gbc - pc$ X`009.WORD`009ifi - pc$ X`009.WORD`009mrn - pc$ X`009.WORD`009mrs - pc$ X`009.WORD`009org - pc$ X`009.WORD`009rat - pc$ X`009.WORD`009rfm - pc$ X`009.WORD`009sdc - pc$ X`009.WORD`009shr - pc$ X`009.WORD`009sts - pc$ X`009.WORD`009stv - pc$ X`009.WORD`009xab - pc$ X`009.WORD`009bdt - pc$`009`009; XABDAT fields X`009.WORD`009cdt - pc$ X`009.WORD`009edt - pc$ X`009.WORD`009rdt - pc$ X`009.WORD`009rvn - pc$ X`009.WORD`009ebk - pc$`009`009; XABFHC fields X`009.WORD`009ffb - pc$ X`009.WORD`009lrl - pc$ X`009.WORD`009sbn - pc$ X`009.WORD`009verlimit - pc$ X`009.WORD`009grp - pc$`009`009; XABPRO fields X`009.WORD`009mbm - pc$ X`009.WORD`009mtacc - pc$ X`009.WORD`009pro - pc$ X`009.WORD`009uic - pc$ X`009.WORD`009noa - pc$`009`009; XABSUM fields X`009.WORD`009nok - pc$ X`009.WORD`009pvn - pc$ X`009.WORD`009aid - pc$`009`009; XABALL fields X`009.WORD`009aln - pc$ X`009.WORD`009a_alq - pc$ X`009.WORD`009aop - pc$ X`009.WORD`009bkz - pc$ X`009.WORD`009a_deq - pc$ X`009.WORD`009loc - pc$ X`009.WORD`009rfi - pc$ X`009.WORD`009vol - pc$ X`009.WORD`009fabadr - pc$`009`009; Block addresses X`009.WORD`009xabdatadr - pc$ X`009.WORD`009xabfhcadr - pc$ X`009.WORD`009xabproadr - pc$ X`009.WORD`009xabsumadr - pc$ X`009.WORD`009xaballadr - pc$ Xotherwise: X`009PUSHL`009#0`009`009`009; success routine X`009PUSHL`009#0`009`009`009; error routine X`009PUSHL`009R2`009`009`009; FAB address X`009CALLS`009#3, SYS$CLOSE +-+-+-+-+-+-+-+- END OF PART 1 +-+-+-+-+-+-+-+- Relay-Version: version nyu B notes v1.6 5/10/89; site acf4.NYU.EDU From: timcc@csv.viccol.edu.au (Tim Cook) Date: 28 Jun 89 20:01 EDT Date-Received: 29 Jun 89 11:31 EDT Subject: VMS TAR part 2 of 10 Message-ID: <523@csv.viccol.edu.au> Path: acf4!cmcl2!nrl-cmf!ukma!rutgers!mailrus!csd4.milw.wisc.edu!lll-winken!uunet!murtoa.cs.mu.oz.au!viccol!timcc Newsgroups: comp.os.vms Organization: Computer Services, Victoria College, Melbourne Lines: 469 -+-+-+-+-+-+-+-+ START OF PART 2 -+-+-+-+-+-+-+-+ X`009BLBC`009R0, 20$ X`009MOVL`009#LIB$_INVARG, R0`009; Item code is not known X20$:`009RET X Xalq:`009MOVL`009FAB$L_ALQ(R2), @buffer_address(R3) X`009BRW`009item_loop Xbks:`009MOVB`009FAB$B_BKS(R2), @buffer_address(R3) X`009BRW`009item_loop Xbls:`009MOVW`009FAB$W_BLS(R2), @buffer_address(R3) X`009BRW`009item_loop Xdeq:`009MOVW`009FAB$W_DEQ(R2), @buffer_address(R3) X`009BRW`009item_loop Xdev:`009MOVL`009FAB$L_DEV(R2), @buffer_address(R3) X`009BRW`009item_loop Xfac:`009MOVB`009FAB$B_FAC(R2), @buffer_address(R3) X`009BRW`009item_loop Xfop:`009MOVL`009FAB$L_FOP(R2), @buffer_address(R3) X`009BRW`009item_loop Xfsz:`009MOVB`009FAB$B_FSZ(R2), @buffer_address(R3) X`009BRW`009item_loop Xgbc:`009MOVW`009FAB$W_GBC(R2), @buffer_address(R3) X`009BRW`009item_loop Xifi:`009MOVW`009FAB$W_IFI(R2), @buffer_address(R3) X`009BRW`009item_loop Xmrn:`009MOVL`009FAB$L_MRN(R2), @buffer_address(R3) X`009BRW`009item_loop Xmrs:`009MOVW`009FAB$W_MRS(R2), @buffer_address(R3) X`009BRW`009item_loop Xorg:`009MOVB`009FAB$B_ORG(R2), @buffer_address(R3) X`009BRW`009item_loop Xrat:`009MOVB`009FAB$B_RAT(R2), @buffer_address(R3) X`009BRW`009item_loop Xrfm:`009MOVB`009FAB$B_RFM(R2), @buffer_address(R3) X`009BRW`009item_loop Xsdc:`009MOVL`009FAB$L_SDC(R2), @buffer_address(R3) X`009BRW`009item_loop Xshr:`009MOVB`009FAB$B_SHR(R2), @buffer_address(R3) X`009BRW`009item_loop Xsts:`009MOVL`009FAB$L_STS(R2), @buffer_address(R3) X`009BRW`009item_loop Xstv:`009MOVL`009FAB$L_STV(R2), @buffer_address(R3) X`009BRW`009item_loop Xxab:`009MOVL`009FAB$L_XAB(R2), @buffer_address(R3) X`009BRW`009item_loop Xbdt:`009MOVQ`009xabdat+XAB$Q_BDT, @buffer_address(R3) X`009BRW`009item_loop Xcdt:`009MOVQ`009xabdat+XAB$Q_CDT, @buffer_address(R3) X`009BRW`009item_loop Xedt:`009MOVQ`009xabdat+XAB$Q_EDT, @buffer_address(R3) X`009BRW`009item_loop Xrdt:`009MOVQ`009xabdat+XAB$Q_RDT, @buffer_address(R3) X`009BRW`009item_loop Xrvn:`009MOVW`009xabdat+XAB$W_RVN, @buffer_address(R3) X`009BRW`009item_loop Xebk:`009MOVL`009xabfhc+XAB$L_EBK, @buffer_address(R3) X`009BRW`009item_loop Xffb:`009MOVW`009xabfhc+XAB$W_FFB, @buffer_address(R3) X`009BRW`009item_loop Xlrl:`009MOVW`009xabfhc+XAB$W_LRL, @buffer_address(R3) X`009BRW`009item_loop Xsbn:`009MOVL`009xabfhc+XAB$L_SBN, @buffer_address(R3) X`009BRW`009item_loop Xverlimit: X`009MOVW`009xabfhc+XAB$W_VERLIMIT, @buffer_address(R3) X`009BRW`009item_loop Xgrp:`009MOVW`009xabpro+XAB$W_GRP, @buffer_address(R3) X`009BRW`009item_loop Xmbm:`009MOVW`009xabpro+XAB$W_MBM, @buffer_address(R3) X`009BRW`009item_loop Xmtacc:`009MOVB`009xabpro+XAB$B_MTACC, @buffer_address(R3) X`009BRW`009item_loop Xpro:`009MOVW`009xabpro+XAB$W_PRO, @buffer_address(R3) X`009BRW`009item_loop Xuic:`009MOVL`009xabpro+XAB$L_UIC, @buffer_address(R3) X`009BRW`009item_loop Xnoa:`009MOVB`009xabsum+XAB$B_NOA, @buffer_address(R3) X`009BRW`009item_loop Xnok:`009MOVB`009xabsum+XAB$B_NOK, @buffer_address(R3) X`009BRW`009item_loop Xpvn:`009MOVW`009xabsum+XAB$W_PVN, @buffer_address(R3) X`009BRW`009item_loop Xaid:`009MOVB`009xaball+XAB$B_AID, @buffer_address(R3) X`009BRW`009item_loop Xaln:`009MOVB`009xaball+XAB$B_ALN, @buffer_address(R3) X`009BRW`009item_loop Xa_alq:`009MOVL`009xaball+XAB$L_ALQ, @buffer_address(R3) X`009BRW`009item_loop Xaop:`009MOVB`009xaball+XAB$B_AOP, @buffer_address(R3) X`009BRW`009item_loop Xbkz:`009MOVB`009xaball+XAB$B_BKZ, @buffer_address(R3) X`009BRW`009item_loop Xa_deq:`009MOVW`009xaball+XAB$W_DEQ, @buffer_address(R3) X`009BRW`009item_loop Xloc:`009MOVL`009xaball+XAB$L_LOC, @buffer_address(R3) X`009BRW`009item_loop Xrfi:`009MOVW`009xaball+XAB$W_RFI, @buffer_address(R3) X`009BRW`009item_loop Xvol:`009MOVW`009xaball+XAB$W_VOL, @buffer_address(R3) X`009BRW`009item_loop X Xfabadr:`009MOVL`009R2, @buffer_address(R3) X`009BRW`009item_loop Xxabdatadr: X`009MOVAB`009xabdat, @buffer_address(R3) X`009BRW`009item_loop Xxabfhcadr: X`009MOVAB`009xabfhc, @buffer_address(R3) X`009BRW`009item_loop Xxabproadr: X`009MOVAB`009xabpro, @buffer_address(R3) X`009BRW`009item_loop Xxabsumadr: X`009MOVAB`009xabsum, @buffer_address(R3) X`009BRW`009item_loop Xxaballadr: X`009MOVAB`009xaball, @buffer_address(R3) X`009BRW`009item_loop X Xno_more_items: X`009TSTL`009pascal_file_var(AP)`009; Used file var, so don't close X`009BNEQ`009return X X`009PUSHL`009#0`009`009`009; success routine X`009PUSHL`009#0`009`009`009; error routine X`009PUSHL`009R2`009`009`009; FAB address X`009CALLS`009#3, SYS$CLOSE Xreturn:`009RET X`009.END $ CALL UNPACK LIBFILATT.MAR;1 810736524 $ create/nolog 'f' X`009.TITLE`009lib_iferr X`009.IDENT`009/1-001/`009`009; File : SRC$UMLIB:LIBIFERR.MAR X`009`009`009`009; Edit : DGM1001 X;++ X; FACILITY: General Utility Library X; X; ABSTRACT: X; X;`009This module contains routines for signalling or unwinding X;`009If a provided condition code is not success. X; X; ENVIRONMENT: Runs at any access mode, AST reentrant X; X; AUTHOR: Douglas G. Miller, CREATION DATE: 03-Jun-1984 X; X; MODIFIED BY: X; X; 1-001 - Original. DGM 03-Jun-1984 X; 1-002 - Add provision for extra messages. DGM 27-Sep-1984 X; 1-003 - Add function return of parameter. DGM 1-Oct-1984 X;-- X; X`009.PSECT`009_LIB_CODE PIC, USR, CON, REL, LCL, SHR, EXE, RD, NOWRT, LONG Xdepth:`009.LONG 2 X; X`009.ENTRY lib_retiferr `094M X`009MOVAL`009LIB___RETIFERR_HANDLER,`009(FP) X`009BRB`009lib_sigiferr+2 X; X`009.ENTRY lib_sigiferr `094M X`009MOVQ`009(AP),`009R6`009`009; R6 is number of arguments X`009BLBS`009R7,`009RET`009`009; R7 is status X`009MULL3`009#4,`009R6,`009R1 X`009SUBL2`009#4,`009R1 X`009PUSHL`009R7 X`009SUBL2`009R1,`009SP X MOVC3`009R1,`0098(AP),`009(SP) X`009CALLS`009R6,`009G`094LIB$SIGNAL XRET:`009MOVL`009R7,`009R0 X`009RET X; Xlib___retiferr_handler:`009.WORD `094M<> X`009MOVL`0098(AP),`009R1`009`009; MECHARGS X`009MOVL`009R7,`00912(R1) X`009$UNWIND_S depth, X`009RET X; X`009.END $ CALL UNPACK LIBIFERR.MAR;1 1731350920 $ create/nolog 'f' X`009.TITLE lib_item_list `032 X; X;`009Doug Miller, April 1984 X; X;`009Turn the argument list into an item list for $GETDVI, $GETJPI, etc. X; X`009$DSCDEF X`009$SFDEF X`009$SSDEF X; XITEM_W_BUFFER_LEN = 0 XITEM_W_CODE = 2 XITEM_A_BUFFER = 4 XITEM_A_RETLENGTH = 8 XITEM_B_BUFFER = 12 XPARAM_W_ITEMCODE = 8 XPARAM_A_BUFFER_DX = 12 XPARAM_A_RETLENGTH = 16 X; X`009.PSECT`009ITEM_LIST, CON, NOEXE, NOSHR, PIC, REL XITEMLIST:`009.BLKL`009256 XITEM`009:`009.BLKL`0093 X; X`009.PSECT`009LIB_ITEM_LIST, CON, EXE, SHR, PIC, REL X`009.ENTRY lib_item_list `094M X; `032 X`009ADDL3`009#4, AP,`009R5`009; Create argument list pointer X`009MOVAL`009@(R5)+,`009R6`009; Create current item address X`009SUBL3`009#1, (AP), R2 X; XLOOP:`009MOVL`009(R5)+,`009R0`009; move current argument to R0 X`009MOVL`009(R0)+,`009(R6)+`009; move buffer_length and item_code X`009MOVQ`009(R0),`009(R6)+`009; move buffer_address and retlength_address X`009SOBGTR`009R2,`009LOOP`009; Count down the items X; X`009CLRL`009(R6)`009`009; Terminate item list X`009RET X; `032 X`009.ENTRY lib_in_item `094M X; X`009MOVAL`009@4(AP),`009`009`009R6`009; Create current item address X`009CLRQ`009`009`009`009ITEM_A_BUFFER(R6) ; clear buffer and retlength addre Vsses X`009MOVAL`009@PARAM_A_BUFFER_DX(AP),`009R7 X`009BEQL`009ITEMEND X`009MOVAL`009ITEM_B_BUFFER(R6),`009ITEM_A_BUFFER(R6) X`009CMPB`009DSC$B_CLASS(R7), #DSC$K_CLASS_VS X`009BEQL`009IN_DVS XIN_DX:`009MOVW`009DSC$W_LENGTH(R7),`009ITEM_W_BUFFER_LEN(R6) X`009MOVC5`009ITEM_W_BUFFER_LEN(R6), @DSC$A_POINTER(R7), #`094A' ', #80, ITEM V_B_BUFFER(R6) X`009BRB`009ITEMEND `032 XIN_DVS:`009MOVW`009@DSC$A_POINTER(R7),`009ITEM_W_BUFFER_LEN(R6) ; use curren Vt length of varying string X`009ADDL3`009#2, DSC$A_POINTER(R7),`009R1 X`009MOVC5`009ITEM_W_BUFFER_LEN(R6), (R1), #`094A' ', #80, ITEM_B_BUFFER(R6) X`009BRB`009ITEMEND `032 X; X`009.ENTRY lib_out_item `094M X X`009MOVAL`009@4(AP),`009`009`009R6`009; Create current item address X`009MOVAL`009@PARAM_A_BUFFER_DX(AP),`009R7 X`009CMPB`009DSC$B_CLASS(R7), #DSC$K_CLASS_VS X`009BEQL`009OUT_DVS XOUT_DX:`009MOVL`009DSC$A_POINTER(R7),`009ITEM_A_BUFFER(R6)`009 X`009MOVW`009DSC$W_LENGTH(R7),`009ITEM_W_BUFFER_LEN(R6) X`009MOVAL`009@PARAM_A_RETLENGTH(AP),`009ITEM_A_RETLENGTH(R6) X`009BRB`009ITEMEND XOUT_DVS:ADDL3`009#2, DSC$A_POINTER(R7),`009ITEM_A_BUFFER(R6)`009 X`009MOVW`009DSC$W_LENGTH(R7),`009ITEM_W_BUFFER_LEN(R6) X`009MOVAW`009@DSC$A_POINTER(R7),`009ITEM_A_RETLENGTH(R6) X; XITEMEND: X`009MOVW`009PARAM_W_ITEMCODE(AP),`009ITEM_W_CODE(R6) X`009RET X; X`009.END $ CALL UNPACK LIBITMLST.MAR;1 1446319600 $ create/nolog 'f' X.TITLE lib_parse - file-spec parsing routine X.IDENT /1-001/ ; File : LIBTEMPLA.MAR X;************************************************************************* X; FACILITY:`009LIB, General Utility Library X; X; ABSTRACT:`009Returns RMS expanded file-spec (or portions therof) X;`009`009by using $PARSE system service. X; X; ENVIRONMENT:`009Runs at any access mode, AST reentrant. X; X; AUTHOR:`009Douglas Miller X; CREATED:`00918-MAR-1985 X;......................................................................... X; MODIFIED X; X;************************************************************************* X; X`009.PSECT _LIB_DATA PIC, USR, CON, REL, LCL, NOSHR, NOEXE, RD, WRT, LONG X; X $NAMDEF X; X nam__node = 0 ; X nam__dev = 1 ; X nam__dir = 2 ; X nam__name = 3 ; X nam__type = 4 ; X nam__ver = 5 ; X; X min_params = 2 X; X _filespec= 1 X _expanded = 2 X _default = 3 X _related = 4 X _expanded_length = 5 X _fields = 6 X; Xes:`009.BLKB nam$c_maxrss X.ALIGN LONG Xfab:`009$FAB NAM=nam X.ALIGN LONG Xnam:`009$NAM ESA=es, ESS=nam$c_maxrss, NOP=SYNCHK ; parse for syntax only X.ALIGN LONG Xrlfnam:`009$NAM NOP=SYNCHK X; X .PSECT _LIB_CODE PIC,USR,CON,REL,LCL,SHR,EXE,RD,NOWRT,LONG X; X .ENTRY lib_parse `094M X; X`009CMPL`009(AP), #_expanded X`009BGEQ`00999$ X`009BRW`009invarg X99$: X; Xfilespec: X`009MOVL`0094*_filespec(AP), R0 X `009JSB`009G`094LIB$ANALYZE_SDESC_R2 X`009BLBS`009R0, 10$ X`009BRW`009error X10$:`009MOVB`009R1, FAB+FAB$B_FNS X`009MOVL`009R2, FAB+FAB$L_FNA X; Xdefault: X`009CMPL`009(AP), #_default X`009BLSS`00999$ X`009MOVL`0094*_default(AP), R0 X`009BEQL`00999$ X`009JSB`009G`094LIB$ANALYZE_SDESC_R2 X`009BLBS`009R0, 10$ X`009BRW`009error X10$:`009MOVB`009R1, FAB+FAB$B_DNS X`009MOVL`009R2, FAB+FAB$L_DNA X99$: X; Xrelated: X`009CMPL`009(AP), #_related X`009BLSS`00999$ X`009MOVL`0094*_related(AP), R0 X`009BEQL`00999$ X`009JSB`009G`094LIB$ANALYZE_SDESC_R2 X`009BLBS`009R0, 10$ X`009BRW`009error X10$:`009MOVB`009R1, RLFNAM+NAM$B_RSS X`009MOVL`009R2, RLFNAM+NAM$L_RSA X`009MOVAL`009rlfnam, nam+NAM$L_RLF X99$: X; Xparse: X`009$PARSE`009FAB=fab X`009BLBS`009R0, 10$ X`009BRW`009error X10$:`009MOVL`009R0, R10 X; X; Xfields: X`009MOVL`009#_fields, R6`009; longword offset to next field code X`009MOVAB`009es, R3 X; X`009CMPL`009R6, (AP) X`009BGTR`00910$ X`009MOVL`009(AP)`091R6`093, R0 X`009BNEQ`009loop X10$:`009BRW`009full_expanded`009; no fields specified, so get everything X; Xloop:`009CASEB`009(R0), #nam__node, #nam__ver X1$:`009.WORD`009node-1$, dev-1$, dir-1$, name-1$, type-1$, ver-1$ X`009BRW`009invarg X; Xnode:`009MOVZBW`009nam+NAM$B_NODE, R0 X`009MOVC3`009R0, @nam+NAM$L_NODE, (R3) X`009BRB next Xdev:`009MOVZBW`009nam+NAM$B_DEV, R0 X`009MOVC3`009R0, @nam+NAM$L_DEV, (R3) X`009BRB next Xdir:`009MOVZBW`009nam+NAM$B_DIR, R0 X`009MOVC3`009R0, @nam+NAM$L_DIR, (R3) X`009BRB next Xname:`009MOVZBW`009nam+NAM$B_NAME, R0 X`009MOVC3`009R0, @nam+NAM$L_NAME, (R3) X`009BRB next Xtype:`009MOVZBW`009nam+NAM$B_TYPE, R0 X`009MOVC3`009R0, @nam+NAM$L_TYPE, (R3) X`009BRB next Xver:`009MOVZBW`009nam+NAM$B_VER, R0 X`009MOVC3`009R0, @nam+NAM$L_VER, (R3) X`009BRB next X; Xnext:`009AOBLEQ`009(AP), R6, 10$ X`009BRB`00999$ X10$:`009MOVL`009(AP)`091R6`093, R0 X`009BRW`009loop X99$: X; X; Xexpanded: X`009SUBL3`009#es, R3, R9`009 ; length of expanded filespec X`009BRB`009move_to_expanded ; some fields filled in Xfull_expanded: X`009MOVZBW`009nam+NAM$B_ESL, R9 X`009MOVC3`009R9, @nam+NAM$L_ESA, es Xmove_to_expanded: X`009MOVL`0094*_expanded(AP), R0 X`009BEQL`009invarg X`009MOVW`009R9, R1 X`009MOVAB`009es, R2 X`009JSB`009G`094STR$COPY_R_R8 X; Xexpanded_length: X`009CMPL`009(AP), #_expanded_length X`009BLSS`009ret X`009MOVL`0094*_expanded_length(AP), R0 X`009BEQL`009ret X`009MOVZBW`009nam+NAM$B_ESL, (R0) X; Xret:`009MOVL`009R10, R0 X`009RET X; Xinvarg:`009MOVL`009#LIB$_INVARG, R0 Xerror:`009RET X; X`009.END $ CALL UNPACK LIBPARSE.MAR;1 524493814 $ create/nolog 'f' X1 TAR XVMS TAR is a utility that emulates the UNIX tar, or Tape ARchive utility, Xwhich is used to store a set of files in a single file, usually on an Xoffline medium, such as 9-track tape. X XVMS TAR automatically performs conversion of files to and from the UNIX Xfile format, and converts between UNIX and VMS file protections and Xmodification times. X XFormat: X X X TAR keyword `091file-spec`093 X X2 Parameters Xkeyword X X One of the keywords APPEND, EXTRACT, LIST or WRITE. Each keyword has a X different function. See the help for each keyword. X Xfile-spec X X The specification of any file(s) to be APPENDed, EXTRACTed, LISTed or X WRITten. X X On an APPEND or WRITE operation, this is a wildcarded VMS file- X specification. On an EXTRACT or LIST operation, the file-spec parameter X is used to match UNIX filenames (case sensitive). Any wildcarding in X the latter case is performed as string wildcarding, so the '*' wildcard X matches all characters, including '.' and '/'. X X2 Examples XFor all TAR operations direct to or from tape, the tape must be MOUNTed Xas in the following EXTRACT example: X X`009$ ALLOCATE MF,MS,MT tar_archive X`009%DCL-I-ALLOC, _$1$MSA0: allocated X`009$ MOUNT /FOREIGN /RECORD_SIZE=512 /BLOCK_SIZE=10240 tar_archive X`009%MOUNT-I-MOUNTED, mounted on _$1$MSA0: X`009$ TAR EXTRACT *.COB /CONFIRM X`009Extract program-1.cob ? (Y/N) `091Y`093: n X`009Extract deep-space.cob ? (Y/N) `091Y`093: X`009%TAR-S-CREATED, created DISK:`091USER`093DEEP-SPACE.COB;1 (2573 records) X`009Extract terrorpods.cob ? (Y/N) `091Y`093: X`009%TAR-S-CREATED, created DISK:`091USER`093TERRORPODS.COB;1 (523 records) +-+-+-+-+-+-+-+- END OF PART 2 +-+-+-+-+-+-+-+- Relay-Version: version nyu B notes v1.6 5/10/89; site acf4.NYU.EDU From: timcc@csv.viccol.edu.au (Tim Cook) Date: 28 Jun 89 20:03 EDT Date-Received: 29 Jun 89 11:31 EDT Subject: VMS TAR part 3 of 10 Message-ID: <524@csv.viccol.edu.au> Path: acf4!cmcl2!husc6!cs.utexas.edu!csd4.milw.wisc.edu!lll-winken!uunet!murtoa.cs.mu.oz.au!viccol!timcc Newsgroups: comp.os.vms Organization: Computer Services, Victoria College, Melbourne Lines: 375 -+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+ X`009Extract foo.cob ? (Y/N) `091Y`093: Yes X`009%TAR-S-CREATED, created DISK:`091USER`093FOO.COB;1 (0 records) X`009%TAR-S-TOTAL, total of 3 files created, 4 files scanned X`009$ DISMOUNT tar_archive X`009$ DEALLOCATE tar_archive X X XIf you wanted to create an archive that would later be copied to a tape, Xthe following sequence of commands might be used: X X `009$ TAR WRITE *.pas /ARCHIVE=PASCAL.TAR /OUTPUT=PASCAL_TAR.LOG X Xand later: X X`009$ ALLOCATE MSA0: X`009%DCL-I-ALLOC, _$1$MSA0: allocated X`009$ MOUNT /FOREIGN /RECORD_SIZE=512 /BLOCK_SIZE=10240 MSA0: X`009%MOUNT-I-MOUNTED, BLANK1 mounted on _$1$MSA0: X`009$ COPY/LOG PASCAL.TAR MSA0: X`009%COPY-S-COPIED, CS:`091STAFF.FRED`093PASCAL.TAR copied to _$1$MSA0: X `009 (315 records). X`009$ (dismount and deallocate) X XThe /BLOCK_SIZE qualifier is important for mounting TAR tapes. UNIX uses Xa default blocking factor of 20, which makes the block size 10240. A UNIX Xtar archive might have been created with a different blocking factor, Xthough. This may be discovered by mounting such an archive tape without Xa /BLOCK_SIZE qualifier and DUMPing the tape drive (DUMP will demonstrate Xthe block size). X XIf you are going to use a tape that has previously been used for an Xunusual format (like VMS BACKUP), you should initialize the tape, using Xthe INITIALIZE command: X X`009$ ALLOCATE MF,MS,MT TAR_ARCHIVE X `009%DCL-I-ALLOC, _$1$MSA0: allocated X`009$ INIT TAR_ARCHIVE FREDDO X! X2 Supported_Files XFiles readable by TAR include: X X Record format Carriage control X ------------- ---------------- X X variable-length carriage-return X stream-lf X variable-fixed-control (VFC) print-file X fixed-length none X XVariable-length VMS files are written to an archive with linefeeds X('newline's or '\n' to UNIX) as record terminators, which is consistent Xwith the UNIX text file format, whereas fixed-length VMS files are not. XExtraction of files that used to be fixed-length is extremely difficult X(see Caveats), as they are indistinguishable from text files when stored Xin tar format. A feature may be added to VMS TAR in future to counter Xthis. X XOther file types may be supported, but a file with FORTRAN carriage Xcontrol for example, may be transmitted in a useless format. Note that Xany file EXTRACTed by tar will always be recreated with the VMS standard Xtext file attributes; varying-length records and carriage-return carriage Xcontrol. X! X2 Caveats XTAR_TIMEZONE X X To assist in the conversion of file modification times, TAR uses time X zone information. TAR gets the local time zone from the logical names X SYS$TIME_ZONE or TAR_TIMEZONE (the latter is used if the former is X not defined). The format of these logicals is "`091s`093`091`091h`093mm` V093", where s is X a sign (+ or -), h is the number of hours (1-18) and mm the number of X minutes (00-59) to be added to GMT to give the local time. An example X is "+1000" for Australian Eastern Standard Time, which is 10 hours X ahead of GMT. X X I'm not sure about the history of SYS$TIME_ZONE. I saw it somewhere, X but I can't remember where. It is not defined on our systems. X X XThe /SCAN qualifier. X X When writing a file with variable-length records to an archive, TAR's X normal behaviour is first to copy the file into a temporary file, in X the TAR format. When this is done, TAR knows the size of the file in X bytes, so it can then write a header record to the real archive, and X quickly load the contents of the temporary file into the archive. X X The presence of the /SCAN qualifier makes TAR read through the whole of X the input file to get its size in bytes, then load it into the archive. X X The first method should save on processing, but the second method X should save on I/O, and could help in a situation of stretched disk X quota. I thought both were useful, so I coded both and made the /SCAN X qualifier. X X Incidentally, if the input file has fixed-length records, its size is X computed using the record size and the size in blocks of the file. This X may not be a completely safe algorithm, as it presumes there are no X record delimiters in fixed-length record files. X X X'Directory not found' when EXTRACTing files X X If you try to make TAR EXTRACT a file into a directory that does not X exist (it may not have been put in the archive), it will say so, X then extract it into the file '`091`093OUT_FILE.DAT'. This wasn't actual Vly X explicitly coded into TAR by me (a side effect), but it seems a X sensible thing to do until I implement a qualifier to tell TAR to X create the directories it needs (like UNIX tar and BACKUP). X X XInternal errors X X If TAR tells you it has encountered an internal error, it means it X has caught a Pascal run-time error that it doesn't have a way of X handling. Generally, this means you have done something strange with X TAR that I haven't done myself in testing. The code supplied in the X INTERNERR message corresponds to a VAX Pascal status code, and I X would like it if you notify me of how you caused the error and the X value of that code. X X XOutput file record wrapping X X VMS TAR has no way of knowing if a file originally had fixed-length X records, so it always assumes a file in an archive is to be EXTRACTed X with variable-length records, and interprets any LF's it finds X accordingly. But, if a record is longer than a certain number X (currently 8192) of bytes, the superfluous bytes are used to make a new X record in the file (they are wrapped). The user is told of this if and X when it happens during the extraction of a file. Note however that the X user will only be notified the first time it happens. X X XExceeding disk quota X X When a sequential file is written to by VAX RMS, it automatically X extends, or allocates more blocks to the file as necessary. I have X seen RMS be overly generous in doing this; to the point where I am X fairly sure there are a few bugs deep down in RMS. This generosity X could cause a user's disk quota to be exceeded when creating a TAR X archive or extracting files from an archive. To combat this, you can X enter the following DCL command before using TAR: X X`009$ SET RMS_DEFAULT/EXTEND=n X X Where n is a fairly low number, like 1 or 2. The RMS default is 32, X but I have seen files with more than 31 allocated but unused blocks X attached to them. X X These superflous extents only exists when the file is being written to, X they are removed when the file is closed. X! X2 APPEND XThis function is the same as WRITE, except that files written to the Xarchive are appended (see WRITE). X! X3 Qualifiers X! X/ARCHIVE X X Specifies the archive to which files are to be APPENDed. The default is X 'TAR_ARCHIVE', which might be a logical name pointing to a tape-drive X (see Examples). The archive file specified must be a valid TAR archive X file. X X/CONFIRM X X If the /CONFIRM qualifier is given on the APPEND keyword, the user is X prompted each time TAR is about to append a file to the archive. The X user may then confirm or abort the archiving of the file. X X/MAP_MODE X /MAP_MODE=PREFIX (Default) X X The MAP_MODE keyword tells TAR how to map VMS file specifications to X UNIX pathnames when writing files to an archive. The available modes X and their behaviours follows: X X PREFIX File names in the archive are relative, any directories X in the pathname of a file that are common to all files X to be written (a common prefix) are removed. X X ABSOLUTE The VMS device, directory, name and type fields are X mapped to an absolute UNIX pathname (one beginning with X '/'). A file called 'DISK:`091USER.SUB`093FOO.BAR' would be X mapped to '/disk/user/sub/foo.bar'. X X ROOT The (logical or physical) device specification is omitted X from the UNIX pathname, but the directory, name and type X are used to form a relative pathname. The file X 'DISK:`091USER.SUB`093FOO.BAR' would be mapped to X 'user/sub/foo.bar'. X X/OUTPUT X X The /OUTPUT qualifier is used to direct messages from TAR to a file, it X works like the /OUTPUT qualifier on other VMS commands. X X/SCAN X X Instructs TAR not to use a temporary archive file for the purpose of X writing a file with variable-length records to an archive. See TAR X Caveats. X! X2 EXTRACT XThis function reads files from an archive, and creates VMS files in your Xcurrent directory with names, protections and modification dates as Xsimilar as possible to their UNIX names. As each file is created, its Xsize in records is logged. X! X3 Qualifiers X! X/ARCHIVE X X Specifies the archive from which files are to be EXTRACTed. The default X is 'TAR_ARCHIVE', which might be a logical name pointing to a tape-drive X (see Examples). X X/CONFIRM X X If the /CONFIRM qualifier is given on the EXTRACT keyword, the user is X prompted each time TAR is about to extract a file. The user may then X confirm or abort the creation of the file. X X/OUTPUT X X The /OUTPUT qualifier is used to direct messages from TAR to a file, it X works like the /OUTPUT qualifier on other VMS commands. X! X2 LIST X This function lists all files, and their sizes in bytes, in an archive X that match file-spec. If file-spec is not supplied, LIST lists all files X in the archive. X! X3 Qualifiers X! X/ARCHIVE X X Specifies the archive TAR is to search for files. The default is X 'TAR_ARCHIVE', which might be a logical name pointing to a tape-drive X (see Examples). X X/FULL X X If the /FULL qualifier is specified on a LIST operation, a more detailed X listing of the archive contents is returned; specifically, the X protection, owner id-number, group id-number, size and name of the file. X X/OUTPUT X X The /OUTPUT qualifier is used to direct messages from TAR to a file, it X works like the /OUTPUT qualifier on other VMS commands. X! X2 WRITE XThis function writes files to an archive, copying the modification Xdate/time and the read and write permission bits (the execute permission Xis present in most places where the read permission is under VMS, and is Xtherefore almost meaningless). The user and group id's are set to 0 X(root). As each file is written, its size in bytes (under UNIX) is Xlogged. X! X3 Qualifiers X! X/ARCHIVE X X Specifies the archive to which files are to be WRITten. The default is X 'TAR_ARCHIVE', which might be a logical name pointing to a tape-drive X (see Examples). X X/CONFIRM X X If the /CONFIRM qualifier is given on the WRITE keyword, the user is X prompted each time TAR is about to write a file to the archive. The X user may then confirm or abort the archiving of the file. X X/MAP_MODE X /MAP_MODE=PREFIX (Default) X X The MAP_MODE keyword tells TAR how to map VMS file specifications to X UNIX pathnames when writing files to an archive. The available modes X and their behaviours follows: X X PREFIX File names in the archive are relative, any directories X in the pathname of a file that are common to all files X to be written (a common prefix) are removed. X X ABSOLUTE The VMS device, directory, name and type fields are X mapped to an absolute UNIX pathname (one beginning with X '/'). A file called 'DISK:`091USER.SUB`093FOO.BAR' would be X mapped to '/disk/user/sub/foo.bar'. X X ROOT The (logical or physical) device specification is omitted X from the UNIX pathname, but the directory, name and type X are used to form a relative pathname. The file X 'DISK:`091USER.SUB`093FOO.BAR' would be mapped to X 'user/sub/foo.bar'. X X/OUTPUT X X The /OUTPUT qualifier is used to direct messages from TAR to a file, it X works like the /OUTPUT qualifier on other VMS commands. X X/SCAN X X Instructs TAR not to use a temporary archive file for the purpose of X writing a file with variable-length records to an archive. See TAR X Caveats. $ CALL UNPACK TAR.HLP;1 1041467832 $ create/nolog 'f' X! MMS script for TAR, Tim Cook, 20-JUN-1989 X X.OBJ.EXE : X`009$(LINK) $(LINKFLAGS) $(MMS$SOURCE_LIST) X XLINKFLAGS = $(LINKFLAGS)/NOTRACE X XTAR_OBJECTS = tar.obj, tar_write.obj, tar_extract.obj, tar_list.obj, tarmsg. Vobj X XMISC_OBJECTS = vcdefs.obj, libfilatt.obj, libiferr.obj, libitmlst.obj, - X libparse.obj X XENVIRONMENTS = SYS$LIBRARY:STARLET.PEN, tar.pen, vcdefs.pen X XSTARLET_MLB = SYS$LIBRARY:STARLET.MLB X Xtar.exe :`009$(TAR_OBJECTS), $(MISC_OBJECTS) X Xvcdefs.obj, vcdefs.pen : vcdefs.pas, SYS$LIBRARY:STARLET.PEN X`009$(PASCAL) $(PFLAGS) $(MMS$SOURCE) X Xtar.obj, tar.pen : tar.pas, SYS$LIBRARY:STARLET.PEN, vcdefs.pen X`009$(PASCAL) $(PFLAGS) $(MMS$SOURCE) X Xtar_write.obj :`009tar_write.pas, $(ENVIRONMENTS) X Xtar_extract.obj : tar_extract.pas, $(ENVIRONMENTS) X Xtar_list.obj :`009tar_list.pas, $(ENVIRONMENTS) X Xtarmsg.obj :`009tarmsg.msg X Xlifilatt.obj :`009libfilatt.mar, $(STARLET_MLB) X Xlibiferr.obj :`009libiferr.mar, $(STARLET_MLB) X Xlibitmlst.obj :`009libitmlst.mar, $(STARLET_MLB) X Xlibparse.obj :`009libparse.mar, $(STARLET_MLB) $ CALL UNPACK TAR.MMS;1 1242157743 $ create/nolog 'f' X`123 TAR.PAS -`009Manipulates Unix 'tar' format archive files. X! X! Abstract:`009A proggie to work with Unix 'tar' (Tape ARchive) files on X!`009`009VMS. Reads and writes files to/from a file 'TAR_ARCHIVE' X!`009`009(if not specified differently on command line), so if the tape X!`009`009drive is MOUNTed/FOREIGN/RECORD=512/BLOCK=10240 (tar default), X!`009`009and pointed to by a logical 'TAR_ARCHIVE', tar will read from X!`009`009the tape-drive. X! X! Copyright:`009Copyright 1989 Victoria College Computer Services. See X!`009`009AAAREADME.1ST for distribution rights. X!___________________________________________________________________________ V_ X! Author:`009Tim Cook (timcc@viccol.edu.au) X! Release:`009Version 1.0, released in comp.os.vms in June 1989 X!___________________________________________________________________________ V_`125 X X`091INHERIT ('STARLET_PEN', 'VCDEFS'), +-+-+-+-+-+-+-+- END OF PART 3 +-+-+-+-+-+-+-+- Relay-Version: version nyu B notes v1.6 5/10/89; site acf4.NYU.EDU From: timcc@csv.viccol.edu.au (Tim Cook) Date: 30 Jun 89 22:52 EDT Date-Received: 30 Jun 89 12:52 EDT Subject: VMS TAR part 4 of 10 Message-ID: <546@csv.viccol.edu.au> Path: acf4!cmcl2!husc6!cs.utexas.edu!uunet!murtoa.cs.mu.oz.au!csv!timcc Newsgroups: comp.os.vms Organization: Computer Services, Victoria College, Melbourne Lines: 439 Sorry about my well thought out schedule being broken. We had the disk NEWS_DEVICE is on replaced the day I started posting VMS_TAR. I thought the first parts would get out in time, but they missed the boat. In deference to those who don't like their mail-box to be flooded, the schedule is postponed by 24 hours. Although, if info-vax propagation is as bad as I imagine it might be, most of you are probably looking at this on Monday or Tuesday, and have received all of VMS_TAR over the weekend. Oh well, here's to the death of info-vax (and the long life of comp.os.vms). -+-+-+-+-+-+-+-+ START OF PART 4 -+-+-+-+-+-+-+-+ X ENVIRONMENT ('TAR')`093 X XPROGRAM tar (input, output, archive, archive_temp) ; X X X CONST X record_size = 512 ; X tar_record_size = record_size ; X VMS_block_size = 512 ; X tar_multi_block_count = 32 ;`009`123 Maximum 127 `125 X space = ' ' ; X null = chr (0) ; X lf = chr (10) ; X crlf = chr (10) + chr (13) ; X colon = ':' ; X dot = '.' ; X dollar = '$' ; X underscore = '_' ; X X output_kt = 'OUTPUT' ; X filespec_kt = 'FILESPEC' ; X archive_kt = 'ARCHIVE' ; X tar_archive_kt = 'TAR_ARCHIVE' ; X confirm_kt = 'CONFIRM' ; X scan_kt = 'SCAN' ; X X VAR X X `123 VMS Error status codes for TAR `125 X X `123 Success `125 X tar__created, X tar__createdir, X tar__written, X tar__appended, X tar__totcreat, X tar__totwrite, X tar__totappend, X X `123 Informational `125 X tar__empty, X tar__hardlink, X tar__softlink, X X `123 Warning `125 X tar__nofiles, X tar__wrapped, X tar__rectoolong, X X `123 Error `125 X tar__openin, X tar__close, X tar__createrr, X tar__errcredir, X X `123 Fatal `125 X tar__badheader, X tar__badarchive, X tar__errread, X tar__internerr X : `091EXTERNAL,VALUE`093 sts_type ; X X TYPE X fab_rfm_type = `091BYTE`093 (undefined, fixed_length, variable_length, X variable_fixed_control, stream, stream_lf, stream_cr) ; X X oat_8 = RECORD `123 Octal Ascii, Terminated by space and null V `125 X value : PACKED ARRAY `0911..6`093 OF char ; X fill_space : char ; X fill_null : char END ; X tar_record_type = PACKED RECORD CASE integer OF X0:( name : PACKED ARRAY `0911..100`093 OF char ; X mode, uid, gid : oat_8 ; X siz, mtime : PACKED ARRAY `0911..12`093 OF char ; X chksum : oat_8 ; X linkflag : char ; X linkname : PACKED ARRAY `0911..100`093 OF char ; X filler : PACKED ARRAY `0911..175`093 OF char) ; X1:( data : PACKED ARRAY `0911..tar_record_size`093 OF char) END ; X X file_mode_type = RECORD CASE integer OF X0:( value : unsigned) ; X1:( mask : PACKED ARRAY `0910..31`093 OF `091BIT`093 boolean) END ; X X tar_record_ptr = `094tar_record_type ; X tar_file_type = FILE OF tar_record_type ; X tar_block_type = ARRAY `0911..20`093 OF tar_record_type ; X broken_time_type = lib_numtim_type ; X class_protection_type = PACKED RECORD X noread, nowrite, noexecute, nodelete : `091BIT`093 boolean END ; X file_protection_type = PACKED RECORD X system, owner, group, world : class_protection_type END ; X fixed_string_100 = PACKED ARRAY `0911..100`093 OF char ; X small_string = VARYING `09150`093 OF char ; X medium_string = VARYING `091255`093 OF char ; X large_string = VARYING `0914100`093 OF char ; X map_mode_type = (prefix_mode, absolute_mode, root_mode, single_dir_mod Ve) ; X X VAR X archive : tar_file_type ; X archive_temp : tar_file_type ; X output_filespec : medium_string ; X i, j : integer ; `123 miscellaneous counters `12 V5 X last_char : integer ; `123 points to last char buffer Ved `125 X eof_mark_found : boolean ; `123 by write_temp `125 X archive_temp_open : boolean ; X option : small_string ; X opening_archive_input : `091VOLATILE`093 boolean ; X creating_archive_output : `091VOLATILE`093 boolean ; X validating : `091VOLATILE`093 boolean ; X full_archive_spec : `091VOLATILE`093 medium_string ; X X default_header : tar_record_type ; X X UNIX_epoch_time : lib_date_type ; X delta_seconds : integer ; `123 Delta time from GMT `125 X X VALUE X default_header := (0, X (100 OF null), `123 name `125 X (' 644', space, null), `123 mode `125 X (' 0', space, null), `123 uid `125 X (' 0', space, null), `123 gid `125 X ' 0 ', `123 siz `125 X ' 4241462038 ', `123 mtime - 10-MAY-1988 12:00 EST `125 X (' 0', null, space), `123 chksum - nul/spc back to front, I k Vnow `125 X X null, `123 linkflag `125 X (100 OF null), `123 linkname `125 X (175 OF null)) ; `123 filler `125 X X UNIX_epoch_time := (0, %x4BEB4000, %x007C9567) ; X `123 which equals 1-JAN-1970 00:00:00.00 `125 X validating := false ; X opening_archive_input := false ; X archive_temp_open := false ; X X X `091ASYNCHRONOUS`093 FUNCTION tar_handler ( `123 TAR condition handle Vr `125 X VAR sigargs : lib_sigargs_type ; X VAR mechargs: lib_mechargs_type) : sts_type ; X X VAR X i, j : integer ; X condition : STS$TYPE ; X X PROCEDURE bad_archive ; X VAR X descriptor : `091STATIC`093 PACKED RECORD X maxlen : lib_word_type ; X dtype, class : lib_byte_type ; X pointer : integer END ; X X BEGIN X sigargs.param_count := 4 ; X sigargs.condition := tar__badarchive ; X sigargs.parameter`0911`093 := 1 ; X descriptor.maxlen := length (full_archive_spec) ; X descriptor.class := DSC$K_CLASS_VS ; X descriptor.dtype := DSC$K_DTYPE_VT ; X descriptor.pointer := iaddress (full_archive_spec) ; X sigargs.parameter`0912`093 := iaddress (descriptor) END ; X X BEGIN `123 tar_handler `125 X tar_handler := SS$_RESIGNAL ; X CASE sigargs.condition OF X PAS$_ERRDUROPE, PAS$_FILNOTFOU, PAS$_ERRDURREW : BEGIN X IF opening_archive_input THEN X sigargs.condition := tar__openin X ELSE IF creating_archive_output THEN X sigargs.condition := tar__createrr X ELSE X LIB$STOP (tar__internerr, 1, sigargs.condition) ; X sigargs.parameter`0911`093 := 1 ; X j := int (sigargs.param_count) - 3 ; X FOR i := 2 TO j DO X sigargs.parameter`091i`093 := sigargs.parameter`091i+2`093 V ; X sigargs.param_count := sigargs.param_count - 2 END ; X PAS$_ACCMETINC, `123 Access method inconsistent `125 X PAS$_RECLENINC, `123 Record length inconsistent `125 X PAS$_RECTYPINC : `123 Record type inconsistent `125 X IF opening_archive_input THEN X bad_archive ; X PAS$_ERRDURGET : `123 Error during GET `125 X sigargs.condition := tar__errread ; X PAS$_INVSYNOCT : `123 Invalid syntax in octal value - Someth Ving X might have blown up while reading a heade Vr `125 X IF validating THEN X bad_archive ; X X OTHERWISE BEGIN X condition := (sigargs.condition)::STS$TYPE ; X IF (condition.STS$V_FAC_NO = PAS$_FACILITY) THEN BEGIN X X `123 Report condition encountered as "internal error" `125 X X LIB$STOP (tar__internerr, 1, sigargs.condition) ; X END END ; X END ; X END ; `123 tar_handler `125 X X X FUNCTION lowercase ( X inp_string : VARYING `091n1`093 OF char ; X start_pos : integer := 1) : medium_string ; X X VAR X i : integer ; X result : medium_string ; X X BEGIN X result := inp_string ; X FOR i := start_pos TO n1 DO X IF inp_string`091i`093 IN `091'A'..'Z'`093 THEN X result`091i`093 := chr (ord (inp_string`091i`093) + 32) ; X lowercase := result ; X END ; X X X FUNCTION uppercase ( `123 Wrote my own cos it looks neater with "lower Vcase" `125 X inp_string : VARYING `091n1`093 OF char) : medium_string ; X X VAR X result : medium_string ; X i : integer ; X X BEGIN X result := inp_string ; X FOR i := 1 TO n1 DO X IF inp_string`091i`093 IN `091'a'..'z'`093 THEN X result`091i`093 := chr (ord (inp_string`091i`093) - 32) ; X uppercase := result ; X END ; X X X PROCEDURE convert_zstr ( `123 Convert a null-terminated string to VAR VYING `125 X z_string : fixed_string_100 ; X VAR vs_string : VARYING `091n1`093 OF char) ; X X BEGIN X vs_string := substr (z_string, 1, index (z_string, null) - 1) ; X END ; X X X FUNCTION checksum ( `123 Calculate the checksum of a TAR header recor Vd `125 X check_record : tar_record_type) X : integer ; X X VAR X result, i : integer ; X X BEGIN X result := 0 ; X FOR i := 1 TO tar_record_size DO X result := result + ord (check_record.data`091i`093) ; X checksum := result END ; X X X FUNCTION february_days (year : integer) : integer ; X BEGIN X IF year REM 4 = 0 THEN X IF year REM 100 = 0 THEN X IF year REM 400 = 0 THEN X february_days := 29 X ELSE X february_days := 28 X ELSE X february_days := 29 X ELSE X february_days := 28 END ; X X X FUNCTION get_timezone : integer ; X VAR X return, hours, minutes, i : integer ; X timezone_str : small_string ; X X BEGIN X return := 1 ; X IF failure ($TRNLNM (, 'LNM$FILE_DEV', 'TAR_TIMEZONE',, X lib_item_list (lib_out_item (LNM$_STRING, %DESCR timezone_str))) V) X THEN X IF failure ($TRNLNM (, 'LNM$FILE_DEV', 'SYS$TIME_ZONE',, X lib_item_list (lib_out_item (LNM$_STRING, X %DESCR timezone_str)))) THEN X return := 0 ; X IF return <> 0 THEN BEGIN X readv (timezone_str, i) ; X hours := i DIV 100 ; X minutes := i - hours * 100 ; X IF (abs (hours) > 18) OR (abs (minutes) > 59) THEN X return := 0`032 X ELSE X return := minutes * 60 + hours * 3600 END ; X get_timezone := return ; X END ; X `032 X X FUNCTION add_timezone (`009`123 converts from GMT to local time `125 X VAR UNIX_time : unsigned) : boolean ; X X BEGIN X add_timezone := true ; X X IF delta_seconds < 0 THEN X IF (-1 * delta_seconds) > UNIX_time THEN BEGIN X UNIX_time := 0 ; X add_timezone := false END`009`123 indicates over/underflow `1 V25 X ELSE X UNIX_time := UNIX_time + delta_seconds X ELSE X IF uint (lib_k_maxlong) - delta_seconds > UNIX_time THEN X UNIX_time := UNIX_time + delta_seconds X ELSE BEGIN X UNIX_time := lib_k_maxlong ; X add_timezone := false END END ; X X X FUNCTION subtract_timezone (`009`009`123 converts from local time to GMT V `125 X VAR UNIX_time : unsigned) : boolean ; X X BEGIN X IF delta_seconds > 0 THEN X IF delta_seconds < UNIX_time THEN X UNIX_time := UNIX_time - delta_seconds X ELSE BEGIN X UNIX_time := 0 ; X subtract_timezone := false END X ELSE X IF (uint (lib_k_maxlong) - (-1 * delta_seconds)) > UNIX_time THE VN X UNIX_time := UNIX_time - delta_seconds X ELSE BEGIN X UNIX_time := lib_k_maxlong ; X subtract_timezone := false END END ; X X X PROCEDURE break_up_UNIX_time ( X UNIX_time : unsigned ; X VAR time : broken_time_type) ; X X CONST X mar =`00931 ; X apr =`00930 + mar ; X may =`00931 + apr ; X jun =`00930 + may ; X jul =`00931 + jun ; X aug =`00931 + jul ; X sep =`00930 + aug ; X oct =`00931 + sep ; X nov =`00930 + oct ; X dec =`00931 + nov ; X jan =`00931 + dec ; X X seconds_per_day =`00986400 ; X seconds_per_hour =`0093600 ; X seconds_per_minute =`00960 ; X weekday_epoch =`0094 ; X days_to_eoy =`009`009306 ;`009`123 Days from 1/3 to 1/1 next year ` V125 X X VAR X UNIX_time_l : unsigned ; X days, m_day, temp : unsigned ; X X BEGIN`009`123 break_up_UNIX_time `125 X UNIX_time_l := UNIX_time ; X X days := int (UNIX_time_l DIV seconds_per_day) ; X X UNIX_time_l := UNIX_time_l - days * seconds_per_day ; X time.hour := int (UNIX_time_l DIV seconds_per_hour) ; X X UNIX_time_l := UNIX_time_l - time.hour * seconds_per_hour ; X time.minute := int (UNIX_time_l DIV seconds_per_minute) ; X X time.second := int (UNIX_time_l - time.minute * seconds_per_minute) V ; X X days := days + 2133 ;`009`009`123 Now relative to 1/3/1964 `125 X X `123 Find remainder of days / 365.25 `125 X temp := days * 4 DIV 1461 ; X m_day := days - temp * 1461 DIV 4 ; X X `123 m_day now contains the day of the year, relative to 1st March `12 V5 X X time.year := -6 ;`009`009`123 Year will then be relative to 1970 `1 V25 X X IF m_day = 0 THEN BEGIN`009`123 It's actually the 29th of Feb! `125 X time.month := 2 ; X time.day := 29 END X ELSE`009`009`009`009`123 Right, figure out month and day `125 X IF m_day > aug THEN X IF m_day > nov THEN X IF m_day > dec THEN BEGIN X IF m_day > jan THEN BEGIN`009`009`123 February `125 X time.month := 2 ; X time.day := int (m_day - jan) END X ELSE BEGIN`009`009`009`009`123 January `125 X time.month := 1 ; X time.day := int (m_day - dec) END ; X time.year := -5 END X ELSE BEGIN X time.month := 12 ; X time.day := int (m_day - nov) END X ELSE X IF m_day > sep THEN +-+-+-+-+-+-+-+- END OF PART 4 +-+-+-+-+-+-+-+- Relay-Version: version nyu B notes v1.6 5/10/89; site acf4.NYU.EDU From: timcc@csv.viccol.edu.au (Tim Cook) Date: 30 Jun 89 22:54 EDT Date-Received: 30 Jun 89 12:52 EDT Subject: VMS TAR part 5 of 10 Message-ID: <547@csv.viccol.edu.au> Path: acf4!cmcl2!rutgers!sun-barr!ames!hc!lll-winken!uunet!murtoa.cs.mu.oz.au!csv!timcc Newsgroups: comp.os.vms Organization: Computer Services, Victoria College, Melbourne Lines: 391 -+-+-+-+-+-+-+-+ START OF PART 5 -+-+-+-+-+-+-+-+ X IF m_day > oct THEN BEGIN`009`009`123 November `125 X time.month := 11 ; X time.day := int (m_day - oct) END X ELSE BEGIN`009`009`009`009`123 October `125 X time.month := 10 ; X time.day := int (m_day - sep) END X ELSE BEGIN`009`009`009`009`123 September `125 X time.month := 9 ; X time.day := int (m_day - aug) END X ELSE X IF m_day > may THEN X IF m_day > jun THEN X IF m_day > jul THEN BEGIN`009`009`123 August `125 X time.month := 8 ; X time.day := int (m_day - jul) END X ELSE BEGIN`009`009`009`009`123 July `125 X time.month := 7 ; X time.day := int (m_day - jun) END X ELSE BEGIN`009`009`009`009`123 June `125 X time.month := 6 ; X time.day := int (m_day - may) END X ELSE X IF m_day > mar THEN X IF m_day > apr THEN BEGIN`009`009`123 May `125 X time.month := 5 ; X time.day := int (m_day - apr) END X ELSE BEGIN`009`009`009`009`123 April `125 X time.month := 4 ; X time.day := int (m_day - mar) END X ELSE BEGIN`009`009`009`009`123 March `125 X time.month := 3 ; X time.day := int (m_day) END ; X X `123 Last of all, what year is it? `125 X X time.year := int (time.year + days * 4 DIV 1461) ; X END ; X X X FUNCTION UNIX_time_to_str ( X UNIX_time : unsigned ; X delta_seconds : integer := 0) : medium_string ; X X VAR X time : broken_time_type ; X UNIX_time_local : unsigned ; X months : `091STATIC`093 ARRAY `0911..12`093 OF PACKED ARRAY `0911.. V3`093 OF char := X ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', X 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec') ; X return_string : VARYING `09117`093 OF char ; X X BEGIN X add_timezone (UNIX_time) ; X UNIX_time_local := UNIX_time ; X break_up_UNIX_time (UNIX_time_local, time) ; X lib_sigiferr (LIB$SYS_FAO ('!2SL !AS !SL !2ZL:!2ZL',, return_string V, X time.day, %STDESCR (months`091time.month`093), time.year + 1970, X time.hour, time.minute)) ; X UNIX_time_to_str := return_string ; X END ; X X X FUNCTION VMS_to_UNIX_time ( X VMS_time : lib_date_type ; X delta_seconds : integer := 0) : unsigned ; X X VAR X VMS_rel_UNIX_epoch : lib_date_type ; `123 delta VMS time relativ Ve `125 X return_value : unsigned ; `123 to 1-JAN-1970 0:0:0.0 V `125 X X BEGIN X VMS_to_UNIX_time := 0 ; X IF success (LIB$SUB_TIMES (VMS_time, UNIX_epoch_time, X VMS_rel_UNIX_epoch)) THEN X IF success (LIB$CVT_FROM_INTERNAL_TIME (LIB$K_DELTA_SECONDS, X return_value, VMS_rel_UNIX_epoch)) THEN BEGIN X subtract_timezone (return_value) ; X VMS_to_UNIX_time := return_value END ; X END ; X X X`123++ X! FUNCTION VMS_to_UNIX_time ( / Calculate seconds from Jan 1 1970, 00:00 G VMT / X! VMS_time : lib_date_type ; X! delta_seconds : integer := 0) : unsigned ; X! X! VAR X! num_time : lib_numtim_type ; X! time_temp : integer ; X! days : integer ; X! feb_days : integer ; X! temp_result : unsigned ; X! X! BEGIN X! lib_sigiferr ($NUMTIM (num_time, VMS_time)) ; X! X! feb_days := february_days (num_time.year) ; X! X! CASE num_time.month OF X! 1 : days := num_time.day ; X! 2 : days := num_time.day + 31 ; X! 3 : days := num_time.day + feb_days + 31 ; X! 4 : days := num_time.day + feb_days + 62 ; X! 5 : days := num_time.day + feb_days + 92 ; X! 6 : days := num_time.day + feb_days + 123 ; X! 7 : days := num_time.day + feb_days + 153 ; X! 8 : days := num_time.day + feb_days + 184 ; X! 9 : days := num_time.day + feb_days + 215 ; X! 10 : days := num_time.day + feb_days + 245 ; X! 11 : days := num_time.day + feb_days + 276 ; X! 12 : days := num_time.day + feb_days + 307 ; X! END ; X! IF num_time.year < 1970 THEN X! temp_result := 0 X! ELSE BEGIN X! temp_result := uint (num_time.second + num_time.minute * 60 + X! num_time.hour * 3600 + days * 3600 * 24 + delta_seconds) ; X! num_time.year := num_time.year - 1970 ; X! temp_result := temp_result + X! uround (num_time.year * 3600 * 24 * 365.25) ; X! / Correct to GMT / X! IF temp_result - delta_seconds < 0 THEN X! VMS_to_UNIX_time := 0 X! ELSE X! VMS_to_UNIX_time := temp_result - delta_seconds END ; X! END ; X!-- X`125 X X X FUNCTION parse ( X filespec : VARYING `091n1`093 OF char ; X default_spec : VARYING `091n2`093 OF char := '' ; X field : integer := 0) : medium_string ; X X VAR X return_string : medium_string ; X X BEGIN X IF field = 0 THEN X lib_sigiferr (lib_parse (%STDESCR (filespec), return_string, X %STDESCR (default_spec))) X ELSE X lib_sigiferr (lib_parse (%STDESCR (filespec), return_string, X %STDESCR (default_spec),,, field)) ; X parse := return_string ; X END ; X X X PROCEDURE get_prompted_string ( X prompt : VARYING `091n1`093 OF char ; X VAR string : VARYING `091n2`093 OF char ; X default : VARYING `091n3`093 OF char := '') ; X X VAR X status : sts_type ; X X BEGIN X status := LIB$GET_INPUT (string, prompt) ; X IF status = RMS$_EOF THEN $EXIT X ELSE lib_sigiferr (status) ; X IF string = '' THEN string := default END ; X X X FUNCTION confirm_operation ( X op_to_confirm : VARYING `091n1`093 OF char ; X conf_filespec : VARYING `091n2`093 OF char ; X confirmed : boolean := false) : boolean ; X X VAR X decision : small_string ; X X BEGIN X IF confirmed THEN confirm_operation := true X ELSE BEGIN X get_prompted_string (lowercase (op_to_confirm, 2) + space + X conf_filespec + '? (Y/N) `091Y`093: ', decision, 'Y') ; X confirm_operation := decision`0911`093 IN `091'Y', 'y', ' '`093 V ; X END ; X END ; X X X FUNCTION VMS_filespec ( X UNIX_filespec : VARYING `091n1`093 OF char ; X VAR absolute : boolean) : medium_string ; X X VAR X UNIX_dir : small_string ; X temp_ch : char ; X i, j : integer ; X device, directory, name : medium_string ; X dot_found, device_name, start_name, more : boolean ; X X BEGIN X absolute := false ; X i := n1 ; X IF i = 0 THEN BEGIN X name := '' ; X unix_dir := '' END X ELSE BEGIN X more := true ; X WHILE more DO X IF i > 0 THEN X IF UNIX_filespec`091i`093 <> '/' THEN X i := i - 1 X ELSE X more := false X ELSE X more := false ; X name := substr (UNIX_filespec, i + 1, n1 - i) ; X IF i > 1 THEN X UNIX_dir := substr (UNIX_filespec, 1, i - 1) X ELSE X UNIX_dir := '' ; X j := length (name) ; X dot_found := false ; X FOR i := j DOWNTO 1 DO X CASE name`091i`093 OF X '.' : X IF dot_found THEN X name`091i`093 := '-' X ELSE X dot_found := true ; X 'a'..'z' : X name`091i`093 := chr (ord (name`091i`093) - 32) ; X 'A'..'Z', '0'..'9', '$', '_', '-' : ; X ',', '+', '`126', '#', '*' : name`091i`093 := '_' ; X OTHERWISE name`091i`093 := '$' ; X END END ; X device := '' ; X directory := '' ; X IF length (UNIX_dir) > 0 THEN BEGIN X IF substr (UNIX_dir, 1, 2) = './' THEN X UNIX_dir := substr (UNIX_dir, 3, length (UNIX_dir) - 2) ; X j := length (UNIX_dir) ; X start_name := true ; X device_name := false ; X i := 0 ; X WHILE i < j DO BEGIN X i := i + 1 ; X CASE UNIX_dir`091i`093 OF X '/' : X IF device_name THEN BEGIN X start_name := true ; X device_name := false END X ELSE IF i = 1 THEN BEGIN X absolute := true ; X device_name := true END X ELSE BEGIN X start_name := true ; X directory := directory + '.' END ; X 'A'..'Z', '0'..'9', '$', '_' : BEGIN X IF device_name THEN X device := device + UNIX_dir`091i`093 X ELSE X directory := directory + UNIX_dir`091i`093 ; X start_name := false END ; X 'a'..'z' : BEGIN X IF device_name THEN X device := device + chr (ord (UNIX_dir`091i`093) - 32 V) X ELSE X directory := directory + chr (ord (UNIX_dir`091i`093 V) - 32) ; X start_name := false END ; X '-' : BEGIN X IF start_name OR device_name THEN X temp_ch := '_' X ELSE X temp_ch := '-' ; X IF device_name THEN X device := device + temp_ch X ELSE X directory := directory + temp_ch END ; X '.' : X IF device_name THEN X device := device + '_' X ELSE X IF (j > i) AND (UNIX_dir`091i+1`093 = '.') THEN BEGI VN X directory := directory + '-' ; X i := i + 1 END X ELSE X directory := directory + '_' ; X OTHERWISE BEGIN X IF device_name THEN X device := device + '$' X ELSE X directory := directory + '$' ; X start_name := false END ; X END ; `123 CASE `125 X END ; `123 WHILE `125 X END ; `123 IF `125 X IF device = '' THEN X IF directory = '' THEN X VMS_filespec := '`091`093' + name X ELSE X VMS_filespec := '`091.' + directory + '`093' + name X ELSE X VMS_filespec := device + ':`091' + directory + '`093' + name X END ; X X X FUNCTION UNIX_filespec ( X VMS_filespec : VARYING `091n1`093 OF char ; `123 ALL fields expected V `125 X map_mode : map_mode_type ; X prefix_length : integer := 0 ; X retain_version : boolean := false) : medium_string ; X X VAR X device, name, type_, version : small_string ; X d, n, t, v, e, i : integer ; X directory, temp_result : medium_string ; X X BEGIN X e := length (VMS_filespec) ; X v := e ; X WHILE VMS_filespec`091v`093 <> ';' DO X v := v - 1 ; X t := v ; X WHILE VMS_filespec`091t`093 <> '.' DO X t := t - 1 ; X n := t ; X WHILE VMS_filespec`091n`093 <> '`093' DO X n := n - 1 ; X d := 1 ; X WHILE VMS_filespec`091d`093 <> ':' DO X d := d + 1 ; X device := substr (VMS_filespec, 1, d - 1) ; X directory := substr (VMS_filespec, d + 2, n - d - 2) ; X X `123 Take out a leading 000000 directory if present (irrelevant) `125 X X IF directory.length > 8 THEN X IF substr (directory, 1, 8) = '000000.' THEN X directory := substr (directory, 8, length (directory) - 7) X ELSE X ELSE X IF directory = '000000' THEN X directory := '' ; X X name := substr (VMS_filespec, n + 1, t - n - 1) ; X type_ := substr (VMS_filespec, t, v - t) ; X version := substr (VMS_filespec, v, e - v + 1) ; X X temp_result := '' ; X IF map_mode IN `091absolute_mode, prefix_mode`093 THEN X temp_result := '/' + device + '/' ; X IF map_mode <> single_dir_mode THEN BEGIN X d := length (directory) ; X IF d > 0 THEN BEGIN X FOR i := 1 TO d DO X IF directory`091i`093 = '.' THEN X directory`091i`093 := '/' ; X temp_result := temp_result + directory + '/' END END ; X temp_result := temp_result + name + type_ ; X IF retain_version THEN X temp_result := temp_result + version ; X IF map_mode = prefix_mode THEN X temp_result := substr (temp_result, prefix_length + 1, X length (temp_result) - prefix_length) ; X UNIX_filespec := lowercase (temp_result) ; X END ; X X X FUNCTION find_file_spec ( X VAR file_buf : `091UNSAFE`093 text) : medium_string ; X X `123 This routine returns the full file specification of the file opened V with X the passed file-variable. This routine does assume that a NAM block ha Vs X been used by Pascal (which is usually the case), and that the file is X open. `125 X X VAR X fab : fab_pointer ; X nam : nam_pointer ; X nam_rsa : nam_rsa_type ; X X BEGIN X fab := PAS$FAB (file_buf) ; +-+-+-+-+-+-+-+- END OF PART 5 +-+-+-+-+-+-+-+- Relay-Version: version nyu B notes v1.6 5/10/89; site acf4.NYU.EDU From: timcc@csv.viccol.edu.au (Tim Cook) Date: 30 Jun 89 22:56 EDT Date-Received: 30 Jun 89 12:52 EDT Subject: VMS TAR part 6 of 10 Message-ID: <548@csv.viccol.edu.au> Path: acf4!cmcl2!rutgers!sun-barr!ames!hc!lll-winken!uunet!murtoa.cs.mu.oz.au!csv!timcc Newsgroups: comp.os.vms Organization: Computer Services, Victoria College, Melbourne Lines: 406 -+-+-+-+-+-+-+-+ START OF PART 6 -+-+-+-+-+-+-+-+ X nam := (fab`094.FAB$L_NAM)::nam_pointer ; X nam_rsa := (nam`094.NAM$L_RSA)::nam_rsa_type ; X find_file_spec := substr (nam_rsa`094, 1, nam`094.NAM$B_RSL) ; X END ; X X X PROCEDURE open_archive_input (`009`123 Opens an archive file for input `1 V25 X filespec : VARYING `091n1`093 OF char ; X share : boolean := false) ; X X VAR X status : sts_type ; X X BEGIN X opening_archive_input := true ; X IF share THEN X open (archive, filespec, history := OLD, sharing := READONLY) X ELSE X open (archive, filespec, history := OLD) ; X reset (archive) ; X opening_archive_input := false ; X END ; X X X FUNCTION eof_archive : boolean ; X BEGIN eof_archive := eof (archive) OR eof_mark_found END ; X X X PROCEDURE bad_header (header : tar_record_type) ; X X BEGIN X close (archive) ; X open (archive, 'SYS$SCRATCH:HEADER.TAR', history := NEW) ; X rewrite (archive) ; X write (archive, header) ; X close (archive) ; X LIB$STOP (tar__badheader) ; X END ; X X X FUNCTION valid_header ( `123 Computes and checks the header checksum `1 V25 X header_record : tar_record_type ; X VAR file_spec : VARYING `091n1`093 OF char ; X VAR file_size : integer ; X VAR file_mtime : unsigned ; X VAR file_mode : file_mode_type ; X VAR directory : boolean) : boolean ; X X VAR X tar_filespec : medium_string ; X header_tmp : tar_record_type ; X header_checksum : integer ; X i : integer ; X response : char ; X X BEGIN X validating := true ; X valid_header := true ; X header_tmp := header_record ; X IF header_record.chksum.value`0911`093 = null THEN BEGIN X `123 This may be end of archive `125 X valid_header := false ; X IF checksum (header_tmp) = 0 THEN `123 You betcha! `125 X eof_mark_found := true END X ELSE BEGIN X X `123 According to TAR(5), chksum is stored as a decimal ascii string, V but X in practice I have found it octal. `125 X X readv (header_record.chksum.value, header_checksum:oct) ; X X `123 In order to calculate the checksum without infinite recursion, X header_tmp.chksum is set to a known value (as UNIX tar sets it).`12 V5 X X header_tmp.chksum.value := ' ' ; X header_tmp.chksum.fill_null := space ; X header_tmp.chksum.fill_space := space ; X IF checksum (header_tmp) <> header_checksum THEN X bad_header (header_record) ; X convert_zstr (header_record.name, file_spec) ; X readv (header_record.siz, file_size:oct) ; X readv (header_record.mtime, file_mtime:oct) ; X readv (header_record.mode.value, file_mode.value:oct) ; X directory := false ; X IF file_mode.mask`09110`093 THEN X IF file_size = 0 THEN X directory := true X ELSE X bad_header (header_record) ; X END ; X validating := false ; X END ; X X X FUNCTION scan_to_next_header ( X file_size : integer := -1) : boolean ; X X VAR X skip_count, i : integer ; X more_to_scan : boolean ; X X BEGIN X scan_to_next_header := true ; X X `123 Assume archive`094 contains header prior to next header `125 X X IF file_size = -1 THEN X readv (archive`094.siz, file_size:oct) ; X IF file_size = 0 THEN skip_count := 0 X ELSE X skip_count := ((file_size - 1) DIV tar_record_size) + 1 ; X i := 0 ; X more_to_scan := true ; X WHILE more_to_scan DO X IF i = skip_count THEN more_to_scan := false X ELSE X IF eof (archive) THEN BEGIN X more_to_scan := false ; X scan_to_next_header := false END X ELSE BEGIN X get (archive) ; X i := i + 1 END ; X END ; X X X FUNCTION selected ( X candidate_spec : VARYING `091n2`093 OF char ; X selection_spec : VARYING `091n1`093 OF char := '*') : boolean ; X X BEGIN X selected := X STR$MATCH_WILD (candidate_spec, selection_spec) = STR$_MATCH END V ; X X X `091EXTERNAL`093 PROCEDURE tar_list ( X list_filespec : VARYING `091n1`093 OF char ; X archive_filespec : VARYING `091n2`093 OF char ; X full : boolean) ; external ; X X `091EXTERNAL`093 PROCEDURE tar_extract ( X extract_filespec : VARYING `091n1`093 OF char ; X archive_filespec : VARYING `091n2`093 OF char ; X confirm : boolean) ; external ; X X `091EXTERNAL`093 PROCEDURE tar_write ( X write_filespec : VARYING `091n1`093 OF char ; X archive_filespec : VARYING `091n2`093 OF char := '' ; X confirm : boolean ; X scan : boolean ; X map_mode : map_mode_type ; X appending : boolean := false) ; external ; X X `091EXTERNAL`093 PROCEDURE tar_append ( X append_filespec : VARYING `091n1`093 OF char ; X archive_filespec : VARYING `091n2`093 OF char ; X confirm : boolean ; X scan : boolean ; X map_mode : map_mode_type) ; external ; X X X FUNCTION get_map_mode : map_mode_type ; X VAR X mode_str : small_string ; X BEGIN X lib_sigiferr (CLI$GET_VALUE ('MAP_MODE', mode_str)) ; X CASE mode_str`0911`093 OF X 'P' : get_map_mode := prefix_mode ; X 'A' : get_map_mode := absolute_mode ; X 'R' : get_map_mode := root_mode END END ; X X X FUNCTION get_cli_value ( X value_name : VARYING `091n1`093 OF char ; X value_default : VARYING `091n2`093 OF char := '*') : medium_string ; X X VAR X return_value : medium_string ; X X BEGIN X IF cli_present (value_name) THEN BEGIN X lib_sigiferr (CLI$GET_VALUE (%DESCR value_name, return_value)) ; X get_cli_value := return_value END X ELSE X get_cli_value := value_default ; X END ; X X X BEGIN `123 tar `125 X establish (tar_handler) ; X delta_seconds := get_timezone ;`009`009`123 Read logical TAR_TIMEZONE V `125 X IF cli_present (output_kt) THEN BEGIN X lib_sigiferr (CLI$GET_VALUE (output_kt, output_filespec)) ; X open (output, output_filespec) ; X rewrite (output) END ; X lib_sigiferr (CLI$GET_VALUE ('OPTION', option)) ; X CASE option`0911`093 OF `123 must be an ordinal type `125 X 'E' : BEGIN X tar_extract (get_cli_value (filespec_kt), get_cli_value (archive V_kt, X tar_archive_kt), cli_present (confirm_kt)) END ; X 'W' : BEGIN X tar_write (get_cli_value (filespec_kt), X get_cli_value (archive_kt, tar_archive_kt), X cli_present (confirm_kt), cli_present (scan_kt), X get_map_mode) END ; X 'A' : BEGIN X tar_append (get_cli_value (filespec_kt), X get_cli_value (archive_kt, tar_archive_kt), X cli_present (confirm_kt), cli_present (scan_kt), X get_map_mode) END ; X 'L' : BEGIN X tar_list (get_cli_value (filespec_kt), get_cli_value (archive_kt V, X tar_archive_kt), cli_present ('FULL')) END ; X END ; X END. $ CALL UNPACK TAR.PAS;1 1245881296 $ create/nolog 'f' X! The 105 in the following .FACILITY directive can be changed, but the X! /PREFIX must be TAR__. X X.FACILITY`009TAR, 105 /PREFIX=TAR__ X X.BASE 256 X.SEVERITY`009SUCCESS`009`009! 256 messages in this group XCREATED`009`009 /FAO=2 XCREATEDIR`009 /FAO=1 XWRITTEN`009`009 /FAO=2 XAPPENDED`009 /FAO=2 XTOTCREAT`009 /FAO=2 XTOTWRITE`009 /FAO=1 XTOTAPPEND`009 /FAO=1 X X.BASE 512 X.SEVERITY`009INFORMATIONAL`009! 256 messages in this group XEMPTY`009`009 /FAO=1 XHARDLINK`009 /FAO=1 XSOFTLINK`009 /FAO=1 X X.BASE 768 X.SEVERITY`009WARNING`009`009! 256 messages in this group XNOFILES`009`009 /FAO=1 XWRAPPED`009`009 - X`009`009 /FAO=1 XRECTOOLONG`009 /FAO=1 X X.BASE 1024 X.SEVERITY`009ERROR`009`009! 256 messages in this group XERRCREDIR`009 /FAO=1 X X.BASE 1280 X.SEVERITY`009FATAL XBADHEADER`009 XBADARCHIVE`009 /FAO=1 XOPENIN`009`009 /FAO=1 XCLOSE`009`009 /FAO=1 XCREATERR`009 /FAO=1 XERRREAD`009`009 /FAO=3`009! coz PAS$_ERRDURGET has 3 V args XINTERNERR`009 /FAO=1 $ CALL UNPACK TARMSG.MSG;1 2001878250 $ create/nolog 'f' X`091INHERIT ('STARLET_PEN', 'VCDEFS', 'TAR')`093 X XMODULE extract ; X X CONST X out_buffer_size = 8192 ; X X TYPE X UNIX_protection_type = `091LONG`093 PACKED RECORD X others, group, owner : PACKED RECORD X execute, write, read : `091BIT`093 boolean END END ; X out_buffer_type = PACKED ARRAY `0911..out_buffer_size`093 OF char ; X X VAR X out_fab : FAB$TYPE ; X out_nam : NAM$TYPE ; X out_xabrdt : XAB$TYPE ; X out_xabpro : XAB$TYPE ; X out_rab : RAB$TYPE ; X default_protection : lib_word_type ; `123 from SYS$SETDFPROT `125 X output_buffer : out_buffer_type ; X output_result_spec : PACKED ARRAY `0911..NAM$C_MAXRSS`093 OF char ; X X VALUE X out_fab := zero ; X out_nam := zero ; X out_xabrdt := zero ; X out_xabpro := zero ; X out_rab := zero ; X X X PROCEDURE open_output_file ( X file_name : VARYING `091n1`093 OF char ; X file_size : integer) ; X X VAR X parsed_spec : medium_string ; X status, secondary_status : sts_type ; X X BEGIN X out_fab.FAB$B_BID := FAB$C_BID ; X out_fab.FAB$B_BLN := FAB$C_BLN ; X out_fab.FAB$B_RFM := FAB$C_VAR ; `123 Varying-length records `125 X out_fab.FAB$V_CR := true ;`009`123 Carriage-return RAT `125 X out_fab.FAB$V_PUT := true ;`009`123 PUT access `125 X out_fab.FAB$V_TEF := true ;`009`123 Truncate on $CLOSE `125 X out_fab.FAB$L_FNA := iaddress (file_name.body) ; X out_fab.FAB$B_FNS := (file_name.length)::lib_byte_type ; X IF file_size > 0 THEN X out_fab.FAB$L_ALQ := (file_size - 1) DIV VMS_block_size + 1 ; X X out_fab.FAB$L_NAM := iaddress (out_nam) ; X out_nam.NAM$B_BID := NAM$C_BID ; X out_nam.NAM$B_BLN := NAM$C_BLN ; X out_nam.NAM$L_RSA := iaddress (output_result_spec) ; X out_nam.NAM$B_RSS := NAM$C_MAXRSS ; X X status := $CREATE (out_fab) ; X X IF success (status) THEN BEGIN X out_rab.RAB$B_BID := RAB$C_BID ; X out_rab.RAB$B_BLN := RAB$C_BLN ; X out_rab.RAB$B_MBC := tar_multi_block_count ; X `123 Multi-block count; specifies how many blocks of a sequen Vtial X file are transferred per disk access `125 X out_rab.RAB$L_FAB := iaddress (out_fab) ; X X status := $CONNECT (out_rab) ; X X IF success (status) THEN BEGIN X out_rab.RAB$B_RAC := RAB$C_SEQ ; X out_rab.RAB$L_RBF := iaddress (output_buffer) END X ELSE X secondary_status := (out_rab.RAB$L_STV)::sts_type END X X ELSE X secondary_status := (out_fab.FAB$L_STV)::sts_type ; X X IF failure (status) THEN BEGIN X parsed_spec := parse (file_name) ; X lib_sigiferr (tar__createrr, 1, %STDESCR (parsed_spec), status, X secondary_status) END ; X X END ; X X X PROCEDURE close_output_file ( X no_records : integer ; X file_mtime : unsigned ; X file_mode : `091UNSAFE`093 UNIX_protection_type) ; X X VAR X created_filespec : medium_string ; X VMS_protection : file_protection_type ; X time_vec : lib_numtim_type ; X X BEGIN X created_filespec := X substr (output_result_spec, 1, out_nam.NAM$B_RSL) ; X X out_fab.FAB$L_XAB := iaddress (out_xabrdt) ; X X out_xabrdt.XAB$B_COD := XAB$C_RDT ; X out_xabrdt.XAB$B_BLN := XAB$C_RDTLEN ; X out_xabrdt.XAB$L_NXT := iaddress (out_xabpro) ; X X `123 Here is where the modification date is converted/copied `125 X add_timezone (file_mtime) ; X break_up_UNIX_time (file_mtime, time_vec) ; X time_vec.year := time_vec.year + 1970 ; X time_vec.hundredth := 0 ; X lib_sigiferr (LIB$CVT_VECTIM (time_vec, out_xabrdt.XAB$Q_RDT)) ; X X out_xabpro.XAB$B_COD := XAB$C_PRO ; X out_xabpro.XAB$B_BLN := XAB$C_PROLEN ; X lib_sigiferr (LIB$GETJPI (JPI$_UIC,,, out_xabpro.XAB$L_UIC)) ; X VMS_protection := (default_protection)::file_protection_type ; X X `123 Here is where the file protection is copied `125 X VMS_protection.world.noread := NOT file_mode.others.read ; X VMS_protection.world.noexecute := NOT file_mode.others.read ; X VMS_protection.world.nowrite := NOT file_mode.others.write ; X X VMS_protection.group.noread := NOT file_mode.group.read ; X VMS_protection.group.noexecute := NOT file_mode.group.read ; X VMS_protection.group.nowrite := NOT file_mode.group.write ; X X VMS_protection.owner.noread := NOT file_mode.owner.read ; X VMS_protection.owner.noexecute := NOT file_mode.owner.read ; X VMS_protection.owner.nowrite := NOT file_mode.owner.write ; X VMS_protection.owner.nodelete := NOT file_mode.owner.write ; X X out_xabpro.XAB$W_PRO := (VMS_protection)::lib_word_type ; X +-+-+-+-+-+-+-+- END OF PART 6 +-+-+-+-+-+-+-+- Relay-Version: version nyu B notes v1.6 5/10/89; site acf4.NYU.EDU From: timcc@csv.viccol.edu.au (Tim Cook) Date: 1 Jul 89 23:30 EDT Date-Received: 1 Jul 89 17:46 EDT Subject: VMS TAR part 7 of 10 Message-ID: <553@csv.viccol.edu.au> Path: acf4!cmcl2!rutgers!cs.utexas.edu!uunet!murtoa.cs.mu.oz.au!csv!timcc Newsgroups: comp.os.vms Organization: Computer Services, Victoria College, Melbourne Lines: 381 -+-+-+-+-+-+-+-+ START OF PART 7 -+-+-+-+-+-+-+-+ X IF failure ($CLOSE (out_fab)) THEN X LIB$STOP (tar__close, 1, %STDESCR (created_filespec), X out_fab.FAB$L_STS, out_fab.FAB$L_STV) X ELSE X LIB$SIGNAL (tar__created, 2, %STDESCR (created_filespec), X no_records) ; X END ; X X X `091GLOBAL`093 PROCEDURE tar_extract ( X extract_filespec : VARYING `091n1`093 OF char ; X archive_filespec : VARYING `091n2`093 OF char ; X confirm : boolean) ; X X VAR X header : boolean ; `123 true if current tar_record is V one `125 X no_records : integer ; `123 no of tar records for curr fi Vle `125 X file_spec : medium_string ; X file_size : integer ; X file_mtime : unsigned ; X file_mode : file_mode_type ; X bytes_written : integer ; `123 bytes written to curr out_fil Ve `125 X files_created, files_scanned : integer ; X tar_filespec, upcase_spec : medium_string ; X more, verbose : boolean ; X selection : boolean ; X warned_of_wrap : boolean ; X absolute : boolean ; X directory : boolean ; X protection : unsigned ; `123 UNIX style protection `125 X X X PROCEDURE extract_file ( X header_record : tar_record_type ; X file_spec : VARYING `091n1`093 OF char ; X file_size : integer ; X file_mtime : unsigned ; X file_mode : file_mode_type) ; X X VAR X more : boolean ; X VMS_spec : medium_string ; X absolute : boolean ; X X X PROCEDURE write_block ( X block : tar_record_type ; X VAR bytes_written : integer ; X VAR no_records : integer) ; X X VAR X i : integer ; X out_pointer : `091STATIC`093 integer := 0 ; X more : boolean ; X X BEGIN X i := 0 ; X more := true ; X WHILE more DO BEGIN X i := i + 1 ; X IF i > record_size THEN more := false X ELSE BEGIN X bytes_written := bytes_written + 1 ; X IF bytes_written = file_size THEN BEGIN `123 eof `12 V5 X more := false ; X IF block.data`091i`093 <> lf THEN BEGIN X out_pointer := out_pointer + 1 ; X output_buffer`091out_pointer`093 := block.data`09 V1i`093 END ; X out_rab.RAB$W_RSZ := (out_pointer)::lib_word_type ; X out_pointer := 0 ; X lib_sigiferr ($PUT (out_rab)) ; X no_records := no_records + 1 END X ELSE IF block.data`091i`093 = lf THEN BEGIN `123 V eoln `125 X out_rab.RAB$W_RSZ := (out_pointer)::lib_word_type V ; X out_pointer := 0 ; X lib_sigiferr ($PUT (out_rab)) ; X no_records := no_records + 1 END X ELSE IF out_pointer < out_buffer_size THEN BEGIN X out_pointer := out_pointer + 1 ; X output_buffer`091out_pointer`093 := block.data V`091i`093 END X ELSE BEGIN `123 wrap output records V `125 X out_rab.RAB$W_RSZ := X (out_pointer)::lib_word_type ; X lib_sigiferr ($PUT (out_rab)) ; X out_pointer := 1 ; X no_records := no_records + 1 ; X output_buffer`091out_pointer`093 := block.data V`091i`093 ; X IF NOT warned_of_wrap THEN BEGIN X LIB$SIGNAL (tar__wrapped, 2, X %STDESCR (VMS_spec), out_buffer_size) ; X warned_of_wrap := true END ; X END ; X END ; X END ; `123 WHILE more `125 X END ; `123 write_block `125 X X X BEGIN `123 extract_file `125 X IF file_size = 0 THEN BEGIN X CASE archive`094.linkflag OF X '1' : X LIB$SIGNAL (tar__hardlink, 1, X %STDESCR (file_spec)) ; X '2' : X LIB$SIGNAL (tar__softlink, 1, X %STDESCR (file_spec)) ; X OTHERWISE BEGIN X open_output_file (VMS_filespec (file_spec, absolute), X file_size) ; X no_records := 0 END ; X END END X ELSE BEGIN`009`009`123 this is done after each header `125 X VMS_spec := VMS_filespec (file_spec, absolute) ; X no_records := 0 ; X bytes_written := 0 ; X open_output_file (VMS_spec, file_size) ; X more := true ; X WHILE more DO BEGIN X get (archive) ; X write_block (archive`094, bytes_written, no_records) ; X IF bytes_written = file_size THEN X more := false END END ; X close_output_file (no_records, file_mtime, file_mode) END ; X X X PROCEDURE make_directory ( X file_spec : medium_string ; X file_mode : file_mode_type) ; X X VAR X temp_spec : medium_string ; X absolute : boolean ; X status : sts_type ; X X BEGIN X temp_spec := VMS_filespec (file_spec + 'place.holder', absolute) V ; X temp_spec := parse (temp_spec, '`091`093') ; X temp_spec := substr (temp_spec, 1, index (temp_spec, '`093')) ; X create_directory (temp_spec, status) ; X IF failure (status) THEN X LIB$STOP (tar__errcredir, 1, %STDESCR (temp_spec), status) X ELSE X LIB$SIGNAL (tar__createdir, 1, %STDESCR (temp_spec)) END ; X X X BEGIN `123 extract `125 X open_archive_input (archive_filespec) ; X full_archive_spec := find_file_spec (archive) ; X selection := extract_filespec <> '*' ; X lib_sigiferr (SYS$SETDFPROT (, default_protection)) ; X files_created := 0 ; X files_scanned := 0 ; X header := true ; X more := true ; X WHILE more DO BEGIN X warned_of_wrap := false ; X IF valid_header (archive`094, file_spec, file_size, file_mtime, X file_mode, directory) THEN BEGIN X files_scanned := files_scanned + 1 ; X IF selected (file_spec, extract_filespec) THEN X IF confirm_operation (option, file_spec, X (NOT confirm) OR directory) THEN BEGIN X IF directory THEN X make_directory (file_spec, file_mode) X ELSE X extract_file (archive`094, file_spec, file_size, X file_mtime, file_mode) ; X files_created := files_created + 1 END X ELSE X scan_to_next_header (file_size) X ELSE X scan_to_next_header (file_size) ; X IF eof (archive) THEN X more := false X ELSE X get (archive) ; X END X ELSE`009`123 NOT valid_header `125 X IF eof_archive THEN X more := false X ELSE X bad_header (archive`094) END ; `123 stops execution `125 X LIB$SIGNAL (tar__totcreat, 2, files_created, files_scanned) ; X close (archive) ; X END ; `123 extract `125 X X X END. $ CALL UNPACK TAR_EXTRACT.PAS;1 1582675662 $ create/nolog 'f' X`091INHERIT ('STARLET_PEN', 'VCDEFS', 'TAR')`093 X XMODULE list ; X X X PROCEDURE find_device_structure ( X device_name : VARYING `091n1`093 OF char ; X VAR dir : `091UNSAFE`093 integer ; `123 Device is directory-s Vtructured `125 X VAR sdi : `091UNSAFE`093 integer) ; `123 Device is single-dir V structured `125 X X BEGIN X lib_sigiferr ($GETDVIW (,, device_name, lib_item_list ( X lib_out_item (DVI$_DIR, %DESCR dir), X lib_out_item (DVI$_SDI, %DESCR sdi)))) END ; X X X `091GLOBAL`093 PROCEDURE tar_list ( X list_filespec : VARYING `091n1`093 OF char ; X archive_filespec : VARYING `091n2`093 OF char ; X full : boolean) ; X X TYPE X fixed_string = PACKED ARRAY `0911..255`093 OF char ; X X fixed_string_ptr = RECORD CASE integer OF X0:( address : unsigned) ; X1:( pointer : `094fixed_string) END ; X X VAR X file_spec : medium_string ; X file_size : integer ; X file_mtime : unsigned ; X file_mode : file_mode_type ; X directory : boolean ; X X files_listed, files_in_archive : integer ; X directory_structured : integer ; X single_directory_structured : integer ; X more_in_archive : boolean ; X X PROCEDURE list_file_if ( `123 list file if it matches list_filespec V `125 X VAR header_record : tar_record_type ; X full : boolean ; X file_spec : VARYING `091n1`093 OF char ; X file_size : integer ; X file_mtime : unsigned ; X file_mode : file_mode_type ; X directory : boolean := false) ; X X VAR X prot_list : PACKED ARRAY `0911..10`093 OF char ; X out_line : medium_string ; X uid_int, gid_int : integer ; X X BEGIN X IF success (STR$MATCH_WILD (file_spec, list_filespec)) X THEN WITH header_record DO BEGIN X IF full THEN BEGIN X prot_list := '-rwxrwxrwx' ; X readv (uid.value, uid_int:oct) ; X readv (gid.value, gid_int:oct) ; X FOR i := 0 TO 8 DO X IF NOT file_mode.mask`091i`093 THEN prot_list`09110-i`0 V93 := '-' ; X`009`009 IF file_mode.mask`09110`093 THEN X prot_list`0911`093 := 'd' `123 Directory `125 X ELSE IF header_record.linkflag IN `091'1', '2'`093 THEN X prot_list`0911`093 := 'l' ; `123 Link `125 X out_line := '' ; X lib_sigiferr (LIB$SYS_FAO ('!AS !4UL/!3UL!10UL !AS !AS', V, X out_line, %STDESCR (prot_list), uid_int, gid_int, X file_size, X %STDESCR (UNIX_time_to_str (file_mtime, delta_seconds)) V, X %STDESCR (file_spec))) ; X writeln (out_line) END X ELSE X writeln (file_size:10, space, file_spec) ; X files_listed := files_listed + 1 END ; X END ; X X BEGIN `123 tar_list `125 X full_archive_spec := parse (archive_filespec, '.DAT') ; X find_device_structure (full_archive_spec, directory_structured, X single_directory_structured) ; X open_archive_input (archive_filespec, X share := NOT (single_directory_structured)::boolean) ; X full_archive_spec := find_file_spec (archive) ; X files_listed := 0 ; X files_in_archive := 0 ; X more_in_archive := valid_header (archive`094, file_spec, file_size, X file_mtime, file_mode, directory) ; X X IF NOT (directory_structured)::boolean THEN X full_archive_spec := substr (full_archive_spec, 1, X index (full_archive_spec, colon)) ; X X IF NOT more_in_archive THEN X LIB$STOP (tar__badarchive, 1, %STDESCR (full_archive_spec)) ; X writeln (crlf, 'Listing of archive ', full_archive_spec, crlf) ; X WHILE more_in_archive DO BEGIN X files_in_archive := files_in_archive + 1 ; X list_file_if (archive`094, full, file_spec, file_size, file_mtim Ve, X file_mode, directory) ; X scan_to_next_header (file_size) ; X IF eof (archive) THEN X more_in_archive := false X ELSE BEGIN X get (archive) ; `123 we're actually just before next header V `125 X more_in_archive := valid_header (archive`094, file_spec, file V_size, X file_mtime, file_mode, directory) END END ; X IF files_listed > 0 THEN writeln ; X writeln ('Total of ', files_listed:1, ' files listed, ', X files_in_archive:1, ' files in archive.') ; X close (archive) ; X END ; X X X END. $ CALL UNPACK TAR_LIST.PAS;1 877794165 $ create/nolog 'f' X`091INHERIT ('STARLET_PEN', 'VCDEFS', 'TAR')`093 X XMODULE write ; X X CONST X in_buffer_size = 8192 ; X X TYPE X in_buffer_type = PACKED ARRAY `0911..in_buffer_size`093 OF char ; X filespec_list_type = ARRAY `0911..100`093 OF medium_string ; X filespec_block_type = RECORD X file_list : filespec_list_type ; X next_block : `094filespec_block_type END ; X X VAR X in_fab : FAB$TYPE ; X in_xabdat, in_xabfhc, in_xabpro : XAB$TYPE ; X in_rab : RAB$TYPE ; X X in_buffer : in_buffer_type ; X X file_spec, default_spec, result_spec : VARYING `091NAM$C_MAXRSS`093 OF V char ; X record_format : lib_byte_type ; X max_record_size, first_free_byte : lib_word_type ; X eof_block : unsigned ; X X block_pointer : `094filespec_block_type ; X start_block : `094filespec_block_type ; X file_index : integer ; X retrieval_index : integer ; X X X VALUE X in_fab := zero ; X in_xabdat := zero ; X in_xabfhc := zero ; X in_xabpro := zero ; X in_rab := zero ; X file_index := 0 ; X X X PROCEDURE add_file_to_list (filespec : VARYING `091n1`093 OF char) ; X BEGIN X IF file_index = 100 THEN BEGIN X new (block_pointer`094.next_block) ; X block_pointer := block_pointer`094.next_block END X ELSE IF file_index = 0 THEN BEGIN X new (block_pointer) ; X start_block := block_pointer END ; +-+-+-+-+-+-+-+- END OF PART 7 +-+-+-+-+-+-+-+- Relay-Version: version nyu B notes v1.6 5/10/89; site acf4.NYU.EDU From: timcc@csv.viccol.edu.au (Tim Cook) Date: 1 Jul 89 23:31 EDT Date-Received: 1 Jul 89 17:46 EDT Subject: VMS TAR part 8 of 10 Message-ID: <554@csv.viccol.edu.au> Path: acf4!cmcl2!rutgers!cs.utexas.edu!uunet!murtoa.cs.mu.oz.au!csv!timcc Newsgroups: comp.os.vms Organization: Computer Services, Victoria College, Melbourne Lines: 373 -+-+-+-+-+-+-+-+ START OF PART 8 -+-+-+-+-+-+-+-+ X file_index := file_index + 1 ; X block_pointer`094.file_list`091file_index`093 := filespec ; X IF file_index = 100 THEN file_index := 0 END ; X X X FUNCTION get_file_from_list : medium_string ; X VAR X end_of_list : boolean ; X return_value : medium_string ; X temp_pointer : `094filespec_block_type ; X X BEGIN X end_of_list := false ; X IF file_index = 0 THEN X block_pointer := start_block X ELSE X IF file_index = 100 THEN X IF block_pointer`094.next_block <> nil THEN BEGIN X file_index := 0 ; X temp_pointer := block_pointer ; X block_pointer := block_pointer`094.next_block ; X dispose (temp_pointer) END X ELSE X end_of_list := true ; X IF end_of_list THEN X return_value := '' X ELSE BEGIN X file_index := file_index + 1 ; X return_value := block_pointer`094.file_list`091file_index`093 EN VD ; X IF return_value = '' THEN X dispose (block_pointer) ; X get_file_from_list := return_value END ; X X X PROCEDURE collect_filespecs ( X selection_spec : VARYING `091n1`093 OF char ; X VAR prefix : VARYING `091n2`093 OF char) ; X X VAR X selection : medium_string ; X i, j : integer ; X first_time, more, done : boolean ; X context : lib_fab_pointer ; X status : sts_type ; X X BEGIN X first_time := true ; X more := true ; X context := nil ; X WHILE more DO BEGIN X status := LIB$FIND_FILE (selection_spec, selection, X context, %DESCR '.DAT') ; X IF success (status) THEN BEGIN X add_file_to_list (selection) ; X selection := UNIX_filespec (selection, absolute_mode) ; X IF first_time THEN BEGIN X `123 Find a first prefix, but ensure the base file name is'nt part of V it `125 X i := length (selection) ; X done := false ; X WHILE NOT done DO BEGIN X IF i = 0 THEN X done := true X ELSE IF selection`091i`093 = '/' THEN X done := true X ELSE X i := i - 1 END ; X prefix := substr (selection, 1, i) ; X first_time := false END X ELSE BEGIN `123 find a common prefix to the filenames `125 X j := min (length (selection), length (prefix)) ; X i := 1 ; X done := false ; X WHILE NOT done DO BEGIN X IF (i > j) THEN X done := true X ELSE IF (selection`091i`093 <> prefix`091i`093) THEN X done := true X ELSE X i := i + 1 END ; X prefix.length := i - 1 END END X ELSE X IF status = RMS$_FNF THEN X LIB$STOP (tar__nofiles, 1, %STDESCR (selection)) X ELSE X more := false END ; X add_file_to_list ('') ; X file_index := 0 ; X X `123 Back up enough to ensure that the prefix ends with a '/' `125 X X i := length (prefix) ; X done := false ; X WHILE NOT done DO BEGIN X IF i = 0 THEN X done := true X ELSE IF prefix`091i`093 = '/' THEN X done := true X ELSE X i := i - 1 END ; X prefix.length := i ; X LIB$FIND_FILE_END (context) END ; X X X FUNCTION open_input_file ( X VAR file_spec : VARYING `091n1`093 OF char ; X VAR record_format : `091UNSAFE`093 lib_byte_type ; X VAR record_size : `091UNSAFE`093 lib_word_type ; X VAR eof_block : `091UNSAFE`093 unsigned ; X VAR first_free_byte : `091UNSAFE`093 lib_word_type ; X VAR modification_date : `091UNSAFE`093 lib_date_type ; X VAR protection : `091UNSAFE`093 lib_word_type) : sts_type ; X X VAR X status : sts_type ; X X BEGIN X in_fab.FAB$B_BID := FAB$C_BID ; X in_fab.FAB$B_BLN := FAB$C_BLN ; X in_fab.FAB$V_GET := true ; X in_fab.FAB$V_SHRGET := true ; X in_fab.FAB$L_XAB := iaddress (in_xabdat) ; X in_fab.FAB$L_FNA := iaddress (file_spec.body) ; X in_fab.FAB$B_FNS := (file_spec.length)::lib_byte_type ; X X in_xabdat.XAB$B_COD := XAB$C_DAT ; X in_xabdat.XAB$B_BLN := XAB$C_DATLEN ; X in_xabdat.XAB$L_NXT := iaddress (in_xabfhc) ; X X in_xabfhc.XAB$B_COD := XAB$C_FHC ; X in_xabfhc.XAB$B_BLN := XAB$C_FHCLEN ; X in_xabfhc.XAB$L_NXT := iaddress (in_xabpro) ; X X in_xabpro.XAB$B_COD := XAB$C_PRO ; X in_xabpro.XAB$B_BLN := XAB$C_PROLEN ; X`032 X status := $OPEN (in_fab) ; X X IF success (status) THEN BEGIN X record_format := in_fab.FAB$B_RFM ; X record_size := in_fab.FAB$W_MRS ; X eof_block := in_xabfhc.XAB$L_EBK ; X first_free_byte := in_xabfhc.XAB$W_FFB ; X modification_date := (in_xabdat.XAB$Q_RDT)::lib_date_type ; X protection := in_xabpro.XAB$W_PRO ; X X in_rab.RAB$B_BID := RAB$C_BID ; X in_rab.RAB$B_BLN := RAB$C_BLN ; X in_rab.RAB$B_MBC := tar_multi_block_count ; X `123 Multi-block count; specifies how many blocks of a sequen Vtial X file are read per disk access `125 X in_rab.RAB$L_FAB := iaddress (in_fab) ; X X status := $CONNECT (in_rab) ; X X in_rab.RAB$B_RAC := RAB$C_SEQ ; X in_rab.RAB$L_UBF := iaddress (in_buffer) ; X CASE record_format OF X FAB$C_UDF : `123 undefined, or stream binary `125 X in_rab.RAB$W_USZ := tar_record_size ; X FAB$C_FIX : X IF record_size > in_buffer_size THEN X LIB$STOP (tar__openin, 1, %STDESCR (file_spec), X tar__rectoolong, 1, (record_size)::unsigned) X ELSE X in_rab.RAB$W_USZ := record_size ; X FAB$C_VAR, FAB$C_VFC, FAB$C_STM, FAB$C_STMLF, FAB$C_STMCR : X in_rab.RAB$W_USZ := size (in_buffer) ; X END END ; X X open_input_file := status END ; X X X FUNCTION VMS_to_UNIX_protection (VMS_protection : file_protection_type) X : unsigned ; X VAR X return : unsigned ; X X BEGIN X WITH VMS_protection DO BEGIN X IF NOT owner.noread THEN return := 256 X ELSE return := 0 ; X IF NOT owner.nowrite THEN return := return + 128 ; X`123 IF NOT owner.noexecute THEN return := return + 64 ; `125 X IF NOT group.noread THEN return := return + 32 ; X IF NOT group.nowrite THEN return := return + 16 ; X`123 IF NOT group.noexecute THEN return := return + 8 ; `125 X IF NOT world.noread THEN return := return + 4 ; X IF NOT world.nowrite THEN return := return + 2 ; X`123 IF NOT world.noexecute THEN return := return + 1 ; `125 X END ; X VMS_to_UNIX_protection := return END ; X X X PROCEDURE build_header ( X head_filespec : VARYING `091n1`093 OF char ; X filesiz : integer ; X VAR out_header : tar_record_type ; X map_mode : map_mode_type ; X modification_date : lib_date_type ; X protection : file_protection_type ; X prefix_length : integer := 0) ; X X VAR X i : integer ; X temp_filespec : medium_string ; X temp_string : small_string ; X X BEGIN X out_header := default_header ; X temp_string := oct (VMS_to_UNIX_protection (protection), 6, 3) ; X out_header.mode.value := temp_string ; X temp_string := oct (filesiz, 11, 1) + space ; X out_header.siz := temp_string ; X temp_string := X oct (VMS_to_UNIX_time (modification_date, delta_seconds), 11, 1) V + X space ; X out_header.mtime := temp_string ; X temp_filespec := UNIX_filespec (head_filespec, map_mode, X prefix_length) ; X FOR i := 1 to length (temp_filespec) DO X out_header.name`091i`093 := temp_filespec`091i`093 ; X `123 I had to do that, to prevent Pascal from blank-padding it `125 X out_header.chksum.value := ' ' ; X out_header.chksum.fill_null := space ; X out_header.chksum.fill_space := space ; X writev (temp_string, oct (checksum (out_header), 6, 1)) ; X out_header.chksum.value := temp_string ; X out_header.chksum.fill_space := null ; `123 That's how DYNIX tar do Ves it`125 X END ; X X X PROCEDURE write_archive ( X VAR file_buf : tar_file_type ; X VAR out_record : in_buffer_type ; X VAR record_length : `091UNSAFE`093 lib_word_type ; X add_lf : boolean := true) ; X X VAR X i : lib_word_type ; X X BEGIN X IF add_lf THEN X IF record_length < in_buffer_size THEN BEGIN X record_length := record_length + 1 ; X out_record`091record_length`093 := lf END ; X FOR i := 1 TO record_length DO BEGIN X IF last_char = tar_record_size THEN BEGIN X put (file_buf) ; X last_char := 1 END X ELSE X last_char := last_char + 1 ; X file_buf`094.data`091last_char`093 := out_record`091i`093 END ; X END ; X X X `091GLOBAL`093 PROCEDURE tar_write ( X write_filespec : VARYING `091n1`093 OF char ; X archive_filespec : VARYING `091n2`093 OF char := '' ; X confirm : boolean ; X scan : boolean ; X map_mode : map_mode_type ; X appending : boolean := false) ; X X VAR X not_this_one : boolean ; X tar_record : tar_record_type ; X current_file : medium_string ; X file_size : integer ; X no_records : integer ; X files_written : integer ; X write_message : sts_type ; X X record_format : lib_byte_type ; `123 These all correspond to V the `125 X record_length : lib_word_type ; `123 input file `125 X eof_block : integer ; X first_free_byte : lib_word_type ; X modification_date : lib_date_type ; X protection : file_protection_type ; X X status : sts_type ; X prefix : medium_string ; X X FUNCTION another_file ( X VAR next_file : VARYING `091n1`093 OF char) : boolean ; X X VAR X context : `091STATIC`093 lib_fab_pointer := NIL ; X status : sts_type ; X X BEGIN X IF map_mode = prefix_mode THEN BEGIN X next_file := get_file_from_list ; X another_file := next_file <> '' END X ELSE BEGIN X another_file := true ; X status := LIB$FIND_FILE (write_filespec, next_file, context) V ; X IF status <> RMS$_NORMAL THEN BEGIN X another_file := false ; X IF status <> RMS$_NMF THEN BEGIN X IF status = RMS$_FNF THEN BEGIN X IF archive_temp_open THEN BEGIN X close (archive_temp, disposition := DELETE) ; X archive_temp_open := false END ; X IF appending THEN BEGIN X FOR i := 1 TO record_size DO X archive`094.data`091i`093 := null ; X put (archive) ; put (archive) ; `123 replace eof- Vmarker `125 X close (archive) END X ELSE X close (archive, disposition := DELETE) ; X LIB$STOP (tar__nofiles, 1, %STDESCR (next_file)) END V ; X lib_sigiferr (status) END ; X lib_sigiferr (LIB$FIND_FILE_END (context)) END END ; X END ; X X X PROCEDURE load_direct ; `123 Directly loads a fixed record length V `125 X BEGIN `123 or stream binary file `125 X file_size := (eof_block - 1) * 512 + first_free_byte ; X X `123 The test below is for cases where the first_free_byte value does not X point to the first byte in a logical record (I have seen this in .EXE's V) `125 X X IF record_format = FAB$C_FIX THEN X IF file_size REM record_length > 0 THEN X file_size := (file_size DIV record_length + 1) * X record_length ; X X build_header (current_file, file_size, archive`094, map_mode, X modification_date, protection, length (prefix)) ; X put (archive) ; `123 writes header `125 X status := $GET (in_rab) ; X WHILE success (status) DO BEGIN X write_archive (archive, in_buffer, in_rab.RAB$W_RSZ, false) ; X no_records := no_records + 1 ; X status := $GET (in_rab) END ; X IF status <> RMS$_EOF THEN X lib_sigiferr (tar__errread, 3, 0, 0, %STDESCR (current_file), X status, in_rab.RAB$L_STV) ; X IF file_size > 0 THEN `123 If non-empty file `125 X put (archive) ; `123 like a flush `125 X END ; X X PROCEDURE load_after_scan ; `123 Scans a var-len file for size then V loads `125 X BEGIN X status := $GET (in_rab) ; X WHILE success (status) DO BEGIN X file_size := file_size + in_rab.RAB$W_RSZ + 1 ; X status := $GET (in_rab) END ; X IF status <> RMS$_EOF THEN X lib_sigiferr (tar__errread, 3, 0, 0, %STDESCR (current_file), X status, in_rab.RAB$L_STV) ; X X build_header (current_file, file_size, archive`094, map_mode, X modification_date, protection, length (prefix)) ; X put (archive) ; `123 writes header `125 X X status := $REWIND (in_rab) ; X IF failure (status) THEN +-+-+-+-+-+-+-+- END OF PART 8 +-+-+-+-+-+-+-+- Relay-Version: version nyu B notes v1.6 5/10/89; site acf4.NYU.EDU From: timcc@csv.viccol.edu.au (Tim Cook) Date: 1 Jul 89 23:33 EDT Date-Received: 1 Jul 89 17:46 EDT Subject: VMS TAR part 9 of 10 Message-ID: <555@csv.viccol.edu.au> Path: acf4!cmcl2!rutgers!cs.utexas.edu!uunet!murtoa.cs.mu.oz.au!csv!timcc Newsgroups: comp.os.vms Organization: Computer Services, Victoria College, Melbourne Lines: 368 -+-+-+-+-+-+-+-+ START OF PART 9 -+-+-+-+-+-+-+-+ X lib_sigiferr (tar__errread, 3, 0, 0, %STDESCR (current_file), X status, in_rab.RAB$L_STV) ; X X status := $GET (in_rab) ; X WHILE success (status) DO BEGIN X write_archive (archive, in_buffer, in_rab.RAB$W_RSZ) ; X no_records := no_records + 1 ; X status := $GET (in_rab) END ; X IF status <> RMS$_EOF THEN X lib_sigiferr (tar__errread, 3, 0, 0, %STDESCR (current_file), X status, in_rab.RAB$L_STV) ; X IF file_size > 0 THEN `123 If non-empty file `125 X put (archive) ; X X END ; X X PROCEDURE load_from_temp ; X BEGIN X IF NOT archive_temp_open THEN BEGIN X open (archive_temp, history := NEW) ; X archive_temp_open := true END ; X rewrite (archive_temp) ; X X status := $GET (in_rab) ; X WHILE success (status) DO BEGIN X file_size := file_size + in_rab.RAB$W_RSZ + 1 ; X write_archive (archive_temp, in_buffer, in_rab.RAB$W_RSZ) ; X status := $GET (in_rab) END ; X IF status <> RMS$_EOF THEN X lib_sigiferr (tar__errread, 3, 0, 0, %STDESCR (current_file), X status, in_rab.RAB$L_STV) ; X IF file_size > 0 THEN `123 If non-empty file `125 X put (archive_temp) ; X X reset (archive_temp) ; X build_header (current_file, file_size, archive`094, map_mode, X modification_date, protection, length (prefix)) ; X put (archive) ; `123 writes header `125 X WHILE NOT eof (archive_temp) DO BEGIN X read (archive_temp, tar_record) ; X write (archive, tar_record) END ; X END ; X X BEGIN `123 tar_write `125 X IF NOT appending THEN BEGIN X creating_archive_output := true ; X open (archive, archive_filespec, history := NEW) ; X rewrite (archive) ; X creating_archive_output := false ; X write_message := tar__written END X ELSE BEGIN X truncate (archive) ; X write_message := tar__appended END ; X files_written := 0 ; X prefix := '' ; X IF map_mode = prefix_mode THEN X IF (index (write_filespec, ':`091') = 0) X AND (index (write_filespec, '`093') = 0) THEN X map_mode := single_dir_mode X ELSE X collect_filespecs (write_filespec, prefix) ; X WHILE another_file (current_file) DO X IF confirm_operation (option, current_file, NOT confirm) THEN BE VGIN X open_input_file (current_file, record_format, record_length, X eof_block, first_free_byte, modification_date, protection) V ; X last_char := 0 ; X no_records := 0 ; X file_size := 0 ; X IF record_format IN `091FAB$C_FIX, FAB$C_UDF`093 THEN X load_direct X ELSE X IF scan THEN X load_after_scan X ELSE X load_from_temp ; X files_written := files_written + 1 ; X LIB$SIGNAL (write_message, 2, %STDESCR (current_file), X file_size) ; X `123 file built and written `125 X status := $CLOSE (in_fab) ; X IF failure (status) THEN X lib_sigiferr (tar__close, 1, %STDESCR (current_file), X status, in_fab.FAB$L_STV) ; X END ; `123 IF confirmed `125 X X IF appending THEN X LIB$SIGNAL (tar__totappend, 1, files_written) X ELSE X LIB$SIGNAL (tar__totwrite, 1, files_written) ; X FOR i := 1 TO record_size DO X archive`094.data`091i`093 := null ; X put (archive) ; put (archive) ; `123 emulate tar's personal eof V `125 X IF archive_temp_open THEN BEGIN X close (archive_temp, disposition := DELETE) ; X archive_temp_open := false END ; X close (archive) ; X END ; `123 tar_write `125 X X X `091GLOBAL`093 PROCEDURE tar_append ( X append_filespec : VARYING `091n1`093 OF char ; X archive_filespec : VARYING `091n2`093 OF char ; X confirm : boolean ; X scan : boolean ; X map_mode : map_mode_type) ; X X VAR X archive_size : integer ; X record_format : fab_rfm_type ; X max_record_size : lib_word_type ; X end_position : integer ; X X BEGIN X open_archive_input (archive_filespec) ; X full_archive_spec := parse (archive_filespec, '.DAT') ; X lib_sigiferr (lib_file_attributes (, archive, lib_item_list ( X lib_out_item (rms__ebk, %DESCR archive_size), X lib_out_item (rms__rfm, %DESCR record_format), X lib_out_item (rms__mrs, %DESCR max_record_size)))) ; X IF (record_format <> fixed_length) OR (max_record_size <> record_si Vze) X OR (archive_size < 3) THEN X LIB$STOP (tar__badarchive) ; X FOR i := 1 TO archive_size - 3 DO X get (archive) ; X IF checksum (archive`094) <> 0 THEN X LIB$STOP (tar__badarchive) ; X tar_write (append_filespec,, confirm, scan, map_mode, X appending := true) ; X END ; `123 tar_append `125 X X X END. $ CALL UNPACK TAR_WRITE.PAS;1 1162463673 $ create/nolog 'f' X`123 X! VCDEFS.PAS -`009VCLIB definitions needed by TAR X! X! This file contains all definitions needed by TAR when packaged for X! external distribution. When TAR is built locally, these definitions X! come from SRC_VCLIB:VCLIB.PEN, but for the distribution package, I X! have extracted the needed definitions from the appropriate files in X! SRC_VCLIB: Any routines defined in here but not coded in here will X! be in appropriately named MACRO source files. X! X! This file can be used to build an evironment and object file to be used X! when building TAR, or it can be %INCLUDEd by TAR.PAS, or it can be X! /INSERTed into a help library. X! X! Tim Cook, 24-FEB-1989 X!-------------------------------------------------------------- X!`125 `091INHERIT ('SYS$LIBRARY:STARLET'), ENVIRONMENT ('VCDEFS')`093 `123 X!`125 MODULE vclib ; `123 X! X! From SRC_VCLIB:LIBDEF.PAS X! X1 LIBDEFPAS X2 CONST X!`125 CONST X lib_k_maxbyte = %xFF ; X lib_k_maxword = %xFFFF ; X lib_k_maxlong = %xFFFFFFFF ;`123 X2 TYPE X!`125 TYPE X sts_type = integer ; X lib_lo_hi = (low, high) ; X lib_byte_type = `091BYTE`093 0..lib_k_maxbyte ; X lib_word_type = `091WORD`093 0..lib_k_maxword ; X lib_signed_word_type = `091WORD`093 -%x8000..%x7FFF ; X lib_long_type = `091LONG`093 unsigned ; X lib_3byte_type = `091BYTE(3)`093 0..%xFFFFFF ; X lib_quad_type = `091QUAD`093 ARRAY `091low..high`093 OF unsigned ; X lib_signed_quad_type = `091QUAD`093 RECORD CASE integer OF X0:( lo : unsigned ; X hi : integer) ; X1:( value : `091QUAD`093 PACKED SET OF 0..63) END ; X lib_date_type = lib_signed_quad_type ; X prv_type = `091QUAD`093 PACKED SET OF 0..63 ; X lib_long_set_type = `091LONG`093 SET OF 0..31 ; X lib_sigargs_type = RECORD X param_count : unsigned ; X condition : sts_type ; X parameter : ARRAY `0911..20`093 OF unsigned END ; X lib_mechargs_type = RECORD X param_count : unsigned ; X stack_frame_address : unsigned ; X stack_frame_depth : unsigned ; X r0, r1 : unsigned END ; X lib_fab_pointer = `094FAB$TYPE ; X lib_numtim_type = RECORD X year, month, day, X hour, minute, second, hundredth : lib_word_type ; END ; X lib_item_type = RECORD X buffer_length : lib_word_type ; X item_code : lib_word_type ; X buffer_address : lib_long_type ; X retlength_adress : lib_long_type END ; X lib_extended_item_type = RECORD X item : lib_item_type ; X buffer : PACKED ARRAY `0911..80`093 OF char END ; X lib_item_list_type = ARRAY `0911..85`093 OF lib_item_type ; X X fab_pointer = `094FAB$TYPE ; X rab_pointer = `094RAB$TYPE ; X nam_pointer = `094NAM$TYPE ; X nam_rs_type = PACKED ARRAY `0911..NAM$C_MAXRSS`093 OF char ; X nam_rsa_type = `094nam_rs_type ; X xab_pointer = `094XAB$TYPE ;`123 X2 DEC_Routines X!`125 X `091ASYNCHRONOUS,EXTERNAL`093 FUNCTION lib$cvt_from_internal_time ( X %REF operation : unsigned ; X VAR resultant_time : unsigned ; X %REF input_time : `091UNSAFE`093 lib_date_type := %IMMED 0) X : sts_type ; external ; X X `091ASYNCHRONOUS,EXTERNAL`093 FUNCTION lib$cvt_vectim ( X %REF input_time : `091UNSAFE`093 lib_numtim_type ; X VAR resultant_time : `091UNSAFE`093 lib_date_type) : sts_type ; extern Val ; X X `091ASYNCHRONOUS,EXTERNAL`093 FUNCTION lib$find_file ( X %DESCR file_spec : VARYING `091n1`093 OF char ; X %DESCR result_spec : VARYING `091n2`093 OF char ; X %REF context : lib_fab_pointer := %REF 0 ; X %DESCR default_spec : VARYING `091n4`093 OF char := %IMMED 0 ; X %DESCR related_spec : VARYING `091n5`093 OF char := %IMMED 0 ; X %REF stv_addr : sts_type := %IMMED 0 ; X %REF user_flags : lib_long_set_type := `091`093) : sts_type ; external V ; X X `091ASYNCHRONOUS,EXTERNAL`093 FUNCTION lib$find_file_end ( X %REF context : lib_fab_pointer := %REF 0) : sts_type ; external ; X X `091ASYNCHRONOUS,EXTERNAL`093 FUNCTION lib$get_input ( X %DESCR get_str : VARYING `091n1`093 OF char ; X %DESCR prompt : VARYING `091n2`093 OF char := %IMMED 0 ; X VAR out_len : lib_word_type := %IMMED 0) : sts_type ; external ; X X `091ASYNCHRONOUS,EXTERNAL`093 FUNCTION lib$getjpi ( X %REF item_code : lib_word_type ; X VAR process_id : unsigned := %IMMED 0 ; X %DESCR process_name : VARYING `091n`093 OF char := %IMMED 0 ; X VAR resultant_value : `091UNSAFE`093 unsigned := %IMMED 0 ; X %DESCR resultant_string : VARYING `091n2`093 OF char := %IMMED 0 ; X VAR resultant_length : lib_word_type := %IMMED 0) : sts_type ; externa Vl ; X X `091ASYNCHRONOUS,EXTERNAL`093 FUNCTION lib$sub_times ( X %REF time_1, time_2 : `091UNSAFE`093 lib_date_type ; X VAR resultant_time : `091UNSAFE`093 lib_date_type) : sts_type ; extern Val ; X X `091ASYNCHRONOUS,EXTERNAL`093 FUNCTION lib$sys_fao ( X ctr_str : `091CLASS_S`093 PACKED ARRAY `091l1..u1:integer`093 OF char V ; X %REF out_len : lib_word_type := %IMMED 0 ; X %DESCR out_buf : VARYING `091n3`093 OF char ; X %IMMED p : `091LIST`093 unsigned) : sts_type ; external ; X X `091ASYNCHRONOUS,EXTERNAL`093 PROCEDURE lib$signal ( X %IMMED condition : `091UNSAFE`093 sts_type ; X %IMMED parameters : `091UNSAFE,LIST`093 unsigned) ; external ; X X `091ASYNCHRONOUS,EXTERNAL`093 PROCEDURE lib$stop ( X %IMMED condition : `091UNSAFE`093 sts_type ; X %IMMED parameters : `091UNSAFE,LIST`093 unsigned) ; external ;`123 X! X! From nowhere in particular X! X1 SYSDEFPAS X2 DEC_Routines X!`125 X `091ASYNCHRONOUS,EXTERNAL`093 FUNCTION SYS$SETDFPROT ( X %REF new_def_prot : lib_word_type := %IMMED 0 ; X VAR cur_def_prot : lib_word_type := %IMMED 0) : sts_type ; external ;` V123 X! X! From SRC_VCLIB:CLIDEF.PAS X! X1 CLIDEFPAS X2 DEC_Routines X!`125 X `091ASYNCHRONOUS,EXTERNAL`093 FUNCTION cli$present ( X %STDESCR name : `091CLASS_S`093 PACKED ARRAY `091l1..u1:integer`093 OF V char ) X : sts_type ; external ; X X `091ASYNCHRONOUS,EXTERNAL`093 FUNCTION cli$get_value ( X %STDESCR name : PACKED ARRAY `091l1..u1 : integer`093 OF char ; X %DESCR retbuf : VARYING `091n2`093 OF char) : sts_type ; external ;`12 V3 X! X! From SRC_VCLIB:STRDEF.PAS X! X1 STRDEFPAS X2 DEC_Routines X!`125 X `091ASYNCHRONOUS,EXTERNAL`093 FUNCTION str$match_wild ( X %DESCR cand_str : VARYING `091n1`093 OF char ; X %DESCR pattern_str : VARYING `091n2`093 OF char) : sts_type ; external V ;`123 X! X! Form SRC_VCLIB:PASMSG.PAS X! X1 PASMSG X!`125 XCONST X %INCLUDE 'SYS$LIBRARY:PASDEF.PAS' X XVAR X PAS$_FACILITY : `091EXTERNAL,VALUE`093 sts_type ;`123 X! X! From SRC_VCLIB:LIBITMLST.DEC X! X1 LIB_ITEM_LIST X FUNCTIONAL DESCRIPTION: X Builds an item list in its own static storage, and returns the X address of the item list. This routine is designed to be called X directly from the parameter list of system services such as $MOUNT X $GETDVI, $GETJPI, and $GETSYI (see PASCAL DECLARATION for an example). X X CALLING SEQUENCE: item_list_address.rr.r = (item.rr.r`091,...`093) X X IMPLICIT INPUTS: None. X X IMPLICIT OUTPUTS: None. X X SIDE EFFECTS: None. X2 Parameters X item -- items for inclusion in the item list. The best way to to generate X these is with LIB_IN_ITEM and LIB_OUT_ITEM. X2 Completion_Status X none -- does not return any status values. X2 PASCAL_Definition X!`125 X `091EXTERNAL`093 FUNCTION lib_item_list (item : `091UNSAFE,LIST`093 lib_i Vtem_type) : X lib_item_list_type ; external ;`123 X3 Calling_Example X`091INHERIT ('STARLET_PEN','VCLIB_PEN')`093 PROGRAM dvitest (output) ; X VAR X logvolnam, disk_label, device : VARYING `09120`093 OF char := '' ; X free_blocks, disk_size, disk_owner_pid : unsigned := 0 ; X BEGIN X lib_sigiferr ($GETDVI (,, 'DISK$0', lib_item_list ( X lib_out_item (dvi$_maxblock, %DESCR disk_size), X lib_out_item (dvi$_freeblocks, %DESCR free_blocks), X lib_out_item (dvi$_logvolnam, %DESCR logvolnam), X lib_out_item (dvi$_volnam, %DESCR disk_label), X lib_out_item (dvi$_devnam, %DESCR device), X lib_out_item (dvi$_pid, %DESCR disk_owner_pid)))) ; X writeln (logvolnam, ', ', device, ', ', disk_label, ', ', X ', free =', free_blocks:1, ', X used =', (disk_size - free_blocks):1) ; X END. X1 LIB_OUT_ITEM X FUNCTIONAL DESCRIPTION: X Builds an item specifing data to be written, for inclusion in an X item_list. This routine is designed to be called from within a X call to LIB_ITEM_LIST. X X CALLING SEQUENCE: item.rr.r = ( +-+-+-+-+-+-+-+- END OF PART 9 +-+-+-+-+-+-+-+- Relay-Version: version nyu B notes v1.6 5/10/89; site acf4.NYU.EDU From: timcc@csv.viccol.edu.au (Tim Cook) Date: 1 Jul 89 23:34 EDT Date-Received: 1 Jul 89 17:46 EDT Subject: VMS TAR part 10 of 10 Message-ID: <556@csv.viccol.edu.au> Path: acf4!cmcl2!rutgers!cs.utexas.edu!uunet!murtoa.cs.mu.oz.au!csv!timcc Newsgroups: comp.os.vms Organization: Computer Services, Victoria College, Melbourne Lines: 352 -+-+-+-+-+-+-+-+ START OF PART 10 -+-+-+-+-+-+-+-+ X item_code.rlu.v, data.wx.dx `091, data_length.wwu. Vr`093) X X IMPLICIT INPUTS: None. X X IMPLICIT OUTPUTS: None. X X SIDE EFFECTS: None. X2 Parameters `032 X item_code -- Symbolic code for the item of data required. X data -- Variable into which the item is to be returned. If it X is of type varying string, the length is returned as well. X data_length -- Variable in which the length of the data is to be return- X ed. This is not done if data was of type varying string. X2 Completion_Status X none -- does not return any status values. X2 PASCAL_Definition X!`125 X `091EXTERNAL`093 FUNCTION lib_out_item ( X %IMMED item_code : lib_long_type ; X %DESCR data : `091UNSAFE`093 lib_long_type ; X VAR data_length : lib_word_type := %IMMED 0) X : lib_item_type ; external ;`123 X1 LIB_IN_ITEM X FUNCTIONAL DESCRIPTION: X Builds an item specifing data to be written, for inclusion in an X item_list. This routine is designed to be called from within a X call to LIB_ITEM_LIST. X X CALLING SEQUENCE: item.rr.r = (item_code.rlu.v `091, data.rx.dx`093) X X IMPLICIT INPUTS: None. X X IMPLICIT OUTPUTS: None. X X SIDE EFFECTS: None. X X RESTRICTIONS: The maximum data length is 80. X2 Parameters X item_code -- Symbolic code for operation required.. X data -- Variable containing data to be read. X2 Completion_Status `032 X none -- does not return any status values. X2 PASCAL_Definition X!`125 X `091EXTERNAL`093 FUNCTION lib_in_item ( X %IMMED item_code : lib_long_type ; X %STDESCR data : `091UNSAFE,READONLY`093 PACKED ARRAY `091l1..u1:intege Vr`093 X OF char := %IMMED 0) : lib_extended_item_type ; external ; X`123 X! From SRC_VCLIB:LIBIFERR.DEC X! X1 LIB_RETIFERR X FUNCTIONAL DESCRIPTION: X Return from a routine if condition is not success. X The condition is put in the return value of the routine (R0). X X CALLING SEQUENCE: ret_status.wlc.r = lib_retiferr (status.rlc.v) X X IMPLICIT INPUTS: None. X X IMPLICIT OUTPUTS: None. X X SIDE EFFECTS: None. X2 Parameters X status = longword condition code X2 Completion_Status X ret_status = status (i.e. the parameter) X2 PASCAL_Definition X!`125 X `091EXTERNAL`093 FUNCTION lib_retiferr ( X %IMMED status : sts_type) : sts_type ; external ;`123 X1 LIB_SIGIFERR X FUNCTIONAL DESCRIPTION: X Signal a condition if it is not success, optionally prefixing it with X other messages (with the normal passing of FAO arguments). X X CALLING SEQUENCE: ret_status.wlc.r = lib_sigiferr ( X status.rlc.v `091, signal_arg, ... `093) X X IMPLICIT INPUTS: None. X X IMPLICIT OUTPUTS: None. X X SIDE EFFECTS: None. X2 Parameters X status = longword condition code X signal_arg = a list of condition codes (and FA0 arguments) to be signall Ved X ahead of the status. X2 Completion_Status X ret_status = status (i.e. the parameter) X2 PASCAL_Definition X!`125 X `091EXTERNAL`093 FUNCTION lib_sigiferr ( X %IMMED status : sts_type ; X %IMMED signal_arg : `091LIST,UNSAFE`093 sts_type) : sts_type ; externa Vl ; X`123 X! From SRC_VCLIB:LIBPARSE.DEC X! X1 LIB_PARSE XFUNCTIONAL DESCRIPTION X Return an expanded file spec (or portions of it) (a run-time X version of F$PARSE). X XCALLING SEQUENCE:`009ret_status.wlc.v = lib_parse ( X file_spec.rt.dx, expanded_spec.wt.dx X `091, default_spec.rt.dx`093 `091, related_spec.r Vt.dx`093 X `091, expanded_length.ww.r,`093 `091, field.rl.r, V ... `093) X XIMPLICIT INPUTS:`009Process default device and directory. X XIMPLICIT OUTPUTS:`009None. X XSIDE EFFECTS:`009`009None X XRESTRICTIONS:`009`009None X X2 Parameters Xexpanded_spec = The expanded file_spec. Xexpanded_length= length of expanded file_spec Xfile_spec = The file_spec to parse Xdefault_spec = See RMS manual. Xrelated_spec = See RMS manual. Xfield,.. = the fields to select. Select from the symbols NAM__NODE X NAM__DEV, NAM__DIR, NAM__NAME, NAM__TYPE, NAM__VER. X If no fields are specified, the entire expanded file_spec X is returned. Otherwise the requested fields are appended X in order in expanded_spec. X2 Completion_Status XAny status returned by RMS or LIB$SCOPY_R_DX X2 PASCAL_DEFINITION X!`125 X `091EXTERNAL`093 FUNCTION lib_parse ( X %STDESCR file_spec : `091CLASS_S`093 PACKED ARRAY `091l1..u1:integer`0 V93 OF char ; X %DESCR expanded_spec : VARYING `091n1`093 OF char ; X %STDESCR default_spec : X `091CLASS_S`093 PACKED ARRAY `091l2..u2:integer`093 OF char := %IMM VED 0 ; X %STDESCR related_spec : X `091CLASS_S`093 PACKED ARRAY `091l3..u3:integer`093 OF char := %IMM VED 0 ; X VAR expanded_length : lib_word_type := %IMMED 0 ; X field : `091LIST`093 sts_type := %IMMED 0) : sts_type ; external ; X`123 X! From SRC_VCLIB:LIBFILATT.DEC X! X1 LIB_FILE_ATTRIBUTES XFUNCTIONAL DESCRIPTION X Provides information about files from the RMS File Access Block (FAB) X and eXtended Access Blocks (XAB). X XCALLING SEQUENCE:`009ret_status.wlc.v = lib_file_attributes ( X `091file_spec.rt.d`093, `091pascal_file_var.rr.r` V093, X item_list.rz.r) X XIMPLICIT INPUTS:`009FAB and XAB data for the file from RMS. X XIMPLICIT OUTPUTS:`009None. X XSIDE EFFECTS:`009`009None X XRESTRICTIONS:`009 i`009Does not read or write any length data associated X`009`009`009with each item. This may produce unexpected X`009`009`009results when an item is requested using a data X`009`009`009type of the incorrect size. X`009`009 ii`009Not exhaustively tested as of FEB-1989. X2 Parameters Xfile_spec The VMS filename of the file whose attributes are wanted. X Xpascal_file_var X A Pascal file variable of an open file whose attributes are X wanted. X Xitem_list Item list specifying which information about the file is to X be returned. The itmlst argument is the address of a list X of item descriptors, each of which describes an item of X information. The list of item descriptors is terminated by X a longword of 0. X XIf the pascal_file_var argument is specified, the routine performs a PAS$FAB Xthen a SYS$DISPLAY to obtain the file's FAB and XABs respectively (the file Xremains open); if it is not specified, the routine performs a SYS$OPEN to Xobtain the FAB and XABs (the file is closed). X2 items X!`125 CONST X`123`009`009FAB fields `125 X`009rms__alq = 1 ;`009 `123 Longword - Alocation quantity (blocks) `125 X`009rms__bks = 2 ;`009 `123 Byte - Bucket size `125 X`009rms__bls = 3 ;`009 `123 Word - Magnetic tape block size `125 X`009rms__deq = 4 ;`009 `123 Word - Default file extension quantity `1 V25 X`009rms__dev = 5 ; `123 Longword - Device characteristics `125 X`009rms__fac = 6 ;`009 `123 Byte - File access `125 X`009rms__fop = 7 ;`009 `123 Longword - File-processing options `125 X`009rms__fsz = 8 ;`009 `123 Byte - Fixed length control area size `12 V5 X`009rms__gbc = 9 ; `123 Word - Global buffer count `125 X`009rms__ifi = 10 ; `123 Word - Internal file identifier `125 X`009rms__mrn = 11 ; `123 Longword - Maximum record number `125 X`009rms__mrs = 12 ; `123 Word - Maximum record size `125 X`009rms__org = 13 ; `123 Byte - File organization `125 X`009rms__rat = 14 ; `123 Byte - Record attributes `125 X`009rms__rfm = 15 ;`009 `123 Byte - Record format `125 X`009rms__sdc = 16 ;`009 `123 Longword - Secondary device characteristics V `125 X`009rms__shr = 17 ; `123 Byte - File sharing `125 X`009rms__sts = 18 ;`009 `123 Longword - Completion status code `125 X`009rms__stv = 19 ;`009 `123 Longword - Status value (I/O chan if succ. O VPEN) `125 X`009rms__xab = 20 ;`009 `123 Longword - Extended attribute block address V `125 X X`123`009`009XABDAT fields `125 X`009rms__bdt = 21 ;`009 `123 Quadword - Backup date and time `125 X`009rms__cdt = 22 ;`009 `123 Quadword - Creation date and time `125 X`009rms__edt = 23 ;`009 `123 Quadword - Expiration date and time `125 X`009rms__rdt = 24 ;`009 `123 Quadword - Revision date and time `125 X`009rms__rvn = 25 ;`009 `123 Word - Revision number `125 X X`123`009`009XABFHC fields `125 X`009rms__ebk = 26 ;`009 `123 Longword - End-of-file block `125 X`009rms__ffb = 27 ;`009 `123 Word - First free byte in the eof block V `125 X`009rms__lrl = 28 ;`009 `123 Word - Longest record length `125 X`009rms__sbn = 29 ;`009 `123 Word - Starting logical block number `12 V5 X`009rms__verlimit = 30 ;`123 Word - Version limit `125 X X`123`009`009XABPRO fields `125 X`009rms__grp = 31 ;`009 `123 Word - Group number of file owner `125 X`009rms__mbm = 32 ;`009 `123 Word - Member number of file owner `125 X`009rms__mtacc = 33 ; `123 Byte - Magnetic tape accessibility `125 X`009rms__pro = 34 ;`009 `123 Word - File protection `125 X`009rms__uic = 35 ;`009 `123 Longword - User Identification Code `125 X X`123`009`009XABSUM fields `125 X`009rms__noa = 36 ;`009 `123 Byte - Number of allocation areas define Vd `125 X`009rms__nok = 37 ;`009 `123 Byte - Number of keys defined `125 X`009rms__pvn = 38 ;`009 `123 Word - Prologue version number `125 X X`123`009`009XABALL fields `125 X`009rms__aid = 39 ; `123 Byte - Area identification number `125 X`009rms__aln = 40 ; `123 Byte - Alignment boundary type `125 X`009rms__a_alq = 41 ; `123 Longword - Area allocation quantity `125 X`009rms__aop = 42 ; `123 Byte - Allocation options `125 X`009rms__bkz = 43 ; `123 Byte - Area bucket size `125 X`009rms__a_deq = 44 ; `123 Word - Area default extension quantity `125 X`009rms__loc = 45 ; `123 Longword - Area position `125 X`009rms__rfi = 46 ; `123 Word - Related file identifier `125 X`009rms__vol = 47 ; `123 Word - Related volume number `125 X X`123`009`009Block addresses `125 X`009rms__fabadr = 48 ;`009`123 Longword - Address of FAB `125 X`009rms__xabdatadr = 49 ;`009`123 Longword - Address of XABDAT `125 X`009rms__xabfhcadr = 50 ;`009`123 Longword - Address of XABFHC `125 X`009rms__xabproadr = 51 ;`009`123 Longword - Address of XABPRO `125 X`009rms__xabsumadr = 52 ;`009`123 Longword - Address of XABSUM `125 X`009rms__xaballadr = 53 ; `123 Longword - Address of XABALL `125`123 X2 Completion_Status XRMS$_NORMAL Routine completed successfully. X XSS$_INSFARG Less than 3 arguments were supplied to the routine. X XLIB$_INVARG The item_code field in one of the items in the X item_list is not known to the routine. X XLIB$_INVFILSPE The file_spec argument specified a string longer than X 255 characters. X XSTR$_ILLSTRCLA An invalid string descriptor was used for the file_spec X argument (signalled). X XAny status returned by $OPEN, $DISPLAY or $CLOSE (if $OPEN successful) X2 PASCAL_Definition X!`125 X `091EXTERNAL`093 FUNCTION lib_file_attributes ( X %DESCR file_spec : VARYING `091n1`093 OF char := %IMMED 0 ; X VAR file_var : `091UNSAFE`093 text := %IMMED 0 ; X %REF item_list : lib_item_list_type) : sts_type ; external ; X`123 X! From SRC_VCLIB:PASLIBDEF.PAS X! X1 PASLIBDEF X`124************************************************************************ V****`124 X`124 Non-modular utility routines for use in PASCAL V `124 X`124 V `032 V `124 X`124 AUTHOR: Doug Miller V `124 X`124 CREATED: 26-Sep-1984 V `124 X`124 MODIFIED: Tim Cook, added addtim, subtim, difftim and bintim V `124 X`124 12-Sep-1985 V `124 X`124 Tim Cook, removed unneeded definitions for a TAR V `124 X`124 distribution, 24-FEB-1989 V `124 X`124************************************************************************ V****`124 X2 CLI_PRESENT X!`125 `091GLOBAL,ASYNCHRONOUS`093 FUNCTION success (`123 X!`125 status : `091UNSAFE`093 STS$TYPE) : boolean ; forward ;`123 X!`125 X `091GLOBAL,ASYNCHRONOUS`093 FUNCTION cli_present ( X keyword : PACKED ARRAY `091l1..u1:integer`093 OF char) : boolean ; X BEGIN X cli_present := success (CLI$PRESENT (keyword)) END ;`123 X2 FAILURE X A simple routine to test the STS$V_SUCCESS bit of a STS$TYPE status. X (used to control program flow) X X!`125 X `091GLOBAL,ASYNCHRONOUS`093 FUNCTION failure ( X status : `091UNSAFE`093 STS$TYPE) : boolean ; X BEGIN X failure := NOT status.STS$V_SUCCESS END ;`123 X2 PAS$FAB X!`125 X `091EXTERNAL,ASYNCHRONOUS`093 FUNCTION pas$fab (VAR f : `091UNSAFE`093 te Vxt) : X fab_pointer ; external ;`123 X2 PAS$RAB X!`125 X `091EXTERNAL,ASYNCHRONOUS`093 FUNCTION pas$rab (VAR f : `091UNSAFE`093 te Vxt) : X rab_pointer ; external ;`123 X2 SUCCESS X A simple routine to test the STS$V_SUCCESS bit of a STS$TYPE status. X (used to control program flow) X X `091GLOBAL,ASYNCHRONOUS`093`125 FUNCTION success `123( X status : `091UNSAFE`093 STS$TYPE) : boolean `125 ; X BEGIN X success := status.STS$V_SUCCESS END ;`123 X! X!`125 END. `123 of MODULE vclib `125 $ CALL UNPACK VCDEFS.PAS;1 1584318633 $ EXIT