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-string-to-integer
  19            #:base64-string-to-string
  20            #:base64-stream-to-string
  21            #:base64-string-to-stream
  22            #:base64-stream-to-stream
  23            #:base64-string-to-usb8-array
  24            #:base64-stream-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            ;; For creating custom encode/decode tables
  35            #:*uri-encode-table*
  36            #:*uri-decode-table*
  37            #:make-decode-table
  38
  39            #:test-base64
  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*))