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.1 2003/01/12 20:25:26 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
  42 (in-package #:cl-base64)
  43
  44
  45 (eval-when (:compile-toplevel :load-toplevel :execute)
  46   (defvar *encode-table*
  47     "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
  48   (declaim (type simple-string *encode-table*))
  49
  50   (defvar *uri-encode-table*
  51     "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
  52   (declaim (type simple-string *uri-encode-table*))
  53
  54   (deftype decode-table () '(array fixnum (256)))
  55
  56   (defun make-decode-table (encode-table)
  57     (let ((dt (make-array 256 :adjustable nil :fill-pointer nil
  58                           :element-type 'fixnum
  59                           :initial-element -1)))
  60       (loop for char of-type character across encode-table
  61          for index of-type fixnum from 0 below 64
  62          do (setf (aref dt (the fixnum (char-code char))) index))
  63       dt))
  64
  65   (defvar *decode-table* (make-decode-table *encode-table*))
  66
  67   (defvar *uri-decode-table* (make-decode-table *uri-encode-table*))
  68
  69   (declaim (type decode-table *decode-table* *uri-decode-table*))
  70
  71   (defvar *pad-char* #\=)
  72   (defvar *uri-pad-char* #\.)
  73   (declaim (type character *pad-char* *uri-pad-char*))
  74   )