( tal.tal ) ( ) ( by d_m ) ( ) ( see https://en.wikipedia.org/wiki/Tar_(computing)#UStar_format ) ( ) ( TODO: ) ( - check for "ustar" header ) ( - handle filename-prefix ) ( - handle 'L' entries ) ( - support creating archives ) ( - arg validation should depend on mode ) ( - better error messages on unsupported files, e.g. symlinks ) ( - better usage message ) ( - support using "-" for stdin/stdout? ) ( - option to ignore symlinks? ) ( File1 is used to read/write the tar file ) ( File2 is used to read/write files and directories ) |a0 @File1 [ &vec $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ] |b0 @File2 [ &vec $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ] |0100 ;arg-callback ;on-stdin arg/init BRK ( exit abnormally ) @panic ( -> $exit ) #010e DEO #010f DEO BRK @print-usage ( -> ) ;usage1 print ;usage2 !print ( handle all provided command-line arguments ) @arg-callback ( -> ) ;arg/count LDA DUP #00 GTH ?{ POP ;missing-mode !handle-error } DUP #01 GTH ?{ POP ;missing-filename !handle-error } POP !run @error-toomany ( -> BRK ) ;too-many-arguments !handle-error @error-noinput ( -> BRK ) ;no-input-arguments !handle-error @handle-error ( ;msg -> BRK ) print print-usage #01 !exit ( run the program ) @run ( -> BRK ) #01 arg/read .File1/name DEO2 #00 arg/read LDA DUP LIT "c NEQ ?{ POP create-archive #00 !exit } DUP LIT "t NEQ ?{ POP list-entries #00 !exit } DUP LIT "x NEQ ?{ POP expand-entries #00 !exit } POP ;invalid-mode print print-usage #00 !exit ( exit normally ) @exit ( code^ -> BRK ) #80 ORA #0f DEO BRK ( ignore stdin once we've processed the args ) @on-stdin ( -> BRK ) BRK ( print a null-terminated string ) @print ( s* -> ) &loop LDAk ?{ POP2 JMP2r } LDAk #18 DEO INC2 !&loop ( print up to `len` bytes from string. stops on NUL. ) @lprint ( s* len* -> ) OVR2 ADD2 SWP2 ( limit* s* ) &loop LDAk ?{ !&done } ( limit* s* ) LDAk #18 DEO INC2 GTH2k ?&loop ( limit* s+1* ) &done POP2 POP2 JMP2r ( ) @print-filename ( -> ) ;header/filename sanitize-path #0064 lprint #0a18 DEO JMP2r @print-long ( hi* lo* -> ) dump-long #0a18 DEO JMP2r ( read 512 bytes of header for the next tar entry. ) ( assumes .File1/name is already set. ) @read-header ( -> ok^ ) #0200 .File1/len DEO2 ;header .File1/r DEO2 .File1/ok DEI2 #0200 EQU2 JMP2r @write-header ( -> ok^ ) #0200 .File1/len DEO2 ;header .File1/w DEO2 .File1/ok DEI2 #0200 EQU2 JMP2r @validate-checksum ( -> ok^ ) ;header/checksum load-octal6 ( chi* clo* ) STH2k SWP2 STH2k SWP2 ( chi* clo* [clo* chi*] ) ;u-sum compute-sum ( chi* clo* uhi* ulo* [clo* chi*] ) u32-eq ?&ok1 ( [clo* chi*] ) STH2r STH2r ;s-sum compute-sum ( chi* clo* shi* slo* ) u32-eq ?&ok2 ( ) ;invalid-checksum print ( ; error message ) print-filename ( ; filename of affected entry ) ;expected print ( ; "expected: " ) ;header/checksum load-octal6 print-long ( ; expected checksum ) ;found print ( ; "found: " ) ;u-sum compute-sum print-long ( ; found checksum ) #00 JMP2r ( 0^ ) &ok1 POP2r POP2r &ok2 #01 JMP2r ( 1^ ) ( maximum checksum is 0001fe00 but in practice ) ( almost all checksums will fit in 16-bits ) @compute-sum ( fn* -> sum0* sum1* ) STH2 ;header/checksum ;header STH2kr JSR2 ( n0* [fn*] ) #0100 ADD2 ;uheader/end ;header/type STH2r JSR2 ( n1* n2* ) OVR2 ADD2 GTH2k #00 SWP ( n1* sum* carry* ) ROT2 POP2 SWP2 JMP2r ( carry* sum* ) @u32-eq ( xhi* xlo* yhi* ylo* -> bool^ ) ROT2 EQU2 STH EQU2 STHr AND JMP2r ( return 16-bit checksum ) ( technically it should be 17-bit. for simplicity we'll ) ( just check the lower 16-bits. ) @u-sum ( limit* start* -> sum* ) LIT2r 0000 ( limit* start* [sum*] ) &loop LDAk LITr 00 STH ( limit* start* [sum* n*] ) ADD2r INC2 GTH2k ?&loop ( limit* pos+1* [sum+n*] ) POP2 POP2 STH2r JMP2r ( sum* ) ( similar to unsigned-sum but treats 8-bit ascii differently ) ( mostly only used for compatibility with old tar files ) @s-sum ( limit* start* -> sum* ) LIT2r 0000 ( limit* start* [sum*] ) &loop LDAk ( limit* start* c^ [sum*] ) DUP #07 SFT #ff MUL SWP STH2 ( limit* start* [sum* n*] ) ADD2r INC2 GTH2k ?&loop ( limit* pos+1* [sum+n*] ) POP2 POP2 STH2r JMP2r ( sum* ) ( list all the entries in the tar archive ) @list-entries ( -> ) ;arg/count LDA #02 GTH ?error-toomany read-header ?{ JMP2r } ;header/filename LDA ?&non-null #800f DEO BRK &non-null validate-checksum ( ) ;header/type LDA ( type^ ) DUP #00 EQU ?list-file ( type^ ) DUP LIT "0 EQU ?list-file ( type^ ) DUP LIT "5 EQU ?list-dir ( type^ ) DUP LIT "7 EQU ?list-file ( type^ ) DUP LIT "x EQU ?list-posix-meta ( type^ ) !list-unsupported @list-posix-meta ( type^ -> ) POP ;header/size load-octal11 STH2 ( s0^ s1* [s2*] ) ORA ORA ?&meta-too-big &meta-too-big POP2r ;meta-too-big print ;header/size dump-longer #0a18 DEO !list-unsupported ( verbose file entry listing ) @list-unsupported ( type^ -> ) ;unsupported print #18 DEO #2018 DEO ;header/size load-octal11 dump-longer #2018 DEO print-filename ;header/size load-octal11 round-up-to-512 skip !list-entries ( verbose file entry listing ) @list-file ( type^ -> ) POP LIT "f #18 DEO #2018 DEO ;header/size load-octal11 dump-longer #2018 DEO print-filename ;header/size load-octal11 round-up-to-512 skip !list-entries ( verbose directory entry listing ) @list-dir ( 00^ -> ) POP LIT "d #18 DEO #2018 DEO ;header/size load-octal11 dump-longer #2018 DEO print-filename !list-entries ( expand a .tar archive in the current working directory ) @expand-entries ( -> ) ;arg/count LDA #02 GTH ?error-toomany read-header ?{ JMP2r } ;header/filename LDA ?&non-null #800f DEO BRK &non-null ;header/type LDA ( type^ ) DUP #00 EQU ?expand-file ( type^ ) DUP LIT "0 EQU ?expand-file ( type^ ) DUP LIT "5 EQU ?expand-dir ( type^ ) DUP LIT "7 EQU ?expand-file ( type^ ) !expand-unsupported ( remove leading / of an absolute path ) @sanitize-path ( s* -> s1* ) LDAk LIT "/ NEQ JMP INC2 JMP2r @remainder-512 ( n* -> extra* ) #01ff AND2 #0200 DUP2 ROT2 SUB2 NEQ2k ?{ POP2 #0000 } NIP2 JMP2r @expand-file ( type^ -> ) POP print-filename .File2/name DEO2 ;header/size load-octal11 STH2k write STH2r remainder-512 skip-lo !expand-entries @expand-dir ( type^ -> ) POP print-filename .File2/name DEO2 #0004 .File2/len DEO2 #0001 .File2/w DEO2 !expand-entries @expand-unsupported ( type^ -> ) ;unsupported print #18 DEO LIT2 ": 18 DEO #2018 DEO print-filename ;header/size load-octal11 round-up-to-512 skip !expand-entries @create-archive ( -> ) ;arg/count LDA #03 LTH ?error-noinput validate-inputs ?{ print-usage #01 !exit } ( ; we know that all input files exist ) #01 arg/read DUP2 path-exists ?&dest-exists .File1/name DEO2 #00 .File1/append DEO ;arg/count LDA #02 &loop DUP arg/read ;path-buf SWP2 archive-path ?&ok ;failed-to-write print arg/read print #0a18 DEO #01 !exit &ok INC GTHk ?&loop POP2 JMP2r &dest-exists ;destination-exists print print #0a18 DEO print-usage #01 !exit @validate-inputs ( -> ok^ ) ;arg/count LDA #02 LITr 01 ( count^ 2^ [1^] ) &loop DUP validate-input ( count^ i^ ok1^ [ok0^] ) STH ANDr INC GTHk ?&loop ( count^ i+1^ [ok2^] ) POP2 STHr JMP2r ( ok^ ) @validate-input ( i^ -> ok^ ) arg/read DUP2 path-exists ?&ok1 ;missing-input print print #0a18 DEO #00 JMP2r &ok1 ;long-size LDA LIT "? NEQ ?&ok2 ;input-toobig print print #0a18 DEO #00 JMP2r &ok2 POP2 #01 JMP2r @path-exists ( path* -> ) path-read-size ;long-size LDA LIT "! NEQ JMP2r @path-read-size ( path* -> ) .File2/name DEO2 #0008 .File2/len DEO2 ;long-size .File2/stat DEO2 JMP2r @archive-dir ( base* path* -> ok^ ) LIT2r =header ( base* path* [h*] ) STH2kr LDA LIT "/ NEQ ?&rel-path ( base* path* [h*] ) LIT ". STH2kr STA INC2r ( base* path* [h+1*] ) &rel-path DUP2 STH2r copy-str0 ( base* path* s1* ; write file name ) LIT2 "/ 00 SWP2 STA2 ( base* path* ; terminate dir path with / ) ;default-d-mode ;header/mode copy-str ( base* path* ; write file permissions ) ;default-id ;header/owner copy-str ( base* path* ; write file owner ) ;default-id ;header/group copy-str ( base* path* ; write file group ) #0000 #0000 ;scratch ( base* path* hi* lo* addr* ) render-octal32 ( base* path* ) #000b ;header/size save-octal ( base* path* ) ;default-mtime ;header/mtime copy-str ( base* path* ; write mtime ) LIT "5 ;header/type STA ( base* path* ; write '0' for normal file ) save-checksum ?archive-children ( base* path* ) POP2 POP2 #00 JMP2r ( not-ok^ ) @archive-children ( base* path* -> ok^ ) #010e DEO DUP2 .File2/name DEO2 ( path* ) #4000 .File2/len DEO2 ( path* ) ;ls-buf .File2/r DEO2 ( path* ) .File2/ok DEI2 DUP2 #4000 EQU2 ?&toobig ( path* size* ) #010e DEO POP2 ( path* ) ;ls-buf #0040 dump-mem ( path* ) print #0a18 DEO #01 JMP2r ( ok^ ) &toobig ;dir-toobig print print #0a18 DEO #01 !exit @archive-path ( base* path* -> ok^ ) zero-header ( base* path* ) ( TODO: copy path to base here, replace with base2 ) DUP2 path-read-size ( base* path* ) ;long-size LDA LIT "- EQU ?archive-dir ( base* path* ) LIT2r =header ( base* path* [h*] ) STH2kr LDA LIT "/ NEQ ?&rel-path ( base* path* [h*] ) LIT ". STH2kr STA INC2r ( base* path* [h+1*] ) &rel-path STH2r copy-str POP2 ( ; write file name ) ;default-f-mode ;header/mode copy-str ( ; write file permissions ) ;default-id ;header/owner copy-str ( ; write file owner ) ;default-id ;header/group copy-str ( ; write file group ) size-to-octal ( ; write file size ) ;default-mtime ;header/mtime copy-str ( ; write mtime ) LIT "0 ;header/type STA ( ; write '0' for normal file ) !save-checksum ( ok^ ) @save-checksum ( -> ) ;u-sum compute-sum ( checksum* ) ;scratch render-octal32 ( ) #0006 ;header/checksum save-octal ( ) #20 ;header/checksum #0007 ADD2 STA ( ) !write-header ( ok^ ) @ascii-to-digit ( c^ -> n* ) #00 SWP DUP #39 GTH #27 MUL SUB #30 SUB JMP2r @ascii-to-short ( s* -> n* ) #0000 SWP2 LITr c0 ( sum* s* [shift^] ) &loop LDAk ascii-to-digit ( sum0* s* digit* [shift^] ) STHkr SFT2 ( sum0* s* digit< ) ;long-size #0008 dump-mem ;long-size ascii-to-short ( hi* ) ;long-size/mid ascii-to-short ( hi* lo* ) ;scratch ( hi* lo* addr* ) render-octal32 ( ) #000b ;header/size save-octal ( ) JMP2r ( ) @render-octal32 ( hi* lo* addr* -> ) short-to-octal STH2 STH ( aaaaaaaa bbbbbbbb [addr+5* 0000000x] ) #0000 ROT ( aaaaaaaa 00000000 00000000 bbbbbbbb [addr+5* 0000000x] ) #10 SFT2 ( aaaaaaaa 00000000 0000000b bbbbbbb0 [addr+5* 0000000x] ) SWP2 #07 SFT2 ( 0000000b bbbbbbb0 0000000a aaaaaaa0 [addr+5* 0000000x] ) SWP2 STH ( 0000000a aaaaaaa0 0000000b [addr+5* 0000000x bbbbbbb0] ) ORA ORAr STHr ( 0000000a aaaaaaab bbbbbbbx [addr+5*] ) STH2r short-to-octal ( 0000000a 0000000z addr+10* ) STH2 SWP #10 SFT ORA ( 000000az [addr+10*] ) LIT "0 ADD STH2kr STA ( [addr+10*] ) ( STH2r INC2 JMP2r ) ( addr+11* ) POP2r JMP2r @short-to-octal ( n* addr* -> n>>15^ addr+5* ) byte-to-octal STH2 SWP ( lo>>6^ hi^ [addr+2*] ) DUP #01 AND #20 SFT ROT ORA ( hi^ [[hi&1]<<2]|lo>>6 [addr+2*] ) LIT "0 ADD STH2kr STA ( hi^ [addr+2*] ) #01 SFT INC2r ( hi>>1^ [addr+3*] ) STH2r !byte-to-octal ( hi>>7^ addr+5* ) @byte-to-octal ( n^ addr* -> n>>6^ addr+2* ) STH2 DUP #07 AND LIT "0 ADD ( n^ digit1^ [addr*] ) STH2kr STA #03 SFT INC2r ( n>>3^ [addr+1*] ) DUP #07 AND LIT "0 ADD ( n>>3^ digit2^ [addr+1*] ) STH2kr STA #03 SFT INC2r ( n>>6^ [addr+2*] ) STH2r JMP2r ( n>>6^ addr+2* ) @save-octal ( count* addr* -> ) LIT2r ffff ( count* addr* [ffff*] ) OVR2 ADD2 ( count* addr+count* [ffff*] ) STH2 ( count* [ffff* addr+count*] ) OVR2r ADD2r ( count* [ffff* h=addr+count-1*] ) ;scratch SWP2 ( s* count* [ffff* h*] ) OVR2 ADD2 SWP2 ( limit=count+s* s* [ffff* h*] ) &loop LDAk STH2kr STA ( limit* s* [ffff* h*] ; h<-s ) INC2 OVR2r ADD2r GTH2k ?&loop ( limit* s+1* [ffff* h-1*] ) POP2 POP2 POP2r POP2r JMP2r ( ) @copy-str0 ( s* addr* -> s1* ) STH2 &loop LDAk DUP ?&next POP POP2 STH2r JMP2r &next STH2kr STA INC2 INC2r !&loop @copy-str ( s* addr* -> ) copy-str0 POP2 JMP2r ( we know header is exactly 512 bytes, an even number ) @zero-header ( -> ) ;uheader/end ;header LIT2r 0000 &loop STH2kr OVR2 STA2 INC2 INC2 GTH2k ?&loop POP2r POP2 POP2 JMP2r ( writes `n` bytes from File1 to File2 ) ( uses a 32k internal buffer ) @write ( carry^ hi* lo* -> ) ;write-buf ;write-lo/writer STA2 write-lo write-hi ?write-4g JMP2r ( writes up to 32768 bytes of; limited by the size of buf ) @write-buf ( n* -> ) ORAk ?{ POP2 JMP2r } ( n* ) DUP2 .File1/len DEO2 ( n* ) ;buffer .File1/r DEO2 ( n* ) DUP2 .File1/ok DEI2 EQU2 ?&ok ( n* ) POP2 ;read-error print !panic ( ) &ok ( n* ) DUP2 .File2/len DEO2 ( n* ) ;buffer .File2/w DEO2 ( n* ) .File2/ok DEI2 EQU2 ?&ok2 ( ) ;write-error print !panic ( ) &ok2 JMP2r ( ) ( skips `n` bytes forward in File1, specified as a 5-byte integer ) ( ) ( since we can only actually read 32k at a time, and since we can ) ( only easily work with 2-byte shorts, we first read the lowest ) ( two bytes and skip that much. then, for the higher byte, we can ) ( do two skips of 32k for each unit found. ) @skip ( carry^ hi* lo* -> ) ;skip-buf ;write-lo/writer STA2 write-lo write-hi ?write-4g JMP2r @skip-lo ( lo* -> ) ;skip-buf ;write-lo/writer STA2 !write-lo ( skips up to 32768 bytes of; limited by the size of buf ) @skip-buf ( n* -> ) ORAk ?{ POP2 JMP2r } DUP2 .File1/len DEO2 ;buffer .File1/r DEO2 .File1/ok DEI2 EQU2 ?&ok ;read-error print !panic &ok JMP2r ( unconditionally write 4GiB, that is 4294967296 bytes ) @write-4g ( -> ) write-2g ( >> ) ( unconditionally write 2GiB, that is 2147483648 bytes ) @write-2g ( -> ) #8000 !write-hi ( writes `hi*65536` bytes ) ( - 0001 will write 65536 bytes ) ( - 0010 will write 1048576 bytes ) ( - ffff will write 4294901760 bytes ) @write-hi ( hi* -> ) #0000 SWP2 SUB2 ( -hi* ) &loop ORAk ?&ok POP2 JMP2r ( ) &ok write-64k INC2 !&loop ( -hi+1* ) ( writes exactly 65536 bytes ) @write-64k ( -> ) write-32k ( >> ) ( writes exactly 32768 bytes ) @write-32k ( -> ) #8000 ( >> ) ( write up to 65536 bytes ) @write-lo ( lo* -> ) DUP2 #8001 LTH2 ?{ write-32k #8000 SUB2 } LIT2 [ &writer =write-buf ] JMP2 ( '0' -> 00 ) ( '1' -> 01 ) ( ... ) ( '7' -> 07 ) ( anything else -> 00 ) @octal-digit ( char^ -> oct^ ) LIT "0 SUB DUP #08 LTH ?{ POP #00 } JMP2r ( returns values between #00:0000:0000 and #01:ffff:ffff ) ( ) ( octal11 of 77777777777 = #01 #ffff #ffff, max value ) ( octal11 of 37777777777 = #00 #ffff #ffff ) ( octal11 of 00000177777 = #00 #0000 #ffff ) ( octal11 of 00000000377 = #00 #0000 #00ff ) ( octal11 of 00000000000 = #00 #0000 #0000, min value ) @load-octal11 ( addr* -> carry^ hi* lo* ) INC2k load-octal10 ( addr* hi* lo* ; load addr+1 ) STH2 STH2 ( addr* [lo* hi*] ) LDA octal-digit STH2r STH ( octal^ a^ [lo* b^] ) #20 SFT #02 SFT2 STHr STH2r ( carry^ hi* lo* ) JMP2r ( carry^ hi* lo* ) ( returns values between #0000:0000 and #3fff:ffff ) ( ) ( octal10 of 7777777777 = #3fff #ffff, max value ) ( octal10 of 0000177777 = #0000 #ffff ) ( octal10 of 0000000377 = #0000 #00ff ) ( octal10 of 0000000000 = #0000 #0000, min value ) @load-octal10 ( addr* -> hi* lo* ) #0005 OVR2 ADD2 ( addr* addr+5* ) load-octal5 STH2 ( addr* [cd*] ) load-octal5 SWPr STHr ( ab* c^ [d^] ) #10 SFT #01 SFT2 STH SWPr ( a^ b>>1^ [lo*] ) #10 SFT #01 SFT2 STH2r ( hi* lo* ) JMP2r ( hi* lo* ) ( returns values between #0000 #0000 and #0003 #ffff ) @load-octal6 ( addr* -> hi* lo* ) STH2k LDA octal-digit ( o^ [addr*] ) #0001 SFT2 ( o1^ o2^ [addr*] ) #0000 ROT SWP2 SWP SWP2 ( o1* o2* [addr*] ) STH2r INC2 load-octal5 ( o1* o2* n* ) ORA2 JMP2r ( o1* o2|n* ) ( returns values between #0000 and #7fff ) ( ) ( octal5 of 77777 = #7fff, max value ) ( octal5 of 00377 = #00ff ) ( octal5 of 00000 = #0000, min value ) @load-octal5 ( addr* -> num* ) #1000 LIT2r 0000 ( addr* place* [sum*] ) &loop ( pos* place* [sum*] ) OVR2 LDA octal-digit ( addr* place* digit^ [sum*] ) #00 SWP ( addr* place* digit* [sum*] ) OVR2 MUL2 STH2 ADD2r ( addr* place* [sum2=sum+place*digit*] ) SWP2 INC2 SWP2 ( addr+1* place* [sum2*] ) #03 SFT2 ORAk ?&loop ( addr+1* place>>3* [sum2*] ) POP2 POP2 STH2r JMP2r ( sum2* ) ( emit 1, 2, 4, or 5 bytes as a decimal number ) ( @emit &1+long STH2 STH2 /byte STH2r STH2r &long SWP2 /short &short SWP /byte &byte DUP #04 SFT /char &char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO JMP2r ) ( round a given 5-byte size up to multiples of 512 ) @round-up-to-512 ( carry^ hi* lo* -> chl^** ) DUP2 #01ff AND2 ORA ?{ JMP2r } DUP2 #fe00 GTH2 ?{ #0200 OVR2 #01ff AND2 SUB2 ADD2 JMP2r } POP2 DUP2 #ffff EQU2 ?{ INC2 #0000 JMP2r } POP2 INC #0000 #0000 JMP2r ( since 4-byte integers are called `long` values, ) ( i'm calling a 5-byte integer a `longer` value. ) @dump-longer ( carry^ long** -- ) STH2 STH2 dump-byte STH2r STH2r ( >> ) @dump-long ( long** -- ) SWP2 dump-short ( >> ) @dump-short ( short* -- ) SWP dump-byte ( >> ) @dump-byte ( byte^ -- ) DUP #04 SFT /hex #0f AND ( >> ) &hex #30 ADD DUP #39 GTH #27 MUL ADD #18 DEO JMP2r @dump-mem ( start* size* -> ) OVR2 ADD2 SWP2 ( lim* start* ) LDAk dump-byte INC2 ( lim* start+1* ) &loop GTH2k ?&ok POP2 POP2 #0a18 DEO JMP2r ( lim^ pos^ ) &ok #2018 DEO LDAk dump-byte INC2 !&loop ( lim^ pos+1^ ) @dump-header ( -> ) LIT2 "- 18 DEOk DEOk DEOk DEOk DEO #0a18 DEO ;header/filename #0064 dump-mem ;header/mode #0008 dump-mem ;header/owner #0008 dump-mem ;header/group #0008 dump-mem ;header/size #000c dump-mem ;header/mtime #000c dump-mem ;header/checksum #0008 dump-mem ;header/type #0001 dump-mem ;header/linkname #0064 dump-mem LIT2 "+ 18 DEOk DEOk DEOk DEOk DEO #0a18 DEO ;uheader/ustar #0006 dump-mem ;uheader/version #0002 dump-mem ;uheader/owner-name #0020 dump-mem ;uheader/group-name #0020 dump-mem ;uheader/major #0008 dump-mem ;uheader/minor #0008 dump-mem ;uheader/filename-prefix #009b dump-mem ;uheader/pad #000c dump-mem LIT2 "- 18 DEOk DEOk DEOk DEOk DEO #0a18 DEO JMP2r ( some handy string constants ) @usage1 "usage: 20 "uxncli 20 "tar.rom 20 "t|x 20 "TARFILE 0a 00 @usage2 20 20 20 20 20 20 20 "uxncli 20 "tar.rom 20 "c 20 "TARFILE 20 "FILE1 20 "... 0a 00 @missing-mode "error: 20 "missing 20 "mode 0a 00 @missing-filename "error: 20 "missing 20 "filename 0a 00 @too-many-arguments "error: 20 "too 20 "many 20 "arguments 0a 00 @no-input-arguments "error: 20 "no 20 "input 20 "files 0a 00 @invalid-mode "error: 20 "invalid 20 "mode 0a 00 @read-error "error 20 "reading 20 "data 0a 00 @write-error "error 20 "writing 20 "data 0a 00 @unsupported "skipped 20 "unsupported 20 "type 20 00 @meta-too-big "extended 20 "metadata 20 "field 20 "too 20 "big: 20 00 @invalid-checksum "error: 20 "invalid 20 "checksum 0a 00 @expected "expected: 20 00 @found "found: 20 20 20 20 00 @missing-input "error: 20 "missing 20 "input 20 "file: 20 00 @input-toobig "error: 20 "input 20 "file 20 "too 20 "large: 20 00 @destination-exists "error: 20 "destination 20 "already 20 "exists: 20 00 @default-d-mode "0000755 00 @default-f-mode "0000644 00 @default-id "0000000 00 @default-mtime "07033241577 00 @failed-to-write "error: 20 "failed 20 "to 20 "write 20 "file: 20 00 @dir-toobig "error: 20 "input 20 "directory 20 "listing 20 "too 20 "large: 20 00 ( load argument parser ) ~arg.tal ( HEADER DETAILS ) ( ) ( header -- basic v7 tar header ) ( /filename - name of file, null-terminated. if ustar, check prefix ) ( /mode - file permissions, ignored by uxn ) ( /owner - owner ID, ignored by uxn ) ( /group - group ID, ignored by uxn ) ( /size - file size as 11 octal digits. max size is 8GiB. ) ( /mtime - last modification time, ignored by uxn ) ( /checksum - 6 octal digits followed by NUL, then space ) ( /type -- only 0, 5, and 7 are supported ) ( '0' [or NUL] normal file ) ( '1' hard link ) ( '2' symlink ) ( '3' character device ) ( '4' block device ) ( '5' directory ) ( '6' fifo ) ( '7' contiguous file -- treat as normal file ) ( 'g' global extended header with metadata; POSIX.1-2001 ) ( 'x' extended header with metadata for next file; POSIX.1-2001 ) ( 'A' solaris ACL ) ( 'D' gnu dump dir ) ( 'E' solaris extended attrs ) ( 'I' inode metadata ) ( 'K' this entry's data is the long link location of next file, null-terminated? ) ( 'L' this entry's data is the long filename of next file, null-terminated ) ( 'M' continuation file ) ( 'N' old gnu for long names ) ( 'S' sparse files ) ( 'V' tape/volume header ) ( 'X' extended attrs, sun ) ( /linkname -- for hardlinks, the file containing the linked data ) ( uheader -- ustar header, found in v7 padding bytes ) ( /ustar -- ustar indiciator, should be "ustar " ) ( /version -- ustar version ) ( /owner-name -- owner name string, ignored by uxn ) ( /group-name -- group name string, ignored by uxn ) ( /major -- major device number, ignored by uxn ) ( /minor -- minor device number, ignored by uxn ) ( /filename-prefix -- if non-null, true path is prefix+"/"+filename ) ( ) ( the v7 header is always 512 bytes even if ustar indicator is absent. ) @header &filename $64 ( 0x00: filename, string, 100 byte ) &mode $8 ( 0x64: mode, octal-1, 8 bytes ) &owner $8 ( 0x6c: owner, octal-1, 8 bytes ) &group $8 ( 0x74: group, octal-1, 8 bytes ) &size $c ( 0x7c: size, octal-1, 12 bytes ) &mtime $c ( 0x88: mtime, octal-1, 12 bytes ) &checksum $8 ( 0x94: checksum, octal-2, 8 bytes ) &type $1 ( 0x9c: file type, 1 byte ) &linkname $64 ( 0x9d: linked filename, string, 100 bytes ) ( >> ) @uheader &ustar $6 ( 0x101: ustar indicator, non-terminated string, 6 bytes, "ustar " ) &version $2 ( 0x107: ustar version, non-terminated string, 2 bytes ) &owner-name $20 ( 0x109: owner name, string, 32 bytes ) &group-name $20 ( 0x129: group name, string, 32 bytes ) &major $8 ( 0x149: device major number, octal? ) &minor $8 ( 0x151: device minor number, octal? ) &filename-prefix $9b ( 0x159: prefix before filename, string, 155 bytes ) &pad $c ( 0x1f4: padding, 12 bytes ) &end ( 0x200: end of header ) ( path buffer ) |3be8 @path-buf $400 ( small scratch buffer ) |3fe8 @scratch $10 ( up to 8 bytes for long size ) |3ff8 @long-size $4 &mid $4 ( buffer for up to 2048 characters of long names/paths ) |4000 @ls-buf $4000 ( buffer for reading up to 32k bytes of data at a time ) |8000 @buffer $8000