From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 18-SEP-1989 10:24
To:	MRGATE::"ARISIA::EVERHART"
Subj:	VMS TAR v1.1   part 5 of 6

Received: From UCBVAX.BERKELEY.EDU by GIZMO.SRI.COM with TCP; Mon, 18 SEP 89 06:35:17 PDT
Received: by ucbvax.Berkeley.EDU (5.61/1.37)
	id AA29079; Mon, 18 Sep 89 06:25:35 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews
	for info-vax@kl.sri.com (info-vax@kl.sri.com)
	(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 15 Sep 89 18:17:37 GMT
From: murtoa.cs.mu.oz.au!viccol!timcc@uunet.uu.net  (Tim Cook)
Organization: Computer Services, Victoria College, Melbourne
Subject: VMS TAR v1.1   part 5 of 6
Message-Id: <1965@csv.viccol.edu.au>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com

-+-+-+-+-+-+-+-+ START OF PART 5 -+-+-+-+-+-+-+-+
X                     ELSE
X                        extract_file (archive`094, file_spec, file_size,
X                           file_mtime, file_mode) ;
X                     file_extracted := true ;
X                     files_created := files_created + 1 END
X               END
X            ELSE  `123 inspect_header = false `125
X               IF eof_archive THEN
X                  more := false
X               ELSE
X                  bad_header (archive`094) ;    `123 stops execution `125
X            IF file_extracted THEN
X               IF eof (archive) THEN
X                  more := false
X               ELSE
X                  get (archive)
X            ELSE
X               scan_to_next_header (file_size) ;
X            more := more AND NOT eof (archive) END ;
X
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 964517214
$ create/nolog 'f'
X`091INHERIT ('SYS$LIBRARY:STARLET', 'VCDEFS', 'TAR'),
X   IDENT ('T1.1')`093
X
XMODULE list ;
X
X
X   PROCEDURE find_device_structure (
X      device_name : filespec_type ;
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      VAR archive_filespec : `091READONLY`093 filespec_type ;
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
X      PROCEDURE list_file (
X         VAR header_record : tar_record_type ;
X         full : boolean ;
X         VAR file_spec : `091READONLY`093 filespec_type ;
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            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 END ;
X
X
X      BEGIN    `123 tar_list `125
X         IF cli_present (filespec_kt) THEN
X            collect_matches (match_node)
X         ELSE BEGIN
X            match_all := true ;
X            match_node := nil END ;
X         lib_parse (archive_filespec, full_archive_spec, '.TAR') ;
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 := inspect_header (archive`094, file_spec, file_siz
Ve,
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            IF match_filespec (file_spec, match_node) THEN
X               list_file (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
X               more_in_archive := inspect_header (archive`094, file_spec,
X                  file_size, file_mtime, file_mode, directory) 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 1752710322
$ create/nolog 'f'
X`091INHERIT ('SYS$LIBRARY:STARLET', 'VCDEFS', 'TAR', 'DSS'),
X   IDENT ('T1.1')`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
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      filespecs_in_storage : boolean ;
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      filespecs_in_storage := false ;
X
X
X   FUNCTION another_file (
X      VAR next_file : filespec_type) : boolean ;
X
X      VAR
X         context : `091STATIC`093 lib_fab_pointer := nil ;
X         filespec : `091STATIC`093 filespec_type := '' ;
X         status : sts_type ;
X         more : boolean ;
X
X      BEGIN
X         IF filespecs_in_storage THEN BEGIN
X            get_string_from_storage (next_file) ;
X            another_file := next_file <> '' END
X         ELSE BEGIN
X            more := true ;
X            WHILE more DO BEGIN
X               IF filespec = '' THEN
X                  IF failure (CLI$GET_VALUE (filespec_kt, filespec)) THEN BE
VGIN
X                     more := false ;
X                     another_file := false END
X                  ELSE
X               ELSE BEGIN
X                  status := LIB$FIND_FILE (filespec, next_file, context,
X                     input_filespec_default) ;
X                  CASE status OF
X                     RMS$_NMF, RMS$_FNF : BEGIN
X                        IF status = RMS$_FNF THEN
X                           LIB$SIGNAL (tar__nofiles, 1, %STDESCR (next_file)
V) ;
X                        LIB$FIND_FILE_END (context) ;
X                        filespec := '' END ;
X                     RMS$_NORMAL : BEGIN
X                        another_file := true ;
X                        more := false END ;
X                     OTHERWISE BEGIN
X                        another_file := false ;
X                        LIB$STOP (tar__parse, 1, %STDESCR (filespec), status
V,
X                           context`094.FAB$L_STV) END END END END END END ;
X
X
X   PROCEDURE collect_filespecs (
X      VAR prefix : filespec_type) ;
X
X      VAR
X         selection : filespec_type ;
X         i, j : integer ;
X         first_time, more, done : boolean ;
X         status : sts_type ;
X
X      BEGIN
X         first_time := true ;
X         more := true ;
X         WHILE another_file (selection) DO BEGIN
X            put_string_in_storage (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
X         rewind_storage ;
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 END ;
X
X
X   FUNCTION open_input_file (
X      VAR file_spec : filespec_type ;
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
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 open_directory (
X      VAR file_spec : filespec_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_xabpro) ;
X
X         in_xabpro.XAB$B_COD := XAB$C_PRO ;
X         in_xabpro.XAB$B_BLN := XAB$C_PROLEN ;
X
X         status := $OPEN (in_fab) ;
X
X         IF success (status) THEN BEGIN
X            modification_date := (in_xabdat.XAB$Q_RDT)::lib_date_type ;
X            protection := in_xabpro.XAB$W_PRO ;
X            $CLOSE (in_fab) END ;
X
X         open_directory := status END ;
X
X
X   FUNCTION VMS_to_UNIX_protection (
X      VMS_protection : file_protection_type ;
X      directory : boolean := false) : unsigned ;
X
X      VAR
X         return : unsigned ;
X
X      BEGIN
X      `123 Note that, because most files that have READ set in VMS also
X        have EXECUTE set, I ignore EXECUTE `125
X
X         WITH VMS_protection DO BEGIN
X            IF NOT owner.noread THEN return := 256                `123 u+r `
V125
X            ELSE return := 0 ;
X            IF NOT owner.nowrite THEN return := return + 128 ;    `123 u+w `
V125
X            IF NOT group.noread THEN return := return + 32 ;      `123 g+r `
V125
X            IF NOT group.nowrite THEN return := return + 16 ;     `123 g+w `
V125
X            IF NOT world.noread THEN return := return + 4 ;       `123 o+r `
V125
X            IF NOT world.nowrite THEN return := return + 2 ;      `123 o+w `
V125
X            IF directory THEN BEGIN
X               return := return + 1024 ;   `123 set the 'd' bit `125
X
X            `123 Note that the EXECUTE privilege on a directory in VMS is
X              not equivalent to it's namesake in UNIX `125
X
X               IF NOT owner.noread THEN return := return + 64 ;   `123 u+x `
V125
X               IF NOT group.noread THEN return := return + 8 ;    `123 g+x `
V125
X               IF NOT world.noread THEN return := return + 1 END ;`123 o+x `
V125
X            END ;
X         VMS_to_UNIX_protection := return END ;
X
X
X   PROCEDURE build_header (
X      head_filespec : filespec_type ;
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      directory : boolean := false) ;
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 (
X            VMS_to_UNIX_protection (protection, directory), 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         IF directory THEN BEGIN    `123 Change ".dir" to "/" `125
X            temp_filespec.length := index (temp_filespec, '.dir') ;
X            temp_filespec`091temp_filespec.length`093 := slash END ;
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   FUNCTION is_directory (
X      filespec : filespec_type) : boolean ;
X
X      BEGIN
X      `123 A simple test, but I don't feel like looking at file-headers (thi
Vs
X        is unsupported).  If someone plays around with the use of '.DIR;1',
X        it's their fault. `125
X         is_directory :=
X            substr (filespec, filespec.length - 5, 6) = dot_dir_1_kt END ;
X
X
X   `091GLOBAL`093 PROCEDURE tar_write (
X      VAR archive_filespec : `091READONLY`093 filespec_type ;
X      confirm : boolean ;
X      scan : boolean ;
X      map_mode : map_mode_type ;
X      appending : boolean := false) ;
X
X      VAR
X         more : boolean ;
X         tar_record : tar_record_type ;
X         current_file : filespec_type ;
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, pending_directory : filespec_type ;
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$STOP (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
X      PROCEDURE load_after_scan ;  `123 Scans a var-len file for size then l
Voads `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$STOP (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
X               LIB$STOP (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$STOP (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
X      PROCEDURE load_from_temp ;
X         BEGIN
X            IF NOT archive_temp_open THEN BEGIN
X               open (archive_temp, history := NEW, disposition := DELETE,
X                  default := sys$scratch_kt) ;
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$STOP (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
X      PROCEDURE load_directory (
X         VAR directory_name : filespec_type) ;
X
X         VAR
X            temp_string : medium_string ;
X
X         BEGIN
X            temp_string := directory_name + dot_dir_1_kt ;
X            IF success (
X                  open_directory (temp_string, modification_date, protection
V))
X            THEN BEGIN
X               build_header (temp_string, 0, archive`094, map_mode,
X                  modification_date, protection, prefix.length,
X                  directory := true) ;
X               put (archive) END
X            ELSE
X               LIB$STOP (tar__openin, 1, %STDESCR (temp_string)) END ;
X
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               default := dot_tar_kt) ;
X            rewrite (archive) ;
X            creating_archive_output := false ;
X            write_message := tar__written END
X         ELSE BEGIN
+-+-+-+-+-+-+-+-  END  OF PART 5 +-+-+-+-+-+-+-+-

