|
4
|
1 ;;; mel-b.el: Base64 encoder/decoder for GNU Emacs
|
|
155
|
2
|
|
|
3 ;; Copyright (C) 1992,1995,1996,1997 Free Software Foundation, Inc.
|
|
|
4
|
|
|
5 ;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp>
|
|
|
6 ;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
|
|
|
7 ;; Maintainer: MORIOKA Tomohiko <morioka@jaist.ac.jp>
|
|
|
8 ;; Created: 1995/6/24
|
|
|
9 ;; Version: $Id: mel-b.el,v 1.3 1997/06/06 00:57:14 steve Exp $
|
|
|
10 ;; Keywords: MIME, Base64
|
|
|
11
|
|
|
12 ;; This file is part of MEL (MIME Encoding Library).
|
|
|
13
|
|
|
14 ;; This program is free software; you can redistribute it and/or
|
|
|
15 ;; modify it under the terms of the GNU General Public License as
|
|
|
16 ;; published by the Free Software Foundation; either version 2, or (at
|
|
|
17 ;; your option) any later version.
|
|
|
18
|
|
|
19 ;; This program is distributed in the hope that it will be useful, but
|
|
|
20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
22 ;; General Public License for more details.
|
|
|
23
|
|
|
24 ;; You should have received a copy of the GNU General Public License
|
|
|
25 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
26 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
27 ;; Boston, MA 02111-1307, USA.
|
|
|
28
|
|
4
|
29 ;;; Code:
|
|
|
30
|
|
|
31 (require 'emu)
|
|
|
32
|
|
|
33
|
|
|
34 ;;; @ variables
|
|
|
35 ;;;
|
|
|
36
|
|
|
37 (defvar base64-external-encoder '("mmencode")
|
|
|
38 "*list of base64 encoder program name and its arguments.")
|
|
|
39
|
|
|
40 (defvar base64-external-decoder '("mmencode" "-u")
|
|
|
41 "*list of base64 decoder program name and its arguments.")
|
|
|
42
|
|
|
43 (defvar base64-internal-encoding-limit 1000
|
|
|
44 "*limit size to use internal base64 encoder.
|
|
|
45 If size of input to encode is larger than this limit,
|
|
|
46 external encoder is called.")
|
|
|
47
|
|
|
48 (defvar base64-internal-decoding-limit 1000
|
|
|
49 "*limit size to use internal base64 decoder.
|
|
|
50 If size of input to decode is larger than this limit,
|
|
|
51 external decoder is called.")
|
|
|
52
|
|
|
53
|
|
|
54 ;;; @ internal base64 decoder/encoder
|
|
|
55 ;;; based on base64 decoder by Enami Tsugutomo
|
|
|
56
|
|
|
57 ;;; @@ convert from/to base64 char
|
|
|
58 ;;;
|
|
|
59
|
|
|
60 (defun base64-num-to-char (n)
|
|
|
61 (cond ((eq n nil) ?=)
|
|
|
62 ((< n 26) (+ ?A n))
|
|
|
63 ((< n 52) (+ ?a (- n 26)))
|
|
|
64 ((< n 62) (+ ?0 (- n 52)))
|
|
|
65 ((= n 62) ?+)
|
|
|
66 ((= n 63) ?/)
|
|
|
67 (t (error "not a base64 integer %d" n))))
|
|
|
68
|
|
|
69 (defun base64-char-to-num (c)
|
|
|
70 (cond ((and (<= ?A c) (<= c ?Z)) (- c ?A))
|
|
|
71 ((and (<= ?a c) (<= c ?z)) (+ (- c ?a) 26))
|
|
|
72 ((and (<= ?0 c) (<= c ?9)) (+ (- c ?0) 52))
|
|
|
73 ((= c ?+) 62)
|
|
|
74 ((= c ?/) 63)
|
|
|
75 ((= c ?=) nil)
|
|
|
76 (t (error "not a base64 character %c" c))))
|
|
|
77
|
|
|
78
|
|
|
79 ;;; @@ encode/decode one base64 unit
|
|
|
80 ;;;
|
|
|
81
|
|
|
82 (defun base64-encode-1 (pack)
|
|
|
83 (let ((a (car pack))
|
|
|
84 (b (nth 1 pack))
|
|
|
85 (c (nth 2 pack)))
|
|
|
86 (concat
|
|
|
87 (char-to-string (base64-num-to-char (ash a -2)))
|
|
|
88 (if b
|
|
|
89 (concat
|
|
|
90 (char-to-string
|
|
|
91 (base64-num-to-char (logior (ash (logand a 3) 4) (ash b -4))))
|
|
|
92 (if c
|
|
|
93 (concat
|
|
|
94 (char-to-string
|
|
|
95 (base64-num-to-char (logior (ash (logand b 15) 2) (ash c -6))))
|
|
|
96 (char-to-string (base64-num-to-char (logand c 63)))
|
|
|
97 )
|
|
|
98 (concat (char-to-string
|
|
|
99 (base64-num-to-char (ash (logand b 15) 2))) "=")
|
|
|
100 ))
|
|
|
101 (concat (char-to-string
|
|
|
102 (base64-num-to-char (ash (logand a 3) 4))) "==")
|
|
|
103 ))))
|
|
|
104
|
|
|
105 (defun base64-decode-1 (pack)
|
|
|
106 (let ((a (base64-char-to-num (car pack)))
|
|
|
107 (b (base64-char-to-num (nth 1 pack)))
|
|
|
108 (c (nth 2 pack))
|
|
|
109 (d (nth 3 pack)))
|
|
|
110 (concat (char-to-string (logior (ash a 2) (ash b -4)))
|
|
|
111 (if (and c (setq c (base64-char-to-num c)))
|
|
|
112 (concat (char-to-string
|
|
|
113 (logior (ash (logand b 15) 4) (ash c -2)))
|
|
|
114 (if (and d (setq d (base64-char-to-num d)))
|
|
|
115 (char-to-string (logior (ash (logand c 3) 6) d))
|
|
|
116 ))))))
|
|
|
117
|
|
|
118
|
|
|
119 ;;; @@ base64 encoder/decoder for string
|
|
|
120 ;;;
|
|
|
121
|
|
|
122 (defun base64-encode-string (string)
|
|
155
|
123 "Encode STRING to base64, and return the result."
|
|
4
|
124 (let ((len (length string))
|
|
|
125 (b 0)(e 57)
|
|
|
126 dest)
|
|
|
127 (while (< e len)
|
|
|
128 (setq dest
|
|
|
129 (concat dest
|
|
|
130 (mapconcat
|
|
|
131 (function base64-encode-1)
|
|
|
132 (pack-sequence (substring string b e) 3)
|
|
|
133 "")
|
|
|
134 "\n"))
|
|
|
135 (setq b e
|
|
|
136 e (+ e 57)
|
|
|
137 )
|
|
|
138 )
|
|
|
139 (let* ((es (mapconcat
|
|
|
140 (function base64-encode-1)
|
|
|
141 (pack-sequence (substring string b) 3)
|
|
|
142 ""))
|
|
|
143 (m (mod (length es) 4))
|
|
|
144 )
|
|
|
145 (concat dest es (cond ((= m 3) "=")
|
|
|
146 ((= m 2) "==")
|
|
|
147 ))
|
|
|
148 )))
|
|
|
149
|
|
|
150 (defun base64-decode-string (string)
|
|
155
|
151 "Decode STRING which is encoded in base64, and return the result."
|
|
4
|
152 (mapconcat (function base64-decode-1)
|
|
|
153 (pack-sequence string 4)
|
|
|
154 ""))
|
|
|
155
|
|
|
156
|
|
|
157 ;;; @ base64 encoder/decoder for region
|
|
|
158 ;;;
|
|
|
159
|
|
|
160 (defun base64-internal-encode-region (beg end)
|
|
|
161 (save-excursion
|
|
|
162 (save-restriction
|
|
|
163 (narrow-to-region beg end)
|
|
|
164 (let ((str (buffer-substring beg end)))
|
|
|
165 (delete-region beg end)
|
|
|
166 (insert (base64-encode-string str))
|
|
|
167 )
|
|
|
168 (or (bolp)
|
|
|
169 (insert "\n")
|
|
|
170 )
|
|
|
171 )))
|
|
|
172
|
|
|
173 (defun base64-internal-decode-region (beg end)
|
|
|
174 (save-excursion
|
|
|
175 (save-restriction
|
|
|
176 (narrow-to-region beg end)
|
|
|
177 (goto-char (point-min))
|
|
|
178 (while (looking-at ".*\n")
|
|
|
179 (condition-case err
|
|
|
180 (replace-match
|
|
|
181 (base64-decode-string
|
|
|
182 (buffer-substring (match-beginning 0) (1- (match-end 0))))
|
|
|
183 t t)
|
|
|
184 (error
|
|
|
185 (prog1
|
|
|
186 (message (nth 1 err))
|
|
|
187 (replace-match "")))))
|
|
|
188 (if (looking-at ".*$")
|
|
|
189 (condition-case err
|
|
|
190 (replace-match
|
|
|
191 (base64-decode-string
|
|
|
192 (buffer-substring (match-beginning 0) (match-end 0)))
|
|
|
193 t t)
|
|
|
194 (error
|
|
|
195 (prog1
|
|
|
196 (message (nth 1 err))
|
|
|
197 (replace-match "")))
|
|
|
198 ))
|
|
|
199 )))
|
|
|
200
|
|
|
201 (defun base64-external-encode-region (beg end)
|
|
|
202 (save-excursion
|
|
|
203 (save-restriction
|
|
|
204 (narrow-to-region beg end)
|
|
|
205 (as-binary-process (apply (function call-process-region)
|
|
|
206 beg end (car base64-external-encoder)
|
|
|
207 t t nil (cdr base64-external-encoder))
|
|
|
208 )
|
|
|
209 ;; for OS/2
|
|
|
210 ;; regularize line break code
|
|
|
211 (goto-char (point-min))
|
|
|
212 (while (re-search-forward "\r$" nil t)
|
|
|
213 (replace-match "")
|
|
|
214 )
|
|
|
215 )))
|
|
|
216
|
|
|
217 (defun base64-external-decode-region (beg end)
|
|
|
218 (save-excursion
|
|
|
219 (as-binary-process (apply (function call-process-region)
|
|
|
220 beg end (car base64-external-decoder)
|
|
|
221 t t nil (cdr base64-external-decoder))
|
|
|
222 )))
|
|
|
223
|
|
155
|
224 (defun base64-encode-region (start end)
|
|
|
225 "Encode current region by base64.
|
|
|
226 START and END are buffer positions.
|
|
|
227 This function calls internal base64 encoder if size of region is
|
|
|
228 smaller than `base64-internal-encoding-limit', otherwise it calls
|
|
|
229 external base64 encoder specified by `base64-external-encoder'. In
|
|
|
230 this case, you must install the program (maybe mmencode included in
|
|
|
231 metamail or XEmacs package)."
|
|
4
|
232 (interactive "r")
|
|
|
233 (if (and base64-internal-encoding-limit
|
|
155
|
234 (> (- end start) base64-internal-encoding-limit))
|
|
|
235 (base64-external-encode-region start end)
|
|
|
236 (base64-internal-encode-region start end)
|
|
4
|
237 ))
|
|
|
238
|
|
155
|
239 (defun base64-decode-region (start end)
|
|
|
240 "Decode current region by base64.
|
|
|
241 START and END are buffer positions.
|
|
|
242 This function calls internal base64 decoder if size of region is
|
|
|
243 smaller than `base64-internal-decoding-limit', otherwise it calls
|
|
|
244 external base64 decoder specified by `base64-external-decoder'. In
|
|
|
245 this case, you must install the program (maybe mmencode included in
|
|
|
246 metamail or XEmacs package)."
|
|
4
|
247 (interactive "r")
|
|
|
248 (if (and base64-internal-decoding-limit
|
|
155
|
249 (> (- end start) base64-internal-decoding-limit))
|
|
|
250 (base64-external-decode-region start end)
|
|
|
251 (base64-internal-decode-region start end)
|
|
4
|
252 ))
|
|
|
253
|
|
|
254
|
|
|
255 ;;; @ base64 encoder/decoder for file
|
|
|
256 ;;;
|
|
|
257
|
|
|
258 (defun base64-insert-encoded-file (filename)
|
|
155
|
259 "Encode contents of file FILENAME to base64, and insert the result.
|
|
|
260 It calls external base64 encoder specified by
|
|
|
261 `base64-external-encoder'. So you must install the program (maybe
|
|
|
262 mmencode included in metamail or XEmacs package)."
|
|
4
|
263 (interactive (list (read-file-name "Insert encoded file: ")))
|
|
|
264 (apply (function call-process) (car base64-external-encoder)
|
|
|
265 filename t nil (cdr base64-external-encoder))
|
|
|
266 )
|
|
|
267
|
|
|
268
|
|
|
269 ;;; @ etc
|
|
|
270 ;;;
|
|
|
271
|
|
|
272 (defun base64-encoded-length (string)
|
|
|
273 (let ((len (length string)))
|
|
|
274 (* (+ (/ len 3)
|
|
|
275 (if (= (mod len 3) 0) 0 1)
|
|
|
276 ) 4)
|
|
|
277 ))
|
|
|
278
|
|
|
279 (defun pack-sequence (seq size)
|
|
|
280 "Split sequence SEQ into SIZE elements packs,
|
|
|
281 and return list of packs. [mel-b; tl-seq function]"
|
|
|
282 (let ((len (length seq)) (p 0) obj
|
|
|
283 unit (i 0)
|
|
|
284 dest)
|
|
|
285 (while (< p len)
|
|
|
286 (setq obj (elt seq p))
|
|
|
287 (setq unit (cons obj unit))
|
|
|
288 (setq i (1+ i))
|
|
|
289 (if (= i size)
|
|
|
290 (progn
|
|
|
291 (setq dest (cons (reverse unit) dest))
|
|
|
292 (setq unit nil)
|
|
|
293 (setq i 0)
|
|
|
294 ))
|
|
|
295 (setq p (1+ p))
|
|
|
296 )
|
|
|
297 (if unit
|
|
|
298 (setq dest (cons (reverse unit) dest))
|
|
|
299 )
|
|
|
300 (reverse dest)
|
|
|
301 ))
|
|
|
302
|
|
|
303
|
|
|
304 ;;; @ end
|
|
|
305 ;;;
|
|
|
306
|
|
|
307 (provide 'mel-b)
|
|
|
308
|
|
|
309 ;;; mel-b.el ends here.
|
