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