diff --git a/racket/collects/net/git-checkout.rkt b/racket/collects/net/git-checkout.rkt index 99c83d6ff3..cb29b16d29 100644 --- a/racket/collects/net/git-checkout.rkt +++ b/racket/collects/net/git-checkout.rkt @@ -1083,17 +1083,24 @@ ;; ADLER32 implementation ;; https://www.ietf.org/rfc/rfc1950.txt -(define (bytes-adler32 bstr) +(define (adler32-through-ports in out) (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)) + (define bstr (make-bytes 4096)) + (let loop ([s1 1] [s2 0]) + (define n (read-bytes! bstr in)) + (cond + [(eof-object? n) + (bitwise-ior (arithmetic-shift s2 16) s1)] + [else + (write-bytes bstr out 0 n) + (define-values (new-s1 new-s2) + (for/fold ([s1 s1] + [s2 s2]) + ([bits (in-bytes bstr 0 n)]) + (define a (modulo (+ s1 bits) ADLER)) + (define b (modulo (+ s2 a) ADLER)) + (values a b))) + (loop new-s1 new-s2)]))) ;; zlib-inflate : input-port output-port ;; Reads compressed data from `i`, writes uncompressed to `o` @@ -1105,17 +1112,20 @@ (when (bitwise-bit-set? flg 5) ;; read dictid (read-bytes-exactly 'dictid 4 i)) - ;; 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? + ;; Include adler32 checksum in the pipeline, writing to `o`: + (define-values (checksum-in checksum-out) (make-pipe 4096)) + (define uncompressed-adler #f) + (define checksum-thread + (thread + (lambda () (set! uncompressed-adler (adler32-through-ports checksum-in o))))) + ;; Inflate, sending output to checksum (and then to `o`): + (inflate i checksum-out) + (close-output-port checksum-out) + (sync checksum-thread) + ;; Verify checksum (define adler (read-bytes-exactly 'adler-checksum 4 i)) (unless (= (integer-bytes->integer adler #f #t) - (bytes-adler32 uncompressed)) + uncompressed-adler) (raise-git-error 'git-checkout "adler32 checksum failed")) (void))