build: remove tracked generated .sls files and ignore them
ober
147a7c2841a14579bbe03f1d7bd1af5458d28345
--- a/.gitignore +++ b/.gitignore @@ -2,6 +2,7 @@ **/*.so **/*.wpo **/*.hash +**/*.sls !vendor/**/*.so # jerbuild whole-program build scratch deleted file mode 100644 --- a/lib/jerboa-coreutils/arch.sls +++ /dev/null @@ -1,41 +0,0 @@ -#!chezscheme -;;; Generated by jerbuild — DO NOT EDIT -;;; Source: src/jerboa-coreutils/arch.ss - -(library (jerboa-coreutils arch) - (export main) - (import - (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- - getenv path-extension path-absolute? thread? make-mutex - mutex? mutex-name) - (only (std sugar) with-catch) (jerboa-coreutils common) - (jerboa-coreutils common version) - (jerboa-coreutils common security) (jerboa core) - (jerboa runtime)) - (def (arch-machine) - (with-catch - (lambda (e) "unknown") - (lambda () - (let-values ([(to-stdin from-stdout from-stderr pid) - (open-process-ports - "/usr/bin/uname -m" - (buffer-mode block) - (native-transcoder))]) - (let ([result (get-line from-stdout)]) - (close-port to-stdin) - (close-port from-stdout) - (close-port from-stderr) - (if (eof-object? result) "unknown" result)))))) - (def (main . args) - (parameterize ([program-name "arch"]) - (init-security!) - (install-proc-only-landlock!) - (install-readonly-seccomp!) - (cond - [(and (pair? args) (member (car args) '("--help" "-h"))) - (displayln "Usage: arch") - (displayln - "Print machine hardware name (same as uname -m).")] - [(and (pair? args) (member (car args) '("--version"))) - (version-info "arch")] - [else (displayln (arch-machine))])))) deleted file mode 100644 --- a/lib/jerboa-coreutils/b2sum.sls +++ /dev/null @@ -1,138 +0,0 @@ -#!chezscheme -;;; Generated by jerbuild — DO NOT EDIT -;;; Source: src/jerboa-coreutils/b2sum.ss - -(library (jerboa-coreutils b2sum) - (export main) - (import - (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- - getenv path-extension path-absolute? thread? make-mutex - mutex? mutex-name) - (only (std sugar) with-catch) - (only (std format) eprintf format) (std cli getopt) - (jerboa-coreutils common) (jerboa-coreutils common version) - (jerboa-coreutils common security) (jerboa core) - (jerboa runtime)) - (def (string-index-of str ch) - (let loop ([i 0]) - (cond - [(>= i (string-length str)) #f] - [(eqv? (string-ref str i) ch) i] - [else (loop (+ i 1))]))) - (def (b2sum-file path) - (with-catch - (lambda (e) (warn "~a: ~a" path (error-message e)) #f) - (lambda () - (let* ([cmd (if (string=? path "-") - "openssl dgst -blake2b512 -r 2>/dev/null" - (string-append - "openssl dgst -blake2b512 -r " - (shell-quote path) - " 2>/dev/null"))] - [input-data (if (string=? path "-") - (let loop ([acc '()]) - (let ([byte (get-u8 - (standard-input-port))]) - (if (eof-object? byte) - (u8-list->bytevector - (reverse acc)) - (loop (cons byte acc))))) - #f)]) - (let-values ([(to-stdin from-stdout from-stderr pid) - (open-process-ports - cmd - (buffer-mode block) - (native-transcoder))]) - (when input-data - (let ([len (bytevector-length input-data)]) - (let loop ([i 0]) - (when (< i len) - (put-char - to-stdin - (integer->char (bytevector-u8-ref input-data i))) - (loop (+ i 1)))))) - (close-port to-stdin) - (let ([line (get-line from-stdout)]) - (close-port from-stdout) - (close-port from-stderr) - (when (and line (not (eof-object? line))) - (let ([space-pos (string-index-of line #\space)]) - (if space-pos - (let ([hex (substring line 0 space-pos)] - [name (if (string=? path "-") "-" path)]) - (displayln hex " " name)) - (displayln line)))))))))) - (def (b2sum-check checkfile) - (let* ([port (if (string=? checkfile "-") - (current-input-port) - (with-catch - (lambda (e) - (die "~a: ~a" checkfile (error-message e))) - (lambda () - (checked-open-input-file checkfile))))] - [ok #t]) - (let loop () - (let ([line (get-line port)]) - (unless (eof-object? line) - (unless (string=? line "") - (let ([parts (split-checksum-line line)]) - (when (and (pair? parts) (pair? (cdr parts))) - (let* ([expected (car parts)] - [filename (cadr parts)] - [actual (compute-b2-hex filename)]) - (if (and actual (string=? expected actual)) - (displayln filename ": OK") - (begin - (displayln filename ": FAILED") - (set! ok #f))))))) - (loop)))) - (unless (string=? checkfile "-") (close-port port)) - (unless ok (exit 1)))) - (def (compute-b2-hex path) - (with-catch - (lambda (e) #f) - (lambda () - (let ([cmd (string-append - "openssl dgst -blake2b512 -r " - (shell-quote path) - " 2>/dev/null")]) - (let-values ([(to-stdin from-stdout from-stderr pid) - (open-process-ports - cmd - (buffer-mode block) - (native-transcoder))]) - (close-port to-stdin) - (let ([line (get-line from-stdout)]) - (close-port from-stdout) - (close-port from-stderr) - (if (and line (not (eof-object? line))) - (let ([space-pos (string-index-of line #\space)]) - (if space-pos (substring line 0 space-pos) #f)) - #f))))))) - (def (split-checksum-line line) - (let ([len (string-length line)]) - (let loop ([i 0]) - (cond - [(>= (+ i 1) len) (list line)] - [(and (eqv? (string-ref line i) #\space) - (eqv? (string-ref line (+ i 1)) #\space)) - (list (substring line 0 i) (substring line (+ i 2) len))] - [else (loop (+ i 1))])))) - (def (main . args) - (parameterize ([program-name "b2sum"]) - (init-security!) - (install-readonly-seccomp!) - (call-with-getopt - (lambda (_ opt) - (let ([files (if (null? (hash-ref opt 'rest)) - '("-") - (hash-ref opt 'rest))]) - (if (hash-get opt 'check) - (for-each b2sum-check files) - (for-each b2sum-file files)))) - args 'program: "b2sum" 'help: - "Print or check BLAKE2 (512-bit) checksums." - (flag 'check "-c" "--check" 'help: - "read BLAKE2 sums from the FILEs and check them") - (flag 'tag "--tag" 'help: "create a BSD-style checksum") - (rest-arguments 'rest))))) deleted file mode 100644 --- a/lib/jerboa-coreutils/base32.sls +++ /dev/null @@ -1,187 +0,0 @@ -#!chezscheme -;;; Generated by jerbuild — DO NOT EDIT -;;; Source: src/jerboa-coreutils/base32.ss - -(library (jerboa-coreutils base32) - (export main) - (import - (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- - getenv path-extension path-absolute? thread? make-mutex - mutex? mutex-name) - (except (jerboa core) bytes->string) - (only (std sugar) with-catch) (only (std format) eprintf) - (std cli getopt) (jerboa-coreutils common) - (jerboa-coreutils common version) - (jerboa-coreutils common security) (jerboa runtime)) - (def *b32-alphabet* "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567") - (def (base32-encode bv) - (let* ([len (bytevector-length bv)] - [out (open-output-string)]) - (let loop ([i 0] [buffer 0] [bits 0]) - (cond - [(and (>= i len) (zero? bits)) (get-output-string out)] - [(< bits 5) - (if (< i len) - (loop - (+ i 1) - (bitwise-ior - (bitwise-arithmetic-shift-left buffer 8) - (bytevector-u8-ref bv i)) - (+ bits 8)) - (let* ([padded (bitwise-arithmetic-shift-left - buffer - (- 5 bits))] - [idx (bitwise-and padded 31)]) - (write-char (string-ref *b32-alphabet* idx) out) - (let* ([total-chars (+ 1 (quotient (* i 8) 5))] - [padded-len (* (ceiling (/ total-chars 8)) 8)] - [padding (inexact->exact - (- padded-len total-chars))]) - (let pad-loop ([p 0]) - (when (< p padding) - (write-char #\= out) - (pad-loop (+ p 1))))) - (get-output-string out)))] - [else - (let* ([shift (- bits 5)] - [idx (bitwise-and - (bitwise-arithmetic-shift-right buffer shift) - 31)]) - (write-char (string-ref *b32-alphabet* idx) out) - (loop - i - (bitwise-and - buffer - (- (bitwise-arithmetic-shift-left 1 shift) 1)) - shift))])))) - (def (b32-char->val c) - (let ([cu (char-upcase c)]) - (cond - [(and (char>=? cu #\A) (char<=? cu #\Z)) - (- (char->integer cu) (char->integer #\A))] - [(and (char>=? cu #\2) (char<=? cu #\7)) - (+ 26 (- (char->integer cu) (char->integer #\2)))] - [else #f]))) - (def (base32-decode str) - (let-values ([(out extract) (open-bytevector-output-port)]) - (let ([len (string-length str)]) - (let loop ([i 0] [buffer 0] [bits 0]) - (if (>= i len) - (extract) - (let ([c (string-ref str i)]) - (cond - [(eqv? c #\=) (extract)] - [else - (let ([val (b32-char->val c)]) - (if (not val) - (loop (+ i 1) buffer bits) - (let* ([new-buffer (bitwise-ior - (bitwise-arithmetic-shift-left - buffer - 5) - val)] - [new-bits (+ bits 5)]) - (if (>= new-bits 8) - (let* ([shift (- new-bits 8)] - [byte (bitwise-and - (bitwise-arithmetic-shift-right - new-buffer - shift) - 255)]) - (put-u8 out byte) - (loop - (+ i 1) - (bitwise-and - new-buffer - (- (bitwise-arithmetic-shift-left - 1 - shift) - 1)) - shift)) - (loop - (+ i 1) - new-buffer - new-bits)))))]))))))) - (def (main . args) - (parameterize ([program-name "base32"]) - (init-security!) - (install-readonly-seccomp!) - (call-with-getopt - (lambda (_ opt) - (let* ([wrap (if (hash-get opt 'wrap) - (string->number (hash-ref opt 'wrap)) - 76)] - [input-port (if (or (null? (hash-ref opt 'rest)) - (string=? - (car (hash-ref opt 'rest)) - "-")) - (standard-input-port) - (checked-open-input-file - (car (hash-ref opt 'rest))))] - [input (read-all-bytes input-port)]) - (when (and (pair? (hash-ref opt 'rest)) - (not (string=? (car (hash-ref opt 'rest)) "-"))) - (close-port input-port)) - (if (hash-get opt 'decode) - (let* ([input-str (bytes->string input)] - [clean (string-filter - input-str - (lambda (c) - (not (char-whitespace? c))))] - [decoded (base32-decode clean)]) - (write-u8vector decoded)) - (let* ([encoded (base32-encode input)] - [out (if (and wrap (> wrap 0)) - (wrap-string encoded wrap) - encoded)]) - (display out) - (newline))))) - args 'program: "base32" 'help: - "Base32 encode or decode FILE, or standard input, to standard output." - (flag 'decode "-d" "--decode" 'help: "decode data") - (option 'wrap "-w" "--wrap" 'help: - "wrap encoded lines after COLS character (default 76). Use 0 to disable." - 'default: #f) - (rest-arguments 'rest)))) - (def (read-all-bytes port) - (let-values ([(out extract) (open-bytevector-output-port)]) - (let loop () - (let ([byte (get-u8 port)]) - (if (eof-object? byte) - (extract) - (begin (put-u8 out byte) (loop))))))) - (def (bytes->string bv) - (let ([len (bytevector-length bv)]) - (let ([str (make-string len)]) - (let loop ([i 0]) - (if (>= i len) - str - (begin - (string-set! - str - i - (integer->char (bytevector-u8-ref bv i))) - (loop (+ i 1)))))))) - (def (string-filter str pred) - (let ([out (open-output-string)]) - (let loop ([i 0]) - (when (< i (string-length str)) - (when (pred (string-ref str i)) - (write-char (string-ref str i) out)) - (loop (+ i 1)))) - (get-output-string out))) - (def (wrap-string str cols) - (let ([len (string-length str)]) - (let loop ([i 0] [out (open-output-string)]) - (if (>= i len) - (get-output-string out) - (let ([end (min (+ i cols) len)]) - (display (substring str i end) out) - (newline out) - (loop end out)))))) - (def (write-u8vector bv) - (let ([port (standard-output-port)]) - (let loop ([i 0]) - (when (< i (bytevector-length bv)) - (put-u8 port (bytevector-u8-ref bv i)) - (loop (+ i 1))))))) deleted file mode 100644 --- a/lib/jerboa-coreutils/base64.sls +++ /dev/null @@ -1,98 +0,0 @@ -#!chezscheme -;;; Generated by jerbuild — DO NOT EDIT -;;; Source: src/jerboa-coreutils/base64.ss - -(library (jerboa-coreutils base64) - (export main) - (import - (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- - base64-encode base64-decode getenv path-extension - path-absolute? thread? make-mutex mutex? mutex-name) - (except (jerboa core) bytes->string) - (only (std sugar) with-catch) (only (std format) eprintf) - (std cli getopt) (std text base64) (jerboa-coreutils common) - (jerboa-coreutils common version) - (jerboa-coreutils common security) (jerboa runtime)) - (def (main . args) - (parameterize ([program-name "base64"]) - (init-security!) - (install-readonly-seccomp!) - (call-with-getopt - (lambda (_ opt) - (let* ([wrap (if (hash-get opt 'wrap) - (string->number (hash-ref opt 'wrap)) - 76)] - [input-port (if (or (null? (hash-ref opt 'rest)) - (string=? - (car (hash-ref opt 'rest)) - "-")) - (standard-input-port) - (checked-open-input-file - (car (hash-ref opt 'rest))))] - [input (read-all-bytes input-port)]) - (when (and (pair? (hash-ref opt 'rest)) - (not (string=? (car (hash-ref opt 'rest)) "-"))) - (close-port input-port)) - (if (hash-get opt 'decode) - (let* ([input-str (bytes->string input)] - [clean (string-filter - input-str - (lambda (c) - (not (char-whitespace? c))))] - [decoded (base64-decode clean)]) - (write-u8vector decoded)) - (let* ([encoded (base64-encode input)] - [out (if (and wrap (> wrap 0)) - (wrap-string encoded wrap) - encoded)]) - (display out) - (newline))))) - args 'program: "base64" 'help: - "Base64 encode or decode FILE, or standard input, to standard output." - (flag 'decode "-d" "--decode" 'help: "decode data") - (option 'wrap "-w" "--wrap" 'help: - "wrap encoded lines after COLS character (default 76). Use 0 to disable." - 'default: #f) - (rest-arguments 'rest)))) - (def (read-all-bytes port) - (let-values ([(out extract) (open-bytevector-output-port)]) - (let loop () - (let ([byte (get-u8 port)]) - (if (eof-object? byte) - (extract) - (begin (put-u8 out byte) (loop))))))) - (def (bytes->string bv) - (let ([len (bytevector-length bv)]) - (let ([str (make-string len)]) - (let loop ([i 0]) - (if (>= i len) - str - (begin - (string-set! - str - i - (integer->char (bytevector-u8-ref bv i))) - (loop (+ i 1)))))))) - (def (string-filter str pred) - (let ([out (open-output-string)]) - (let loop ([i 0]) - (when (< i (string-length str)) - (let ([c (string-ref str i)]) - (when (pred c) (write-char c out))) - (loop (+ i 1)))) - (get-output-string out))) - (def (wrap-string str cols) - (let ([len (string-length str)]) - (let loop ([i 0] [out (open-output-string)]) - (if (>= i len) - (get-output-string out) - (let ([end (min (+ i cols) len)]) - (display (substring str i end) out) - (newline out) - (loop end out)))))) - (def (write-u8vector bv) - (let ([port (standard-output-port)]) - (let loop ([i 0]) - (when (< i (bytevector-length bv)) - (put-u8 port (bytevector-u8-ref bv i)) - (loop (+ i 1))))))) deleted file mode 100644 --- a/lib/jerboa-coreutils/basename.sls +++ /dev/null @@ -1,84 +0,0 @@ -#!chezscheme -;;; Generated by jerbuild — DO NOT EDIT -;;; Source: src/jerboa-coreutils/basename.ss - -(library (jerboa-coreutils basename) - (export main) - (import - (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- - getenv path-extension path-absolute? thread? make-mutex - mutex? mutex-name) - (only (std sugar) with-catch) (std cli getopt) - (jerboa-coreutils common) (jerboa-coreutils common version) - (jerboa-coreutils common security) (jerboa core) - (jerboa runtime)) - (def (main . args) - (parameterize ([program-name "basename"]) - (init-security!) - (install-readonly-seccomp!) - (call-with-getopt - (lambda (_ opt) - (let ([names (hash-ref opt 'rest)] - [suffix (or (hash-get opt 'suffix) "")] - [delim (if (hash-get opt 'zero) #\nul #\newline)]) - (cond - [(null? names) (die "missing operand")] - [(or (hash-get opt 'multiple) (hash-get opt 'suffix)) - (for-each - (lambda (name) - (display (strip-basename name suffix)) - (write-char delim)) - names)] - [(and (= (length names) 2) (string=? suffix "")) - (display (strip-basename (car names) (cadr names))) - (write-char delim)] - [(= (length names) 1) - (display (strip-basename (car names) suffix)) - (write-char delim)] - [else (die "extra operand '~a'" (cadr names))]))) - args 'program: "basename" 'help: - "Print NAME with any leading directory components removed. If specified, also remove a trailing SUFFIX." - (flag 'multiple "-a" "--multiple" 'help: - "support multiple arguments and treat each as a NAME") - (option 'suffix "-s" "--suffix" 'help: - "remove a trailing SUFFIX; implies -a" 'default: #f) - (flag 'zero "-z" "--zero" 'help: - "end each output line with NUL, not newline") - (rest-arguments 'rest)))) - (def (strip-basename name suffix) - (let* ([name (let loop ([n name]) - (if (and (> (string-length n) 1) - (eqv? - (string-ref n (- (string-length n) 1)) - #\/)) - (loop (substring n 0 (- (string-length n) 1))) - n))] - [base (cond - [(string=? name "/") "/"] - [else - (let ([pos (string-last-index-of name #\/)]) - (if pos - (substring - name - (+ pos 1) - (string-length name)) - name))])]) - (if (and (> (string-length suffix) 0) - (> (string-length base) (string-length suffix)) - (string=? - (substring - base - (- (string-length base) (string-length suffix)) - (string-length base)) - suffix)) - (substring - base - 0 - (- (string-length base) (string-length suffix))) - base))) - (def (string-last-index-of str ch) - (let loop ([i (- (string-length str) 1)]) - (cond - [(< i 0) #f] - [(eqv? (string-ref str i) ch) i] - [else (loop (- i 1))])))) deleted file mode 100644 --- a/lib/jerboa-coreutils/basenc.sls +++ /dev/null @@ -1,318 +0,0 @@ -#!chezscheme -;;; Generated by jerbuild — DO NOT EDIT -;;; Source: src/jerboa-coreutils/basenc.ss - -(library (jerboa-coreutils basenc) - (export main) - (import - (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- - base64-encode base64-decode getenv path-extension - path-absolute? thread? make-mutex mutex? mutex-name) - (except (jerboa core) bytes->string) - (only (std sugar) with-catch) - (only (std format) eprintf format) (std cli getopt) - (std text base64) (jerboa-coreutils common) - (jerboa-coreutils common version) - (jerboa-coreutils common security) (jerboa runtime)) - (define *b32-alphabet* "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567") - (def (base32-encode bv) - (let* ([len (bytevector-length bv)] - [out (open-output-string)]) - (let loop ([i 0] [buffer 0] [bits 0]) - (cond - [(and (>= i len) (zero? bits)) (get-output-string out)] - [(< bits 5) - (if (< i len) - (loop - (+ i 1) - (bitwise-ior - (bitwise-arithmetic-shift-left buffer 8) - (bytevector-u8-ref bv i)) - (+ bits 8)) - (let* ([padded (bitwise-arithmetic-shift-left - buffer - (- 5 bits))] - [idx (bitwise-and padded 31)]) - (write-char (string-ref *b32-alphabet* idx) out) - (let* ([total-chars (+ 1 (quotient (* i 8) 5))] - [padded-len (* (inexact->exact - (ceiling (/ total-chars 8))) - 8)] - [padding (- padded-len total-chars)]) - (let pad-loop ([p 0]) - (when (< p padding) - (write-char #\= out) - (pad-loop (+ p 1))))) - (get-output-string out)))] - [else - (let* ([shift (- bits 5)] - [idx (bitwise-and - (bitwise-arithmetic-shift-right buffer shift) - 31)]) - (write-char (string-ref *b32-alphabet* idx) out) - (loop - i - (bitwise-and - buffer - (- (bitwise-arithmetic-shift-left 1 shift) 1)) - shift))])))) - (def (base32-decode str) - (let* ([len (string-length str)] [acc '()]) - (let loop ([i 0] [buffer 0] [bits 0] [result '()]) - (if (>= i len) - (u8-list->bytevector (reverse result)) - (let ([c (string-ref str i)]) - (cond - [(eqv? c #\=) (u8-list->bytevector (reverse result))] - [else - (let ([val (b32-char->val c)]) - (if (not val) - (loop (+ i 1) buffer bits result) - (let* ([new-buffer (bitwise-ior - (bitwise-arithmetic-shift-left - buffer - 5) - val)] - [new-bits (+ bits 5)]) - (if (>= new-bits 8) - (let* ([shift (- new-bits 8)] - [byte (bitwise-and - (bitwise-arithmetic-shift-right - new-buffer - shift) - 255)]) - (loop - (+ i 1) - (bitwise-and - new-buffer - (- (bitwise-arithmetic-shift-left - 1 - shift) - 1)) - shift - (cons byte result))) - (loop - (+ i 1) - new-buffer - new-bits - result)))))])))))) - (def (b32-char->val c) - (let ([cu (char-upcase c)]) - (cond - [(and (char>=? cu #\A) (char<=? cu #\Z)) - (- (char->integer cu) (char->integer #\A))] - [(and (char>=? cu #\2) (char<=? cu #\7)) - (+ 26 (- (char->integer cu) (char->integer #\2)))] - [else #f]))) - (def (base16-encode bv) - (let* ([len (bytevector-length bv)] - [out (open-output-string)]) - (let loop ([i 0]) - (when (< i len) - (let* ([b (bytevector-u8-ref bv i)] - [hi (bitwise-arithmetic-shift-right b 4)] - [lo (bitwise-and b 15)]) - (write-char (hex-digit hi) out) - (write-char (hex-digit lo) out)) - (loop (+ i 1)))) - (get-output-string out))) - (def (hex-digit n) - (integer->char - (if (< n 10) - (+ (char->integer #\0) n) - (+ (char->integer #\A) (- n 10))))) - (def (base16-decode str) - (let* ([len (string-length str)]) - (let loop ([i 0] [result '()]) - (if (>= (+ i 1) len) - (u8-list->bytevector (reverse result)) - (let ([hi (hex-val (string-ref str i))] - [lo (hex-val (string-ref str (+ i 1)))]) - (if (and hi lo) - (loop (+ i 2) (cons (+ (* hi 16) lo) result)) - (loop (+ i 2) result))))))) - (def (hex-val c) - (cond - [(and (char>=? c #\0) (char<=? c #\9)) - (- (char->integer c) (char->integer #\0))] - [(and (char>=? (char-upcase c) #\A) - (char<=? (char-upcase c) #\F)) - (+ 10 - (- (char->integer (char-upcase c)) (char->integer #\A)))] - [else #f])) - (def (base2-encode bv) - (let* ([len (bytevector-length bv)] - [out (open-output-string)]) - (let loop ([i 0]) - (when (< i len) - (let ([b (bytevector-u8-ref bv i)]) - (let bit-loop ([bit 7]) - (when (>= bit 0) - (write-char - (if (zero? - (bitwise-and - b - (bitwise-arithmetic-shift-left 1 bit))) - #\0 - #\1) - out) - (bit-loop (- bit 1))))) - (loop (+ i 1)))) - (get-output-string out))) - (def (base2-decode str) - (let* ([clean (string-filter-ws str)] - [len (string-length clean)]) - (let loop ([i 0] [result '()]) - (if (> (+ i 7) len) - (u8-list->bytevector (reverse result)) - (let byte-loop ([j 0] [val 0]) - (if (>= j 8) - (loop (+ i 8) (cons val result)) - (let ([bit (if (eqv? (string-ref clean (+ i j)) #\1) - 1 - 0)]) - (byte-loop (+ j 1) (+ (* val 2) bit))))))))) - (def (string-filter-ws str) - (let ([out (open-output-string)]) - (let loop ([i 0]) - (when (< i (string-length str)) - (let ([c (string-ref str i)]) - (unless (char-whitespace? c) (write-char c out))) - (loop (+ i 1)))) - (get-output-string out))) - (def (read-all-bytes port) - (let loop ([acc '()]) - (let ([byte (get-u8 port)]) - (if (eof-object? byte) - (u8-list->bytevector (reverse acc)) - (loop (cons byte acc)))))) - (def (bytes->string bv) - (let ([len (bytevector-length bv)]) - (let ([str (make-string len)]) - (let loop ([i 0]) - (if (>= i len) - str - (begin - (string-set! - str - i - (integer->char (bytevector-u8-ref bv i))) - (loop (+ i 1)))))))) - (def (string-filter str pred) - (let ([out (open-output-string)]) - (let loop ([i 0]) - (when (< i (string-length str)) - (when (pred (string-ref str i)) - (write-char (string-ref str i) out)) - (loop (+ i 1)))) - (get-output-string out))) - (def (wrap-string str cols) - (let ([len (string-length str)]) - (let loop ([i 0] [out (open-output-string)]) - (if (>= i len) - (get-output-string out) - (let ([end (min (+ i cols) len)]) - (display (substring str i end) out) - (newline out) - (loop end out)))))) - (def (write-bv-out bv) - (let ([port (standard-output-port)]) - (let loop ([i 0]) - (when (< i (bytevector-length bv)) - (put-u8 port (bytevector-u8-ref bv i)) - (loop (+ i 1)))))) - (def (main . args) - (parameterize ([program-name "basenc"]) - (init-security!) - (install-readonly-seccomp!) - (call-with-getopt - (lambda (_ opt) - (let* ([decode (hash-get opt 'decode)] - [wrap (if (hash-get opt 'wrap) - (string->number (hash-ref opt 'wrap)) - 76)] - [input-port (if (or (null? (hash-ref opt 'rest)) - (string=? - (car (hash-ref opt 'rest)) - "-")) - (standard-input-port) - (open-file-input-port - (car (hash-ref opt 'rest))))] - [input (read-all-bytes input-port)] - [encoding (cond - [(hash-get opt 'base64) 'base64] - [(hash-get opt 'base64url) 'base64] - [(hash-get opt 'base32) 'base32] - [(hash-get opt 'base32hex) 'base32] - [(hash-get opt 'base16) 'base16] - [(hash-get opt 'base2msbf) 'base2] - [(hash-get opt 'base2lsbf) 'base2] - [else 'base64])]) - (when (and (pair? (hash-ref opt 'rest)) - (not (string=? (car (hash-ref opt 'rest)) "-"))) - (close-port input-port)) - (if decode - (let* ([input-str (bytes->string input)] - [clean (string-filter - input-str - (lambda (c) - (not (char-whitespace? c))))] - [decoded (case encoding - [(base64) (base64-decode clean)] - [(base32) (base32-decode clean)] - [(base16) (base16-decode clean)] - [(base2) (base2-decode clean)] - [else (base64-decode clean)])]) - (write-bv-out decoded)) - (let* ([encoded (case encoding - [(base64) (base64-encode input)] - [(base32) (base32-encode input)] - [(base16) (base16-encode input)] - [(base2) (base2-encode input)] - [else (base64-encode input)])] - [out (if (and wrap (> wrap 0)) - (wrap-string encoded wrap) - (string-append encoded "\n"))]) - (display out))))) - args 'program: "basenc" 'help: - "Encode/decode data and print to standard output." - (flag 'decode "-d" "--decode" 'help: "decode data") - (flag - 'base64 - "--base64" - 'help: - "same as base64 (RFC 4648 section 4)") - (flag - 'base64url - "--base64url" - 'help: - "file- and url-safe base64 (RFC 4648 section 5)") - (flag - 'base32 - "--base32" - 'help: - "same as base32 (RFC 4648 section 6)") - (flag - 'base32hex - "--base32hex" - 'help: - "extended hex base32 (RFC 4648 section 7)") - (flag - 'base16 - "--base16" - 'help: - "hex encoding (RFC 4648 section 8)") - (flag - 'base2msbf - "--base2msbf" - 'help: - "bit string with most significant bit first") - (flag - 'base2lsbf - "--base2lsbf" - 'help: - "bit string with least significant bit first") - (option 'wrap "-w" "--wrap" 'help: - "wrap encoded lines after COLS characters (default 76). Use 0 to disable." - 'default: #f) - (rest-arguments 'rest))))) deleted file mode 100644 --- a/lib/jerboa-coreutils/cat.sls +++ /dev/null @@ -1,160 +0,0 @@ -#!chezscheme -;;; Generated by jerbuild — DO NOT EDIT -;;; Source: src/jerboa-coreutils/cat.ss - -(library (jerboa-coreutils cat) - (export main) - (import - (except (chezscheme) make-hash-table hash-table? iota \x31;+ \x31;- - getenv path-extension path-absolute? thread? make-mutex - mutex? mutex-name) - (only (std sugar) with-catch try catch finally) - (only (std format) eprintf format) (std cli getopt) - (jerboa-coreutils common) (jerboa-coreutils common version) - (jerboa-coreutils common security) (jerboa core) - (jerboa runtime)) - (define exit-status 0) - (def (process-cat-files files proc) - (for-each - (lambda (f) - (if (equal? f "-") - (proc (current-input-port)) - (with-catch - (lambda (e) - (warn "~a: No such file or directory" f) - (set! exit-status 1)) - (lambda () - (let ([port (checked-open-input-file f)]) - (try (proc port) - (finally (close-input-port port)))))))) - files)) - (def (display-right-aligned n width) - (let* ([s (number->string n)] - [pad (- width (string-length s))]) - (let loop ([i 0]) - (when (< i pad) (display " ") (loop (+ i 1)))) - (display s))) - (def (transform-line line show-tabs? show-nonprinting?) - (if (and (not show-tabs?) (not show-nonprinting?)) - line - (let ([out (open-output-string)]) - (let loop ([i 0]) - (if (>= i (string-length line)) - (get-output-string out) - (let ([c (string-ref line i)]) - (cond - [(and show-tabs? (eqv? c #\tab)) (display "^I" out)] - [(and show-nonprinting? - (< (char->integer c) 32) - (not (eqv? c #\tab))) - (write-char #\^ out) - (write-char - (integer->char (+ (char->integer c) 64)) - out)] - [(and show-nonprinting? (= (char->integer c) 127)) - (display "^?" out)] - [(and show-nonprinting? (> (char->integer c) 127)) - (display "M-" out) - (let ([c2 (- (char->integer c) 128)]) - (cond - [(< c2 32) - (write-char #\^ out) - (write-char (integer->char (+ c2 64)) out)] - [(= c2 127) (display "^?" out)] - [else (write-char (integer->char c2) out)]))] - [else (write-char c out)]) - (loop (+ i 1)))))))) - (def (cat-fast port) - (let ([buf (make-bytevector 65536)] - [out (standard-output-port)]) - (let loop () - (let ([n (get-bytevector-n! port buf 0 65536)]) - (unless (eof-object? n) - (put-bytevector out buf 0 n) - (loop)))) - (flush-output-port out))) - (def (cat-lines port number-lines? number-nonblank? squeeze? - show-ends? show-tabs? show-nonprinting?) - (let loop ([line-num 1] [prev-blank? #f]) - (let ([line (get-line port)]) - (unless (eof-object? line) - (let* ([blank? (string=? line "")] - [skip? (and squeeze? prev-blank? blank?)]) - (unless skip? - (when number-lines? - (if (and number-nonblank? blank?) - (void) - (begin - (display-right-aligned line-num 6) - (display "\t")))) - (display - (transform-line line show-tabs? show-nonprinting?)) - (when show-ends? (display "$")) - (newline)) - (loop - (if (and number-lines? - (not skip?) - (not (and number-nonblank? blank?))) - (+ line-num 1) - line-num) - blank?)))))) - (def (main . args) - (parameterize ([program-name "cat"]) - (init-security!) - (install-readonly-seccomp!) - (with-fs-read-capability - (call-with-getopt - (lambda (_ opt) - (let ([files (hash-ref opt 'rest)] - [number-lines? (or (hash-get opt 'number) - (hash-get opt 'number-nonblank))]