|
14
|
1 ;;; base64.el,v --- Base64 encoding functions
|
|
16
|
2 ;; Author: Kyle E. Jones
|
|
|
3 ;; Created: 1997/01/23 00:13:17
|
|
|
4 ;; Version: 1.4
|
|
14
|
5 ;; Keywords: extensions
|
|
|
6
|
|
|
7 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
16
|
8 ;;; Copyright (C) 1997 Kyle E. Jones
|
|
14
|
9 ;;;
|
|
|
10 ;;; This file is not part of GNU Emacs, but the same permissions apply.
|
|
|
11 ;;;
|
|
|
12 ;;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
13 ;;; it under the terms of the GNU General Public License as published by
|
|
|
14 ;;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
15 ;;; any later version.
|
|
|
16 ;;;
|
|
|
17 ;;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
20 ;;; GNU General Public License for more details.
|
|
|
21 ;;;
|
|
|
22 ;;; You should have received a copy of the GNU General Public License
|
|
|
23 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
24 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
25 ;;; Boston, MA 02111-1307, USA.
|
|
|
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
27
|
|
16
|
28 ;; For non-MULE
|
|
|
29 (if (not (fboundp 'char-int))
|
|
|
30 (fset 'char-int 'identity))
|
|
|
31
|
|
|
32 (defvar base64-alphabet
|
|
|
33 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
|
|
14
|
34
|
|
16
|
35 (defvar base64-decoder-program nil
|
|
|
36 "*Non-nil value should be a string that names a MIME base64 decoder.
|
|
|
37 The program should expect to read base64 data on its standard
|
|
|
38 input and write the converted data to its standard output.")
|
|
|
39
|
|
|
40 (defvar base64-decoder-switches nil
|
|
|
41 "*List of command line flags passed to the command named by
|
|
|
42 base64-decoder-program.")
|
|
14
|
43
|
|
16
|
44 (defvar base64-encoder-program nil
|
|
|
45 "*Non-nil value should be a string that names a MIME base64 encoder.
|
|
|
46 The program should expect arbitrary data on its standard
|
|
|
47 input and write base64 data to its standard output.")
|
|
|
48
|
|
|
49 (defvar base64-encoder-switches nil
|
|
|
50 "*List of command line flags passed to the command named by
|
|
|
51 base64-encoder-program.")
|
|
14
|
52
|
|
16
|
53 (defconst base64-alphabet-decoding-alist
|
|
|
54 '(
|
|
|
55 ( ?A . 00) ( ?B . 01) ( ?C . 02) ( ?D . 03) ( ?E . 04) ( ?F . 05)
|
|
|
56 ( ?G . 06) ( ?H . 07) ( ?I . 08) ( ?J . 09) ( ?K . 10) ( ?L . 11)
|
|
|
57 ( ?M . 12) ( ?N . 13) ( ?O . 14) ( ?P . 15) ( ?Q . 16) ( ?R . 17)
|
|
|
58 ( ?S . 18) ( ?T . 19) ( ?U . 20) ( ?V . 21) ( ?W . 22) ( ?X . 23)
|
|
|
59 ( ?Y . 24) ( ?Z . 25) ( ?a . 26) ( ?b . 27) ( ?c . 28) ( ?d . 29)
|
|
|
60 ( ?e . 30) ( ?f . 31) ( ?g . 32) ( ?h . 33) ( ?i . 34) ( ?j . 35)
|
|
|
61 ( ?k . 36) ( ?l . 37) ( ?m . 38) ( ?n . 39) ( ?o . 40) ( ?p . 41)
|
|
|
62 ( ?q . 42) ( ?r . 43) ( ?s . 44) ( ?t . 45) ( ?u . 46) ( ?v . 47)
|
|
|
63 ( ?w . 48) ( ?x . 49) ( ?y . 50) ( ?z . 51) ( ?0 . 52) ( ?1 . 53)
|
|
|
64 ( ?2 . 54) ( ?3 . 55) ( ?4 . 56) ( ?5 . 57) ( ?6 . 58) ( ?7 . 59)
|
|
|
65 ( ?8 . 60) ( ?9 . 61) ( ?+ . 62) ( ?/ . 63)
|
|
|
66 ))
|
|
14
|
67
|
|
16
|
68 (defvar base64-alphabet-decoding-vector
|
|
|
69 (let ((v (make-vector 123 nil))
|
|
|
70 (p base64-alphabet-decoding-alist))
|
|
|
71 (while p
|
|
|
72 (aset v (car (car p)) (cdr (car p)))
|
|
|
73 (setq p (cdr p)))
|
|
|
74 v))
|
|
14
|
75
|
|
16
|
76 (defun base64-run-command-on-region (start end output-buffer command
|
|
|
77 &rest arg-list)
|
|
|
78 (let ((tempfile nil) status errstring)
|
|
|
79 (unwind-protect
|
|
|
80 (progn
|
|
|
81 (setq tempfile (make-temp-name "base64"))
|
|
|
82 (setq status
|
|
|
83 (apply 'call-process-region
|
|
|
84 start end command nil
|
|
|
85 (list output-buffer tempfile)
|
|
|
86 nil arg-list))
|
|
|
87 (cond ((equal status 0) t)
|
|
|
88 ((zerop (save-excursion
|
|
|
89 (set-buffer (find-file-noselect tempfile))
|
|
|
90 (buffer-size)))
|
|
|
91 t)
|
|
|
92 (t (save-excursion
|
|
|
93 (set-buffer (find-file-noselect tempfile))
|
|
|
94 (setq errstring (buffer-string))
|
|
|
95 (kill-buffer nil)
|
|
|
96 (cons status errstring)))))
|
|
|
97 (condition-case ()
|
|
|
98 (delete-file tempfile)
|
|
|
99 (error nil)))))
|
|
|
100
|
|
|
101 (defun base64-insert-char (char &optional count ignored buffer)
|
|
|
102 (condition-case nil
|
|
|
103 (progn
|
|
|
104 (insert-char char count ignored buffer)
|
|
|
105 (fset 'vm-insert-char 'insert-char))
|
|
|
106 (wrong-number-of-arguments
|
|
|
107 (fset 'base64-insert-char 'base64-xemacs-insert-char)
|
|
|
108 (base64-insert-char char count ignored buffer))))
|
|
|
109
|
|
|
110 (defun base64-xemacs-insert-char (char &optional count ignored buffer)
|
|
|
111 (if (and buffer (eq buffer (current-buffer)))
|
|
|
112 (insert-char char count)
|
|
|
113 (save-excursion
|
|
|
114 (set-buffer buffer)
|
|
|
115 (insert-char char count))))
|
|
14
|
116
|
|
16
|
117 (defun base64-decode-region (start end)
|
|
|
118 (interactive "r")
|
|
|
119 (message "Decoding base64...")
|
|
|
120 (let ((work-buffer nil)
|
|
|
121 (done nil)
|
|
|
122 (counter 0)
|
|
|
123 (bits 0)
|
|
|
124 (lim 0) inputpos
|
|
|
125 (non-data-chars (concat "^=" base64-alphabet)))
|
|
|
126 (unwind-protect
|
|
|
127 (save-excursion
|
|
|
128 (setq work-buffer (generate-new-buffer " *base64-work*"))
|
|
|
129 (buffer-disable-undo work-buffer)
|
|
|
130 (if base64-decoder-program
|
|
|
131 (let* ((binary-process-output t) ; any text already has CRLFs
|
|
|
132 (status (apply 'command-on-region
|
|
|
133 start end work-buffer
|
|
|
134 base64-decoder-program
|
|
|
135 base64-decoder-switches)))
|
|
|
136 (if (not (eq status t))
|
|
|
137 (error "%s" (cdr status))))
|
|
|
138 (goto-char start)
|
|
|
139 (skip-chars-forward non-data-chars end)
|
|
|
140 (while (not done)
|
|
|
141 (setq inputpos (point))
|
|
|
142 (cond
|
|
|
143 ((> (skip-chars-forward base64-alphabet end) 0)
|
|
|
144 (setq lim (point))
|
|
|
145 (while (< inputpos lim)
|
|
|
146 (setq bits (+ bits
|
|
|
147 (aref base64-alphabet-decoding-vector
|
|
|
148 (char-int (char-after inputpos)))))
|
|
|
149 (setq counter (1+ counter)
|
|
|
150 inputpos (1+ inputpos))
|
|
|
151 (cond ((= counter 4)
|
|
|
152 (base64-insert-char (lsh bits -16) 1 nil work-buffer)
|
|
|
153 (base64-insert-char (logand (lsh bits -8) 255) 1 nil
|
|
|
154 work-buffer)
|
|
|
155 (base64-insert-char (logand bits 255) 1 nil
|
|
|
156 work-buffer)
|
|
|
157 (setq bits 0 counter 0))
|
|
|
158 (t (setq bits (lsh bits 6)))))))
|
|
|
159 (cond
|
|
|
160 ((= (point) end)
|
|
|
161 (if (not (zerop counter))
|
|
|
162 (error "at least %d bits missing at end of base64 encoding"
|
|
|
163 (* (- 4 counter) 6)))
|
|
|
164 (setq done t))
|
|
|
165 ((= (char-after (point)) ?=)
|
|
|
166 (setq done t)
|
|
|
167 (cond ((= counter 1)
|
|
|
168 (error "at least 2 bits missing at end of base64 encoding"))
|
|
|
169 ((= counter 2)
|
|
|
170 (base64-insert-char (lsh bits -10) 1 nil work-buffer))
|
|
|
171 ((= counter 3)
|
|
|
172 (base64-insert-char (lsh bits -16) 1 nil work-buffer)
|
|
|
173 (base64-insert-char (logand (lsh bits -8) 255)
|
|
|
174 1 nil work-buffer))
|
|
|
175 ((= counter 0) t)))
|
|
|
176 (t (skip-chars-forward non-data-chars end)))))
|
|
|
177 (or (markerp end) (setq end (set-marker (make-marker) end)))
|
|
|
178 (goto-char start)
|
|
|
179 (insert-buffer-substring work-buffer)
|
|
|
180 (delete-region (point) end))
|
|
|
181 (and work-buffer (kill-buffer work-buffer))))
|
|
|
182 (message "Decoding base64... done"))
|
|
14
|
183
|
|
16
|
184 (defun base64-encode-region (start end)
|
|
14
|
185 (interactive "r")
|
|
16
|
186 (message "Encoding base64...")
|
|
|
187 (let ((work-buffer nil)
|
|
|
188 (counter 0)
|
|
|
189 (cols 0)
|
|
|
190 (bits 0)
|
|
|
191 (alphabet base64-alphabet)
|
|
|
192 inputpos)
|
|
|
193 (unwind-protect
|
|
|
194 (save-excursion
|
|
|
195 (setq work-buffer (generate-new-buffer " *base64-work*"))
|
|
|
196 (buffer-disable-undo work-buffer)
|
|
|
197 (if base64-encoder-program
|
|
|
198 (let ((status (apply 'base64-run-command-on-region
|
|
|
199 start end work-buffer
|
|
|
200 base64-encoder-program
|
|
|
201 base64-encoder-switches)))
|
|
|
202 (if (not (eq status t))
|
|
|
203 (error "%s" (cdr status))))
|
|
|
204 (setq inputpos start)
|
|
|
205 (while (< inputpos end)
|
|
|
206 (setq bits (+ bits (char-int (char-after inputpos))))
|
|
|
207 (setq counter (1+ counter))
|
|
|
208 (cond ((= counter 3)
|
|
|
209 (base64-insert-char (aref alphabet (lsh bits -18)) 1 nil
|
|
|
210 work-buffer)
|
|
|
211 (base64-insert-char
|
|
|
212 (aref alphabet (logand (lsh bits -12) 63))
|
|
|
213 1 nil work-buffer)
|
|
|
214 (base64-insert-char
|
|
|
215 (aref alphabet (logand (lsh bits -6) 63))
|
|
|
216 1 nil work-buffer)
|
|
|
217 (base64-insert-char
|
|
|
218 (aref alphabet (logand bits 63))
|
|
|
219 1 nil work-buffer)
|
|
|
220 (setq cols (+ cols 4))
|
|
|
221 (cond ((= cols 72)
|
|
|
222 (base64-insert-char ?\n 1 nil work-buffer)
|
|
|
223 (setq cols 0)))
|
|
|
224 (setq bits 0 counter 0))
|
|
|
225 (t (setq bits (lsh bits 8))))
|
|
|
226 (setq inputpos (1+ inputpos)))
|
|
|
227 ;; write out any remaining bits with appropriate padding
|
|
|
228 (if (= counter 0)
|
|
|
229 nil
|
|
|
230 (setq bits (lsh bits (- 16 (* 8 counter))))
|
|
|
231 (base64-insert-char (aref alphabet (lsh bits -18)) 1 nil
|
|
|
232 work-buffer)
|
|
|
233 (base64-insert-char (aref alphabet (logand (lsh bits -12) 63))
|
|
|
234 1 nil work-buffer)
|
|
|
235 (if (= counter 1)
|
|
|
236 (base64-insert-char ?= 2 nil work-buffer)
|
|
|
237 (base64-insert-char (aref alphabet (logand (lsh bits -6) 63))
|
|
|
238 1 nil work-buffer)
|
|
|
239 (base64-insert-char ?= 1 nil work-buffer)))
|
|
|
240 (if (> cols 0)
|
|
|
241 (base64-insert-char ?\n 1 nil work-buffer)))
|
|
|
242 (or (markerp end) (setq end (set-marker (make-marker) end)))
|
|
|
243 (goto-char start)
|
|
|
244 (insert-buffer-substring work-buffer)
|
|
|
245 (delete-region (point) end))
|
|
|
246 (and work-buffer (kill-buffer work-buffer))))
|
|
|
247 (message "Encoding base64... done"))
|
|
14
|
248
|
|
16
|
249 (defun base64-encode (string)
|
|
|
250 (save-excursion
|
|
|
251 (set-buffer (get-buffer-create " *base64-encode*"))
|
|
|
252 (erase-buffer)
|
|
|
253 (insert string)
|
|
|
254 (base64-encode-region (point-min) (point-max))
|
|
|
255 (skip-chars-backward " \t\r\n")
|
|
|
256 (delete-region (point-max) (point))
|
|
|
257 (prog1
|
|
|
258 (buffer-string)
|
|
|
259 (kill-buffer (current-buffer)))))
|
|
|
260
|
|
|
261 (defun base64-decode (string)
|
|
|
262 (save-excursion
|
|
|
263 (set-buffer (get-buffer-create " *base64-decode*"))
|
|
|
264 (erase-buffer)
|
|
|
265 (insert string)
|
|
|
266 (base64-decode-region (point-min) (point-max))
|
|
|
267 (goto-char (point-max))
|
|
|
268 (skip-chars-backward " \t\r\n")
|
|
|
269 (delete-region (point-max) (point))
|
|
|
270 (prog1
|
|
|
271 (buffer-string)
|
|
|
272 (kill-buffer (current-buffer)))))
|
|
14
|
273
|
|
|
274 (provide 'base64)
|
