md5 pre processing

#lang racket


(define (bytes-length-in-bits data)
  (* 8 (bytes-length data)))


(define (byte->bitstring x)
  ;; returns a string containing the given byte in binary
  ;; returns #f when the input isn't a byte
    (and
     (byte? x)
     (~a #:width 8 #:pad-string "0" #:align 'right
        (number->string x 2))))

(define (bytes->bitstring data)
  ;; returns a the data in binary format
  (foldl
   (λ (b str)
     (string-append str (byte->bitstring b)))
   ""
   (bytes->list data)))


;;PRE-PROCESSING

(define (pre-process-complete-padding data)
  (letrec ([add-the-bit-1-and-7-zeroes
            (λ (x)
              (bytes-append
               x
               (bytes (arithmetic-shift 1 7))))]
           [complete-padding
            (λ (x)
              (if (= (modulo (bytes-length-in-bits x) 512) 448)
                  x
                  (complete-padding (bytes-append x (bytes 0)))))])
    (complete-padding (add-the-bit-1-and-7-zeroes data))))


(define (pre-process-add-length padded-data original-length)
  (define str (~a #:width 64 #:pad-string "0" #:align 'right
                  (number->string original-length 2)))

  (foldl
   (λ (b data)
     (bytes-append data b))
   padded-data
   (for/list ([start (in-range 0 64 8)])
     (define end (+ start 8))
     (bytes (string->number (substring str start end) 2)))))


(define (complete-pre-process data-bytes)
  (define original-length (bytes-length data-bytes))

  (pre-process-add-length
   (pre-process-complete-padding data-bytes)
   original-length))



(define (md5 data)
  (if (system-big-endian?)
      "Your system needs to be little endian"
      (let* ([s (list 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)]
             [K (list #xd76aa478 #xe8c7b756 #x242070db #xc1bdceee
                      #xf57c0faf #x4787c62a #xa8304613 #xfd469501
                      #x698098d8 #x8b44f7af #xffff5bb1 #x895cd7be
                      #x6b901122 #xfd987193 #xa679438e #x49b40821
                      #xf61e2562 #xc040b340 #x265e5a51 #xe9b6c7aa
                      #xd62f105d #x02441453 #xd8a1e681 #xe7d3fbc8
                      #x21e1cde6 #xc33707d6 #xf4d50d87 #x455a14ed
                      #xa9e3e905 #xfcefa3f8 #x676f02d9 #x8d2a4c8a
                      #xfffa3942 #x8771f681 #x6d9d6122 #xfde5380c
                      #xa4beea44 #x4bdecfa9 #xf6bb4b60 #xbebfbc70
                      #x289b7ec6 #xeaa127fa #xd4ef3085 #x04881d05
                      #xd9d4d039 #xe6db99e5 #x1fa27cf8 #xc4ac5665
                      #xf4292244 #x432aff97 #xab9423a7 #xfc93a039
                      #x655b59c3 #x8f0ccc92 #xffeff47d #x85845dd1
                      #x6fa87e4f #xfe2ce6e0 #xa3014314 #x4e0811a1
                      #xf7537e82 #xbd3af235 #x2ad7d2bb #xeb86d391)]
             [a0 #x67452301]
             [b0 #xefcdab89]
             [c0 #x98badcfe]
             [d0 #x10325476]

             [data-bytes (if (string? data)
                             (string->bytes/utf-8 data)
                             data)]
             [message (complete-pre-process data-bytes)]
             )
        (bytes->bitstring message))))