(define-module (language python checksum) #:use-module (oop pf-objects) #:use-module (language python bytes) #:use-module (language python for) #:use-module (language python list) #:use-module (language python exceptions) #:use-module (ice-9 binary-ports) #:use-module (rnrs bytevectors) #:use-module (ice-9 popen) #:export (Summer run)) (define mapper (make-hash-table)) (let lp ((i 0)) (if (< i 256) (let ((a (logand #xf i)) (b (ash (logand #xf0 i) -16))) (define (m i) (car (string->list (number->string i 16)))) (hash-set! mapper i (cons (m a) (m b))) (lp (+ i 1))))) (define (run data command) (define n1 (char->integer #\0)) (define n2 (char->integer #\9)) (define p1 (char->integer #\a)) (define p2 (char->integer #\f)) (let ((i.o (pipe))) (with-output-to-port (cdr i.o) (lambda () (let ((port (open-pipe command OPEN_WRITE))) (for ((b : data)) () (put-u8 port b)) (close-pipe port)))) (close-port (cdr i.o)) (let* ((ret (get-bytevector-all (car i.o))) (n (len ret))) (let lp ((i 0)) (define (hex? i) (and (< i n) (let ((i (bytevector-u8-ref ret i))) (or (and (>= i n1) (<= i n2)) (and (>= i p1) (<= i p2)))))) (define (hex i) (let ((i (bytevector-u8-ref ret i))) (if (and (>= i n1) (<= i n2)) (+ (- i n1) 0) (+ (- i p1) 10)))) (define (final l) (let ((ret (make-bytevector (len l)))) (let lp ((l l) (i (- (len l) 1))) (if (>= i 0) (begin (bytevector-u8-set! ret i (car l)) (lp (cdr l) (- i 1))) (bytes ret))))) (if (hex? i) (let lp ((i i) (l '())) (if (hex? i) (if (hex? (+ i 1)) (lp (+ i 2) (cons (+ (hex i) (ash (hex (+ i 1)) 4)) l)) (final (cons (hex i) l))) (final l))) (error "no hex output checksum code")))))) (define-python-class Summer () (define __init__ (lambda (self) (set self '_data None))) (define update (lambda (self data) (let ((old (ref self '_data))) (if (eq? old None) (set self '_data data) (set self '_data (+ old data)))) (set self '_digest None) (values))) (define digest (lambda (self) (let ((data (ref self '_data))) (if (eq? data None) (raise (ValueError "no data to digest")) (let ((old (ref self '_digest))) (if (eq? old None) (set! old (run data (ref self '_command)))) (set self '_digest old) old))))) (define hexdigest (lambda (self) (let* ((x (digest self)) (o (make-string (* 2 (len x))))) (for ((b : (bv-scm x))) ((i 0)) (let ((a.b (hash-ref mapper b))) (string-set! o i (car a.b)) (string-set! o (+ i 1) (cdr a.b)) (+ i 2)) #:final o)))) (define copy (lambda (self) (let ((o ((ref self '__class__)))) (set o '_data (ref self '_data)) (set o '_digest (ref self '_digest)) o))))