Changeset 14249 in project


Ignore:
Timestamp:
04/15/09 00:27:54 (11 years ago)
Author:
Jim Ursetto
Message:

base64: encoder optionally outputs linebreaks

Location:
release/4/base64/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/base64/trunk/base64-test.scm

    r14246 r14249  
    11(use test)
    22(use base64)
     3
     4(define lorem-ipsum "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum.")
     5(define lorem-ipsum-base64
     6  '("TG9yZW0gaXBzdW0gZG9sb3Igc2l0IGFtZXQsIGNvbnNlY3RldHVyIGFkaXBpc2ljaW5nIGVsaXQs"
     7    "IHNlZCBkbyBlaXVzbW9kIHRlbXBvciBpbmNpZGlkdW50IHV0IGxhYm9yZSBldCBkb2xvcmUgbWFn"
     8    "bmEgYWxpcXVhLiBVdCBlbmltIGFkIG1pbmltIHZlbmlhbSwgcXVpcyBub3N0cnVkIGV4ZXJjaXRh"
     9    "dGlvbiB1bGxhbWNvIGxhYm9yaXMgbmlzaSB1dCBhbGlxdWlwIGV4IGVhIGNvbW1vZG8gY29uc2Vx"
     10    "dWF0LiBEdWlzIGF1dGUgaXJ1cmUgZG9sb3IgaW4gcmVwcmVoZW5kZXJpdCBpbiB2b2x1cHRhdGUg"
     11    "dmVsaXQgZXNzZSBjaWxsdW0gZG9sb3JlIGV1IGZ1Z2lhdCBudWxsYSBwYXJpYXR1ci4gRXhjZXB0"
     12    "ZXVyIHNpbnQgb2NjYWVjYXQgY3VwaWRhdGF0IG5vbiBwcm9pZGVudCwgc3VudCBpbiBjdWxwYSBx"
     13    "dWkgb2ZmaWNpYSBkZXNlcnVudCBtb2xsaXQgYW5pbSBpZCBlc3QgbGFib3J1bS4="
     14    ""))   ; trailing empty for intersperse
    315
    416(test-group
     
    3042 (test "encode binary string"
    3143       "3q2+78r+sAs="
    32        (base64-encode "\xde\xad\xbe\xef\xca\xfe\xb0\x0b")))
     44       (base64-encode "\xde\xad\xbe\xef\xca\xfe\xb0\x0b"))
     45 (test "lorem ipsum"
     46       (apply string-append lorem-ipsum-base64)
     47       (base64-encode lorem-ipsum)))
     48
     49(test-group
     50 "encoding linebreaks"
     51 (parameterize ((base64-line-breaks #t))
     52   (test "encode empty string"
     53         ""
     54         (base64-encode ""))
     55   (test "encode 9 chars"
     56         "YWFhYWFhYWFh\r\n"
     57         (base64-encode (make-string 9 #\a)))
     58   (test "encode 55 chars"
     59         "YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYQ==\r\n"
     60         (base64-encode (make-string 55 #\a)))
     61   (test "encode 56 chars"
     62         "YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWE=\r\n"
     63         (base64-encode (make-string 56 #\a)))
     64   (test "encode 57 chars"
     65         "YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFh\r\n"
     66         (base64-encode (make-string 57 #\a)))
     67   (test "encode 58 chars"
     68         "YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFh\r\nYQ==\r\n"
     69         (base64-encode (make-string 58 #\a)))
     70   (test "encode 57*2 chars"
     71         (string-append "YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFh"
     72                        "\r\n"
     73                        "YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFh"
     74                        "\r\n")
     75         (base64-encode (make-string (* 57 2) #\a)))
     76   (test "encode 57*2+1 chars"
     77         (string-append "YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFh"
     78                        "\r\n"
     79                        "YWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFhYWFh"
     80                        "\r\n"
     81                        "YQ=="
     82                        "\r\n")
     83         (base64-encode (make-string (+ 1 (* 57 2)) #\a)))
     84 (test "lorem ipsum"
     85       (string-intersperse
     86        lorem-ipsum-base64
     87        "\r\n")
     88       (base64-encode lorem-ipsum))
     89
     90   ))
    3391
    3492;; to avoid measuring time in test (doesn't really matter)
     
    78136       ""
    79137       (base64-decode large-invalid-string))
    80  )
     138 (test "decode lorem ipsum with linebreaks"
     139       lorem-ipsum
     140       (base64-decode (string-intersperse lorem-ipsum-base64 "\r\n"))))
    81141
    82142;; Not on a 64-bit machine! :)
  • release/4/base64/trunk/base64.scm

    r14246 r14249  
    3939
    4040(module base64
    41   (base64-encode base64-decode) ;; base64-decode/lax
     41  (base64-encode base64-decode base64-line-breaks) ;; base64-decode/lax
    4242 
    4343  (import scheme chicken)
    4444
    45 (define (base64-encode str)
     45(define (base64-encode-orig str)
    4646  (define-inline (bits-at idx)
    4747    (char->integer (string-ref str idx)))
     
    8686        (string-set! out (+ o 2) (b64->char (arithmetic-shift n -6)))
    8787        (string-set! out (+ o 3) (b64->char n))))))
     88
     89(define base64-line-breaks (make-parameter #f))
     90;; If base64-line-breaks is true, a CRLF is inserted every
     91;; 76 output chars (57 input chars) and at the end of the last
     92;; line, if it was partial (between 1 and 75 output chars).
     93(define (base64-encode str)
     94  (define-inline (bits-at idx)
     95    (char->integer (string-ref str idx)))
     96  (define-inline (b64->char n)
     97    (define enc-table
     98      '#(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
     99         #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z
     100         #\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
     101         #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z
     102         #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\+ #\/))
     103    (vector-ref enc-table (bitwise-and n 63)))
     104
     105  (define (encode-tail out i o r)
     106    ;; Handle last 1 or 2 bytes
     107    (case r
     108      ((0) o)
     109      ((1)
     110       (let ((n (arithmetic-shift (bits-at i) 16)))
     111         (string-set! out o (b64->char (arithmetic-shift n -18)))
     112         (string-set! out (+ o 1) (b64->char (arithmetic-shift n -12)))
     113         (+ o 4)))
     114      ((2)
     115       (let ((n (bitwise-ior (arithmetic-shift (bits-at i) 16)
     116                             (arithmetic-shift (bits-at (+ i 1)) 8))))
     117         (string-set! out o (b64->char (arithmetic-shift n -18)))
     118         (string-set! out (+ o 1) (b64->char (arithmetic-shift n -12)))
     119         (string-set! out (+ o 2) (b64->char (arithmetic-shift n -6)))
     120         (+ o 4)))))
     121
     122  (##sys#check-string str 'base64-encode)
     123  (let ((l (string-length str)))
     124    (let* ((nobreak? (not (base64-line-breaks)))
     125           (outlen (* 4 (fx/ (+ l 2) 3)))
     126           (full-lines (fx/ l 57))
     127           (partial-line (not (= 0 (fxmod l 57))))
     128           (outlen (if nobreak?
     129                       outlen
     130                       (+ outlen (fx* 2 (+ full-lines
     131                                           (if partial-line 1 0))))))
     132           (out (make-string outlen #\=)))
     133      (let ((o
     134             (let loop ((i 0) (o 0) (r l) (c 1))
     135               (if (< r 3)
     136                   (encode-tail out i o r)
     137                   (let ((n (bitwise-ior (arithmetic-shift (bits-at i) 16)
     138                                         (arithmetic-shift (bits-at (+ i 1)) 8)
     139                                         (bits-at (+ i 2)))))
     140                     (string-set! out o       (b64->char (arithmetic-shift n -18)))
     141                     (string-set! out (+ o 1) (b64->char (arithmetic-shift n -12)))
     142                     (string-set! out (+ o 2) (b64->char (arithmetic-shift n -6)))
     143                     (string-set! out (+ o 3) (b64->char n))
     144                     (cond (nobreak?
     145                            (loop (+ i 3) (+ o 4) (- r 3) c))
     146                           ((< c 19)  ; 57/3 = 76/4 = 19
     147                            (loop (+ i 3) (+ o 4) (- r 3) (+ c 1)))
     148                           (else
     149                            (string-set! out (+ o 4) #\return)
     150                            (string-set! out (+ o 5) #\newline)
     151                            (loop (+ i 3) (+ o 6) (- r 3) 1)))
     152                     )))))
     153        (when (and (not nobreak?)
     154                   partial-line)
     155          (string-set! out o #\return)
     156          (string-set! out (+ o 1) #\newline))
     157        out))))
    88158
    89159;; (define (calc-dec-table)
     
    128198                    0))))))
    129199
    130   (##sys#check-string str 'base64:decode)
     200  (##sys#check-string str 'base64-decode)
    131201  (let ((l (string-length str)))
    132202    (if (= l 0)
    133         ""
     203        str
    134204        (let* ((outlen (guess-out-length l))  ; avoid substring if possible
    135205               (out (make-string outlen))
     
    196266             out))))
    197267
    198   (##sys#check-string str 'base64:decode)
     268  (##sys#check-string str 'base64-decode)
    199269  (let ((l (string-length str)))
    200270    (cond
    201271     ((= l 0) "")
    202272     ((not (= l (fx* 4 (fx/ l 4))))
    203       (error 'base64:decode "string length must be a multiple of 4" l))
     273      (error 'base64-decode "string length must be a multiple of 4" l))
    204274     (else
    205275      (let* ((outlen (- (* 3 (fx/ l 4))
  • release/4/base64/trunk/base64.setup

    r14246 r14249  
    55 'base64
    66 '("base64.import.so" "base64.so")
    7  '((version 3.0)
     7 '((version 3.1)
    88   (documentation "base64.html")))
Note: See TracChangeset for help on using the changeset viewer.