|
0
|
1 ;;; base64.el,v --- Base64 encoding functions
|
|
|
2 ;; Author: wmperry
|
|
|
3 ;; Created: 1996/04/22 15:08:08
|
|
|
4 ;; Version: 1.7
|
|
|
5 ;; Keywords: extensions
|
|
|
6
|
|
|
7 ;;; LCD Archive Entry:
|
|
|
8 ;;; base64.el|William M. Perry|wmperry@spry.com|
|
|
|
9 ;;; Package for encoding/decoding base64 data (MIME)|
|
|
|
10 ;;; 1996/04/22 15:08:08|1.7|Location Undetermined
|
|
|
11 ;;;
|
|
|
12
|
|
|
13 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
14 ;;; Base 64 encoding functions
|
|
|
15 ;;; This code was converted to lisp code by me from the C code in
|
|
|
16 ;;; ftp://cs.utk.edu/pub/MIME/b64encode.c
|
|
|
17 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
18
|
|
|
19 (defvar base64-code-string
|
|
|
20 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
|
|
|
21 "Character set used for base64 decoding")
|
|
|
22
|
|
|
23 (defvar base64-decode-vector
|
|
|
24 (let ((vec (make-vector 256 nil))
|
|
|
25 (i 0)
|
|
|
26 (case-fold-search nil))
|
|
|
27 (while (< i 256)
|
|
|
28 (aset vec i (string-match (regexp-quote (char-to-string i))
|
|
|
29 base64-code-string))
|
|
|
30 (setq i (1+ i)))
|
|
|
31 vec))
|
|
|
32
|
|
|
33 (defvar base64-max-line-length 64)
|
|
|
34
|
|
|
35 ;(defun b0 (x) (aref base64-code-string (logand (lsh x -18) 63)))
|
|
|
36 ;(defun b1 (x) (aref base64-code-string (logand (lsh x -12) 63)))
|
|
|
37 ;(defun b2 (x) (aref base64-code-string (logand (lsh x -6) 63)))
|
|
|
38 ;(defun b3 (x) (aref base64-code-string (logand x 63)))
|
|
|
39
|
|
|
40 (defmacro b0 (x) (` (aref base64-code-string (logand (lsh (, x) -18) 63))))
|
|
|
41 (defmacro b1 (x) (` (aref base64-code-string (logand (lsh (, x) -12) 63))))
|
|
|
42 (defmacro b2 (x) (` (aref base64-code-string (logand (lsh (, x) -6) 63))))
|
|
|
43 (defmacro b3 (x) (` (aref base64-code-string (logand (, x) 63))))
|
|
|
44
|
|
|
45 (defun base64-encode (str)
|
|
|
46 "Do base64 encoding on string STR and return the encoded string.
|
|
|
47 This code was converted to lisp code by me from the C code in
|
|
|
48 ftp://cs.utk.edu/pub/MIME/b64encode.c. Returns a string that is
|
|
|
49 broken into `base64-max-line-length' byte lines."
|
|
|
50 (or str (setq str (buffer-string)))
|
|
|
51 (let ((x (base64-encode-internal str))
|
|
|
52 (y ""))
|
|
|
53 (while (> (length x) base64-max-line-length)
|
|
|
54 (setq y (concat y (substring x 0 base64-max-line-length) "\n")
|
|
|
55 x (substring x base64-max-line-length nil)))
|
|
|
56 (setq y (concat y x))
|
|
|
57 y))
|
|
|
58
|
|
|
59 (defun base64-encode-internal (str)
|
|
|
60 "Do base64 encoding on string STR and return the encoded string.
|
|
|
61 This code was converted to lisp code by me from the C code in
|
|
|
62 ftp://cs.utk.edu/pub/MIME/b64encode.c. Returns the entire string,
|
|
|
63 not broken up into `base64-max-line-length' byte lines."
|
|
|
64 (let (
|
|
|
65 (word 0) ; The word to translate
|
|
|
66 w1 w2 w3
|
|
|
67 )
|
|
|
68 (cond
|
|
|
69 ((> (length str) 3)
|
|
|
70 (concat
|
|
|
71 (base64-encode-internal (substring str 0 3))
|
|
|
72 (base64-encode-internal (substring str 3 nil))))
|
|
|
73 ((= (length str) 3)
|
|
|
74 (setq w1 (aref str 0)
|
|
|
75 w2 (aref str 1)
|
|
|
76 w3 (aref str 2)
|
|
|
77 word (logior
|
|
|
78 (lsh (logand w1 255) 16)
|
|
|
79 (lsh (logand w2 255) 8)
|
|
|
80 (logand w3 255)))
|
|
|
81 (format "%c%c%c%c" (b0 word) (b1 word) (b2 word) (b3 word)))
|
|
|
82 ((= (length str) 2)
|
|
|
83 (setq w1 (aref str 0)
|
|
|
84 w2 (aref str 1)
|
|
|
85 word (logior
|
|
|
86 (lsh (logand w1 255) 16)
|
|
|
87 (lsh (logand w2 255) 8)
|
|
|
88 0))
|
|
|
89 (format "%c%c%c=" (b0 word) (b1 word) (b2 word)))
|
|
|
90 ((= (length str) 1)
|
|
|
91 (setq w1 (aref str 0)
|
|
|
92 word (logior
|
|
|
93 (lsh (logand w1 255) 16)
|
|
|
94 0))
|
|
|
95 (format "%c%c==" (b0 word) (b1 word)))
|
|
|
96 (t ""))))
|
|
|
97
|
|
|
98 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
99 ;;; Base64 decoding functions
|
|
|
100 ;;; Most of the decoding code is courtesy Francesco Potorti`
|
|
|
101 ;;; <F.Potorti@cnuce.cnr.it>
|
|
|
102 ;;; this is much faster than my original code - thanks!
|
|
|
103 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
104 (defun base64-decode-region (beg end)
|
|
|
105 (interactive "r")
|
|
|
106 (barf-if-buffer-read-only)
|
|
|
107 (let
|
|
|
108 ((exchange (= (point) beg))
|
|
|
109 (endchars 0)
|
|
|
110 (list) (code))
|
|
|
111 (goto-char beg)
|
|
|
112 (while (< (point) end)
|
|
|
113 (setq list (mapcar
|
|
|
114 (function
|
|
|
115 (lambda (c)
|
|
|
116 (cond
|
|
|
117 ((aref base64-decode-vector c))
|
|
|
118 ((char-equal c ?=)
|
|
|
119 (setq endchars (1+ endchars))
|
|
|
120 0)
|
|
|
121 (nil
|
|
|
122 (error
|
|
|
123 "Character %c does not match Mime base64 coding" c)))))
|
|
|
124 (buffer-substring (point) (+ (point) 4))))
|
|
|
125 (setq code (+ (nth 3 list) (lsh (nth 2 list) 6)
|
|
|
126 (lsh (nth 1 list) 12) (lsh (car list) 18)))
|
|
|
127 (delete-char 4)
|
|
|
128 (cond
|
|
|
129 ((zerop endchars)
|
|
|
130 (insert (% (lsh code -16) 256) (% (lsh code -8) 256) (% code 256)))
|
|
|
131 ((= endchars 1)
|
|
|
132 (insert (% (lsh code -16) 256) (% (lsh code -8) 256))
|
|
|
133 (setq end (point)))
|
|
|
134 ((= endchars 2)
|
|
|
135 (insert (% (lsh code -16) 256))
|
|
|
136 (setq end (point))))
|
|
|
137 (if (char-equal (following-char) ?\n)
|
|
|
138 (progn (delete-char 1)
|
|
|
139 (setq end (- end 2)))
|
|
|
140 (setq end (1- end))))
|
|
|
141 ))
|
|
|
142 ; (if exchange
|
|
|
143 ; (exchange-point-and-mark))))
|
|
|
144
|
|
|
145 (defun base64-decode (st &optional nd)
|
|
|
146 "Do base64 decoding on string STR and return the original string.
|
|
|
147 If given buffer positions, destructively decodes that area of the
|
|
|
148 current buffer."
|
|
|
149 (let ((replace-p nil)
|
|
|
150 (retval nil))
|
|
|
151 (if (stringp st)
|
|
|
152 nil
|
|
|
153 (setq st (prog1
|
|
|
154 (buffer-substring st (or nd (point-max)))
|
|
|
155 (delete-region st (or nd (point-max))))
|
|
|
156 replace-p t))
|
|
|
157 (setq retval
|
|
|
158 (save-excursion
|
|
|
159 (set-buffer (get-buffer-create " *b64decode*"))
|
|
|
160 (erase-buffer)
|
|
|
161 (insert st)
|
|
|
162 (goto-char (point-min))
|
|
|
163 (while (re-search-forward "\r*\n" nil t)
|
|
|
164 (replace-match ""))
|
|
|
165 (goto-char (point-min))
|
|
|
166 (base64-decode-region (point-min) (point-max))
|
|
|
167 (buffer-string)))
|
|
|
168 (if replace-p (insert retval))
|
|
|
169 retval))
|
|
|
170
|
|
|
171 (provide 'base64)
|
