net/git-chckout: check ADLER32 after inflate
Check ADLER32 after inflate, instead of assuming that the inflated bytes are correct.
This commit is contained in:
parent
06a6d290fd
commit
d7db2aff59
|
@ -1081,6 +1081,20 @@
|
||||||
(arithmetic-shift (read-number-by-bits i (arithmetic-shift n -1))
|
(arithmetic-shift (read-number-by-bits i (arithmetic-shift n -1))
|
||||||
8))]))
|
8))]))
|
||||||
|
|
||||||
|
;; ADLER32 implementation
|
||||||
|
;; https://www.ietf.org/rfc/rfc1950.txt
|
||||||
|
(define (bytes-adler32 bstr)
|
||||||
|
(define ADLER 65521)
|
||||||
|
(define-values (s1 s2)
|
||||||
|
(for/fold ([s1 1]
|
||||||
|
[s2 0])
|
||||||
|
([bits (in-bytes bstr)])
|
||||||
|
(define a (modulo (+ s1 bits) ADLER))
|
||||||
|
(define b (modulo (+ s2 a) ADLER))
|
||||||
|
(values a b)))
|
||||||
|
; (s2 << 16) | s1
|
||||||
|
(bitwise-ior (arithmetic-shift s2 16) s1))
|
||||||
|
|
||||||
;; zlib-inflate : input-port output-port
|
;; zlib-inflate : input-port output-port
|
||||||
;; Reads compressed data from `i`, writes uncompressed to `o`
|
;; Reads compressed data from `i`, writes uncompressed to `o`
|
||||||
(define (zlib-inflate i o)
|
(define (zlib-inflate i o)
|
||||||
|
@ -1091,9 +1105,18 @@
|
||||||
(when (bitwise-bit-set? flg 5)
|
(when (bitwise-bit-set? flg 5)
|
||||||
;; read dictid
|
;; read dictid
|
||||||
(read-bytes-exactly 'dictid 4 i))
|
(read-bytes-exactly 'dictid 4 i))
|
||||||
(inflate i o)
|
;; obtain the uncompressed bytes even if o is a file port
|
||||||
|
(define intermediate-out (open-output-bytes))
|
||||||
|
(inflate i intermediate-out)
|
||||||
|
(define uncompressed (get-output-bytes intermediate-out))
|
||||||
|
(close-output-port intermediate-out)
|
||||||
|
;; pass the bytes to o
|
||||||
|
(display uncompressed o)
|
||||||
;; Verify checksum?
|
;; Verify checksum?
|
||||||
(read-bytes-exactly 'adler-checksum 4 i)
|
(define adler (read-bytes-exactly 'adler-checksum 4 i))
|
||||||
|
(unless (= (integer-bytes->integer adler #f #t)
|
||||||
|
(bytes-adler32 uncompressed))
|
||||||
|
(raise-git-error 'git-checkout "adler32 checksum failed"))
|
||||||
(void))
|
(void))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
Loading…
Reference in New Issue
Block a user