🚀 go-pugleaf

Submitted-by: moeller@gwdgv1.gwdg.de
Posting-number: Volume 4, Issue 32
Archive-name: vms_unshare/part01

This is an update of the command procedure previously
posted to INFO-VAX under the name of UNSHAR.COM which
understands files "packed" by VMS_SHARE versions up to 8.1.

The purpose of VMS_UNSHARE is to "unpack" VMS_SHARE'd files
without executing *them* (for security reasons).

VMS_UNSHARE also makes sure that files get created only
in or below the caller's current default directory.

NB. this file is packed by VMS_SHARE 6.10, so it can be unpacked
    by the old version of UNSHAR (if you have it).

Wolfgang J. Moeller, GWDG, D-3400 Goettingen, F.R.Germany | Disclaimer ...
PSI%(0262)45050352008::MOELLER      Phone: +49 551 201516 | No claim intended!
Internet: moeller@gwdgv1.dnet.gwdg.de   | This space intentionally left blank.

$! ................... Cut between dotted lines and save. ...................
$!...........................................................................
$! VAX/VMS archive file created by VMS_SHARE V06.10 7-FEB-1989.
$!
$! VMS_SHARE was written by James Gray (Gray:OSBUSouth@Xerox.COM) from
$! VMS_SHAR by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au).
$!
$! To unpack, simply save, concatinate all parts into one file and
$! execute (@) that file.
$!
$! This archive was created by user MOELLER
$! on 19-DEC-1992 01:19:59.73.
$!
$! It contains the following 1 file:
$!        VMS_UNSHARE.COM
$!
$!============================================================================
$ SET SYMBOL/SCOPE=( NOLOCAL, NOGLOBAL )
$ VERSION = F$GETSYI( "VERSION" )
$ IF VERSION .GES "V4.4" THEN GOTO VERSION_OK
$ WRITE SYS$OUTPUT "You are running VMS ''VERSION'; ", -
    "VMS_SHARE V06.10 7-FEB-1989 requires VMS V4.4 or higher."
$ EXIT 44 ! SS$_ABORT
$VERSION_OK:
$ GOTO START
$!
$UNPACK_FILE:
$ WRITE SYS$OUTPUT "Creating ''FILE_IS'"
$ DEFINE/USER_MODE SYS$OUTPUT NL:
$ EDIT/TPU/COMMAND=SYS$INPUT/NODISPLAY/OUTPUT='FILE_IS'/NOSECTION -
    VMS_SHARE_DUMMY.DUMMY
b_part := CREATE_BUFFER( "{Part}", GET_INFO( COMMAND_LINE, "file_name" ) )
; s_file_spec := GET_INFO( COMMAND_LINE, "output_file" ); SET( OUTPUT_FILE
, b_part, s_file_spec ); b_errors := CREATE_BUFFER( "{Errors}" ); i_errors
:= 0; pat_beg_1 := ANCHOR & "-+-+-+ Beginning"; pat_beg_2 := LINE_BEGIN
& "+-+-+-+ Beginning"; pat_end := ANCHOR & "+-+-+-+-+ End"; POSITION
( BEGINNING_OF( b_part ) ); LOOP EXITIF SEARCH( SPAN( ' ' )@r_trail
& LINE_END, FORWARD) = 0; POSITION( r_trail ); ERASE( r_trail ); ENDLOOP
; POSITION( BEGINNING_OF( b_part ) ); i_append_line := 0; LOOP EXITIF MARK
( NONE ) = END_OF( b_part ); s_x := ERASE_CHARACTER( 1 )
; IF s_x = '+' THEN r_skip := SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip
<> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF
; ENDIF; IF s_x = '-' THEN r_skip := SEARCH( pat_end, FORWARD, EXACT )
; IF r_skip <> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip
:= MARK( NONE ); r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip
<> 0 THEN POSITION( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET )
; MOVE_VERTICAL( 1 ); MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part )
); ENDIF; ERASE( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF
; IF s_x = 'V' THEN s_x := ''; IF i_append_line <> 0 THEN APPEND_LINE
; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF; i_append_line := 1
; MOVE_VERTICAL( 1 ); ENDIF; IF s_x = 'X' THEN s_x := ''; IF i_append_line
<> 0 THEN APPEND_LINE; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF
; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; IF s_x <> '' THEN i_errors
:= i_errors + 1; s_text := CURRENT_LINE; POSITION( b_errors ); COPY_TEXT
( "The following line could not be unpacked properly:" ); SPLIT_LINE
; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part ); MOVE_VERTICAL
( 1 ); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP r_x := SEARCH
( "`", FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x ); ERASE_CHARACTER( 1
); COPY_TEXT( ASCII( INT( ERASE_CHARACTER( 3 ) ) ) ); ENDLOOP
; IF i_errors = 0 THEN SET( NO_WRITE, b_errors, ON ); ELSE POSITION
( BEGINNING_OF( b_errors ) ); COPY_TEXT( FAO
( "The following !UL errors were detected while unpacking !AS", i_errors
, s_file_spec ) ); SPLIT_LINE; SET( OUTPUT_FILE, b_errors, "SYS$COMMAND" )
; ENDIF; EXIT;
$ DELETE VMS_SHARE_DUMMY.DUMMY;*
$ CHECKSUM 'FILE_IS
$ WRITE SYS$OUTPUT " CHECKSUM ", -
  F$ELEMENT( CHECKSUM_IS .EQ. CHECKSUM$CHECKSUM, ",", "failed!!,passed." )
