File: md5.lisp

package info (click to toggle)
maxima 5.47.0-9
  • links: PTS
  • area: main
  • in suites: forky, sid
  • size: 193,104 kB
  • sloc: lisp: 434,678; fortran: 14,665; tcl: 10,990; sh: 4,577; makefile: 2,763; ansic: 447; java: 328; python: 262; perl: 201; xml: 60; awk: 28; sed: 15; javascript: 2
file content (232 lines) | stat: -rw-r--r-- 8,193 bytes parent folder | download | duplicates (2)
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
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232

#|
   This program is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2 of the License, or
   (at your option) any later version.
   
   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.
   
   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
   MA 02110-1301, USA.
   
   
**** md5sum ********************************************************************
   
   Copyright Volker van Nek, 2013 - 2015

   md5sum returns the md5 checksum of a string, a non-negative integer or 
   a list of octets. 
   
   The default return value is a string that guarantees 32 hex characters. 
   An optional argument allows md5sum to return the corresponding number or 
   list of octets.
   
   (%i1) ibase: obase: 16.$
   (%i2) msg: "foo bar baz"$
   (%i3) string: md5sum(msg);
   (%o3)                  ab07acbb1e496801937adfa772424bf7
   (%i4) integer: md5sum(msg, 'number);
   (%o4)                 0ab07acbb1e496801937adfa772424bf7
   (%i5) octets: md5sum(msg, 'list);
   (%o5)        [0AB,7,0AC,0BB,1E,49,68,1,93,7A,0DF,0A7,72,42,4B,0F7]
   (%i6) sdowncase( printf(false, "~{~2,'0x~^:~}", octets) );
   (%o6)           ab:07:ac:bb:1e:49:68:01:93:7a:df:a7:72:42:4b:f7

   Note that in case the string contains German umlauts or other non-ASCII 
   characters the md5 checksum is platform dependent.
   
   To check the md5sum of a *small* file the file can be streamed into a string.

   (%i1) ostream : make_string_output_stream();
   (%o1)                  #<string-output stream 00f06ae8>
   (%i2) fos : openr("/home/volker/pub_key_temp.pem");
   (%o2)            #<input stream /home/volker/pub_key_temp.pem>
   (%i3) while (c : readchar(fos)) # false do printf(ostream, "~a", c);
   (%o3)                                done
   (%i4) close(fos);
   (%o4)                                true
   (%i5) string : get_output_stream_string(ostream);
   (%o5) -----BEGIN PUBLIC KEY-----
   MIIBCgKCAQEA7CCxZOFAoZ7khi0TiwIxU8cHEZJnIQb96ONrPbSqq/s3CVwU1eLH
   9QEaZb8viFhe6/Db66DjR6RqCO3uIfx2siAb8SaTo0PYZz8JQ5IenjBDJAGA56gE
   6OX8JadgPCLEZTdJ2Q0axqPHwoWsZkn56Pt4UlJfUcW7cNPNIihgy2DwE1PpbHCY
   IdhYcT/iYA6C+TiYdYNcAFUsQyGExBxOTOXrMGFknjALedkLoq9IN3Djnw4kxGYv
   vl3hVYBJpixusUgOK5LhYwowQayeczPoMA0Ef5KAZwJY9lUZ2UYBKMqdoNpdJuDz
   q4QOxlkqUvZxWTEHqNmlfX4/2w71ZiAqpwIDAQAB
   -----END PUBLIC KEY-----
   (%i6) close(ostream);
   (%o6)                                true
   (%i7) md5sum(string);
   (%o7)                  b5f2033ccb6f4066874aa5a2308bd561
   
   The result is checked against openssl in GNU/Linux.
   
   (%i8) system("openssl dgst -md5 '/home/volker/pub_key_temp.pem' > temp ; cat temp");
   MD5(/home/volker/pub_key_temp.pem)= b5f2033ccb6f4066874aa5a2308bd561
   (%o8)                                  0

|#

(in-package :maxima)

(eval-when
    (:compile-toplevel :execute)
  (defvar old-ibase-md5 *read-base*)
  (setq *read-base* 10.) )


(defvar *h5* nil)
(defvar *w5* nil)

(defvar *k5* (make-array 64. :element-type 'integer :initial-element 0))
(do ((i 0 (1+ i)))
    ((= i 64.))
  (setf (svref *k5* i) (floor (* (abs (sin (+ i 1.0))) #x100000000))) )

(defvar *s5* 
  #( 7. 12. 17. 22.   7. 12. 17. 22.   7. 12. 17. 22.   7. 12. 17. 22.
     5.  9. 14. 20.   5.  9. 14. 20.   5.  9. 14. 20.   5.  9. 14. 20.
     4. 11. 16. 23.   4. 11. 16. 23.   4. 11. 16. 23.   4. 11. 16. 23.
     6. 10. 15. 21.   6. 10. 15. 21.   6. 10. 15. 21.   6. 10. 15. 21. )) 


(declaim (inline md5-not md5+ md5-left-rotation))

(defun md5-not (i32)
  (logand (lognot i32) #xffffffff) )

(defun md5+ (&rest args)
  (logand (apply #'+ args) #xffffffff) )

(defun md5-left-rotation (i32 k)
  (logior (logand (ash i32 k) #xffffffff) (ash i32 (- k 32.))) )


(defun md5-worker ()
  (multiple-value-bind (a b c d) (apply #'values *h5*)
    (let (f g tmp hlp)
      (do ((i 0 (1+ i)))
          ((= i 64.))
        (cond
          ((< i 16.)
            (setq f (logior (logand b c) (logand (md5-not b) d))
                  g i ))
          ((< i 32.)
            (setq f (logior (logand b d) (logand c (md5-not d)))
                  g (logand (+ (* 5 i) 1) #xf) ))
          ((< i 48.)
            (setq f (logxor b c d)
                  g (logand (+ (* 3 i) 5) #xf) ))
          (t
            (setq f (logxor c (logior b (md5-not d)))
                  g (logand (* 7 i) #xf) )))
        (setq tmp d
              d c
              c b
              hlp (md5+ a f (svref *k5* i) (svref *w5* g))
              hlp (md5-left-rotation hlp (svref *s5* i))
              b (md5+ b hlp)
              a tmp ))  
      (setq *h5* (mapcar #'md5+ (list a b c d) *h5*)) )))


(defun swap-endian64 (i64) ;; little-endian <--> big-endian
  (do ((masq #xff (ash masq 8))
       (sh 0 (- sh 8)) w )
      ((= sh -64.) (nreverse w))
    (push (ash (logand i64 masq) sh) w) ))

(defun swap-endian32 (i32)
  (logior (ash (logand i32 #xff) 24.)
          (ash (logand i32 #xff00) 8.)
          (ash (logand i32 #xff0000) -8.)
          (ash (logand i32 #xff000000) -24.) ))


(defun md5-words (vec) ;; 32 bit little-endian
  (let ((w (make-array 16. :element-type 'integer :initial-element 0))
        (inc -1) )
    (do ((i 0 (1+ i)))
        ((= i 16.) w)
      (setf (svref w i) 
        (logior      (svref vec (incf inc))
                (ash (svref vec (incf inc))  8.)
                (ash (svref vec (incf inc)) 16.)
                (ash (svref vec (incf inc)) 24.) )))))

(defun md5-update (bytes)
  (setq *w5* (md5-words (coerce bytes 'vector)))
  (md5-worker) )

(defun md5-final (bytes off len)
  (when bytes (setq bytes (append bytes '(#x80)))) ;; don't modify bytes
  (when (= 0 off) (setq bytes '(#x80)))
  (if (<= off 55.)
    (let* ((bits (ash len 3))
           (len64 (swap-endian64 bits))
           (pad (make-list (- 55. off) :initial-element 0)) )
      (md5-update (append bytes pad len64)) )
    (let ((pad (make-list (- 63. off) :initial-element 0)))
      (md5-update (append bytes pad))
      (md5-final nil -1 len) )))


(defmfun $md5sum (s &optional (rtype '$string))
  (let (bytes len)
    (cond
      ((stringp s)
        (setq bytes (string-to-octets s)) )
      ((and (integerp s) (>= s 0))
        (setq bytes (number-to-octets s)) )
      (($listp s)
        (setq bytes (cdr s)) )
      ((streamp s)
       (return-from md5sum-impl (md5sum-stream s rtype)))
      (t 
        (gf-merror (intl:gettext 
          "`md5sum': Argument must be a string, non-negative integer, list of octets, or stream." ))))
    (setq len (length bytes) 
          *h5* '(#x67452301 #xefcdab89 #x98badcfe #x10325476) )
    (do ((off len)) 
        ((< off 64.) (md5-final bytes off len))
      (setq off (- off 64.))
      (md5-update (butlast bytes off))
      (setq bytes (last bytes off)) )
    (setq *h5* (mapcar #'swap-endian32 *h5*))
    (md5sum-return rtype)))

(defun md5sum-return (rtype)
  (cond
    ((equal rtype '$list)
      (cons '(mlist simp)
        (reduce #'nconc (mapcar #'word-to-octets *h5*)) ))
    ((equal rtype '$number)
      (reduce #'(lambda (x y) (logior (ash x 32.) y)) *h5*) )
    ((equal rtype '$string)
      (nstring-downcase (format nil "~{~8,'0x~}" *h5*)) )
    (t  
      (gf-merror (intl:gettext 
        "`md5sum': Optional argument must be 'list, 'number or 'string." )))))

(defun md5sum-stream (s rtype)
  (setq *h5* '(#x67452301 #xefcdab89 #x98badcfe #x10325476))
  (let ((bytes (make-list 64.)) (len 0))
    (do
      ((len-1 (read-sequence bytes s)))
      ((< len-1 64.) (md5-final (butlast bytes (- (length bytes) len-1)) len-1 (+ len len-1)))
      (md5-update bytes)
      (setq len (+ len len-1))
      (setq len-1 (read-sequence bytes s))))

  (setq *h5* (mapcar #'swap-endian32 *h5*))
  (md5sum-return rtype))

(eval-when
    (:compile-toplevel :execute)
  (setq *read-base* old-ibase-md5) )