cgit.sxemacs.org Git - packages/blob - xemacs-packages/ecrypto/ascii-armor.el

   1 ;;;  ascii-armor.el -- translate data into and from ascii-armor
   2 ;;;                    (radix64)
   3
   4 ;; Copyright (C) 1998 Ray Jones
   5
   6 ;; Author: Ray Jones, rjones@pobox.com
   7 ;; Keywords: base64, ascii-armor, radix64, oink
   8 ;; Created: 1998-04-14
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14 ;;
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with this program; if not, you can either send email to this
  22 ;; program's maintainer or write to: The Free Software Foundation,
  23 ;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
  24
  25 ;;; Commentary:
  26
  27 ;;; Code:
  28
  29 (require 'cl)
  30
  31 (defun ascii-armor-char (val)
  32   (cond ((< val 26) (+ val ?A))
  33         ((< val 52) (+ (- val 26) ?a))
  34         ((< val 62) (+ (- val 52) ?0))
  35         ((= val 62) ?+)
  36         ((= val 63) ?/)
  37         (t (error "no ascii-armor character for %d!" val))))
  38
  39 (defun ascii-armor-val (char)
  40   (cond ((and (<= ?A char) (<= char ?Z)) (- char ?A))
  41         ((and (<= ?a char) (<= char ?z)) (+ (- char ?a) 26))
  42         ((and (<= ?0 char) (<= char ?9)) (+ (- char ?0) 52))
  43         ((= char ?+) 62)
  44         ((= char ?/) 63)
  45         (t nil)))
  46
  47 (defun ascii-armor-length (n)
  48   "calculate the number of characters needed to encode N octets."
  49
  50   (let* (
  51          ;; number of bits
  52          (n1 (* n 8))
  53          ;; ascii armor is 6 bits per symbol...
  54          (n2 (car (ceiling* n1 6)))
  55          ;; but always a multiple of 4 symbols
  56          (n3 (* 4 (car (ceiling* n2 4)))))
  57     n3))
  58
  59 (defun ascii-armor-data-length (str)
  60   "calculate the number of octets stored in an ascii-armor string"
  61
  62   (let ((len (length str)))
  63     (while (and (> len 0)
  64                 (eq ?= (aref str (1- len))))
  65       (decf len))
  66     (/ (* len 6) 8)))
  67
  68 ;; translate a vector of 16-bit values into an ascii-armor string
  69 (defun vec16-to-ascii-armor (vec)
  70   (let* ((in-len (length vec))
  71          (out-len (ascii-armor-length (* 2 in-len)))
  72          (out-str (make-string out-len ?=))
  73          (out-idx 0)
  74          (bits-start 0))
  75     ;; helper function
  76     (flet ((next-out (val)
  77              (aset out-str out-idx
  78                    (ascii-armor-char
  79                     (logand ?\x3f val)))
  80              (incf out-idx)))
  81
  82       (dotimes (in-idx in-len)
  83         (incf bits-start 16)
  84         ;; read out as many bits from the current index as possible
  85         (while (> bits-start 0)
  86           ;; do the next 6 bits straddle a boundary in vec?
  87
  88           (if (< bits-start 6)
  89               ;; straddle
  90               (let ((hi-val (aref vec in-idx))
  91                     ;; pad with 0s
  92                     (lo-val (if (< in-idx (1- in-len))
  93                                 (aref vec (1+ in-idx))
  94                               0)))
  95                 (next-out (logior
  96                            (ash hi-val (- 6 bits-start))
  97                            (ash lo-val (- 6 bits-start 16)))))
  98
  99             ;; 6 bits all from the current entry in vec
 100             (next-out (ash (aref vec in-idx) (- 6 bits-start))))
 101
 102           (decf bits-start 6))))
 103
 104     ;; pad with ?=, if out-str isn't full
 105     (while (< out-idx out-len)
 106       (aset out-str out-idx ?=)
 107       (incf out-idx))
 108
 109     out-str))
 110
 111 ;; translate an ascii-armor string to a 16-bit vector
 112 (defun ascii-armor-to-vec16 (string)
 113   ;; ascii armor is padded, so this doesn't have to be rounded, just
 114   ;; truncated.
 115   (let* ((out-len (/ (ascii-armor-data-length string) 2))
 116          (out-vec (make-vector out-len 0))
 117          (buf 0)
 118          (bits-in-buf 0)
 119          (in-idx 0))
 120     (dotimes (out-idx out-len)
 121       ;; shift bits from the string until there are enough to stick
 122       ;; into the output vector
 123       (while (< bits-in-buf 16)
 124         (let ((val (ascii-armor-val (aref string in-idx))))
 125           (when val
 126             (setq buf (logior (ash buf 6)
 127                               val))
 128             (incf bits-in-buf 6))
 129           (incf in-idx)))
 130
 131       (aset out-vec out-idx (ash buf (- 16 bits-in-buf)))
 132       (decf bits-in-buf 16)
 133       ;; turn off the used bits
 134       (setq buf (logand buf (lognot (ash #xffff bits-in-buf)))))
 135
 136     out-vec))
 137
 138 (provide 'ascii-armor)