|
14
|
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@cs.indiana.edu|
|
|
|
9 ;;; Package for encoding/decoding base64 data (MIME)|
|
|
|
10 ;;; 1996/04/22 15:08:08|1.7|Location Undetermined
|
|
|
11 ;;;
|
|
|
12
|
|
|
13 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
14 ;;; Copyright (c) 1996 Free Software Foundation, Inc.
|
|
|
15 ;;; Copyright (c) 1995, 1996 by William M. Perry (wmperry@cs.indiana.edu)
|
|
|
16 ;;;
|
|
|
17 ;;; This file is not part of GNU Emacs, but the same permissions apply.
|
|
|
18 ;;;
|
|
|
19 ;;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
20 ;;; it under the terms of the GNU General Public License as published by
|
|
|
21 ;;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
22 ;;; any later version.
|
|
|
23 ;;;
|
|
|
24 ;;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
25 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
26 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
27 ;;; GNU General Public License for more details.
|
|
|
28 ;;;
|
|
|
29 ;;; You should have received a copy of the GNU General Public License
|
|
|
30 ;;; along with GNU Emacs; see the file COPYING. If not, write to the
|
|
|
31 ;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
32 ;;; Boston, MA 02111-1307, USA.
|
|
|
33 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
34
|
|
|
35 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
36 ;;; Base 64 encoding functions
|
|
|
37 ;;; This code was converted to lisp code by me from the C code in
|
|
|
38 ;;; ftp://cs.utk.edu/pub/MIME/b64encode.c
|
|
|
39 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
40
|
|
|
41 (defvar base64-code-string
|
|
|
42 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
|
|
|
43 "Character set used for base64 decoding")
|
|
|
44
|
|
|
45 (defvar base64-decode-vector
|
|
|
46 (let ((vec (make-vector 256 nil))
|
|
|
47 (i 0)
|
|
|
48 (case-fold-search nil))
|
|
|
49 (while (< i 256)
|
|
|
50 (aset vec i (string-match (regexp-quote (char-to-string i))
|
|
|
51 base64-code-string))
|
|
|
52 (setq i (1+ i)))
|
|
|
53 vec))
|
|
|
54
|
|
|
55 (defvar base64-max-line-length 64)
|
|
|
56
|
|
|
57 ;(defun b0 (x) (aref base64-code-string (logand (lsh x -18) 63)))
|
|
|
58 ;(defun b1 (x) (aref base64-code-string (logand (lsh x -12) 63)))
|
|
|
59 ;(defun b2 (x) (aref base64-code-string (logand (lsh x -6) 63)))
|
|
|
60 ;(defun b3 (x) (aref base64-code-string (logand x 63)))
|
|
|
61
|
|
|
62 (defmacro b0 (x) (` (aref base64-code-string (logand (lsh (, x) -18) 63))))
|
|
|
63 (defmacro b1 (x) (` (aref base64-code-string (logand (lsh (, x) -12) 63))))
|
|
|
64 (defmacro b2 (x) (` (aref base64-code-string (logand (lsh (, x) -6) 63))))
|
|
|
65 (defmacro b3 (x) (` (aref base64-code-string (logand (, x) 63))))
|
|
|
66
|
|
|
67 (defun base64-encode (str)
|
|
|
68 "Do base64 encoding on string STR and return the encoded string.
|
|
|
69 This code was converted to lisp code by me from the C code in
|
|
|
70 ftp://cs.utk.edu/pub/MIME/b64encode.c. Returns a string that is
|
|
|
71 broken into `base64-max-line-length' byte lines."
|
|
|
72 (or str (setq str (buffer-string)))
|
|
|
73 (let ((x (base64-encode-internal str))
|
|
|
74 (y ""))
|
|
|
75 (while (> (length x) base64-max-line-length)
|
|
|
76 (setq y (concat y (substring x 0 base64-max-line-length) "\n")
|
|
|
77 x (substring x base64-max-line-length nil)))
|
|
|
78 (setq y (concat y x))
|
|
|
79 y))
|
|
|
80
|
|
|
81 (defun base64-encode-internal (str)
|
|
|
82 "Do base64 encoding on string STR and return the encoded string.
|
|
|
83 This code was converted to lisp code by me from the C code in
|
|
|
84 ftp://cs.utk.edu/pub/MIME/b64encode.c. Returns the entire string,
|
|
|
85 not broken up into `base64-max-line-length' byte lines."
|
|
|
86 (let (
|
|
|
87 (word 0) ; The word to translate
|
|
|
88 w1 w2 w3
|
|
|
89 )
|
|
|
90 (cond
|
|
|
91 ((> (length str) 3)
|
|
|
92 (concat
|
|
|
93 (base64-encode-internal (substring str 0 3))
|
|
|
94 (base64-encode-internal (substring str 3 nil))))
|
|
|
95 ((= (length str) 3)
|
|
|
96 (setq w1 (aref str 0)
|
|
|
97 w2 (aref str 1)
|
|
|
98 w3 (aref str 2)
|
|
|
99 word (logior
|
|
|
100 (lsh (logand w1 255) 16)
|
|
|
101 (lsh (logand w2 255) 8)
|
|
|
102 (logand w3 255)))
|
|
|
103 (format "%c%c%c%c" (b0 word) (b1 word) (b2 word) (b3 word)))
|
|
|
104 ((= (length str) 2)
|
|
|
105 (setq w1 (aref str 0)
|
|
|
106 w2 (aref str 1)
|
|
|
107 word (logior
|
|
|
108 (lsh (logand w1 255) 16)
|
|
|
109 (lsh (logand w2 255) 8)
|
|
|
110 0))
|
|
|
111 (format "%c%c%c=" (b0 word) (b1 word) (b2 word)))
|
|
|
112 ((= (length str) 1)
|
|
|
113 (setq w1 (aref str 0)
|
|
|
114 word (logior
|
|
|
115 (lsh (logand w1 255) 16)
|
|
|
116 0))
|
|
|
117 (format "%c%c==" (b0 word) (b1 word)))
|
|
|
118 (t ""))))
|
|
|
119
|
|
|
120 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
121 ;;; Base64 decoding functions
|
|
|
122 ;;; Most of the decoding code is courtesy Francesco Potorti`
|
|
|
123 ;;; <F.Potorti@cnuce.cnr.it>
|
|
|
124 ;;; this is much faster than my original code - thanks!
|
|
|
125 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
126 (defun base64-decode-region (beg end)
|
|
|
127 (interactive "r")
|
|
|
128 (barf-if-buffer-read-only)
|
|
|
129 (let
|
|
|
130 ((exchange (= (point) beg))
|
|
|
131 (endchars 0)
|
|
|
132 (list) (code))
|
|
|
133 (goto-char beg)
|
|
|
134 (while (< (point) end)
|
|
|
135 (setq list (mapcar
|
|
|
136 (function
|
|
|
137 (lambda (c)
|
|
|
138 (cond
|
|
|
139 ((aref base64-decode-vector c))
|
|
|
140 ((char-equal c ?=)
|
|
|
141 (setq endchars (1+ endchars))
|
|
|
142 0)
|
|
|
143 (nil
|
|
|
144 (error
|
|
|
145 "Character %c does not match Mime base64 coding" c)))))
|
|
|
146 (buffer-substring (point) (+ (point) 4))))
|
|
|
147 (setq code (+ (nth 3 list) (lsh (nth 2 list) 6)
|
|
|
148 (lsh (nth 1 list) 12) (lsh (car list) 18)))
|
|
|
149 (delete-char 4)
|
|
|
150 (cond
|
|
|
151 ((zerop endchars)
|
|
|
152 (insert (% (lsh code -16) 256) (% (lsh code -8) 256) (% code 256)))
|
|
|
153 ((= endchars 1)
|
|
|
154 (insert (% (lsh code -16) 256) (% (lsh code -8) 256))
|
|
|
155 (setq end (point)))
|
|
|
156 ((= endchars 2)
|
|
|
157 (insert (% (lsh code -16) 256))
|
|
|
158 (setq end (point))))
|
|
|
159 (if (char-equal (following-char) ?\n)
|
|
|
160 (progn (delete-char 1)
|
|
|
161 (setq end (- end 2)))
|
|
|
162 (setq end (1- end))))
|
|
|
163 ))
|
|
|
164 ; (if exchange
|
|
|
165 ; (exchange-point-and-mark))))
|
|
|
166
|
|
|
167 (defun base64-decode (st &optional nd)
|
|
|
168 "Do base64 decoding on string STR and return the original string.
|
|
|
169 If given buffer positions, destructively decodes that area of the
|
|
|
170 current buffer."
|
|
|
171 (let ((replace-p nil)
|
|
|
172 (retval nil))
|
|
|
173 (if (stringp st)
|
|
|
174 nil
|
|
|
175 (setq st (prog1
|
|
|
176 (buffer-substring st (or nd (point-max)))
|
|
|
177 (delete-region st (or nd (point-max))))
|
|
|
178 replace-p t))
|
|
|
179 (setq retval
|
|
|
180 (save-excursion
|
|
|
181 (set-buffer (get-buffer-create " *b64decode*"))
|
|
|
182 (erase-buffer)
|
|
|
183 (insert st)
|
|
|
184 (goto-char (point-min))
|
|
|
185 (while (re-search-forward "\r*\n" nil t)
|
|
|
186 (replace-match ""))
|
|
|
187 (goto-char (point-min))
|
|
|
188 (base64-decode-region (point-min) (point-max))
|
|
|
189 (buffer-string)))
|
|
|
190 (if replace-p (insert retval))
|
|
|
191 retval))
|
|
|
192
|
|
|
193 (provide 'base64)
|
