Mercurial > hg > xemacs-beta
diff lisp/url/base64.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:45:50 +0200 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/url/base64.el Mon Aug 13 08:45:50 2007 +0200 @@ -0,0 +1,171 @@ +;;; base64.el,v --- Base64 encoding functions +;; Author: wmperry +;; Created: 1996/04/22 15:08:08 +;; Version: 1.7 +;; Keywords: extensions + +;;; LCD Archive Entry: +;;; base64.el|William M. Perry|wmperry@spry.com| +;;; Package for encoding/decoding base64 data (MIME)| +;;; 1996/04/22 15:08:08|1.7|Location Undetermined +;;; + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Base 64 encoding functions +;;; This code was converted to lisp code by me from the C code in +;;; ftp://cs.utk.edu/pub/MIME/b64encode.c +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar base64-code-string + "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/" + "Character set used for base64 decoding") + +(defvar base64-decode-vector + (let ((vec (make-vector 256 nil)) + (i 0) + (case-fold-search nil)) + (while (< i 256) + (aset vec i (string-match (regexp-quote (char-to-string i)) + base64-code-string)) + (setq i (1+ i))) + vec)) + +(defvar base64-max-line-length 64) + +;(defun b0 (x) (aref base64-code-string (logand (lsh x -18) 63))) +;(defun b1 (x) (aref base64-code-string (logand (lsh x -12) 63))) +;(defun b2 (x) (aref base64-code-string (logand (lsh x -6) 63))) +;(defun b3 (x) (aref base64-code-string (logand x 63))) + +(defmacro b0 (x) (` (aref base64-code-string (logand (lsh (, x) -18) 63)))) +(defmacro b1 (x) (` (aref base64-code-string (logand (lsh (, x) -12) 63)))) +(defmacro b2 (x) (` (aref base64-code-string (logand (lsh (, x) -6) 63)))) +(defmacro b3 (x) (` (aref base64-code-string (logand (, x) 63)))) + +(defun base64-encode (str) + "Do base64 encoding on string STR and return the encoded string. +This code was converted to lisp code by me from the C code in +ftp://cs.utk.edu/pub/MIME/b64encode.c. Returns a string that is +broken into `base64-max-line-length' byte lines." + (or str (setq str (buffer-string))) + (let ((x (base64-encode-internal str)) + (y "")) + (while (> (length x) base64-max-line-length) + (setq y (concat y (substring x 0 base64-max-line-length) "\n") + x (substring x base64-max-line-length nil))) + (setq y (concat y x)) + y)) + +(defun base64-encode-internal (str) + "Do base64 encoding on string STR and return the encoded string. +This code was converted to lisp code by me from the C code in +ftp://cs.utk.edu/pub/MIME/b64encode.c. Returns the entire string, +not broken up into `base64-max-line-length' byte lines." + (let ( + (word 0) ; The word to translate + w1 w2 w3 + ) + (cond + ((> (length str) 3) + (concat + (base64-encode-internal (substring str 0 3)) + (base64-encode-internal (substring str 3 nil)))) + ((= (length str) 3) + (setq w1 (aref str 0) + w2 (aref str 1) + w3 (aref str 2) + word (logior + (lsh (logand w1 255) 16) + (lsh (logand w2 255) 8) + (logand w3 255))) + (format "%c%c%c%c" (b0 word) (b1 word) (b2 word) (b3 word))) + ((= (length str) 2) + (setq w1 (aref str 0) + w2 (aref str 1) + word (logior + (lsh (logand w1 255) 16) + (lsh (logand w2 255) 8) + 0)) + (format "%c%c%c=" (b0 word) (b1 word) (b2 word))) + ((= (length str) 1) + (setq w1 (aref str 0) + word (logior + (lsh (logand w1 255) 16) + 0)) + (format "%c%c==" (b0 word) (b1 word))) + (t "")))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Base64 decoding functions +;;; Most of the decoding code is courtesy Francesco Potorti` +;;; <F.Potorti@cnuce.cnr.it> +;;; this is much faster than my original code - thanks! +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(defun base64-decode-region (beg end) + (interactive "r") + (barf-if-buffer-read-only) + (let + ((exchange (= (point) beg)) + (endchars 0) + (list) (code)) + (goto-char beg) + (while (< (point) end) + (setq list (mapcar + (function + (lambda (c) + (cond + ((aref base64-decode-vector c)) + ((char-equal c ?=) + (setq endchars (1+ endchars)) + 0) + (nil + (error + "Character %c does not match Mime base64 coding" c))))) + (buffer-substring (point) (+ (point) 4)))) + (setq code (+ (nth 3 list) (lsh (nth 2 list) 6) + (lsh (nth 1 list) 12) (lsh (car list) 18))) + (delete-char 4) + (cond + ((zerop endchars) + (insert (% (lsh code -16) 256) (% (lsh code -8) 256) (% code 256))) + ((= endchars 1) + (insert (% (lsh code -16) 256) (% (lsh code -8) 256)) + (setq end (point))) + ((= endchars 2) + (insert (% (lsh code -16) 256)) + (setq end (point)))) + (if (char-equal (following-char) ?\n) + (progn (delete-char 1) + (setq end (- end 2))) + (setq end (1- end)))) + )) +; (if exchange +; (exchange-point-and-mark)))) + +(defun base64-decode (st &optional nd) + "Do base64 decoding on string STR and return the original string. +If given buffer positions, destructively decodes that area of the +current buffer." + (let ((replace-p nil) + (retval nil)) + (if (stringp st) + nil + (setq st (prog1 + (buffer-substring st (or nd (point-max))) + (delete-region st (or nd (point-max)))) + replace-p t)) + (setq retval + (save-excursion + (set-buffer (get-buffer-create " *b64decode*")) + (erase-buffer) + (insert st) + (goto-char (point-min)) + (while (re-search-forward "\r*\n" nil t) + (replace-match "")) + (goto-char (point-min)) + (base64-decode-region (point-min) (point-max)) + (buffer-string))) + (if replace-p (insert retval)) + retval)) + +(provide 'base64)