$ RETURN
$!
$START:
$ FILE_IS = "VMS_UNSHARE.COM"
$ CHECKSUM_IS = 1716071061
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X$!*****`009VMS_UNSHARE.COM: unpack VMS_SHARE files without executing them.
X$!`009Apart from a temporary file in SYS$SCRATCH, this procedure will
X$!`009create files only in or below the current default directory.
X$!
X$! p1:  file[s] to UNSHARe, may be comma-separated list,
X$!`009may contain wildcards, provided that a DIRECTORY command
X$!`009with the same p1 lists the files in part order.
X$!
X$! Written by W.J.Moeller 04-dec-1989 (after VMS_SHARE 7.1-004)
X$! mod 06-dec-1989 wjm: add support for older versions
V$! fix 15-dec-1989 wjm: f$edit(,"trim") won't work when argument has 1 '"' in
X it
V$! fix 07-apr-1990 wjm: support 6.3's "`096`096" escape (comes as "`096096" i
Xn 6.10)
X$! mod 07-apr-1990 wjm: add support for 7.2
X$! mod 18-sep-1992 wjm: 1 fix, add support for 8.1
V$! fix 23-nov-1992 wjm: don't try to rename between SYS$SCRATCH and destinati
Xon
X$!
X$!`009... supports VMS_SHARE 8.1
X$!`009`009     VMS_SHARE 7.1-001 thru -004, 7.2-007
X$!`009`009     VMS_SHARE 6.10, 6.3
X$!`009`009     VMS_SHAR 5.4
X$!`009`009and maybe more ...
X$!
X$! Acknowledgements:
X$!`009VMS_SHAR: Copyright (c) 1987, by Michael Bednarek
X$!`009VMS_SHARE 6.x: Copyright `169 1988, by James Gray
X$! `009VMS_SHARE 7.x and up: Written by Andy Harper, Kings College London UK
X$!`009`009`009`009<UDAA055@ELM.CC.KCL.AC.UK>
X$!
X$!*****
X$!
X$ v = 'f$verify(f$trnlnm("UNSHAR_VERIFY"),f$env("verify_image"))'
X$ set = "set"
X$ set symbol/scope=(nolocal,noglobal)
X$!
X$ on warning then goto err_on
X$!
X$ SS$_FORMAT = %x00BC`009`009! %SYSTEM-F-FORMAT, invalid media format
X$ RMS$_NMF = %x182CA
X$!
X$ sum_files = 0
X$ sum_skip = 0
X$ sum_cksum = 0
X$ sum_ckskp = 0
X$!
X$ sharvers = ""`009`009! unknown yet
X$ recfm = ""`009`009! void unless set by 8.x
X$!
X$ f = f$parse("UNSHAR_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
X$ e = "write sys$error  ""%UNSHAR"", "
X$ w = "write sys$output ""%UNSHAR"", "
X$ vmsv = f$getsyi("version")
X$ vmsv = f$extract(1,f$length(vmsv)-1,vmsv)`009! ... w/o initial letter
X$ if vmsv.ges."4.4" then $ goto START
X$ e "-F-VMSVERSION, Must run at least VMS 4.4"
X$ return %x10000674`009! F, SS$_SYSVERDIF (signalled)
X$!
X$!
X$!*****`009GOSUBroutine: fetch 'line' from input
X$!
X$getline_init:`009`009`009`009`009!GOSUB entry
X$ define UNSHAR_INPUTS`009'p1'
X$ oldfn = ""
X$ gosub getline_open
X$ return 1
X$!
X$getline_open:`009`009`009`009`009!internal GOSUB
X$ fn = f$search("UNSHAR_INPUTS",1)
X$ if fn.eqs."".or.fn.eqs.oldfn then return RMS$_NMF`009! trigger ON WARNING
X$ oldfn = fn
X$ w "-I-Opening input file ",fn
X$ open/read UNSHAR_INPUT 'fn'
X$ return 1
X$!
X$getline:`009`009`009`009`009!GOSUB entry
X$ read/end=getline_eof UNSHAR_INPUT line`009!REPEATED for faster access...
X$ return 1
X$getline_eof:
X$ close UNSHAR_INPUT
X$ gosub getline_open
X$ goto getline
X$!
X$!
X$!*****`009start of UNSHARing
X$!
X$START:
X$ gosub getline_init
X$!
X$!*****`009search for "$START:" label
X$sloop:
X$ gosub getline
X$ if f$edit(f$element(0," ",line),"upcase").nes."$START:" then goto sloop
X$ if f$edit(f$extract(7,f$length(line)-7,line),"trim").nes."" then goto sloop
X$!
X$!*****`009decide upon version by looking at the line(s) after "$START:"
X$!`009`009end of input may also occur
X$nextfile:
X$ gosub getline
X$ if f$edit(line,"trim").eqs."" then gosub getline`009! void line in 6.x
X$!
X$ if f$edit(line,"trim").nes."$!" then goto next_not_8`009! so far 8.1 only
X$   gosub getline
X$   if f$edit(line,"trim").eqs."$ create 'f'" then goto share801`009!8.1
X$   goto expect_end`009`009`009`009`009! ???
X$next_not_8:
X$!
X$ if f$edit(line,"trim").eqs."$ create 'f'" then goto share702`009`009!7.2
X$ if f$edit(line,"trim").eqs."$ create/nolog 'f'" then goto share701`009!7.1
X$ x1 = f$element(0,"""",line)
X$ if x1.eqs."$ FILE_IS = " then goto share6`009`009`009`009!6.x
X$ if x1.eqs."$File_is=" then goto share5`009`009`009`009!5.x
X$ if f$extract(0,10,line).nes."$Goto Part" then goto expect_end`009`009!5.x
X$!
X$!*****`009skip to "$Part<n>:" (VMS_SHAR only)
X$ lab = "$"+f$element(1," ",line)
X$gloop:
X$ gosub getline
X$ if f$element(0,":",line).nes.lab then goto gloop
X$ if f$edit(line-(lab+":"),"trim").nes."" then goto gloop
X$ goto nextfile
X$!
X$!*****`009come back here when file 'f' has been written
X$!`009and 'sharvers','outfn','cksum','recfm' are known
X$unpack:
X$ close UNSHAR_TEMP
X$!
X$ ospec = f$parse(outfn,"[]",,,"syntax_only")
X$!
V$!*****`009make sure that output files will be created in the current directo
Xry
X$!`009`009`009`009`009`009or in a subdirectory thereof
X$!
X$ dummy = f$parse("DUMMY.DUMMY;1","[]",,,"syntax_only")
X$ defdir = dummy - "DUMMY.DUMMY;1"
X$ if defdir.eqs.dummy then return 4`009! must not happen
X$ defdirlen = f$length(defdir)
X$retry_dir:
X$ outdir = ospec-(f$parse(ospec,,,"name","syntax_only")+-
X`009`009f$parse(ospec,,,"type","syntax_only")+-
X`009`009f$parse(ospec,,,"version","syntax_only"))
X$ if outdir.nes.ospec then`009-`009`009! need properly formed dir
X  if outdir.eqs.defdir .or.`009-`009`009`009! same directory
V     (f$extract(0,defdirlen-1,outdir).eqs.f$extract(0,defdirlen-1,defdir).and
X.-
X     f$extract(defdirlen-1,1,outdir).eqs.".") then -`009! subdirectory
X`009goto dir_ok
X$ e "-F-DIRCHANGED, ",f$fao("directory for file !AS changed!/"+-
X`009"to the current directory !AS,!/"+-
X`009"because the SHARE file specifies an improper directory name.",-
X`009outfn,defdir)
X$ ospec = f$parse(defdir,outfn,,,"syntax_only")
X$ goto retry_dir`009`009`009! verify again, just in case ...
X$dir_ok:
X$!
X$ if f$parse(ospec).nes."" then goto no_credir
X$ dn = f$parse(ospec,,,"device")+f$parse(ospec,"[]",,"directory")
X$ w "-I-Creating directory ",dn
X$ create/dir 'dn'
X$ goto no_skip`009`009! can't be duplicate
X$no_credir:
V$ if f$length(f$parse(ospec,,,"version","syntax_only")).lt.2 then goto no_ski
Xp
X$!
X$!*****`009check for duplicate file only if version is given (7.x and up)
X$!
X$ if f$search(ospec) .eqs. "" then goto no_skip
X$ e "-W-SKIPPED, File ''outfn' exists - skipped."
X$ sum_skip = sum_skip + 1
X$ delete/nolog 'f'*
X$ goto nextfile
X$no_skip:
X$!
X$ w "-I-Unpacking file ",outfn
X$ gosub unpack_'sharvers'
X$ delete/nolog 'f'*
X$!
X$ if recfm.eqs."" then goto fdl_skip
X$   copy 'outfn' 'f'`009`009! move the file we just created to a safe place
X$   delete/nolog 'outfn1'
X$   open/write UNSHAR_TEMP 'f'
X$   write UNSHAR_TEMP "RECORD"
X$   write UNSHAR_TEMP recfm
X$   close UNSHAR_TEMP
X$   w "-I-CONVRFM, converting record format to ",recfm
X$   convert/fdl='f' 'f'-1 'outfn'
X$   delete/nolog 'f'*
X$fdl_skip:
X$!
X$ if cksum.eqs."""""" then goto cksum_skip`009`009`009! new with 8.x
X$ CHECKSUM 'ospec'
X$ sum_files = sum_files + 1
X$ IF CHECKSUM$CHECKSUM .eqs. cksum then goto nextfile`009! all o.k.
X$ e "-E-CHKSUMFAIL, Checksum of ''outfn' failed."
X$ sum_cksum = sum_cksum + 1
X$ goto nextfile
X$!
X$cksum_skip:
X$ w "-W-CHKSUMSKIP, checksum validation unavailable for ",outfn
X$ sum_files = sum_files + 1
X$ sum_ckskp = sum_ckskp + 1
X$ goto nextfile
X$!
V$!***************************************************************************
X***
X$getline:`009`009`009`009`009!GOSUB entry
X$ read/end=getline_eof UNSHAR_INPUT line`009!REPEATED for faster access...
X$ return 1
X$getline_eof:
X$ close UNSHAR_INPUT
X$ gosub getline_open
X$ goto getline
X$!
V$!*****`009VMS_SHARE 8.1 ****************************************************
X******
X$share801:
X$ if sharvers.eqs."" then sharvers = 801
X$ if sharvers.ne.801 then return SS$_FORMAT
X$ open/write UNSHAR_TEMP 'f'
X$ w "-I-Working on next file ..."
X$cloop8:
X$ gosub getline
X$ if f$extract(0,14,line).eqs."$ call unpack " then goto cloop8end
X$ write UNSHAR_TEMP line
X$ goto cloop8
X$cloop8end:
X$ long_line = f$edit(line,"trim,compress")`009! this line may be continued
X$lloop8:
V$   if f$extract(f$length(long_line)-1,1,long_line).nes."-" then goto lloop8e
Xnd
X$   long_line = f$extract(0,f$length(long_line)-1,long_line)
X$   gosub getline
X$   long_line = f$edit(long_line + line,"trim,compress")
X$   goto lloop8
X$lloop8end:
X$ outfn = f$element(3," ",long_line)
X$ cksum = f$element(4," ",long_line)`009`009`009! maybe ""
X$ recfm = long_line - ("$ call unpack " + outfn + " " + cksum + " ")
X$ if f$extract(0,1,recfm).eqs."""" .and.-
X     f$extract(f$length(recfm)-1,1,recfm).eqs."""" then -
X`009recfm = f$extract(1,f$length(recfm)-2,recfm)`009! unquote quoted string
X$ recfm = f$edit(recfm,"trim")
X$ goto unpack
X$!
X$!*****
X$!
X$unpack_801:`009!GOSUB`009`009`009! from VMS_SHARE 8.1 with /COMPRESS
X$! `009`009`009! NOTE: this will also work for files w/o /COMPRESS,
X$!`009`009`009!`009since Run_Flag='&' is always escaped by 8.1
X$ define/user sys$output nl:
X$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='ospec'
XPROCEDURE GetHex LOCAL x1,x2;x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,
XERASE_CHARACTER(1))-1;RETURN 16*x1+x2;ENDPROCEDURE;
XPROCEDURE SkipPartsep LOOP EXITIF INDEX(ERASE_LINE,"-+-+-+-+-+-+-+-+")=1;
XENDLOOP;ENDPROCEDURE;
XPROCEDURE ExpandChar CASE CURRENT_CHARACTER FROM ' ' TO 'z' ["&"]
V:ERASE_CHARACTER(1);x:=GetHex;COPY_TEXT(ASCII(GetHex)*x);["`096"]:ERASE_CHARA
XCTER(
X1);COPY_TEXT(ASCII(GetHex));[" "]:ERASE_CHARACTER(1);[OUTRANGE,INRANGE]
X:MOVE_HORIZONTAL(1);ENDCASE;ENDPROCEDURE;PROCEDURE ProcessLine s:=
VERASE_CHARACTER(1);LOOP EXITIF CURRENT_OFFSET>=LENGTH(CURRENT_LINE);ExpandCha
Xr;
XENDLOOP;IF s="V" THEN APPEND_LINE;ENDIF;ENDPROCEDURE;
XPROCEDURE AdvanceLine MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);
VENDPROCEDURE;PROCEDURE Decode POSITION(BEGINNING_OF(b));LOOP EXITIF MARK(NONE
X)=
XEND_OF(b);IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+-")=1 THEN SkipPartSep;
XELSE ProcessLine;AdvanceLine;ENDIF;ENDLOOP;ENDPROCEDURE;SET(FACILITY_NAME,
X"UNPACK");SET(SUCCESS,OFF);SET(INFORMATIONAL,OFF);t:="0123456789ABCDEF";f:=
XGET_INFO(COMMAND_LINE,"file_name");b:=CREATE_BUFFER(f,f);Decode;WRITE_FILE(b,
XGET_INFO(COMMAND_LINE,"output_file"));QUIT;
X$ return
X$!
X$!*****
X$!
X$getline:`009`009`009`009`009!GOSUB entry
X$ read/end=getline_eof UNSHAR_INPUT line`009!REPEATED for faster access...
X$ return 1
X$getline_eof:
X$ close UNSHAR_INPUT
X$ gosub getline_open
X$ goto getline
X$!
V$!*****`009VMS_SHARE 7.1-001 thru -004, 7.2-007 *****************************
X******
X$share701:
X$ if sharvers.eqs."" then sharvers = 701
X$ if sharvers.ne.701 then return SS$_FORMAT
X$ goto share7
X$share702:
X$ if sharvers.eqs."" then sharvers = 702
X$ if sharvers.ne.702 then return SS$_FORMAT
X$share7:
X$ open/write UNSHAR_TEMP 'f'
X$ w "-I-Working on next file ..."
X$cloop7:
X$ gosub getline
X$ if f$extract(0,14,line).eqs."$ CALL UNPACK " then goto cloop7end
X$ write UNSHAR_TEMP line
X$ goto cloop7
X$cloop7end:
X$ outfn = f$element(3," ",f$edit(line,"compress"))
X$ cksum = f$element(4," ",f$edit(line,"compress"))
X$ goto unpack
X$!
X$!*****
X$!
X$unpack_701:`009!GOSUB`009`009`009`009! from VMS_SHARE 7.1-004
X$ define/user sys$output nl:
X$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='ospec'
XPROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
XSUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");
Xbuff:=CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(buff))
X;LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
XBEGINNING_OF(buff));g:=0;LOOP EXITIF MARK(NONE)=END_OF(buff);x:=
XERASE_CHARACTER(1);IF g = 0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x=
X"V" THEN APPEND_LINE;MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;
XIF x="+" THEN g:=1;ERASE_LINE;ENDIF;ELSE IF x="-" THEN g:=0;ENDIF;ERASE_LINE;
VENDIF;ENDLOOP;p:="`096";POSITION(BEGINNING_OF(buff));LOOP r:=SEARCH(p,FORWARD
X);
XEXITIF r=0;POSITION(r);ERASE(r);COPY_TEXT(ASCII(INT(ERASE_CHARACTER(3))));
XENDLOOP;o:=GET_INFO(COMMAND_LINE,"output_file");WRITE_FILE(buff,o);
XENDPROCEDURE;Unpacker;EXIT;
X$ return
X$!
X$!*****
X$!
X$getline:`009`009`009`009`009!GOSUB entry
X$ read/end=getline_eof UNSHAR_INPUT line`009!REPEATED for faster access...
X$ return 1
X$getline_eof:
X$ close UNSHAR_INPUT
X$ gosub getline_open
X$ goto getline
X$!
X$!*****
X$!
X$unpack_702:`009!GOSUB`009`009`009`009! from VMS_SHARE 7.2-007
X$ define/user sys$output nl:
X$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='ospec'
XPROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
XSUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
XCREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
XLOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
XBEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
XIF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
XMOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
XERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
X1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
VPOSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`096",FORWARD);EXITIF r=0;POSITION(
Xr);
XERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
XCOPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
X"output_file"));ENDPROCEDURE;Unpacker;QUIT;
X$ return
V$!***************************************************************************
X***
X$!
X$getline:`009`009`009`009`009!GOSUB entry
X$ read/end=getline_eof UNSHAR_INPUT line`009!REPEATED for faster access...
X$ return 1
X$getline_eof:
X$ close UNSHAR_INPUT
X$ gosub getline_open
X$ goto getline
X$!
V$!*****`009VMS_SHARE 6.10 ***************************************************
X******
X$share6:
X$ if sharvers.eqs."" then sharvers = 610
X$ if sharvers.ne.610 then return SS$_FORMAT
X$!
X$ line = f$edit(line-x1,"trim")
X$ outfn = f$element(1,"""",line)
X$ if line.nes.""""+outfn+"""" then goto err_unx
X$ gosub getline
X$ if f$element(0,"=",line).nes."$ CHECKSUM_IS " then goto err_unx
X$ cksum = f$edit(line-"$ CHECKSUM_IS = ","trim")
X$ if f$type(cksum).nes."INTEGER" then goto err_unx
X$ gosub getline
X$ if f$edit(line,"trim").nes."$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY" then -
X`009goto err_unx
X$!*****`009do it
X$ open/write UNSHAR_TEMP 'f'
X$ w "-I-Working on ",outfn
X$cloop6:
X$ gosub getline
X$ if f$extract(0,19,line).eqs."$ GOSUB UNPACK_FILE" then goto cloop6end
X$ write UNSHAR_TEMP line
X$ goto cloop6
X$cloop6end:
X$ goto unpack
X$!
X$!*****
X$!
X$unpack_610:`009!GOSUB`009`009`009`009! from VMS_SHARE 6.10
X$ define/user sys$output nl:
X$ EDIT/TPU/NOSECT/NODISP/COMM=SYS$INPUT 'f'/OUTPUT='ospec'
Vb_part := CREATE_BUFFER( "`123Part`125", GET_INFO( COMMAND_LINE, "file_name"
X ) )
X; s_file_spec := GET_INFO( COMMAND_LINE, "output_file" ); SET( OUTPUT_FILE
V, b_part, s_file_spec ); b_errors := CREATE_BUFFER( "`123Errors`125" ); i_err
Xors`032
X:= 0; pat_beg_1 := ANCHOR & "-+-+-+ Beginning"; pat_beg_2 := LINE_BEGIN`032
X& "+-+-+-+ Beginning"; pat_end := ANCHOR & "+-+-+-+-+ End"; POSITION
X( BEGINNING_OF( b_part ) ); LOOP EXITIF SEARCH( SPAN( ' ' )@r_trail`032
X& LINE_END, FORWARD) = 0; POSITION( r_trail ); ERASE( r_trail ); ENDLOOP
X; POSITION( BEGINNING_OF( b_part ) ); i_append_line := 0; LOOP EXITIF MARK
X( NONE ) = END_OF( b_part ); s_x := ERASE_CHARACTER( 1 )
V; IF s_x = '+' THEN r_skip := SEARCH( pat_beg_1, FORWARD, EXACT ); IF r_skip`
X032
X<> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ERASE_LINE; ENDIF
X; ENDIF; IF s_x = '-' THEN r_skip := SEARCH( pat_end, FORWARD, EXACT )
V; IF r_skip <> 0 THEN s_x := ''; MOVE_HORIZONTAL( -CURRENT_OFFSET ); m_skip`0
X32
X:= MARK( NONE ); r_skip := SEARCH( pat_beg_2, FORWARD, EXACT ); IF r_skip`032
X<> 0 THEN POSITION( END_OF( r_skip ) ); MOVE_HORIZONTAL( -CURRENT_OFFSET )
V; MOVE_VERTICAL( 1 ); MOVE_HORIZONTAL( -1 ); ELSE POSITION( END_OF( b_part`03
X2
X) ); ENDIF; ERASE( CREATE_RANGE( m_skip, MARK( NONE ), NONE ) ); ENDIF; ENDIF
X; IF s_x = 'V' THEN s_x := ''; IF i_append_line <> 0 THEN APPEND_LINE
X; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF; i_append_line := 1
V; MOVE_VERTICAL( 1 ); ENDIF; IF s_x = 'X' THEN s_x := ''; IF i_append_line`03
X2
X<> 0 THEN APPEND_LINE; MOVE_HORIZONTAL( -CURRENT_OFFSET ); ENDIF
V; i_append_line := 0; MOVE_VERTICAL( 1 ); ENDIF; IF s_x <> '' THEN i_errors`0
X32
X:= i_errors + 1; s_text := CURRENT_LINE; POSITION( b_errors ); COPY_TEXT
X( "The following line could not be unpacked properly:" ); SPLIT_LINE
X; COPY_TEXT( s_x ); COPY_TEXT( s_text ); POSITION( b_part ); MOVE_VERTICAL
X( 1 ); ENDIF; ENDLOOP; POSITION( BEGINNING_OF( b_part ) ); LOOP r_x := SEARCH
X( "`096", FORWARD, EXACT ); EXITIF r_x = 0; POSITION( r_x ); ERASE_CHARACTER
X( 1 );`032
VIF CURRENT_CHARACTER = "`096" THEN MOVE_HORIZONTAL( 1 ); ELSE`009! wjm added
X ...
X       COPY_TEXT( ASCII( INT( ERASE_CHARACTER( 3 ) ) ) );`032
XENDIF;`009`009`009`009`009`009`009  ! ... for 6.03 - "`096`096"
X`009`009`009`009`009`009`009  ENDLOOP`009
X; IF i_errors = 0 THEN SET( NO_WRITE, b_errors, ON ); ELSE POSITION
X( BEGINNING_OF( b_errors ) ); COPY_TEXT( FAO
X( "The following !UL errors were detected while unpacking !AS", i_errors
X, s_file_spec ) ); SPLIT_LINE; SET( OUTPUT_FILE, b_errors, "SYS$COMMAND" )
X; ENDIF; EXIT;`032
X$ return
V$!***************************************************************************
X***
X$!
X$getline:`009`009`009`009`009!GOSUB entry
X$ read/end=getline_eof UNSHAR_INPUT line`009!REPEATED for faster access...
X$ return 1
X$getline_eof:
X$ close UNSHAR_INPUT
X$ gosub getline_open
X$ goto getline
X$!
V$!*****`009VMS_SHAR 5.04 ****************************************************
X******
X$share5:
X$ if sharvers.eqs."" then sharvers = 504
X$ if sharvers.ne.504 then return SS$_FORMAT
X$!
X$ line = f$edit(line-x1,"trim")
X$ outfn = f$element(1,"""",line)
X$ if line.nes.""""+outfn+"""" then goto err_unx
X$ gosub getline
X$ if f$element(0,"=",line).nes."$Check_Sum_is" then goto err_unx
X$ cksum = f$edit(line-"$Check_Sum_is=","trim")
X$ if f$type(cksum).nes."INTEGER" then goto err_unx
X$ gosub getline
X$ if f$edit(line,"trim").nes."$Copy SYS$Input VMS_SHAR_DUMMY.DUMMY" then -
X`009goto err_unx
X$!*****`009do it
X$ open/write UNSHAR_TEMP 'f'
X$ w "-I-Working on ",outfn
X$cloop5:
X$ gosub getline
X$ if f$extract(0,19,line).eqs."$GoSub Convert_File" then goto cloop5end
X$ write UNSHAR_TEMP line
X$ goto cloop5
X$cloop5end:
X$ goto unpack
X$!
X$!*****
X$!
X$unpack_504:`009!GOSUB`009`009`009`009! from VMS_SHAR 5.04-wjm
X$ define/user sys$output nl:
X$ EDIT/TPU/NOSECT/NODISP/COMM=SYS$INPUT 'f'/OUTPUT='ospec'
Xf:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
Xo:=Get_Info(Command_Line,"Output_File");Set(Output_File,b,o);
XPosition(Beginning_of(b));Loop x:=Erase_Character(1);Loop ExitIf x<>"V";
XMove_Vertical(1);x:=Erase_Character(1);Append_Line;
XMove_Horizontal(-Current_Offset);EndLoop;Move_Vertical(1);
XExitIf Mark(None)=End_of(b) EndLoop;Position(Beginning_of(b));Loop
Xx:=Search("`096",Forward,Exact);ExitIf x=0;Position(x);Erase_Character(1);
XIf Current_Character='`096' then Move_Horizontal(1);else
XCopy_Text(ASCII(INT(Erase_Character(3))));EndIf;EndLoop;Exit;
X$ return
V$!***************************************************************************
X***
X$!
X$!*****`009no more files ...`032
X$expect_end:
X$ if f$edit(line,"trim").eqs."$ v=f$verify(v)" then -`009! 7.1-004
X`009gosub getline
X$ if f$edit(line,"trim,upcase,collapse").nes."$EXIT" then goto err_unx
X$ close UNSHAR_INPUT
X$eoi:
X$ xstat=1
X$ goto done
X$!
X$!***** error handling
X$err_on:
X$ xstat=$status
X$ set noon
X$ if xstat.eq.RMS$_NMF then goto err_eoi
X$ e f$fao("-F-VMS error !AS!/-!AS",f$string(xstat),f$message(xstat)-"%")
X$ xstat=(xstat.and.%xFFFFFFF8).or.%x10000004
X$ goto done
X$err_unx:
X$ e "-E-UNXCMD, unexpected command in file: "+line
X$ xstat=%x10000002
X$ goto done
X$err_eoi:
X$ e "-E-UNXEOF, unexpected end of input file(s)"
X$ xstat=%x10000002
X$!
X$!*****`009final cleanup
X$done:
X$ if f$search(f).eqs."" then goto notemp
X$ close/nolog UNSHAR_TEMP
X$ delete/nolog 'f'*
X$notemp:
X$ close/nolog UNSHAR_INPUT
X$ deassign UNSHAR_INPUTS
X$!
X$ w "-I-Summary: "+-
X    f$fao("!SL file!%S created, !SL checksum error!%S, !SL file!%S skipped",-
X`009  sum_files,sum_cksum,sum_skip)
X$ if sum_ckskp.gt.0 then -
X`009w "-W-Checksum NOT checked on " +-
X`009  f$fao("!SL file!%S - NO GUARANTEES",sum_ckskp)
X$!
X$ exit xstat+f$ver(v,f$env("verify_image"))*0
$ GOSUB UNPACK_FILE
$ EXIT