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: package.lisp,v 1.4 2003/04/15 16:05:39 kevin Exp $
  11 ;;;;
  12 ;;;; *************************************************************************
  13
  14 (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
  15
  16 (defpackage #:cl-base64
  17   (:nicknames #:base64)
  18   (:use #:cl)
  19   (:export #:base64-stream-to-integer
  20            #:base64-string-to-integer
  21            #:base64-string-to-string
  22            #:base64-stream-to-string
  23            #:base64-string-to-stream
  24            #:base64-stream-to-stream
  25            #:base64-string-to-usb8-array
  26            #:base64-stream-to-usb8-array
  27            #:string-to-base64-string
  28            #:string-to-base64-stream
  29            #:usb8-array-to-base64-string
  30            #:usb8-array-to-base64-stream
  31            #:stream-to-base64-string
  32            #:stream-to-base64-stream
  33            #:integer-to-base64-string
  34            #:integer-to-base64-stream
  35
  36            ;; For creating custom encode/decode tables
  37            #:*uri-encode-table*
  38            #:*uri-decode-table*
  39            #:make-decode-table
  40
  41            #:test-base64
  42            ))
  43
  44 (in-package #:cl-base64)
  45
  46
  47 (defvar *encode-table*
  48   "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
  49 (declaim (type simple-string *encode-table*))
  50
  51 (defvar *uri-encode-table*
  52   "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
  53 (declaim (type simple-string *uri-encode-table*))
  54
  55 (deftype decode-table () '(simple-array fixnum (256)))
  56
  57 (defun make-decode-table (encode-table)
  58   (let ((dt (make-array 256 :adjustable nil :fill-pointer nil
  59                         :element-type 'fixnum
  60                         :initial-element -1)))
  61     (declare (type decode-table dt))
  62     (loop for char of-type character across encode-table
  63        for index of-type fixnum from 0 below 64
  64        do (setf (aref dt (the fixnum (char-code char))) index))
  65     dt))
  66
  67 (defvar *decode-table* (make-decode-table *encode-table*))
  68
  69 (defvar *uri-decode-table* (make-decode-table *uri-encode-table*))
  70
  71 (defvar *pad-char* #\=)
  72 (defvar *uri-pad-char* #\.)
  73 (declaim (type character *pad-char* *uri-pad-char*))