From 281497b61239273c4ea1a82e6005a6aeba7823d7 Mon Sep 17 00:00:00 2001 From: Lassi Kortela Date: Fri, 27 Dec 2019 15:24:11 +0200 Subject: [PATCH] Do not mutate bytevectors --- trivial-tar-writer.scm | 67 +++++++++++++++++++++++------------------- 1 file changed, 37 insertions(+), 30 deletions(-) diff --git a/trivial-tar-writer.scm b/trivial-tar-writer.scm index a70f792..8dcd44b 100644 --- a/trivial-tar-writer.scm +++ b/trivial-tar-writer.scm @@ -2,51 +2,58 @@ ;; SPDX-License-Identifier: ISC (define nulls (make-bytevector 512 0)) -(define zeros (make-bytevector 12 (char->integer #\0))) +(define blank-checksum (make-bytevector 7 (char->integer #\space))) -(define (tar-poke-string! header at nbyte string) +(define (tar-string nbyte string) (let* ((bytes (string->utf8 string)) (nnull (- nbyte (bytevector-length bytes)))) (when (< nnull 1) (error "tar: string too long")) - (bytevector-copy! header at bytes) - (bytevector-copy! header (+ at (bytevector-length bytes)) nulls 0 nnull))) + (bytevector-append bytes (make-bytevector nnull 0)))) -(define (tar-poke-octal! header at nbyte number) +(define (tar-octal nbyte number) (unless (integer? number) (error "tar: not an integer")) (when (< number 0) (error "tar: negative integer")) (let* ((bytes (string->utf8 (number->string number 8))) (nzero (- nbyte 1 (bytevector-length bytes)))) (when (< nzero 0) (error "tar: number too big")) - (bytevector-copy! header at zeros 0 nzero) - (bytevector-copy! header (+ at nzero) bytes) - (bytevector-u8-set! header (+ at nbyte -1) 0))) + (bytevector-append (make-bytevector nzero (char->integer #\0)) + bytes (bytevector 0)))) -(define (tar-header-checksum header) - (let ((n (bytevector-length header))) - (let loop ((i 0) (sum 0)) - (if (= i n) - (truncate-remainder sum (expt 8 6)) - (loop (+ i 1) (+ sum (bytevector-u8-ref header i))))))) +(define (tar-checksum . vectors) + (let loop-vectors ((vectors vectors) (sum 0)) + (if (null? vectors) (truncate-remainder sum (expt 8 6)) + (let* ((v (car vectors)) (n (bytevector-length v))) + (let loop-bytes ((i 0) (sum sum)) + (if (= i n) (loop-vectors (cdr vectors) sum) + (loop-bytes (+ i 1) (+ sum (bytevector-u8-ref v i))))))))) (define (tar-write-file fake-path bytes) - (let* ((header (make-bytevector 512 0)) + (let* ((unix-time-now 0) (nbyte (bytevector-length bytes)) (nnull (- 512 (truncate-remainder nbyte 512))) - (unix-time-now 0)) - (tar-poke-string! header 0 100 fake-path) - (tar-poke-octal! header 100 8 #o644) - (tar-poke-octal! header 108 8 0) - (tar-poke-octal! header 116 8 0) - (tar-poke-octal! header 124 12 nbyte) - (tar-poke-octal! header 136 12 unix-time-now) - (bytevector-copy! header 148 (make-bytevector 8 (char->integer #\space))) - (bytevector-u8-set! header 156 (char->integer #\0)) - (tar-poke-string! header 157 100 "") - (tar-poke-string! header 257 8 "ustar ") - (tar-poke-string! header 265 32 "root") - (tar-poke-string! header 297 32 "root") - (tar-poke-octal! header 148 7 (tar-header-checksum header)) - (write-bytevector header) + (header-before-checksum + (bytevector-append + (tar-string 100 fake-path) + (tar-octal 8 #o644) + (tar-octal 8 0) + (tar-octal 8 0) + (tar-octal 12 nbyte) + (tar-octal 12 unix-time-now))) + (header-after-checksum + (bytevector-append + (bytevector (char->integer #\space)) + (bytevector (char->integer #\0)) + (tar-string 100 "") + (tar-string 8 "ustar ") + (tar-string 32 "root") + (tar-string 32 "root") + (make-bytevector 183 0))) + (checksum (tar-octal 7 (tar-checksum header-before-checksum + blank-checksum + header-after-checksum)))) + (write-bytevector header-before-checksum) + (write-bytevector checksum) + (write-bytevector header-after-checksum) (write-bytevector bytes) (write-bytevector nulls (current-output-port) 0 nnull)))