summaryrefslogtreecommitdiff
path: root/modules/language/python/checksum.scm
blob: dc0ce80b08044c78e408c070257896929acc7e48 (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
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))))