1 ;;; mel-b-el.el --- Base64 encoder/decoder.
3 ;; Copyright (C) 1992,95,96,97,98,99,2001 Free Software Foundation, Inc.
5 ;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp>
6 ;; MORIOKA Tomohiko <tomo@m17n.org>
8 ;; Keywords: MIME, Base64
10 ;; This file is part of FLIM (Faithful Library about Internet Message).
12 ;; This program is free software; you can redistribute it and/or
13 ;; modify it under the terms of the GNU General Public License as
14 ;; published by the Free Software Foundation; either version 2, or (at
15 ;; your option) any later version.
17 ;; This program is distributed in the hope that it will be useful, but
18 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with this program; see the file COPYING. If not, write to the
24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25 ;; Boston, MA 02110-1301, USA.
31 ;; XXX: the macro `as-binary-process' should be provided when compiling.
39 "Base64 encoder/decoder"
42 (defcustom base64-external-encoder '("mmencode")
43 "*list of base64 encoder program name and its arguments."
45 :type '(cons (file :tag "Command")(repeat :tag "Arguments" string)))
47 (defcustom base64-external-decoder '("mmencode" "-u")
48 "*list of base64 decoder program name and its arguments."
50 :type '(cons (file :tag "Command")(repeat :tag "Arguments" string)))
52 (defcustom base64-external-decoder-option-to-specify-file '("-o")
53 "*list of options of base64 decoder program to specify file.
54 If the base64 decoder program does not have such option, set this as nil."
56 :type '(repeat :tag "Arguments" string))
58 (defcustom base64-internal-encoding-limit 1000
59 "*limit size to use internal base64 encoder.
60 If size of input to encode is larger than this limit,
61 external encoder is called."
63 :type '(choice (const :tag "Always use internal encoder" nil)
64 (integer :tag "Size")))
66 (defcustom base64-internal-decoding-limit (if (and (featurep 'xemacs)
70 "*limit size to use internal base64 decoder.
71 If size of input to decode is larger than this limit,
72 external decoder is called."
74 :type '(choice (const :tag "Always use internal decoder" nil)
75 (integer :tag "Size")))
78 ;;; @ utility function
81 (defun pack-sequence (seq size)
82 "Split sequence SEQ into SIZE elements packs, and return list of packs.
83 \[mel-b-el; tl-seq function]"
84 (let ((len (length seq))
88 (setq unit (cons (elt seq p) unit))
90 (when (zerop (mod p size))
91 (setq dest (cons (nreverse unit) dest))
94 (nreverse (cons (nreverse unit) dest))
98 ;;; @ internal base64 encoder
99 ;;; based on base64 decoder by Enami Tsugutomo
102 (defconst base64-characters
103 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
106 (defmacro base64-num-to-char (n)
107 `(aref base64-characters ,n))
109 (defun base64-encode-1 (pack)
110 (let ((buf (make-string 4 ?=)))
111 (aset buf 0 (base64-num-to-char (ash (car pack) -2)))
114 (aset buf 1 (base64-num-to-char
115 (logior (ash (logand (car pack) 3) 4)
116 (ash (nth 1 pack) -4))))
119 (aset buf 2 (base64-num-to-char
120 (logior (ash (logand (nth 1 pack) 15) 2)
121 (ash (nth 2 pack) -6))))
122 (aset buf 3 (base64-num-to-char
123 (logand (nth 2 pack) 63))))
124 (aset buf 2 (base64-num-to-char
125 (ash (logand (nth 1 pack) 15) 2)))))
126 (aset buf 1 (base64-num-to-char
127 (ash (logand (car pack) 3) 4))))
130 (defun-maybe base64-encode-string (string &optional no-line-break)
131 "Base64-encode STRING and return the result.
132 Optional second argument NO-LINE-BREAK means do not break long lines
134 (let* ((len (length string))
141 (function base64-encode-1)
142 (pack-sequence (substring string b e) 3)
144 (if (not no-line-break) "\n")))
149 (function base64-encode-1)
150 (pack-sequence (substring string b) 3)
153 (defun base64-internal-encode-region (beg end &optional no-line-break)
156 (narrow-to-region beg end)
159 (base64-encode-string (buffer-substring beg end) no-line-break)
160 (delete-region beg end))))))
163 ;;; @ internal base64 decoder
166 (defconst base64-numbers
168 (let ((len (length base64-characters))
169 (vec (make-vector 123 nil))
172 (aset vec (aref base64-characters i) i)
176 (defmacro base64-char-to-num (c)
177 `(aref base64-numbers ,c))
179 (defsubst base64-internal-decode (string buffer)
180 (let* ((len (length string))
185 (when (prog1 (setq v1 (base64-char-to-num (aref string i)))
187 (setq v2 (base64-char-to-num (aref string i))
189 v3 (base64-char-to-num (aref string i))
191 (aset buffer j (logior (lsh v1 2)(lsh v2 -4)))
194 (let ((v4 (base64-char-to-num (aref string i))))
196 (aset buffer j (logior (lsh (logand v2 15) 4)(lsh v3 -2)))
199 (aset buffer (prog1 j (setq j (1+ j)))
200 (logior (lsh (logand v3 3) 6) v4))
203 (substring buffer 0 j)))
205 (defun base64-internal-decode-string (string)
206 (base64-internal-decode string (make-string (length string) 0)))
208 ;; (defsubst base64-decode-string! (string)
209 ;; (setq string (string-as-unibyte string))
210 ;; (base64-internal-decode string string))
212 (defun base64-internal-decode-region (beg end)
214 (let ((str (string-as-unibyte (buffer-substring beg end))))
217 (base64-internal-decode str str)
218 (delete-region beg end))))))
220 ;; (defun base64-internal-decode-region2 (beg end)
222 ;; (let ((str (buffer-substring beg end)))
223 ;; (delete-region beg end)
225 ;; (insert (base64-decode-string! str)))))
227 ;; (defun base64-internal-decode-region3 (beg end)
229 ;; (let ((str (buffer-substring beg end)))
230 ;; (delete-region beg end)
232 ;; (insert (base64-internal-decode-string str)))))
235 ;;; @ external encoder/decoder
238 (defun base64-external-encode-region (beg end &optional no-line-break)
241 (narrow-to-region beg end)
243 (apply (function call-process-region)
244 beg end (car base64-external-encoder)
246 (cdr base64-external-encoder)))
248 ;; regularize line break code
249 (goto-char (point-min))
250 (while (re-search-forward "\r$" nil t)
254 (goto-char (point-min))
255 (while (search-forward "\n" nil t)
256 (replace-match "")))))))
258 (defun base64-external-decode-region (beg end)
261 (apply (function call-process-region)
262 beg end (car base64-external-decoder)
264 (cdr base64-external-decoder)))))
266 (defun base64-external-decode-string (string)
270 (apply (function call-process-region)
271 (point-min)(point-max) (car base64-external-decoder)
273 (cdr base64-external-decoder)))
277 ;;; @ application interfaces
280 (defun-maybe base64-encode-region (start end &optional no-line-break)
281 "Base64-encode the region between START and END.
282 Return the length of the encoded text.
283 Optional third argument NO-LINE-BREAK means do not break long lines
285 This function calls internal base64 encoder if size of region is
286 smaller than `base64-internal-encoding-limit', otherwise it calls
287 external base64 encoder specified by `base64-external-encoder'. In
288 this case, you must install the program (maybe mmencode included in
289 metamail or XEmacs package)."
291 (if (and base64-internal-encoding-limit
292 (> (- end start) base64-internal-encoding-limit))
293 (base64-external-encode-region start end no-line-break)
294 (base64-internal-encode-region start end no-line-break)))
296 (defun-maybe base64-decode-region (start end)
297 "Decode current region by base64.
298 START and END are buffer positions.
299 This function calls internal base64 decoder if size of region is
300 smaller than `base64-internal-decoding-limit', otherwise it calls
301 external base64 decoder specified by `base64-external-decoder'. In
302 this case, you must install the program (maybe mmencode included in
303 metamail or XEmacs package)."
305 (if (and base64-internal-decoding-limit
306 (> (- end start) base64-internal-decoding-limit))
307 (base64-external-decode-region start end)
308 (base64-internal-decode-region start end)))
310 (defun-maybe base64-decode-string (string)
311 "Decode STRING which is encoded in base64, and return the result.
312 This function calls internal base64 decoder if size of STRING is
313 smaller than `base64-internal-decoding-limit', otherwise it calls
314 external base64 decoder specified by `base64-external-decoder'. In
315 this case, you must install the program (maybe mmencode included in
316 metamail or XEmacs package)."
317 (if (and base64-internal-decoding-limit
318 (> (length string) base64-internal-decoding-limit))
319 (base64-external-decode-string string)
320 (base64-internal-decode-string string)))
323 (mel-define-method-function (mime-encode-string string (nil "base64"))
324 'base64-encode-string)
325 (mel-define-method-function (mime-decode-string string (nil "base64"))
326 'base64-decode-string)
327 (mel-define-method-function (mime-encode-region start end (nil "base64"))
328 'base64-encode-region)
329 (mel-define-method-function (mime-decode-region start end (nil "base64"))
330 'base64-decode-region)
332 (mel-define-method-function (encoded-text-encode-string string (nil "B"))
333 'base64-encode-string)
335 (mel-define-method encoded-text-decode-string (string (nil "B"))
336 (if (string-match (eval-when-compile
337 (concat "\\`" B-encoded-text-regexp "\\'"))
339 (base64-decode-string string)
340 (error "Invalid encoded-text %s" string)))
342 (defun base64-insert-encoded-file (filename)
343 "Encode contents of file FILENAME to base64, and insert the result.
344 It calls external base64 encoder specified by
345 `base64-external-encoder'. So you must install the program (maybe
346 mmencode included in metamail or XEmacs package)."
347 (interactive "*fInsert encoded file: ")
348 (if (and base64-internal-encoding-limit
349 (> (nth 7 (file-attributes filename))
350 base64-internal-encoding-limit))
351 (apply (function call-process)
352 (car base64-external-encoder)
354 (cdr base64-external-encoder))
356 (base64-encode-string
358 (set-buffer-multibyte nil)
359 (insert-file-contents-as-binary filename)
361 (or (bolp) (insert ?\n))))
363 (mel-define-method-function (mime-insert-encoded-file filename (nil "base64"))
364 'base64-insert-encoded-file)
366 (defun base64-write-decoded-region (start end filename)
367 "Decode and write current region encoded by base64 into FILENAME.
368 START and END are buffer positions."
369 (interactive "*r\nFWrite decoded region to file: ")
370 (if (and base64-internal-decoding-limit
371 (> (- end start) base64-internal-decoding-limit))
374 (apply (function call-process-region)
375 start end (car base64-external-decoder)
376 (null base64-external-decoder-option-to-specify-file)
377 (unless base64-external-decoder-option-to-specify-file
378 (list (current-buffer) nil))
382 (cdr base64-external-decoder)
383 base64-external-decoder-option-to-specify-file
384 (when base64-external-decoder-option-to-specify-file
386 (unless base64-external-decoder-option-to-specify-file
387 (write-region-as-binary (point-min) (point-max) filename)))
388 (let ((str (buffer-substring start end)))
390 (insert (base64-internal-decode-string str))
391 (write-region-as-binary (point-min) (point-max) filename)))))
393 (mel-define-method-function
394 (mime-write-decoded-region start end filename (nil "base64"))
395 'base64-write-decoded-region)
403 ;;; mel-b-el.el ends here.