1 files changed, 124 insertions, 0 deletions
diff --git a/modules/language/python/checksum.scm b/modules/language/python/checksum.scm
new file mode 100644
index 0000000..dc0ce80
--- /dev/null
+++ b/modules/language/python/checksum.scm
@@ -0,0 +1,124 @@
+(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))))
+               
+                  
+      
+
+