suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs: fix compression-conversion build step to support LZ4

Browse Source
This commit is contained in:
Matthew Flatt 2019-05-25 07:18:37 -06:00
parent fb8368e373
commit e43bfd5767
1 changed files with 48 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
racket/src/cs/c/adjust-compress.rkt
View File

@ -1,13 +1,17 @@
#lang racket/base #lang racket/base
(require racket/file (require racket/file
racket/system
file/gzip file/gzip
file/gunzip) file/gunzip)
(provide enable-compress! (provide enable-compress!
compress-enabled? compress-enabled?
set-compress-format!
get-compress-format
adjust-compress) adjust-compress)
(define compress? #f) (define compress? #f)
(define compress-format 'lz4)
(define (enable-compress!) (define (enable-compress!)
(set! compress? #t)) (set! compress? #t))
@ -15,6 +19,14 @@
(define (compress-enabled?) (define (compress-enabled?)
compress?) 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) (define (reencode bstr encode)
(let ([o (open-output-bytes)] (let ([o (open-output-bytes)]
[i (open-input-bytes bstr)]) [i (open-input-bytes bstr)])
@ -24,15 +36,43 @@
(loop))) (loop)))
(get-output-bytes o))) (get-output-bytes o)))
(define (adjust-compress bstr) (define (lz4 flag bstr)
(if (bytes=? #"\0\0\0\0chez" (subbytes bstr 0 8)) (define o (open-output-bytes))
(if compress? (unless (parameterize ([current-input-port (open-input-bytes bstr)]
(reencode bstr (lambda (i o) (gzip-through-ports i o #f 0))) [current-output-port o])
bstr) (system* (find-executable-path "lz4") flag))
(if compress? (error "lz4 failed"))
bstr (get-output-bytes o))
(reencode bstr gunzip-through-ports))))
(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 (module+ main
(require racket/cmdline) (require racket/cmdline)