From 1e06cd215ad169e24a2f7244c5c3833fa88e2ae5 Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Fri, 21 Mar 2014 16:04:21 +0900
Subject: [PATCH] Making http ports binary.

---
 lib/chibi/io/io.scm    |  2 +-
 lib/chibi/net/http.scm | 40 +++++++++++++++++++++++++++++++++++++---
 lib/chibi/net/http.sld |  5 +++--
 3 files changed, 41 insertions(+), 6 deletions(-)

diff --git a/lib/chibi/io/io.scm b/lib/chibi/io/io.scm
index 5e2fad1a..7100e235 100644
--- a/lib/chibi/io/io.scm
+++ b/lib/chibi/io/io.scm
@@ -344,7 +344,7 @@
            (set! offset (+ offset n))
            n)
           (else
-           (string-copy! str start buf offset len)
+           (string-copy! str start buf offset (+ offset len))
            (let lp ((i (+ start (- len offset))))
              (set! buf (generator))
              (cond
diff --git a/lib/chibi/net/http.scm b/lib/chibi/net/http.scm
index 4a259d84..49d23887 100644
--- a/lib/chibi/net/http.scm
+++ b/lib/chibi/net/http.scm
@@ -51,6 +51,40 @@
               n
               (if (>= j len) "" (substring line (+ j 1) len))))))
 
+(define (make-generated-binary-input-port generator)
+  (let ((buf #u8())
+        (len 0)
+        (offset 0))
+    (make-custom-binary-input-port
+     (lambda (bv start end)
+       (let ((n (- end start)))
+         (cond
+          ((>= (- len offset) n)
+           (bytevector-copy! bv start buf offset (+ offset n))
+           (set! offset (+ offset n))
+           n)
+          (else
+           (bytevector-copy! bv start buf offset (+ offset len))
+           (let lp ((i (+ start (- len offset))))
+             (set! buf (generator))
+             (cond
+              ((not (bytevector? buf))
+               (set! buf #u8())
+               (set! len 0)
+               (set! offset 0)
+               (- i start))
+              (else
+               (set! len (bytevector-length buf))
+               (set! offset 0)
+               (cond
+                ((>= (- len offset) (- n i))
+                 (bytevector-copy! bv i buf offset (+ offset (- n i)))
+                 (set! offset (+ offset (- n i)))
+                 n)
+                (else
+                 (bytevector-copy! bv i buf offset len)
+                 (lp (+ i (- len offset)))))))))))))))
+
 (define (http-wrap-chunked-input-port in)
   (define (read-chunk in)
     (let* ((line (read-line in))
@@ -59,8 +93,8 @@
        ((not (and (integer? n) (<= 0 n http-chunked-size-limit)))
         (error "invalid chunked size line" line))
        ((zero? n) "")
-       (else (read-string n in)))))
-  (make-generated-input-port
+       (else (read-bytevector n in)))))
+  (make-generated-binary-input-port
    (lambda () (read-chunk in))))
 
 (define (http-get/raw url in-headers limit)
@@ -91,7 +125,7 @@
                  (display (cdr x) out) (display "\r\n" out))
                in-headers)
               (display "Connection: close\r\n\r\n" out)
-              (flush-output out)
+              (flush-output-port out)
               (let* ((resp (http-parse-response (read-line in)))
                      (headers (mime-headers->list in))
                      (status (quotient (cadr resp) 100)))
diff --git a/lib/chibi/net/http.sld b/lib/chibi/net/http.sld
index 796d9448..d5235e34 100644
--- a/lib/chibi/net/http.sld
+++ b/lib/chibi/net/http.sld
@@ -4,6 +4,7 @@
           call-with-input-url call-with-input-url/headers
           with-input-from-url
           http-parse-request http-parse-form)
-  (import (chibi) (srfi 39) (chibi net) (chibi io)
-          (chibi uri) (chibi mime))
+  (import (scheme base) (scheme write) (scheme char)
+          (srfi 39)
+          (chibi net) (chibi io) (chibi uri) (chibi mime))
   (include "http.scm"))