base64.el

   1 ;;;
   2 ;;; $Id$
   3 ;;;
   4
   5 (require 'tl-seq)
   6
   7 ;;; @ internal base64 decoder/encoder
   8 ;;;     based on base64 decoder by Enami Tsugutomo
   9
  10 ;;; @@ convert from/to base64 char
  11 ;;;
  12
  13 (defun base64-num-to-char (n)
  14   (cond ((eq n nil) ?=)
  15         ((< n 26) (+ ?A n))
  16         ((< n 52) (+ ?a (- n 26)))
  17         ((< n 62) (+ ?0 (- n 52)))
  18         ((= n 62) ?+)
  19         ((= n 63) ?/)
  20         (t (error "not a base64 integer %d" n))))
  21
  22 (defun base64-char-to-num (c)
  23   (cond ((and (<= ?A c) (<= c ?Z)) (- c ?A))
  24         ((and (<= ?a c) (<= c ?z)) (+ (- c ?a) 26))
  25         ((and (<= ?0 c) (<= c ?9)) (+ (- c ?0) 52))
  26         ((= c ?+) 62)
  27         ((= c ?/) 63)
  28         ((= c ?=) nil)
  29         (t (error "not a base64 character %c" c))))
  30
  31
  32 ;;; @@ encode/decode one base64 unit
  33 ;;;
  34
  35 (defun base64-mask (i n) (logand i (1- (ash 1 n))))
  36
  37 (defun base64-encode-1 (a &optional b &optional c)
  38   (cons (ash a -2)
  39         (cons (logior (ash (base64-mask a 2) (- 6 2))
  40                       (if b (ash b -4) 0))
  41               (if b
  42                   (cons (logior (ash (base64-mask b 4) (- 6 4))
  43                                 (if c (ash c -6) 0))
  44                         (if c
  45                             (cons (base64-mask c (- 6 0))
  46                                   nil)))))))
  47
  48 (defun base64-decode-1 (a b &optional c &optional d)
  49   (cons (logior (ash a 2) (ash b (- 2 6)))
  50         (if c (cons (logior (ash (base64-mask b 4) 4)
  51                             (base64-mask (ash c (- 4 6)) 4))
  52                     (if d (cons (logior (ash (base64-mask c 2) 6) d)
  53                                 nil))))))
  54
  55 (defun base64-encode-chars (a &optional b &optional c)
  56   (mapcar (function base64-num-to-char) (base64-encode-1 a b c)))
  57
  58 (defun base64-decode-chars (&rest args)
  59   (apply (function base64-decode-1)
  60          (mapcar (function base64-char-to-num) args)
  61          ))
  62
  63
  64 ;;; @@ encode/decode base64 string
  65 ;;;
  66
  67 (defun base64-encode-string (string)
  68   (let* ((es (mapconcat
  69               (function
  70                (lambda (pack)
  71                  (mapconcat (function char-to-string)
  72                             (apply (function base64-encode-chars) pack)
  73                             "")
  74                  ))
  75               (pack-sequence string 3)
  76               ""))
  77          (m (mod (length es) 4))
  78          )
  79     (concat es (cond ((= m 3) "=")
  80                      ((= m 2) "==")
  81                      ))
  82     ))
  83
  84 (defun base64-decode-string (string)
  85   (mapconcat (function
  86               (lambda (pack)
  87                 (mapconcat (function char-to-string)
  88                            (apply (function base64-decode-chars) pack)
  89                            "")
  90                 ))
  91              (pack-sequence string 4)
  92              ""))
  93
  94
  95 ;;; @ etc
  96 ;;;
  97
  98 (defun base64-encoded-length (string)
  99   (let ((len (length string)))
 100     (* (+ (/ len 3)
 101           (if (= (mod len 3) 0) 0 1)
 102           ) 4)
 103     ))
 104
 105 (provide 'base64)