Use sendfile instead of copy-port which is currently broken in C6; allow overriding http line limit1.8

2 files changed, 12 insertions, 6 deletions

diff --git a/henrietta-cache.scm b/henrietta-cache.scm
index b376b3e..06bd423 100644
--- a/henrietta-cache.scm
+++ b/henrietta-cache.scm
@@ -7,20 +7,20 @@
   (chicken-4 (import chicken)
              (use utils files extras posix data-structures ports
                   http-client matchable uri-common srfi-1 irregex
-                  setup-api)
+                  setup-api intarweb sendfile)
              (define read-list read-file))
   (chicken-5 (import (chicken base) (chicken condition) (chicken file)
                      (chicken format) (chicken string) (chicken port)
                      (chicken process) (chicken process-context)
                      (chicken pathname) (chicken io) (chicken sort)
                      (chicken irregex) (chicken file posix)
-                     http-client matchable uri-common srfi-1))
+                     http-client intarweb sendfile matchable uri-common srfi-1))
   (chicken-6 (import (scheme base) (chicken base) (chicken condition)
                      (chicken file) (chicken format) (chicken string) (chicken port)
                      (chicken process) (chicken process-context)
                      (chicken pathname) (chicken io) (chicken sort)
                      (chicken irregex) (chicken file posix)
-                     http-client matchable uri-common srfi-1)))
+                     http-client intarweb sendfile matchable uri-common srfi-1)))
 
 (define (usage code)
   (print #<#EOF
@@ -34,6 +34,7 @@ usage: henrietta-cache [OPTION ...]
   -r   -chicken-release REL     the major CHICKEN release version for which to fetch (defaults to 5)
   -k   -keep NUM                only keep this many latest releases, delete the rest
   -n   -no-download             don't download any releases (useful for purging in combination with -k)
+  -L   -http-line-limit N       override HTTP line limit (for e.g. headers) to N characters (pass 0 to disable entirely)
 
 Henrietta-cache will download cached copies of each egg listed in the file
 EGGLIST, to CACHEDIR.
@@ -164,7 +165,7 @@ EOF
               (lambda (i)
                 (call-with-output-file
                     (make-pathname tmp-dir file)
-                  (lambda (o) (copy-port i o)))))
+                  (lambda (o) (sendfile i o)))))
            (e (exn http)
               (error (sprintf
                          (conc "Could not download file \"~A\", "
@@ -188,7 +189,7 @@ EOF
       (condition-case
           (call-with-input-request
            uri #f (lambda (i) (call-with-output-file tmp-file
-                                (lambda (o) (copy-port i o)))))
+                                (lambda (o) (sendfile i o)))))
         (e (exn http)
            (error (sprintf "Could not fetch ~A-file ~A -- ~A"
                     type uri (get-condition-property e 'exn 'message)))))
@@ -442,6 +443,11 @@ EOF
                 ((or (string=? arg "-n") (string=? arg "-no-download"))
                  (set! *no-download* #t)
                  (loop (cdr args)))
+                ((or (string=? arg "-L") (string=? arg "-http-line-limit"))
+                 (unless (pair? (cdr args)) (usage 1))
+                 (let ((limit (string->number (cadr args))))
+                   (http-line-limit (if (zero? limit) #f limit)))
+                 (loop (cddr args)))
                 ((and (positive? (string-length arg))
                       (char=? #\- (string-ref arg 0)))
                  (if (> (string-length arg) 2)
diff --git a/henrietta-cache.setup b/henrietta-cache.setup
index 229b9ef..b95f3a6 100644
--- a/henrietta-cache.setup
+++ b/henrietta-cache.setup
@@ -5,4 +5,4 @@
 (install-program
  'henrietta-cache
  '("henrietta-cache")
- '((version "1.6.1")))
+ '((version "1.8")))