The purpose of this task to code and validate an implementation of the MD5 Message Digest Algorithm by coding the algorithm directly (not using a call to a built-in or external hashing library). For details of the algorithm refer to MD5 on Wikipedia or the MD5 definition in IETF RFC (1321).

 The implementation needs to implement the key functionality namely producing a correct message digest for an input string. It is not necessary to mimic all of the calling modes such as adding to a digest one block at a time over subsequent calls. 
 In addition to coding and verifying your implementation, note any challenges your language presented implementing the solution, implementation choices made, or limitations of your solution. 
 Solutions on this page should implement MD5 directly and NOT use built in (MD5) functions, call outs to operating system calls or library routines written in other languages as is common in the original MD5 task.
 The following are acceptable:
 An original implementation from the specification, reference implementation, or pseudo-code
 A translation of a correct implementation from another language
 A library routine in the same language; however, the source must be included here.


The solutions shown here will provide practical illustrations of bit manipulation, unsigned integers, working with little-endian data. Additionally, the task requires an attention to details such as boundary conditions since being out by even 1 bit will produce dramatically different results. Subtle implementation bugs can result in some hashes being correct while others are wrong. Not only is it critical to get the individual sub functions working correctly, even small errors in padding, endianness, or data layout will result in failure.

RFC 1321
                            hash code <== string 
   0xd41d8cd98f00b204e9800998ecf8427e <== ""  
   0x0cc175b9c0f1b6a831c399e269772661 <== "a"
   0x900150983cd24fb0d6963f7d28e17f72 <== "abc"
   0xf96b697d7cb7938d525a2f31aaf161d0 <== "message digest"
   0xc3fcd3d76192e4007dfb496cca67e13b <== "abcdefghijklmnopqrstuvwxyz"
   0xd174ab98d277d9f5a5611c2c9f419d9f <== "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
   0x57edf4a22be3c955ac49da2e2107b67a <== "12345678901234567890123456789012345678901234567890123456789012345678901234567890"
In addition, intermediate outputs to aid in developing an implementation can be found here.

The MD5 Message-Digest Algorithm was developed by RSA Data Security, Inc. in 1991.



 Warning
Rosetta Code is not a place you should rely on for examples of code in critical roles, including security.
Also, note that MD5 has been broken and should not be used in applications requiring security. For these consider SHA2 or the upcoming SHA3.

(defpackage #:md5
  (:use #:cl))
 
(in-package #:md5)
 
(require :babel)
 
(deftype word () '(unsigned-byte 32))
(deftype octet () '(unsigned-byte 8))
(deftype octets () '(vector octet))
 
(defparameter *s*
  (make-array 16 :element-type 'word
                 :initial-contents '(7 12 17 22
                                     5  9 14 20
                                     4 11 16 23
                                     6 10 15 21)))
 
(defun s (i)
  (declare ((integer 0 63) i))
  (aref *s* (+ (ash (ash i -4) 2)
               (ldb (byte 2 0) i))))
 
(defparameter *k*
  (loop with result = (make-array 64 :element-type 'word)
        for i from 0 below 64
        do (setf (aref result i) (floor (* (ash 1 32) (abs (sin (1+ (float i 1d0)))))))
        finally (return result)))
 
(defun wrap (bits integer)
  (declare (fixnum bits) (integer integer))
  (ldb (byte bits 0) integer))
 
(defun integer->8octets (integer)
  (declare (integer integer))
  (loop for n = (wrap 64 integer) then (ash n -8)
        repeat 8
        collect (wrap 8 n)))
 
(defun pad-octets (octets)
  (declare (octets octets))
  (let* ((octets-length (length octets))
         (zero-pad-length (- 64 (mod (+ octets-length 9) 64)))
         (zero-pads (loop repeat zero-pad-length collect 0)))
    (concatenate 'octets octets '(#x80) zero-pads (integer->8octets (* 8 octets-length)))))
 
(defun octets->words (octets)
  (declare (octets octets))
  (loop with result = (make-array (/ (length octets) 4) :element-type 'word)
        for n from 0 below (length octets) by 4
        for i from 0
        do (setf (aref result i)
                 (dpb (aref octets (+ n 3)) (byte 8 24)
                      (dpb (aref octets (+ n 2)) (byte 8 16)
                           (dpb (aref octets (1+ n)) (byte 8 8)
                                (dpb (aref octets n) (byte 8 0) 0)))))
        finally (return result)))
 
(defun words->octets (&rest words)
  (loop for word of-type word in words
        collect (ldb (byte 8 0)  word)
        collect (ldb (byte 8 8)  word)
        collect (ldb (byte 8 16) word)
        collect (ldb (byte 8 24) word)))
 
(defun left-rotate (x c)
  (declare (integer x) (fixnum c))
  (let ((x (wrap 32 x)))
    (wrap 32 (logior (ash x c)
                     (ash x (- c 32))))))
 
(defun md5 (string)
  (declare (string string))
  (loop with m = (octets->words (pad-octets (babel:string-to-octets string)))
        with a0 of-type word = #x67452301
        with b0 of-type word = #xefcdab89
        with c0 of-type word = #x98badcfe
        with d0 of-type word = #x10325476
        for j from 0 below (length m) by 16
        do (loop for a of-type word = a0 then d
                 and b of-type word = b0 then new-b
                 and c of-type word = c0 then b
                 and d of-type word = d0 then c
                 for i from 0 below 64
                 for new-b = (multiple-value-bind (f g)
                                 (ecase (ash i -4)
                                   (0 (values (wrap 32 (logior (logand b c)
                                                               (logand (lognot b) d)))
                                              i))
                                   (1 (values (wrap 32 (logior (logand d b)
                                                               (logand (lognot d) c)))
                                              (wrap 4 (1+ (* 5 i)))))
                                   (2 (values (wrap 32 (logxor b c d))
                                              (wrap 4 (+ (* 3 i) 5))))
                                   (3 (values (wrap 32 (logxor c
                                                               (logior b (lognot d))))
                                              (wrap 4 (* 7 i)))))
                               (declare (word f g))
                               (wrap 32 (+ b (left-rotate (+ a f (aref *k* i) (aref m (+ j g)))
                                                          (s i)))))
                 finally (setf a0 (wrap 32 (+ a0 a))
                               b0 (wrap 32 (+ b0 b))
                               c0 (wrap 32 (+ c0 c))
                               d0 (wrap 32 (+ d0 d))))
        finally (return (with-output-to-string (s)
                          (dolist (o (words->octets a0 b0 c0 d0))
                            (format s "~(~2,'0X~)" o))))))
 
(defun test-cases ()
  (assert (string= "d41d8cd98f00b204e9800998ecf8427e"
                   (md5 "")))
  (assert (string= "0cc175b9c0f1b6a831c399e269772661"
                   (md5 "a")))
  (assert (string= "900150983cd24fb0d6963f7d28e17f72"
                   (md5 "abc")))
  (assert (string= "f96b697d7cb7938d525a2f31aaf161d0"
                   (md5 "message digest")))
  (assert (string= "c3fcd3d76192e4007dfb496cca67e13b"
                   (md5 "abcdefghijklmnopqrstuvwxyz")))
  (assert (string= "d174ab98d277d9f5a5611c2c9f419d9f"
                   (md5 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")))
  (assert (string= "57edf4a22be3c955ac49da2e2107b67a"
                   (md5 "12345678901234567890123456789012345678901234567890123456789012345678901234567890"))))