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.3 2003/01/14 11:59:44 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 (defvar *encode-table*
  46   "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/")
  47 (declaim (type simple-string *encode-table*))
  48
  49 (defvar *uri-encode-table*
  50   "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_")
  51 (declaim (type simple-string *uri-encode-table*))
  52
  53 (deftype decode-table () '(simple-array fixnum (256)))
  54
  55 (defun make-decode-table (encode-table)
  56   (let ((dt (make-array 256 :adjustable nil :fill-pointer nil
  57                         :element-type 'fixnum
  58                         :initial-element -1)))
  59     (declare (type decode-table dt))
  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 (defvar *pad-char* #\=)
  70 (defvar *uri-pad-char* #\.)
  71 (declaim (type character *pad-char* *uri-pad-char*))