diff --git a/racket/src/cs/c/adjust-compress.rkt b/racket/src/cs/c/adjust-compress.rkt index 0a638daa13..12281c8e3d 100644 --- a/racket/src/cs/c/adjust-compress.rkt +++ b/racket/src/cs/c/adjust-compress.rkt @@ -1,13 +1,17 @@ #lang racket/base (require racket/file + racket/system file/gzip file/gunzip) (provide enable-compress! compress-enabled? + set-compress-format! + get-compress-format adjust-compress) (define compress? #f) +(define compress-format 'lz4) (define (enable-compress!) (set! compress? #t)) @@ -15,6 +19,14 @@ (define (compress-enabled?) compress?) +(define (set-compress-format! fmt) + (unless (memq fmt '(lz4 gzip)) + (error 'set-compress-format! "bad format: ~v" fmt)) + (set! compress-format fmt)) + +(define (get-compress-format) + compress-format) + (define (reencode bstr encode) (let ([o (open-output-bytes)] [i (open-input-bytes bstr)]) @@ -24,15 +36,43 @@ (loop))) (get-output-bytes o))) -(define (adjust-compress bstr) - (if (bytes=? #"\0\0\0\0chez" (subbytes bstr 0 8)) - (if compress? - (reencode bstr (lambda (i o) (gzip-through-ports i o #f 0))) - bstr) - (if compress? - bstr - (reencode bstr gunzip-through-ports)))) +(define (lz4 flag bstr) + (define o (open-output-bytes)) + (unless (parameterize ([current-input-port (open-input-bytes bstr)] + [current-output-port o]) + (system* (find-executable-path "lz4") flag)) + (error "lz4 failed")) + (get-output-bytes o)) +(define (adjust-compress bstr) + (cond + [(bytes=? #"\0\0\0\0chez" (subbytes bstr 0 8)) + ;; source is not compressed + (cond + [(and compress? (eq? compress-format 'gzip)) + (reencode bstr (lambda (i o) (gzip-through-ports i o #f 0)))] + [(and compress? (eq? compress-format 'lz4)) + (lz4 "-z" bstr)] + [else bstr])] + [(bytes=? #"\4\"M\30" (subbytes bstr 0 4)) + ;; source is LZ4 + (cond + [(and compress? (eq? compress-format 'gzip)) + (reencode (lz4 "-d" bstr) (lambda (i o) (gzip-through-ports i o #f 0)))] + [(and compress? (eq? compress-format 'lz4)) + bstr] + [else (lz4 "-d" bstr)])] + [(bytes=? #"\37\213\b" (subbytes bstr 0 3)) + ;; source is gzip + (cond + [(and compress? (eq? compress-format 'gzip)) + bstr] + [(and compress? (eq? compress-format 'lz4)) + (lz4 "-z" (reencode bstr gunzip-through-ports))] + [else + (reencode bstr gunzip-through-ports)])] + [else (error 'adjust-compress "unrecognized format ~s" (subbytes bstr 0 3))])) + (module+ main (require racket/cmdline)