r3767: Auto commit for Debian build
authorKevin M. Rosenberg <kevin@rosenberg.net>
Tue, 14 Jan 2003 11:43:10 +0000 (11:43 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Tue, 14 Jan 2003 11:43:10 +0000 (11:43 +0000)
debian/changelog
decode.lisp
encode.lisp

index 71a38ed..b25f4f0 100644 (file)
@@ -1,3 +1,9 @@
+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
 
   * Remove src.lisp and add package.lisp, decode.lisp, encode.lisp     
index 775bb8e..d1e9ed3 100644 (file)
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; 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
 ;;;; defined in RFC 1521 by Borensten & Freed, September 1993.
@@ -61,7 +61,7 @@
                          (:string
                           '((simple-string result)))
                          (:usb8-array
-                          '((type (array fixnum (*)) result))))
+                          '((type (array (usigned-byte 8) (*)) result))))
                  (fixnum ridx))
         (do* ((bitstore 0)
               (bitcount 0)
               ,(case output-type
                      (:stream
                       'stream)
-                     ((or :stream :string)
-                      '(subseq result 0 ridx))))
+                     ((:string :usb8-array)
+                      'result)
+                     ;; ((:stream :string)
+                     ;; '(subseq result 0 ridx))))
+                     ))
           (declare (fixnum bitstore bitcount)
                    (character char))
           (let ((svalue (aref decode-table (the fixnum (char-code char)))))
                          (:string
                           '((simple-string result)))
                          (:usb8-array
-                          '((type (array fixnum (*)) result))))
+                          '((type (array (unsigned-byte 8) (*)) result))))
                  (fixnum ridx))
         (loop 
            for char of-type character across input
         ,(case output-type
                (:stream
                 'stream)
-               ((:stream :string)
+               ((:usb8-array :string)
                 '(subseq result 0 ridx)))))))
 
 (def-base64-string-to-* :string)
index 803c9ce..4bca7a3 100644 (file)
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; 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
 ;;;; defined in RFC 1521 by Borensten & Freed, September 1993.
@@ -28,7 +28,7 @@
 ;;;;   - Renamed functions now that supporting integer conversions
 ;;;;   - 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)
 
        x
        (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)
   `(defun ,(intern (concatenate 'string (symbol-name input-type)
                                (symbol-name :-to-base64-)
@@ -170,7 +58,7 @@ with a #\Newline."
                      (:string
                       '((string input)))
                      (:usb8-array
-                      '((type (array fixnum (*)) input))))
+                      '((type (array (unsigned-byte 8) (*)) input))))
              (fixnum columns)
              (optimize (speed 3)))
      (let ((pad (if uri *uri-pad-char* *pad-char*))