;;;
;;; $Id$
;;;

(require 'tl-seq)

;;; @ internal base64 decoder/encoder
;;;	based on base64 decoder by Enami Tsugutomo

;;; @@ convert from/to base64 char
;;;

(defun base64-num-to-char (n)
  (cond ((eq n nil) ?=)
	((< n 26) (+ ?A n))
	((< n 52) (+ ?a (- n 26)))
	((< n 62) (+ ?0 (- n 52)))
	((= n 62) ?+)
	((= n 63) ?/)
	(t (error "not a base64 integer %d" n))))

(defun base64-char-to-num (c)
  (cond ((and (<= ?A c) (<= c ?Z)) (- c ?A))
	((and (<= ?a c) (<= c ?z)) (+ (- c ?a) 26))
	((and (<= ?0 c) (<= c ?9)) (+ (- c ?0) 52))
	((= c ?+) 62)
	((= c ?/) 63)
	((= c ?=) nil)
	(t (error "not a base64 character %c" c))))


;;; @@ encode/decode one base64 unit
;;;

(defun base64-mask (i n) (logand i (1- (ash 1 n))))

(defun base64-encode-1 (a &optional b &optional c)
  (cons (ash a -2)
	(cons (logior (ash (base64-mask a 2) (- 6 2))
		      (if b (ash b -4) 0))
	      (if b
		  (cons (logior (ash (base64-mask b 4) (- 6 4))
				(if c (ash c -6) 0))
			(if c
			    (cons (base64-mask c (- 6 0))
				  nil)))))))

(defun base64-decode-1 (a b &optional c &optional d)
  (cons (logior (ash a 2) (ash b (- 2 6)))
	(if c (cons (logior (ash (base64-mask b 4) 4)
			    (base64-mask (ash c (- 4 6)) 4))
		    (if d (cons (logior (ash (base64-mask c 2) 6) d)
				nil))))))

(defun base64-encode-chars (a &optional b &optional c)
  (mapcar (function base64-num-to-char) (base64-encode-1 a b c)))

(defun base64-decode-chars (&rest args)
  (apply (function base64-decode-1)
	 (mapcar (function base64-char-to-num) args)
	 ))


;;; @@ encode/decode base64 string
;;;

(defun base64-encode-string (string)
  (let* ((es (mapconcat
	      (function
	       (lambda (pack)
		 (mapconcat (function char-to-string)
			    (apply (function base64-encode-chars) pack)
			    "")
		 ))
	      (pack-sequence string 3)
	      ""))
	 (m (mod (length es) 4))
	 )
    (concat es (cond ((= m 3) "=")
		     ((= m 2) "==")
		     ))
    ))

(defun base64-decode-string (string)
  (mapconcat (function
	      (lambda (pack)
		(mapconcat (function char-to-string)
			   (apply (function base64-decode-chars) pack)
			   "")
		))
	     (pack-sequence string 4)
	     ""))


;;; @ etc
;;;

(defun base64-encoded-length (string)
  (let ((len (length string)))
    (* (+ (/ len 3)
	  (if (= (mod len 3) 0) 0 1)
	  ) 4)
    ))

(provide 'base64)