package.lisp

   1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          package.lisp
   6 ;;;; Purpose:       Package definition for cl-base64
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Dec 2002
   9 ;;;;
  10 ;;;; $Id$
  11 ;;;;
  12 ;;;; *************************************************************************
  13
  14 (defpackage #:cl-base64
  15   (:nicknames #:base64)
  16   (:use #:cl)
  17   (:export #:base64-stream-to-integer
  18            #:base64-stream-to-string
  19            #:base64-stream-to-stream
  20            #:base64-stream-to-usb8-array
  21            #:base64-string-to-integer
  22            #:base64-string-to-string
  23            #:base64-string-to-stream
  24            #:base64-string-to-usb8-array
  25            #:string-to-base64-string
  26            #:string-to-base64-stream
  27            #:usb8-array-to-base64-string
  28            #:usb8-array-to-base64-stream
  29            #:stream-to-base64-string
  30            #:stream-to-base64-stream
  31            #:integer-to-base64-string
  32            #:integer-to-base64-stream
  33
  34            ;; Conditions.
  35            #:base64-error
  36            #:bad-base64-character
  37            #:incomplete-base64-data
  38
  39            ;; For creating custom encode/decode tables.
  40            #:make-decode-table
  41            #:+decode-table+
  42            #:+uri-decode-table+
  43            ;; What's the point of exporting these?
  44            #:*uri-encode-table*
  45            #:*uri-decode-table*
  46            ))
  47
  48 (in-package #:cl-base64)
  49
  50 (eval-when (:compile-toplevel :load-toplevel :execute)
  51 (defvar *encode-table*
  52   "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
  53 (declaim (type simple-string *encode-table*))
  54
  55 (defvar *uri-encode-table*
  56   "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
  57 (declaim (type simple-string *uri-encode-table*))
  58
  59 (defvar *pad-char* #\=)
  60 (defvar *uri-pad-char* #\.)
  61 (declaim (type character *pad-char* *uri-pad-char*))
  62
  63   (deftype decode-table () '(simple-array (signed-byte 8) (128)))
  64   (defun make-decode-table (encode-table pad-char
  65                             &key (whitespace-chars
  66                                   '(#\Linefeed #\Return #\Space #\Tab)))
  67     (assert (< (length encode-table) 128)
  68             (encode-table)
  69             "Encode table too big: ~S" encode-table)
  70     (let ((dt (make-array 128 :element-type '(signed-byte 8)
  71                               :initial-element -1)))
  72       (declare (type decode-table dt))
  73       (loop for char across encode-table
  74             for index upfrom 0
  75             do (setf (aref dt (char-code char)) index))
  76       (setf (aref dt (char-code pad-char)) -2)
  77       (loop for char in whitespace-chars
  78             do (setf (aref dt (char-code char)) -3))
  79       dt)))
  80
  81 (defconstant +decode-table+
  82   (if (boundp '+decode-table+)
  83       (symbol-value '+decode-table+)
  84       (make-decode-table *encode-table* *pad-char*)))
  85 (defvar *decode-table* +decode-table+ "Deprecated.")
  86 (declaim (type decode-table +decode-table+ *decode-table*))
  87
  88 (defconstant +uri-decode-table+
  89   (if (boundp '+uri-decode-table+)
  90       (symbol-value '+uri-decode-table+)
  91       (make-decode-table *uri-encode-table* *uri-pad-char*)))
  92 (defvar *uri-decode-table* +uri-decode-table+ "Deprecated.")
  93 (declaim (type decode-table +uri-decode-table+ *uri-decode-table*))