Guile base64

Guile base64

[Romel Sandoval]

Hi

What happened to base64 library on Guile recent versions?

I have see that was on Guile 1.4 (ice-9 base64) [1]. Even the code
appears to be available [2].

Also I found an old guile project (codesystem base64) [3]

Anybody knows if it's going to be reincorporated into Guile libraries or
not?

[1] http://www.gnuvola.org/software/guile/doc/Base64.html
[2] http://cygwin.ru/ml/guile/2000-01/msg00622.html
[3] http://www.gnu.org/software/guile/old-gnu-guile-projects.html

Regards,

-- 
Romel R. Sandoval-Palomo

Re: Guile base64

[Ludovic Courtès]

Hello!

Romel Sandoval <romel@lavabit.com> writes:

> What happened to base64 library on Guile recent versions?

As far as I know there’s never been an (ice-9 base64) module in
GNU Guile, but...

[...]

> [1] http://www.gnuvola.org/software/guile/doc/Base64.html
> [2] http://cygwin.ru/ml/guile/2000-01/msg00622.html
> [3] http://www.gnu.org/software/guile/old-gnu-guile-projects.html

Item [1] points to a Guile 1.4 fork maintained by Thien-Thi Nguyen.
Thien-Thi now has commit rights to the Guile repository so it’d be great
if he would add this module in ‘master’.  :-)

(Alternatively, if this strategy fails, you can submit a patch.)

Thanks,
Ludo’.

Re: Guile base64

[Andy Wingo]

Greets,

On Thu 02 Sep 2010 01:12, ludo@gnu.org (Ludovic Courtès) writes:

> Romel Sandoval <romel@lavabit.com> writes:
>
>> What happened to base64 library on Guile recent versions?

There is 

  http://gitorious.com/tekuti/tekuti/blobs/master/tekuti/base64.scm

also.

Cheers,

Andy
-- 
http://wingolog.org/

Re: Guile base64

[Andreas Rottmann]

Andy Wingo <wingo@pobox.com> writes:

> Greets,
>
> On Thu 02 Sep 2010 01:12, ludo@gnu.org (Ludovic Courtès) writes:
>
>> Romel Sandoval <romel@lavabit.com> writes:
>>
>>> What happened to base64 library on Guile recent versions?
>
> There is 
>
>   http://gitorious.com/tekuti/tekuti/blobs/master/tekuti/base64.scm
>
Also the R6RS version, which should probably work in Guile as well (and
it is defmacro-free ;-).

   http://gitorious.org/tekuti/tekuti/blobs/t/r6rs/do-port/tekuti/base64.sls

[ I really need to make another pass over Tekuti, now that Guile has
  R6RS support -- this could bring the versions a good deal closer
  together. ]

Regards, Rotty
-- 
Andreas Rottmann -- <http://rotty.yi.org/>

Re: Guile base64

[Romel Sandoval]

El vie, 03-09-2010 a las 01:34 +0200, Andreas Rottmann escribió:
> Andy Wingo <wingo@pobox.com> writes:
> 
> > Greets,
> >
> > On Thu 02 Sep 2010 01:12, ludo@gnu.org (Ludovic Courtès) writes:
> >
> >> Romel Sandoval <romel@lavabit.com> writes:
> >>
> >>> What happened to base64 library on Guile recent versions?
> >
> > There is 
> >
> >   http://gitorious.com/tekuti/tekuti/blobs/master/tekuti/base64.scm
> >
> Also the R6RS version, which should probably work in Guile as well (and
> it is defmacro-free ;-).
> 
>    http://gitorious.org/tekuti/tekuti/blobs/t/r6rs/do-port/tekuti/base64.sls
> 
> [ I really need to make another pass over Tekuti, now that Guile has
>   R6RS support -- this could bring the versions a good deal closer
>   together. ]
> 
> Regards, Rotty

Do you think any of mentioned implementations should be included with
Guile 2.0 or it's better to keep it apart?

Regards, Romel

Re: Guile base64

[Thien-Thi Nguyen]

() Romel Sandoval <romel@lavabit.com>
() Fri, 03 Sep 2010 15:15:58 -0500

   Do you think any of mentioned implementations should be
   included with Guile 2.0 or it's better to keep it apart?

