Skip to content
Snippets Groups Projects
Commit b8e5576d authored by Kevin M. Rosenberg's avatar Kevin M. Rosenberg
Browse files

r3767: Auto commit for Debian build

parent 092e2542
No related branches found
No related tags found
No related merge requests found
cl-base64 (3.0.1-1) unstable; urgency=low
* Fix output of base64-string-to-usb8-array
-- Kevin M. Rosenberg <kmr@debian.org> Tue, 14 Jan 2003 04:35:05 -0700
cl-base64 (3.0.0-1) unstable; urgency=low cl-base64 (3.0.0-1) unstable; urgency=low
* Remove src.lisp and add package.lisp, decode.lisp, encode.lisp * Remove src.lisp and add package.lisp, decode.lisp, encode.lisp
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;;; Programmer: Kevin M. Rosenberg ;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Dec 2002 ;;;; Date Started: Dec 2002
;;;; ;;;;
;;;; $Id: decode.lisp,v 1.2 2003/01/12 22:32:40 kevin Exp $ ;;;; $Id: decode.lisp,v 1.3 2003/01/14 11:43:10 kevin Exp $
;;;; ;;;;
;;;; This file implements the Base64 transfer encoding algorithm as ;;;; This file implements the Base64 transfer encoding algorithm as
;;;; defined in RFC 1521 by Borensten & Freed, September 1993. ;;;; defined in RFC 1521 by Borensten & Freed, September 1993.
...@@ -61,7 +61,7 @@ ...@@ -61,7 +61,7 @@
(:string (:string
'((simple-string result))) '((simple-string result)))
(:usb8-array (:usb8-array
'((type (array fixnum (*)) result)))) '((type (array (usigned-byte 8) (*)) result))))
(fixnum ridx)) (fixnum ridx))
(do* ((bitstore 0) (do* ((bitstore 0)
(bitcount 0) (bitcount 0)
...@@ -71,8 +71,11 @@ ...@@ -71,8 +71,11 @@
,(case output-type ,(case output-type
(:stream (:stream
'stream) 'stream)
((or :stream :string) ((:string :usb8-array)
'(subseq result 0 ridx)))) 'result)
;; ((:stream :string)
;; '(subseq result 0 ridx))))
))
(declare (fixnum bitstore bitcount) (declare (fixnum bitstore bitcount)
(character char)) (character char))
(let ((svalue (aref decode-table (the fixnum (char-code char))))) (let ((svalue (aref decode-table (the fixnum (char-code char)))))
...@@ -143,7 +146,7 @@ ...@@ -143,7 +146,7 @@
(:string (:string
'((simple-string result))) '((simple-string result)))
(:usb8-array (:usb8-array
'((type (array fixnum (*)) result)))) '((type (array (unsigned-byte 8) (*)) result))))
(fixnum ridx)) (fixnum ridx))
(loop (loop
for char of-type character across input for char of-type character across input
...@@ -189,7 +192,7 @@ ...@@ -189,7 +192,7 @@
,(case output-type ,(case output-type
(:stream (:stream
'stream) 'stream)
((:stream :string) ((:usb8-array :string)
'(subseq result 0 ridx))))))) '(subseq result 0 ridx)))))))
(def-base64-string-to-* :string) (def-base64-string-to-* :string)
......
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;;; Programmer: Kevin M. Rosenberg ;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Dec 2002 ;;;; Date Started: Dec 2002
;;;; ;;;;
;;;; $Id: encode.lisp,v 1.3 2003/01/13 21:38:01 kevin Exp $ ;;;; $Id: encode.lisp,v 1.4 2003/01/14 11:43:10 kevin Exp $
;;;; ;;;;
;;;; This file implements the Base64 transfer encoding algorithm as ;;;; This file implements the Base64 transfer encoding algorithm as
;;;; defined in RFC 1521 by Borensten & Freed, September 1993. ;;;; defined in RFC 1521 by Borensten & Freed, September 1993.
...@@ -28,7 +28,7 @@ ...@@ -28,7 +28,7 @@
;;;; - Renamed functions now that supporting integer conversions ;;;; - Renamed functions now that supporting integer conversions
;;;; - URI-compatible encoding using :uri key ;;;; - URI-compatible encoding using :uri key
;;;; ;;;;
;;;; $Id: encode.lisp,v 1.3 2003/01/13 21:38:01 kevin Exp $ ;;;; $Id: encode.lisp,v 1.4 2003/01/14 11:43:10 kevin Exp $
(in-package #:cl-base64) (in-package #:cl-base64)
...@@ -43,118 +43,6 @@ ...@@ -43,118 +43,6 @@
x x
(the fixnum (+ x (the fixnum (- n remainder))))))) (the fixnum (+ x (the fixnum (- n remainder)))))))
(defun string-to-base64 (string &key (uri nil) (columns 0) (stream nil))
"Encode a string array to base64. If columns is > 0, designates
maximum number of columns in a line and the string will be terminated
with a #\Newline."
(declare (string string)
(fixnum columns)
(optimize (speed 3)))
(let ((pad (if uri *uri-pad-char* *pad-char*))
(encode-table (if uri *uri-encode-table* *encode-table*)))
(declare (simple-string encode-table)
(character pad))
(let* ((string-length (length string))
(complete-group-count (truncate string-length 3))
(remainder (nth-value 1 (truncate string-length 3)))
(padded-length (* 4 (truncate (+ string-length 2) 3)))
(num-lines (if (plusp columns)
(truncate (+ padded-length (1- columns)) columns)
0))
(num-breaks (if (plusp num-lines)
(1- num-lines)
0))
(strlen (if stream
0
(+ padded-length num-breaks)))
(result (make-string strlen))
(col (if (plusp columns)
0
(1+ padded-length)))
(ioutput 0))
(declare (fixnum string-length padded-length col ioutput)
(simple-string result))
(labels ((output-char (ch)
(if (= col columns)
(progn
(if stream
(write-char #\Newline stream)
(progn
(setf (schar result ioutput) #\Newline)
(incf ioutput)))
(setq col 1))
(incf col))
(if stream
(write-char ch stream)
(progn
(setf (schar result ioutput) ch)
(incf ioutput))))
(output-group (svalue chars)
(declare (fixnum svalue chars))
(output-char
(schar encode-table
(the fixnum
(logand #x3f
(the fixnum (ash svalue -18))))))
(output-char
(schar encode-table
(the fixnum
(logand #x3f
(the fixnum (ash svalue -12))))))
(if (> chars 2)
(output-char
(schar encode-table
(the fixnum
(logand #x3f
(the fixnum (ash svalue -6))))))
(output-char pad))
(if (> chars 3)
(output-char
(schar encode-table
(the fixnum
(logand #x3f svalue))))
(output-char pad))))
(do ((igroup 0 (1+ igroup))
(isource 0 (+ isource 3)))
((= igroup complete-group-count)
(cond
((= remainder 2)
(output-group
(the fixnum
(+
(the fixnum
(ash (the fixnum
(char-code (the character
(char string isource))))
16))
(the fixnum
(ash (the fixnum
(char-code (the character
(char string (1+ isource)))))
8))))
3))
((= remainder 1)
(output-group
(the fixnum
(ash
(the fixnum
(char-code (the character (char string isource))))
16))
2)))
result)
(declare (fixnum igroup isource))
(output-group
(the fixnum
(+
(the fixnum
(ash (char-code (the character
(char string isource))) 16))
(the fixnum
(ash (char-code (the character (char string (1+ isource)))) 8))
(the fixnum
(char-code (the character (char string (+ 2 isource)))))))
4))))))
(defmacro def-*-to-base64-* (input-type output-type) (defmacro def-*-to-base64-* (input-type output-type)
`(defun ,(intern (concatenate 'string (symbol-name input-type) `(defun ,(intern (concatenate 'string (symbol-name input-type)
(symbol-name :-to-base64-) (symbol-name :-to-base64-)
...@@ -170,7 +58,7 @@ with a #\Newline." ...@@ -170,7 +58,7 @@ with a #\Newline."
(:string (:string
'((string input))) '((string input)))
(:usb8-array (:usb8-array
'((type (array fixnum (*)) input)))) '((type (array (unsigned-byte 8) (*)) input))))
(fixnum columns) (fixnum columns)
(optimize (speed 3))) (optimize (speed 3)))
(let ((pad (if uri *uri-pad-char* *pad-char*)) (let ((pad (if uri *uri-pad-char* *pad-char*))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment