1	extend
2	! &
	! UNTAR.BAS						**	&
	! &
	! Author: Jim Burrows and Martin Minow
	! &
	! Decompile Unix tar tapes on VAX/VMS or RSTS/E.  The file has	&
	! been copied onto a disk using VRDMT.BAS on VMS or RDMT.BAS	&
	! on RSTS/E.
	! &
	! You should assume that you will have to modify this program	&
	! to suit your specific needs.					&
	! &
	! Note: lines marked with '**' will differ between		&
	! UNTAR and VUNTAR versions.  Others should not.		&
	! &

10	On error goto 19000		! Common error handler		&
\	LF$ = chr$(10%)			! Line feed			&

20	DefIndev$ = "dk:tartap.dat"	! Default input device	**	&
	\ DefLog$ = "sy:files.lst"	! Log file		**	&
	\ DefOut$ = "dskz:"		! Output header file	**	&

100	print "Input device (and file) <"; DefIndev$; ">";		&
\	input InDev$							&
\	InDev$ = cvt$$(InDev$, -1%)					&
\	InDev$ = DefIndev$ if InDev$ = ""				&
\	Rsize% = 512%							&

110	open InDev$ for input as file #1%,				&
	!	organization virtual,		!!		**	&
		recordsize Rsize%					&
		! InDev$ contains a block-by-block copy of the TAR tape	&

120	print "Log file <"; DefLog$; ">";				&
\	input LogFile$							&
\	LogFile$ = cvt$$(LogFile$, -1%)					&
\	LogFile$ = DefLog$ if LogFile$ = ""				&
\	open LogFile$ for output as file #3%				&
		! LogFile will contain a log of the unTAR process

130	if DefOut$ = ""							&
	    then print "Output header"					&
	    else print "Output header <"; DefOut$; ">"; 		&
\	input OutHead$							&
\	OutHead$ = cvt$$(OutHead$, -1%)					&
		! Output file header

140	DoDirectory% = Fngetyesno%("Directory only ", "No")		&
\	if DoDirectory% = 0% then					&
		Query% = Fngetyesno%("Inquire for each file ", "No")	&
\		IsAscii% = Fngetyesno%("Convert \n to <CR><LF>", "Yes")	&
! \	  	SubDir% = Fngetyesno%("foo/bar -> [.foo]bar", "No")  ** &

1000	InputBlocks% = 0%		! Total input block count	&
\	until 0%			! For all blocks in the file,	&
					! Get the file header and	&
					! Process the file		&
\	    get #1%			! Read header record 		&
\	    InputBlocks% = InputBlocks% + 1%				&
\	    field #1%,			! Parse the record buffer:	&
		100% as UnixFilNam$,	! Path name			&
		8% as ProtMode$,	! Protection mode		&
		8% as User$,		! User ID			&
		8% as Nlinks$,		! Number of links		&
		8% as BlkCnt$,		! Blocks of data		&
		3% as BytCnt$,		! Bytes in last block		&
		13% as UnixDate$,	! Seconds since 1970		&
		8% as CheckSum$,	! Random Number			&
		1% as LinkFlag$,	! == '1' if link		&
		100% as LinkPath$	! If needed			&
\	    UnixFilNam$, FilNam$ = cvt$$(UnixFilNam$, 1%+2%+4%)		&
\	    if right(UnixFilNam$, len(UnixFilNam$)) = '/' then		&
		print '"'; UnixFilNam$; '" is a directory.'		&
\		print #3%, '"'; UnixFilNam$; '" is a directory.'	&
\		goto 8000

1030	    if LinkFlag$ = '1' then					&
		LinkPath$ = cvt$$(LinkPath$, 1%+2%+4%)			&
\		print '"'; UnixFilNam$; '" linked to "'; LinkPath$	&
\		print #3%, '"'; UnixFilNam$; '" linked to "'; LinkPath$	&
\		goto 8000

1050	    gosub 12000				! Get Unix file		&
\	    BytCnt% = Fnb%(BytCnt$, 8%)		! convert oct->int for 	&
\	    BlkCnt% = Fnb%(BlkCnt$, 8%)		! block and byte counts	&
\	    goto 8000 if (BlkCnt% = 0% and BytCnt% = 0%)		&
\	    print '"'; UnixFilNam$; '"';				&
 		BlkCnt%; " blocks, "; BytCnt%; " bytes in last"		&
\	    print #3%, '"'; UnixFilNam$; '"';				&
		BlkCnt%; " blocks, "; BytCnt%; " bytes in last"		&
		    if DoDirectory% <> 0%

1100	    For Blk%=1% to BlkCnt%		! Copy all the blocks	&
\		Get #1%				! From channel one	&
\		InCount% = recount		! How many bytes	&
\		InputBlocks% = InputBlocks% + 1%			&
\		GoSub 10000			! This will open a file	&
\		GoSub 11000			! This writes record	&
\	    next blk%				! Do all blocks		&
\	    If (BytCnt%) then			! If stuff in a final	&
		get #1%				! block, get it and	&
\		InCount% = recount		! How many bytes	&
\		InputBlocks% = InputBlocks% + 1%			&
\		InCount% = BytCnt% if BytCnt% < InCount%		&
\		GoSub 10000			! (maybe open file)	&
\		GoSub 11000			! And output it		&

1200	    if DoDirectory% = 0% then					&
		Close #2%			! Outfile finished

8000	next					! For entire Archive	&

9000	Close #3%				! Logfile finished	&
\	goto 32767				! Exit program.		&

10000	return if (Bufsiz(2%) <> 0%)		! Return if file open	&
\	return if (DoDirectory% <> 0%)		! or directory only	&
\	if Query% <> 0% then						&
	    return if Fngetyesno%('"' + UnixFilNam$ + '"', "Yes") = 0%	&

10010	Open OutFile$ for input as file #2%	! See if it's there	&
\	Print OutFile$; " already exists!"				&
\	Close #2%							&
\	Input "new File name? "; OutFile$				&
\	Goto 10010							&

10100	if IsAscii%							&
	    then Open OutFile$ for output as file #2%	!	**	&
\	Print #3%, UnixFilNam$; "==>"; OutFile$				&

10200	return								&

10300	Print OutFile$; " is illegal"					&
	\ Input "new File name? "; OutFile$				&
	\ Goto 10010							&


11000	return if DoDirectory% <> 0%					&
\	If not IsAscii% then						&
	    put #2% + Swap%(1%), count InCount%		! Binary	&
\	    return							&

11010	i% = 0%						! Ascii		&
\	While i% < InCount%						&
\	    field #1%, i% as A$, InCount% - i% as A$			&
\	    j% = instr(1%, A$, LF$)					&
\	    if (j% = 0%) then			! If no more LF		&
		print #2%, A$;			! Finish this block	&
\		i% = InCount%			! Exit next time	&
\		goto 11080			! Continue		&

11020	    field #1%, i% as A$, j%-1% as A$	! Do another line	&
\	    print #2%, A$			! Line + <CR><LF>	&
\	    i% = i% + j%			! Step over newline	&

11080	next					! For the record	&

11090	return

12000	if SubDir% = 0% then gosub 12300	! Subdir?		&
	else					! Try for parse		&
	    SubDir$ = ""			! Sub directory string	&
\	    FilNam$ = right(FilNam$, 2%) if left(FilNam$, 1%) = '='	&
\	    q% = instr(1%, Filnam$, '/')	! Find foo/ dir. name	&
\	    while q% <> 0%						&
\		SubDir$ = SubDir$ + '.' + left(FilNam$, q% - 1%)	&
\		FilNam$ = right(FilNam$, q% + 1%)			&
\		q% = instr(1%, Filnam$, '/')				&
\	    next							&
\	    FilNam$ = '[' + SubDir$ + ']' + FilNam$ if SubDir$ <> ""	&
\	    gosub 12500				! Remove '_'		&
\	    OutFile$ = OutHead$ + FilNam$				&

12010	return								&

12300	gosub 12400				! No, remove path names	&
\	gosub 12500				! Squeeze '_'		&
\	OutFile$ = OutHead$ + FilNam$		! Output file name	&
\	return					! All done		&

12400	q% = instr(1%, FilNam$, '/')		! Remove path names	&
\	while q%				! All of them		&
\	    FilNam$ = right(FilNam$, q%+1%)	! Remove path		&
\	    q% = instr(1%, FilNam$, '/')	! More?			&
\	next					! Loop			&
\	return

12500	q% = instr(1%,filnam$,'_')		! Squeeze "foo_bar" to	&
\	While q%				! "foobar"		&
\	    FilNam$ = left(Filnam$, q% - 1%) + right(filnam$, q% + 1%)	&
\	    q% = instr(1%,filnam$,'_')		! another '_' ?		&
\	next					! for all '_'		&
\	return					! And exit		&

19000	resume 10100 if (erl = 10010 and err=5%)! Can't find file	&
	\ resume 10300 if (erl = 10010)		! Bad file name		&
	\ resume 9000 if (erl = 1000 and err = 11%)	! Normal	&

19100	print "Failed with error"; err; "at output block"; Blk%;	&
	    "and input block"; InputBlocks%				&
	\ close #3%				! Close log file	&

19999	on error goto 0				! Crash on fatal errors	&

24000	def fngetyesno%(prompt$, default$)	! Prompt and get truth	&
\	q% = 0%								&
\	until (q% = 1% or q% = 5%)					&
\	    print prompt$; "(Y/N) <"; default$; ">";			&
\	    input line q$						&
\	    q$ = cvt$$(q$, -1%)						&
\	    q$ = cvt$$(default$, -1%) if q$ = ""			&
\	    q% = instr(1%, "YES NO", q$)				&
\	next								&
\	fngetyesno% = (q% = 1%)						&
\	fnend

25550	def fnb%(s$, b%)			! Base b% to integer	&
\	s$ = cvt$$(s$, -1%)			! Fix case, strip junk	&
\	s$ = '0' if s$ = ""			! Null datum == 0	&
\	q = 0.0					! Must be floating	&
\	for q.ndx% = 1% to len(s$)					&
\	    q = b% * q + instr(1%,					&
		"0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",			&
		left(s$, 1%)) - 1%					&
\		s$=right(s$,2%)						&
\	next q.ndx%							&
\	q = q - 65536. if q > 32767.					&
\	fnb% = q							&
\	fnend								&

32767	end
