base64.clj

;;; base64.clj --- Base64 encode/decode utility
;;
;; Copyright (c) 2010 OGINO Masanori <[email protected]>
;;
;; Permission is hereby granted, free to charge, to any person obtaining a
;; copy of this software and associated documentation files (the "Software"),
;; to deal in the Software without restriction, including without limitation
;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
;; and/or sell copies of the Software, and to permit persons to whom the
;; Software is furnished to do so, subject to the following conditions:
;;
;; The above copyright notice and this permission notice shall be included in
;; all copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF NAY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
;; FROM, PUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
;; DEALINGS IN THE SOFTWARE.
(ns base64)


(def *default-encode-table* "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")

(def *hibernate-encode-table* "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789*-")

(def *imap4-encode-table* "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+,")

(def *ircu-encode-table* "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789[]")

(def *python-urlsafe-encode-table* "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")

(def *encode-table* *default-encode-table*)

(defn- map-and-join [f coll]
  (apply str (map f coll)))

(defn- strip [ch s]
  (re-find (re-pattern (format ".+[^%s]" (str ch))) s))

(defn- fill-forward [s len pad]
  (if (not (= (.length s) len))
    (re-find (re-pattern (format ".{%d}$" len)) (str (apply str (repeat len pad)) s))
    s))

(defn- fill-backward [s len pad]
  (if (not (= (.length s) len))
    (re-find (re-pattern (format "^.{%d}" len)) (str s (apply str (repeat len pad))))
    s))

(defn- signed-to-unsigned [n]
  (Integer/parseInt (format "%x" n) 16))

(defn- byte-to-binary-string [n]
  (let [s (Integer/toBinaryString (signed-to-unsigned n))]
    (fill-forward s 8 "0")))

(defn- binary-string-to-byte [s]
  (byte (Integer/parseInt s 2)))

(defn- generate-range-re [from to]
  (re-pattern (format ".{%d,%d}" from to)))

(defn- range-seq [from to s]
  (re-seq (generate-range-re from to) s))

(defn- lookup-from-6bits-string [s]
  (nth *encode-table* (binary-string-to-byte s)))

(defn- lookup-from-character [ch]
  (.indexOf *encode-table* (str ch)))


(defn encode
  "Encode array of bytes to string encoded by Base64."
  {:test (fn []
           (assert (= (encode (.getBytes "ABCDEFG")) "QUJDREVGRw==")))}
  [ba]
  (map-and-join
    #(fill-backward % 4 "=")
    (range-seq 1 4
               (map-and-join
                 #(lookup-from-6bits-string (fill-backward % 6 "0"))
                 (range-seq 1 6
                            (map-and-join
                              byte-to-binary-string
                              (seq ba)))))))

(defn encode-from-string
  "Encode string to Base64 encoded string."
  {:test (fn []
           (assert (= (encode-from-string "ABCDEFG") "QUJDREVGRw==")))}
  ([s] (encode-from-string s "UTF-8"))
  ([s encoding] (encode (.getBytes s encoding))))

(defn decode
  "Decode string encoded by Base64 to array of bytes."
  {:test (fn []
           (assert (= (String. (decode "QUJDREVGRw==")) "ABCDEFG")))}
  [s]
  (byte-array
    (map
      binary-string-to-byte
      (re-seq
        #".{8}"
        (map-and-join
          #(fill-forward % 6 "0")
          (map
            #(byte-to-binary-string (lookup-from-character %))
            (strip \= s)))))))

(defn decode-to-string
  "Decode string from Base64 encoded string."
  {:test (fn []
           (assert (= (decode-to-string "QUJDREVGRw==") "ABCDEFG")))}
  ([s] (decode-to-string s "UTF-8"))
  ([s encoding] (String. (decode s) encoding)))


;;; Basic Tests
(defn basic-tests []
  (test #'encode)
  (test #'encode-from-string)
  (test #'decode)
  (test #'decode-to-string))

;;; Performance Tests
(defn performance-tests []
  (let [long-string-1 (apply str (repeat 100 "Clojure is very cool!"))
        long-byte-array-1 (.getBytes long-string-1)
        long-encoded-string-1 (encode long-byte-array-1)
        long-string-2 (apply str (repeat 100 "Clojureはすごくイケてる！"))
        long-byte-array-2 (.getBytes long-string-2)
        long-encoded-string-2 (encode long-byte-array-2)]
    (println "encode")
    (dotimes [_ 3]
      (time (encode long-byte-array-1))
      (time (encode long-byte-array-2)))
    (println "encode-from-string")
    (dotimes [_ 3]
      (time (encode-from-string long-string-1))
      (time (encode-from-string long-string-2)))
    (println "decode")
    (dotimes [_ 3]
      (time (decode long-encoded-string-1))
      (time (decode long-encoded-string-2)))
    (println "decode-to-string")
    (dotimes [_ 3]
      (time (decode-to-string long-encoded-string-1))
      (time (decode-to-string long-encoded-string-2)))))