Probably next week (2010-09-13 onward) i can find some time to add
(ice-9 base64) from Guile 1.4.x.  However, that implementation uses
‘(srfi srfi-56) read-byte’, which is not available in Guile 2.
Could someone suggest a replacement?

Re: Guile base64

[Ludovic Courtès]

Hi,

Thien-Thi Nguyen <ttn@gnuvola.org> writes:

> () Romel Sandoval <romel@lavabit.com>
> () Fri, 03 Sep 2010 15:15:58 -0500
>
>    Do you think any of mentioned implementations should be
>    included with Guile 2.0 or it's better to keep it apart?
>
> Probably next week (2010-09-13 onward) i can find some time to add
> (ice-9 base64) from Guile 1.4.x.  However, that implementation uses
> ‘(srfi srfi-56) read-byte’, which is not available in Guile 2.
> Could someone suggest a replacement?

Maybe (rnrs bytevectors) and (rnrs io ports)?

Thanks,
Ludo’.

Re: Guile base64

[Thien-Thi Nguyen]

() ludo@gnu.org (Ludovic Courtès)
() Mon, 06 Sep 2010 00:47:46 +0200

   > Could someone suggest a replacement?

   Maybe (rnrs bytevectors) and (rnrs io ports)?

Thanks for the tip; i'll look into those modules.

Re: Guile base64

[Andy Wingo]

Hi,

On Sun 05 Sep 2010 23:58, Thien-Thi Nguyen <ttn@gnuvola.org> writes:

> () Romel Sandoval <romel@lavabit.com>
> () Fri, 03 Sep 2010 15:15:58 -0500
>
>    Do you think any of mentioned implementations should be
>    included with Guile 2.0 or it's better to keep it apart?
>
> Probably next week (2010-09-13 onward) i can find some time to add
> (ice-9 base64) from Guile 1.4.x

Cool!

