matasano-challenge-1.scm

(define (safe-string-head s start) ; gives 'up to' 6 or remaining
  (let ((sl (string-length s)))
    (if (>= sl start)
        (string-head s start)
        (string-head s sl)))) 

(define (safe-string-tail s end) ; gives 'up to' 6 and remaining
  (let ((sl (string-length s)))
    (if (>= sl end)
        (string-tail s end)
        (string-tail s sl)))) ; 

(define (string-split s split-at)
  (define (split ss ac)
    (if (string-null? ss)
        ac
        (split (safe-string-tail ss split-at) (cons (safe-string-head ss split-at) ac))))
  (reverse (split s '())))

; expects 6 character hex string and returns 24 character binary string
(define (hex-string->binary-string hs)
  (let ((hs-lst (string-split hs 2))
        ; pads to length of 8 as conversion drops leading zero
        (p (lambda (x) (string-pad-left (number->string (string->number x 16) 2) 8 #\0))))
    (fold-right (lambda (x r) (string-append (p x) r)) "" hs-lst)))

; maps a 24-bit binary string to a list of 4 decimals
(define (binary-string->decimals bs) 
  ; split out binary string into 4 6-bit strings
  (let ((bs-lst (string-split bs 6))
        ; converts binary string (padding with zeros if less than 6 bits) into decimal
        (p (lambda (s) (string->number (string-pad-right (safe-string-head s 6) 6 #\0) 2))))
    ; apply conversion to each string
    (map p bs-lst)))

; maps a decimal value to its base64 equivalent
(define (decimal->base64 d)
  (let ((base64-table "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"))
    (char->name (string-ref base64-table d))))

(define (base64-encode hex-string)
  ; split out hex string into 24-bit binary strings
  (let ((bs-lst (map hex-string->binary-string (string-split hex-string 6))))
    ; pad resulting text
    (define (pad-base64 s)
      (let ((mod (modulo (string-length hex-string) 6)))
        (if (= mod 0) 
            s ; full 'frame', no padding needed
            (string-append s (make-string (/ (- 6 mod) 2) #\=))))) ; partial 'frame', pad with 1 or 2 '='s
    (pad-base64 (apply string (map decimal->base64 (concatenate (map binary-string->decimals bs-lst)))))))