correctly compute and validate checksums
This commit is contained in:
parent
e1579c56f3
commit
a17211edc9
86
tar.tal
86
tar.tal
|
|
@ -43,8 +43,8 @@
|
|||
@run ( -> BRK )
|
||||
#01 arg/read .File1/name DEO2
|
||||
#00 arg/read LDA
|
||||
DUP LIT "t NEQ ?{ list-entries #00 !exit }
|
||||
DUP LIT "x NEQ ?{ expand-entries #00 !exit }
|
||||
DUP LIT "t NEQ ?{ POP list-entries #00 !exit }
|
||||
DUP LIT "x NEQ ?{ POP expand-entries #00 !exit }
|
||||
POP ;invalid-mode print ;usage print #00 !exit
|
||||
|
||||
( exit normally )
|
||||
|
|
@ -67,20 +67,73 @@
|
|||
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
|
||||
( TODO validate checksum )
|
||||
.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 ( -> )
|
||||
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^ )
|
||||
|
|
@ -104,8 +157,7 @@
|
|||
;unsupported print
|
||||
#18 DEO #2018 DEO
|
||||
;header/size load-octal11 dump-longer #2018 DEO
|
||||
;header/filename sanitize-path
|
||||
#0064 lprint #0a18 DEO
|
||||
print-filename
|
||||
;header/size load-octal11 round-up-to-512 skip !list-entries
|
||||
|
||||
( verbose file entry listing )
|
||||
|
|
@ -113,7 +165,7 @@
|
|||
POP
|
||||
LIT "f #18 DEO #2018 DEO
|
||||
;header/size load-octal11 dump-longer #2018 DEO
|
||||
;header/filename #0064 lprint #0a18 DEO
|
||||
print-filename
|
||||
;header/size load-octal11 round-up-to-512 skip !list-entries
|
||||
|
||||
( verbose directory entry listing )
|
||||
|
|
@ -121,7 +173,7 @@
|
|||
POP
|
||||
LIT "d #18 DEO #2018 DEO
|
||||
;header/size load-octal11 dump-longer #2018 DEO
|
||||
;header/filename #0064 lprint #0a18 DEO
|
||||
print-filename
|
||||
!list-entries
|
||||
|
||||
( expand a .tar archive in the current working directory )
|
||||
|
|
@ -146,16 +198,14 @@
|
|||
|
||||
@expand-file ( type^ -> )
|
||||
POP
|
||||
;header/filename sanitize-path
|
||||
DUP2 #0064 lprint #0a18 DEO
|
||||
print-filename
|
||||
.File2/name DEO2
|
||||
;header/size load-octal11 STH2k write
|
||||
STH2r remainder-512 skip-lo !expand-entries
|
||||
|
||||
@expand-dir ( type^ -> )
|
||||
POP
|
||||
;header/filename sanitize-path
|
||||
DUP2 #0064 lprint #0a18 DEO
|
||||
print-filename
|
||||
.File2/name DEO2
|
||||
#0004 .File2/len DEO2
|
||||
#0001 .File2/w DEO2
|
||||
|
|
@ -164,8 +214,7 @@
|
|||
@expand-unsupported ( type^ -> )
|
||||
;unsupported print
|
||||
#18 DEO LIT2 ": 18 DEO #2018 DEO
|
||||
;header/filename sanitize-path
|
||||
#0064 lprint #0a18 DEO
|
||||
print-filename
|
||||
;header/size load-octal11 round-up-to-512 skip !expand-entries
|
||||
|
||||
( src and dst should be paths )
|
||||
|
|
@ -275,6 +324,14 @@
|
|||
#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 )
|
||||
|
|
@ -359,6 +416,9 @@
|
|||
@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
|
||||
|
||||
( load argument parser )
|
||||
~arg.tal
|
||||
|
|
|
|||
Loading…
Reference in New Issue