From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 14-SEP-1989 07:02
To:	MRGATE::"ARISIA::EVERHART"
Subj:	VMS TAR v1.1   part 3 of 6

Received: From UCBVAX.BERKELEY.EDU by GIZMO.SRI.COM with TCP; Thu, 14 SEP 89 01:52:36 PDT
Received: by ucbvax.Berkeley.EDU (5.61/1.37)
	id AA09774; Thu, 14 Sep 89 01:47:52 -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: 14 Sep 89 20:07:32 GMT
From: uhccux!munnari.oz.au!murtoa.cs.mu.oz.au!viccol!timcc@ames.arc.nasa.gov  (Tim Cook)
Organization: Computer Services, Victoria College, Melbourne
Subject: VMS TAR v1.1   part 3 of 6
Message-Id: <1940@csv.viccol.edu.au>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com

-+-+-+-+-+-+-+-+ START OF PART 3 -+-+-+-+-+-+-+-+
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      inspecting_header := false ;
X      opening_archive_input := false ;
X      archive_temp_open := false ;
X      match_all := 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         convert : boolean ;
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         convert := false ;
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                  convert := true ;
X               IF NOT convert THEN BEGIN
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`
V093 ;
X                  sigargs.param_count := sigargs.param_count - 2 END 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               ELSE
X                  convert := true ;
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 inspecting_header THEN
X                  bad_archive
X               ELSE
X                  convert := true ;
X            OTHERWISE
X               convert := true END ;
X
X         IF convert THEN BEGIN
X            condition := (sigargs.condition)::STS$TYPE ;
X            IF (condition.STS$V_FAC_NO = PAS$_FACILITY) THEN BEGIN
X         `123 Report condition encountered as "internal error" `125
X               LIB$STOP (tar__internerr, 1, sigargs.condition) ;
X               END END ;
X         END ;    `123 tar_handler `125
X
X
X   FUNCTION lowercase (
X      VAR inp_string : `091READONLY`093 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 inp_string.length 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      VAR inp_string : `091READONLY`093 VARYING `091n1`093 OF char) : medium
V_string ;
X
X      VAR
X         result : medium_string ;
X         i : integer ;
X
X      BEGIN
X         result := inp_string ;
X         FOR i := 1 TO inp_string.length 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      VAR z_string : `091READONLY`093 PACKED ARRAY `091l1..u1:integer`093 OF
V char ;
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      VAR check_record : `091READONLY`093 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_kt, 'TAR_TIMEZONE',,
X            lib_item_list (lib_out_item (LNM$_STRING, %DESCR timezone_str)))
V)
X         THEN
X            IF failure ($TRNLNM (, lnm$file_dev_kt, '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            IF failure (OTS$CVT_TI_L ((timezone_str), i)) THEN
X               LIB$STOP (tar__invtimzon, 1, %STDESCR (timezone_str)) ;
X            hours := i DIV 100 ;
X            minutes := i - hours * 100 ;
X            IF (abs (hours) > 18) OR (abs (minutes) > 59) THEN
X               return := 0
X            ELSE
X               return := minutes * 60 + hours * 3600 END ;
X         get_timezone := return ;
X         END ;
X
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   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
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      VAR VMS_time : lib_date_type ;            `123 Should be READONLY `125
X      delta_seconds : integer := 0) : unsigned ;
X
X      VAR
X         VMS_rel_UNIX_epoch : lib_date_type ;
X            `123 delta VMS time relative to 1-JAN-1970 0:0:0.0 `125
X         h_time : quadruple ;          `123 quadruple precision, or H_FLOAT
V `125
X         result_time : unsigned ;
X
X      BEGIN
X         VMS_to_UNIX_time := 0 ;
X         IF success (LIB$SUBX (
X               VMS_time, UNIX_epoch_time, VMS_rel_UNIX_epoch)) THEN
X            IF VMS_rel_UNIX_epoch.hi > 0 THEN BEGIN
X               h_time :=
X                  quad (VMS_rel_UNIX_epoch.hi) * 4294967296.0 ; `123 2 `094
V 32 `125
X               h_time := h_time + quad (VMS_rel_UNIX_epoch.lo) ;
X               h_time := h_time / 10000000 ;    `123 convert to seconds `125
X               h_time := h_time - delta_seconds ; `123 convert to local time
V `125
X               IF h_time < 0 THEN
X                  VMS_to_UNIX_time := 0
X               ELSE
X                  IF h_time > 4294967295.0 THEN
X                     VMS_to_UNIX_time := %xFFFFFFFF `123 which equals 429496
V7295 `125
X                  ELSE
X                     VMS_to_UNIX_time := uround (h_time) END END ;
X
X
X   FUNCTION 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      : sts_type ;
X
X      VAR
X         status : sts_type ;
X
X      BEGIN
X         status := LIB$GET_INPUT (string, prompt) ;
X         IF success (status) THEN
X            IF string = '' THEN string := default ;
X         get_prompted_string := status END ;
X
X
X   PROCEDURE set_this_false (
X      VAR bool_to_set_false : boolean) ;
X
X      BEGIN
X         bool_to_set_false := false END ;
X
X
X   FUNCTION confirm_operation (
X      VAR op_to_confirm : `091READONLY`093 VARYING `091n1`093 OF char ;
X      VAR conf_filespec : `091READONLY`093 filespec_type ;
X      confirmed : boolean := false ;
X      PROCEDURE eof_routine (VAR p1 : boolean) ;
X      VAR eof_routine_p1 : boolean) : boolean ;
X
X      VAR
X         decision : small_string ;
X         status : sts_type ;
X
X      BEGIN
X         IF confirmed THEN confirm_operation := true
X         ELSE BEGIN
X            status := get_prompted_string (
X               lowercase (op_to_confirm, 2) + space + conf_filespec +
X               '? (Y/N) `091Y`093: ', decision, 'Y') ;
X            IF success (status) THEN
X               confirm_operation := decision`0911`093 IN `091'Y', 'y', ' '`0
V93
X            ELSE
X               IF status = RMS$_EOF THEN BEGIN
X                  eof_routine (eof_routine_p1) ;
X                  confirm_operation := false END
X               ELSE
X                  LIB$SIGNAL (status) END END ;
X
X
X   FUNCTION VMS_filespec (
X      VAR UNIX_filespec : `091READONLY`093 filespec_type ;
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 := UNIX_filespec.length ;
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 <> slash THEN
X                     i := i - 1
X                  ELSE
X                     more := false
X               ELSE
X                  more := false ;
X            name := substr (UNIX_filespec, i + 1, UNIX_filespec.length - i)
V ;
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                  slash :
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      VAR VMS_filespec : `091READONLY`093 filespec_type ;   `123ALL fields e
Vxpected `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         IF type_ = '.' THEN
X            type_ := '' ;
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 := slash + device + slash ;
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 := slash ;
X               temp_result := temp_result + directory + slash 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) ;
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      VAR filespec : `091READONLY`093 filespec_type ;
X      share : boolean := false) ;
X
X      BEGIN
X         opening_archive_input := true ;
X         IF share THEN
X            open (archive, filespec, history := OLD, sharing := READONLY,
X               default := dot_tar_kt)
X         ELSE
X            open (archive, filespec, history := OLD, default := dot_tar_kt)
V ;
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 (
X      VAR header : `091READONLY`093 tar_record_type) ;
X
X      BEGIN
X         close (archive) ;
X         open (archive, 'HEADER.TAR', history := NEW,
X            default := sys$scratch_kt) ;
X         rewrite (archive) ;
X         write (archive, header) ;
X         close (archive) ;
X         LIB$STOP (tar__badheader) ;
X         END ;
X
X
X   FUNCTION is_valid_header (
+-+-+-+-+-+-+-+-  END  OF PART 3 +-+-+-+-+-+-+-+-

