mel-b.el

   1 ;;; mel-b.el: Base64 encoder/decoder for GNU Emacs
   2
   3 ;; Copyright (C) 1992,1995,1996,1997,1998 Free Software Foundation, Inc.
   4
   5 ;; Author: ENAMI Tsugutomo <enami@sys.ptg.sony.co.jp>
   6 ;;         MORIOKA Tomohiko <morioka@jaist.ac.jp>
   7 ;; Created: 1995/6/24
   8 ;; Keywords: MIME, Base64
   9
  10 ;; This file is part of MEL (MIME Encoding Library).
  11
  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.
  16
  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.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Code:
  28
  29 (require 'emu)
  30
  31
  32 ;;; @ variables
  33 ;;;
  34
  35 (defvar base64-external-encoder '("mmencode")
  36   "*list of base64 encoder program name and its arguments.")
  37
  38 (defvar base64-external-decoder '("mmencode" "-u")
  39   "*list of base64 decoder program name and its arguments.")
  40
  41 (defvar base64-external-decoder-option-to-specify-file '("-o")
  42   "*list of options of base64 decoder program to specify file.")
  43
  44 (defvar base64-internal-encoding-limit 1000
  45   "*limit size to use internal base64 encoder.
  46 If size of input to encode is larger than this limit,
  47 external encoder is called.")
  48
  49 (defvar base64-internal-decoding-limit 1000
  50   "*limit size to use internal base64 decoder.
  51 If size of input to decode is larger than this limit,
  52 external decoder is called.")
  53
  54
  55 ;;; @ internal base64 decoder/encoder
  56 ;;;     based on base64 decoder by Enami Tsugutomo
  57
  58 ;;; @@ convert from/to base64 char
  59 ;;;
  60
  61 (defun base64-num-to-char (n)
  62   (cond ((eq n nil) ?=)
  63         ((< n 26) (+ ?A n))
  64         ((< n 52) (+ ?a (- n 26)))
  65         ((< n 62) (+ ?0 (- n 52)))
  66         ((= n 62) ?+)
  67         ((= n 63) ?/)
  68         (t (error "not a base64 integer %d" n))))
  69
  70 (defun base64-char-to-num (c)
  71   (cond ((and (<= ?A c) (<= c ?Z)) (- c ?A))
  72         ((and (<= ?a c) (<= c ?z)) (+ (- c ?a) 26))
  73         ((and (<= ?0 c) (<= c ?9)) (+ (- c ?0) 52))
  74         ((= c ?+) 62)
  75         ((= c ?/) 63)
  76         ((= c ?=) nil)
  77         (t (error "not a base64 character %c" c))))
  78
  79
  80 ;;; @@ encode/decode one base64 unit
  81 ;;;
  82
  83 (defun base64-encode-1 (pack)
  84   (let ((a (car pack))
  85         (b (nth 1 pack))
  86         (c (nth 2 pack)))
  87     (concat
  88      (char-to-string (base64-num-to-char (ash a -2)))
  89      (if b
  90          (concat
  91           (char-to-string
  92            (base64-num-to-char (logior (ash (logand a 3) 4) (ash b -4))))
  93           (if c
  94               (concat
  95                (char-to-string
  96                 (base64-num-to-char (logior (ash (logand b 15) 2) (ash c -6))))
  97                (char-to-string (base64-num-to-char (logand c 63)))
  98                )
  99             (concat (char-to-string
 100                      (base64-num-to-char (ash (logand b 15) 2))) "=")
 101             ))
 102        (concat (char-to-string
 103                 (base64-num-to-char (ash (logand a 3) 4))) "==")
 104        ))))
 105
 106 (defun base64-decode-unit (a b &optional c d)
 107   (condition-case err
 108       (concat
 109        (char-to-string (logior (ash (base64-char-to-num a) 2)
 110                                (ash (setq b (base64-char-to-num 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     (error (message (nth 1 err))
 118            "")))
 119
 120
 121 ;;; @@ base64 encoder/decoder for string
 122 ;;;
 123
 124 (defun base64-encode-string (string)
 125   "Encode STRING to base64, and return the result."
 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-internal-decode-string (string)
 153   (let ((len (length string))
 154         (i 0)
 155         dest)
 156     (while (< i len)
 157       (let ((a (aref string i)))
 158         (setq i (1+ i))
 159         (unless (eq a ?\n)
 160           (let ((b (aref string i)))
 161             (setq i (1+ i))
 162             (cond
 163              ((eq b ?\n)
 164               ;; invalid
 165               )
 166              ((>= i len)
 167               (setq dest (concat dest (base64-decode-unit a b) ))
 168               )
 169              (t
 170               (let ((c (aref string i)))
 171                 (setq i (1+ i))
 172                 (cond
 173                  ((eq c ?\n)
 174                   (setq dest (concat dest (base64-decode-unit a b)))
 175                   )
 176                  ((>= i len)
 177                   (setq dest (concat dest (base64-decode-unit a b c)))
 178                   )
 179                  (t
 180                   (let ((d (aref string i)))
 181                     (setq i (1+ i))
 182                     (setq dest
 183                           (concat dest
 184                                   (if (eq c ?\n)
 185                                       (base64-decode-unit a b c)
 186                                     (base64-decode-unit a b c d))))
 187                     ))))))))))
 188     dest))
 189
 190
 191 ;;; @ base64 encoder/decoder for region
 192 ;;;
 193
 194 (defun base64-internal-encode-region (beg end)
 195   (save-excursion
 196     (save-restriction
 197       (narrow-to-region beg end)
 198       (let ((str (buffer-substring beg end)))
 199         (delete-region beg end)
 200         (insert (base64-encode-string str))
 201         )
 202       (or (bolp)
 203           (insert "\n")
 204           )
 205       )))
 206
 207 (defun base64-internal-decode-region (beg end)
 208   (save-excursion
 209     (let ((str (buffer-substring beg end)))
 210       (delete-region beg end)
 211       (goto-char beg)
 212       (insert (base64-internal-decode-string str)))))
 213
 214 (defun base64-external-encode-region (beg end)
 215   (save-excursion
 216     (save-restriction
 217       (narrow-to-region beg end)
 218       (as-binary-process
 219        (apply (function call-process-region)
 220               beg end (car base64-external-encoder)
 221               t t nil (cdr base64-external-encoder)))
 222       ;; for OS/2
 223       ;;   regularize line break code
 224       (goto-char (point-min))
 225       (while (re-search-forward "\r$" nil t)
 226         (replace-match ""))
 227       )))
 228
 229 (defun base64-external-decode-region (beg end)
 230   (save-excursion
 231     (as-binary-process
 232      (apply (function call-process-region)
 233             beg end (car base64-external-decoder)
 234             t t nil (cdr base64-external-decoder)))
 235     ))
 236
 237 (defun base64-external-decode-string (string)
 238   (with-temp-buffer
 239     (insert string)
 240     (as-binary-process
 241      (apply (function call-process-region)
 242             (point-min) (point-max)
 243             (car base64-external-decoder)
 244             t t nil (cdr base64-external-decoder)))
 245     (buffer-string)))
 246
 247
 248 (defun base64-encode-region (start end)
 249   "Encode current region by base64.
 250 START and END are buffer positions.
 251 This function calls internal base64 encoder if size of region is
 252 smaller than `base64-internal-encoding-limit', otherwise it calls
 253 external base64 encoder specified by `base64-external-encoder'.  In
 254 this case, you must install the program (maybe mmencode included in
 255 metamail or XEmacs package)."
 256   (interactive "r")
 257   (if (and base64-internal-encoding-limit
 258            (> (- end start) base64-internal-encoding-limit))
 259       (base64-external-encode-region start end)
 260     (base64-internal-encode-region start end)))
 261
 262 (defun base64-decode-region (start end)
 263   "Decode current region by base64.
 264 START and END are buffer positions.
 265 This function calls internal base64 decoder if size of region is
 266 smaller than `base64-internal-decoding-limit', otherwise it calls
 267 external base64 decoder specified by `base64-external-decoder'.  In
 268 this case, you must install the program (maybe mmencode included in
 269 metamail or XEmacs package)."
 270   (interactive "r")
 271   (if (and base64-internal-decoding-limit
 272            (> (- end start) base64-internal-decoding-limit))
 273       (base64-external-decode-region start end)
 274     (base64-internal-decode-region start end)))
 275
 276 (defun base64-decode-string (string)
 277   "Decode STRING which is encoded in base64, and return the result.
 278 This function calls internal base64 decoder if size of STRING is
 279 smaller than `base64-internal-decoding-limit', otherwise it calls
 280 external base64 decoder specified by `base64-external-decoder'.  In
 281 this case, you must install the program (maybe mmencode included in
 282 metamail or XEmacs package)."
 283   (interactive "r")
 284   (if (and base64-internal-decoding-limit
 285            (> (length string) base64-internal-decoding-limit))
 286       (base64-external-decode-string string)
 287     (base64-internal-decode-string string)))
 288
 289
 290 ;;; @ base64 encoder/decoder for file
 291 ;;;
 292
 293 (defun base64-insert-encoded-file (filename)
 294   "Encode contents of file FILENAME to base64, and insert the result.
 295 It calls external base64 encoder specified by
 296 `base64-external-encoder'.  So you must install the program (maybe
 297 mmencode included in metamail or XEmacs package)."
 298   (interactive (list (read-file-name "Insert encoded file: ")))
 299   (if (and base64-internal-encoding-limit
 300            (> (nth 7 (file-attributes filename))
 301               base64-internal-encoding-limit))
 302       (apply (function call-process) (car base64-external-encoder)
 303              filename t nil (cdr base64-external-encoder))
 304     (insert
 305      (base64-encode-string
 306       (with-temp-buffer
 307         (insert-file-contents-as-binary filename)
 308         (buffer-string))))
 309     (or (bolp)
 310         (insert "\n"))
 311      ))
 312
 313 (defun base64-write-decoded-region (start end filename)
 314   "Decode and write current region encoded by base64 into FILENAME.
 315 START and END are buffer positions."
 316   (interactive
 317    (list (region-beginning) (region-end)
 318          (read-file-name "Write decoded region to file: ")))
 319   (if (and base64-internal-decoding-limit
 320            (> (- end start) base64-internal-decoding-limit))
 321       (as-binary-process
 322        (apply (function call-process-region)
 323               start end (car base64-external-decoder)
 324               nil nil nil
 325               (append (cdr base64-external-decoder)
 326                       base64-external-decoder-option-to-specify-file
 327                       (list filename))))
 328     (let ((str (buffer-substring start end)))
 329       (with-temp-buffer
 330         (insert (base64-internal-decode-string str))
 331         (write-region-as-binary (point-min) (point-max) filename)))))
 332
 333 ;;; @ etc
 334 ;;;
 335
 336 (defun base64-encoded-length (string)
 337   (let ((len (length string)))
 338     (* (+ (/ len 3)
 339           (if (= (mod len 3) 0) 0 1)
 340           ) 4)
 341     ))
 342
 343 (defun pack-sequence (seq size)
 344   "Split sequence SEQ into SIZE elements packs,
 345 and return list of packs. [mel-b; tl-seq function]"
 346   (let ((len (length seq)) (p 0) obj
 347         unit (i 0)
 348         dest)
 349     (while (< p len)
 350       (setq obj (elt seq p))
 351       (setq unit (cons obj unit))
 352       (setq i (1+ i))
 353       (if (= i size)
 354           (progn
 355             (setq dest (cons (reverse unit) dest))
 356             (setq unit nil)
 357             (setq i 0)
 358             ))
 359       (setq p (1+ p))
 360       )
 361     (if unit
 362         (setq dest (cons (reverse unit) dest))
 363       )
 364     (reverse dest)
 365     ))
 366
 367
 368 ;;; @ end
 369 ;;;
 370
 371 (provide 'mel-b)
 372
 373 ;;; mel-b.el ends here.