Perhaps we could combine interfaces -- the stream-based (I presume; I
haven't seen your code yet, but I know your Scheme code looks good)
interfaces from yours, and the map-3-to-4 stuff from Andreas' R6RS port
of my base64.scm.

I say this because the r6rs port already uses bytevectors, and compiles
down to fairly tight VM code. I haven't run benchmarks though.

Cheers,

Andy
-- 
http://wingolog.org/

Re: Guile base64

[Thien-Thi Nguyen]

[-- Attachment #1: Type: text/plain, Size: 1169 bytes --]

() Andy Wingo <wingo@pobox.com>
() Mon, 06 Sep 2010 11:59:15 +0200

   Perhaps we could combine interfaces -- the stream-based (I presume; I
   haven't seen your code yet, but I know your Scheme code looks good)
   interfaces from yours, and the map-3-to-4 stuff from Andreas' R6RS port
   of my base64.scm.

   I say this because the r6rs port already uses bytevectors, and compiles
   down to fairly tight VM code. I haven't run benchmarks though.

Please find below a five-minute port of (ice-9 base64) to Guile 1.9.x.
To play, write it to /tmp and try something like:

  $ cd /tmp
  $ cat > hack <<EOF
  (use-modules (ice-9 base64))
  (base64-encode #t (open-input-file "/tmp/hack") 44)
  (newline)
  EOF
  
  $ base64 -w 44 hack > A
  $ guile -l base64.scm -s hack | diff A -

Probably the next step is to settle the interface.  I am biased towards
1.4.x compatability but am open (albeit reluctantly) to breaking it.
Once the interface is settled, i'll add docs and some perfunctory tests
and repost.  WRT performance -- feel free to rewrite things afterwards;
i'm not yet up to speed (har har) on this area of Guile development
enough to help more than hinder.


[-- Attachment #2: base64.scm --]
[-- Type: application/octet-stream, Size: 8942 bytes --]

;;; base64.scm --- base64 encode/decode

;; Copyright (C) 2010 Free Software Foundation, Inc.
;; Copyright (C) 2004, 2005, 2007 Thien-Thi Nguyen
;;
;; This library is free software; you can redistribute it and/or
;; modify it under the terms of the GNU Lesser General Public
;; License as published by the Free Software Foundation; either
;; version 3 of the License, or (at your option) any later version.
;;
;; This library is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; Lesser General Public License for more details.
;;
;; You should have received a copy of the GNU Lesser General Public
;; License along with this library; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

;;; Commentary:

;; The base64 encoding (rfc 2045) is basically a 3-byte to
;; 4-byte transform:
;;
;; GGGGGGGG NNNNNNNN UUUUUUUU <=> GGGGGG GGNNNN NNNNUU UUUUUU
;; GGGGGGRR RRRROOOO OOKKKKKK <=> GGGGGG RRRRRR OOOOOO KKKKKK
;;
;; modulo line breaks and terminating delimiters.  It is widely used
;; in MIME and other protocols where the transmission medium may not
;; be guaranteed 8-bit clean.

;;; Code:

(define-module (ice-9 base64)
  #:export (base64-encode base64-decode)
  #:use-module ((rnrs io ports) #:select (get-u8)))

;;; support

(define (getb!-proc port)
  (lambda ()
    (let ((b (get-u8 port)))
      (and (not (eof-object? b)) b))))

(define (analyze-input input)           ; => (getb! . exp-input)
  (cond ((string? input)
         (cons (getb!-proc (open-input-string input))
               (string-length input)))
        ((port? input)
         (cons (getb!-proc input)
               (and (port-filename input)
                    (let ((guess (false-if-exception
                                  (stat:size (stat input)))))
                      (and (number? guess)
                           (positive? guess)
                           guess)))))
        (else #f)))

(define c2i char->integer)
(define i2c integer->char)

(define (char+ c n)
  (i2c (+ (c2i c) n)))

(define *reasonable-chunk* (ash 1 (ash 1 (ash 1 (ash 1 (ash 1 0)))))) ; 64 KiB

(define subs substring)

(define (make-buffer-stack size)
  (let ((cur #f) (stack '()) (idx size))

    (define (new!)
      (set! cur (make-string size))
      (set! stack (cons cur stack))
      (set! idx 0))

    (define (spill!)
      (or (= idx size) (set-car! stack (subs (car stack) 0 idx)))
      (let ((res (apply string-append (reverse! stack))))
        (set! cur #f)
        (set! stack '())
        (set! idx size)
        res))

    ;; rv
    (lambda (c)
      (cond (c (and (= idx size) (new!))
               (string-set! cur idx c)
               (set! idx (1+ idx)))
            (else (spill!))))))

(define (make-outp-buffer outp size)
  (let ((buf (make-string size)) (idx 0) (count 0))

    (define (>OUT flush? x)    ;;; todo: make non-blocking if (not flush?)
      (display x outp)
      (and flush? (force-output outp)))

    (define (new!)
      (>OUT #f buf)
      (set! idx 0))

    (define (spill!)
      (>OUT #t (if (= idx size) buf (subs buf 0 idx)))
      (set! idx 0)
      (let ((rv count))
        (set! count 0)
        rv))

    ;; rv
    (lambda (c)
      (cond (c (and (= idx size) (new!))
               (string-set! buf idx c)
               (set! idx (1+ idx))
               (set! count (1+ count)))
            (else (spill!))))))

(define (make-ob! output size)          ; output bufferer
  (if output
      (make-outp-buffer (if (eq? #t output)
                            (current-output-port)
                            output)
                        (min *reasonable-chunk* size))
      (make-buffer-stack size)))

;;; encoding

(define *enc-map*
  (let ((em (make-vector 64 #f)))
    (vector-set! em 62 #\+)
    (vector-set! em 63 #\/)
    (do ((i 0 (1+ i)))
        ((= i 26) em)                   ; rv
      (and (< i 10)
           (vector-set! em (+ 52 i) (char+ #\0 i)))
      (vector-set! em (+ 0 i) (char+ #\A i))
      (vector-set! em (+ 26 i) (char+ #\a i)))))

(define (encode! output getb! line-break crlf exp-input)
  (let* ((bgrp (and line-break (quotient (max 4 line-break) 4)))
         (ob! (make-ob! output
                        (if exp-input
                            ;; compute exact result size
                            (let ((raw (* 4 (inexact->exact
                                             (ceiling (/ (1- exp-input)
                                                         3))))))
                              (+ raw (if bgrp
                                         (* (quotient raw (* 4 bgrp))
                                            (if crlf 2 1))
                                         0)))
                            *reasonable-chunk*)))
         (lb! (if crlf
                  (lambda () (ob! #\cr) (ob! #\newline))
                  (lambda ()            (ob! #\newline)))))

    (define (acc! x)
      (ob! (if x (vector-ref *enc-map* x) #\=)))

    (let loop ((group bgrp))
      (let* ((g (getb!))                ; do not use `let' here
             (n (getb!))
             (u (getb!)))
        (cond (g
               (and bgrp (zero? group) (begin (lb!) (set! group bgrp)))
               (acc! (ash g -2))
               (acc! (and (or g n)
                          (logior (ash (logand (or g 0) 3) 4)
                                  (logand (ash (or n 0) -4) 15))))
               (acc! (and (or n u)
                          (logior (ash (logand (or n 0) 15) 2)
                                  (ash (or u 0) -6))))
               (acc! (and u (logand u 63)))))
        (if (and g n u)
            (loop (and bgrp (1- group)))
            (ob! #f))))))

;; Write to @var{out-port} the result of base64-encoding @var{input} and
;; return the number of bytes written.  If @var{out-port} is #t, send to
;; the current output port.  If @var{out-port} is #f, return the
;; result as a string, instead.  @var{input} may be a string or a port.
;;
;; Optional third arg @var{line-break} specifies the maximum number of columns
;; to appear in the result before a line break.  Actual number of columns is a
;; rounded-down multiple of four, but not less than four.  The result never
;; ends with a line break.  #f means omit line breaks entirely.
;;
;; Optional fourth arg @var{crlf?} non-#f means use @sc{crlf} for line breaks
;; instead of simply @sc{lf}.
;;
;;-sig: (out-port input [line-break [crlf?]])
;;
(define (base64-encode out-port input . opts)
  (or (and=> (analyze-input input)
             (lambda (pair)             ; (getb! . exp-input)
               (encode! out-port
                        (car pair)
                        (and (not (null? opts))
                             (car opts))
                        (and (not (null? opts))
                             (not (null? (cdr opts)))
                             (cadr opts))
                        (cdr pair))))
      (error "bad input:" input)))

;;; decoding

(define *dec-map*
  (let ((dm (make-vector 256 #f)))
    (do ((i 0 (1+ i)))
        ((= i 64) dm)                   ; rv
      (vector-set! dm (c2i (vector-ref *enc-map* i)) i))))

(define byte-whitespace?
  (let ((ws-bytes (map c2i '(#\space #\np #\nl #\cr #\ht #\vt))))
    (lambda (b) (memq b ws-bytes))))

(define (decode! output getb! exp-input)
  (let ((ob! (make-ob!
              output
              (if exp-input
                  ;; approximate result size (whitespace not known a priori)
                  (inexact->exact (ceiling (* 3 (/ (1+ exp-input) 4))))
                  *reasonable-chunk*))))

    (define (acc! x)
      (ob! (i2c x)))

    (define (find!)
      (let ((b (getb!)))
        (and b (if (byte-whitespace? b)
                   (find!)
                   (vector-ref *dec-map* b)))))

    ;; do it!
    (let loop ()
      (let* ((g (find!))                ; do not use `let' here
             (r (find!))
             (o (find!))
             (k (find!)))
        (and g r (acc! (logior (ash g 2) (ash r -4))))
        (and r o (acc! (logior (ash (logand r 15) 4) (ash o -2))))
        (and o k (acc! (logior (ash (logand o 3) 6) k)))
        (if (and g r o k)
            (loop)
            (ob! #f))))))

;; Write to @var{out-port} the result of base64-decoding @var{input} and
;; return the number of bytes written.  If @var{out-port} is #t, send to
;; the current output port.  If @var{out-port} is #f, return the
;; result as a string, instead.  @var{input} may be a string or a port.
;;
(define (base64-decode out-port input)
  (or (and=> (analyze-input input)
             (lambda (pair)             ; (getb! . exp-input)
               (decode! out-port
                        (car pair)
                        (cdr pair))))
      (error "bad input:" input)))

;;; base64.scm ends here