1 | ;;;; message-digest-bv.scm |
---|
2 | ;;;; Kon Lovett, Jan '06 (message-digest.scm) |
---|
3 | ;;;; Kon Lovett, May '10 (message-digest.scm) |
---|
4 | ;;;; Kon Lovett, Apr '12 |
---|
5 | ;;;; Kon Lovett, Aug '17 |
---|
6 | |
---|
7 | ;; Issues |
---|
8 | |
---|
9 | (module message-digest-bv |
---|
10 | |
---|
11 | (;export |
---|
12 | ; |
---|
13 | message-digest-update-blob |
---|
14 | message-digest-update-string |
---|
15 | message-digest-blob |
---|
16 | message-digest-string |
---|
17 | message-digest-blob! |
---|
18 | message-digest-string! |
---|
19 | ;DEPRECATED |
---|
20 | message-digest-update-substring) |
---|
21 | |
---|
22 | (import scheme chicken) |
---|
23 | |
---|
24 | (use |
---|
25 | (only srfi-13 substring/shared) |
---|
26 | (only type-checks |
---|
27 | check-blob check-string check-natural-fixnum check-range) |
---|
28 | message-digest-primitive |
---|
29 | message-digest-type |
---|
30 | message-digest-support) |
---|
31 | |
---|
32 | (declare |
---|
33 | (bound-to-procedure ##sys#substring)) |
---|
34 | |
---|
35 | ;;; Message Digest API |
---|
36 | |
---|
37 | ;; Update |
---|
38 | |
---|
39 | ;; |
---|
40 | |
---|
41 | (define (message-digest-update-blob md blb #!optional (start 0) (end (blob-size blb))) |
---|
42 | (*message-digest-update-blob |
---|
43 | (check-message-digest 'message-digest-update-blob md) |
---|
44 | (check-blob/slice 'message-digest-update-blob blb start end)) ) |
---|
45 | |
---|
46 | ;; |
---|
47 | |
---|
48 | (define (message-digest-update-string md str #!optional (start 0) (end (string-length str))) |
---|
49 | (*message-digest-update-string |
---|
50 | (check-message-digest 'message-digest-update-string md) |
---|
51 | (check-string/slice 'message-digest-update-string str start end)) ) |
---|
52 | |
---|
53 | ;; |
---|
54 | |
---|
55 | ;DEPRECATED |
---|
56 | (define (message-digest-update-substring md str start end) |
---|
57 | (*message-digest-update-string |
---|
58 | (check-message-digest 'message-digest-update-substring md) |
---|
59 | (substring/shared (check-string 'message-digest-update-substring str) start end)) ) |
---|
60 | |
---|
61 | ;; Single Source API |
---|
62 | |
---|
63 | (define (message-digest-blob mdp blb |
---|
64 | #!optional |
---|
65 | (result-type (message-digest-result-form)) |
---|
66 | (start 0) (end (blob-size blb))) |
---|
67 | (let ((md (initialize-message-digest mdp))) |
---|
68 | (message-digest-update-blob md blb start end) |
---|
69 | (finalize-message-digest md result-type) ) ) |
---|
70 | |
---|
71 | (define (message-digest-string mdp str |
---|
72 | #!optional |
---|
73 | (result-type (message-digest-result-form)) |
---|
74 | (start 0) (end (string-length str))) |
---|
75 | (let ((md (initialize-message-digest mdp))) |
---|
76 | (message-digest-update-string md str start end) |
---|
77 | (finalize-message-digest md result-type) ) ) |
---|
78 | |
---|
79 | (define (message-digest-blob! mdp blb result-buffer |
---|
80 | #!optional |
---|
81 | (start 0) (end (blob-size blb))) |
---|
82 | (let ((md (initialize-message-digest mdp))) |
---|
83 | (message-digest-update-blob md blb start end) |
---|
84 | (finalize-message-digest! md result-buffer) ) ) |
---|
85 | |
---|
86 | (define (message-digest-string! mdp str result-buffer |
---|
87 | #!optional |
---|
88 | (start 0) (end (string-length str))) |
---|
89 | (let ((md (initialize-message-digest mdp))) |
---|
90 | (message-digest-update-string md str start end) |
---|
91 | (finalize-message-digest! md result-buffer) ) ) |
---|
92 | |
---|
93 | ;;; |
---|
94 | |
---|
95 | (define (check-blob/slice loc blb start end) |
---|
96 | (check-blob loc blb) |
---|
97 | (check-fixnum-range loc start end) |
---|
98 | (blob/slice blb start end) ) |
---|
99 | |
---|
100 | (define (check-string/slice loc str start end) |
---|
101 | (check-string loc str) |
---|
102 | (check-fixnum-range loc start end) |
---|
103 | (string/slice str start end) ) |
---|
104 | |
---|
105 | (define (check-fixnum-range loc start end) |
---|
106 | (check-range loc |
---|
107 | (check-natural-fixnum loc start 'start) |
---|
108 | (check-natural-fixnum loc end 'end) |
---|
109 | "end < start") ) |
---|
110 | |
---|
111 | ) ;module message-digest-bv |
---|