2019-12-27 18:46:02 -05:00
|
|
|
#!
|
2019-03-27 20:38:45 -04:00
|
|
|
|
|
|
|
(import (scheme base)
|
|
|
|
(scheme file)
|
|
|
|
(scheme process-context)
|
2019-06-23 05:16:23 -04:00
|
|
|
(scheme read)
|
2019-03-27 20:38:45 -04:00
|
|
|
(scheme write)
|
2019-06-23 05:16:23 -04:00
|
|
|
(trivial-tar-writer))
|
|
|
|
|
|
|
|
(define (slurp-binary-file filename)
|
|
|
|
(call-with-port
|
|
|
|
(open-binary-input-file filename)
|
|
|
|
(lambda (port)
|
|
|
|
(let loop ((whole (make-bytevector 0)))
|
|
|
|
(let ((part (read-bytevector 4096 port)))
|
|
|
|
(if (eof-object? part)
|
|
|
|
whole
|
|
|
|
(loop (bytevector-append whole part))))))))
|
|
|
|
|
2019-03-27 20:38:45 -04:00
|
|
|
(define (main arguments)
|
2019-06-23 05:16:23 -04:00
|
|
|
(for-each (lambda (file) (tar-write-file file (slurp-binary-file file)))
|
2019-03-27 20:38:45 -04:00
|
|
|
(cdr arguments)))
|
|
|
|
|
|
|
|
(main (command-line))
|