Ticket #1838: 0001-accept-a-procedure-for-file-content-which-is-a-thunk.patch

File 0001-accept-a-procedure-for-file-content-which-is-a-thunk.patch, 4.2 KB (added by Woodrow E Douglass, 18 months ago)

  • http-client.scm 

    From 13eb8902e0505e26e6f41dd9b36e9f85460ba58a Mon Sep 17 00:00:00 2001
From: Woodrow Douglass <wdouglass@carnegierobotics.com>
Date: Mon, 24 Jun 2024 13:04:30 -0400
Subject: [PATCH] accept a procedure for file content, which is a thunk that
 returns a port

---
 http-client.scm | 40 +++++++++++++++++++++++-----------------
 1 file changed, 23 insertions(+), 17 deletions(-)

diff --git a/http-client.scm b/http-client.scm
index e9c181b..922ddfd 100644
    a b  
    733733                (list "--" boundary "\r\n" hs "\r\n"
    734734                      (cond ((string? file) (cons 'file file))
    735735                            ((port? file) (cons 'port file))
     736                            ((procedure? file) (cons 'procedure file))
    736737                            ((eq? keys #t) "")
    737738                            (else (->string keys)))
    738739                  ;; The next boundary must always start on a new line
    … …  
    744745  (for-each (lambda (entry)
    745746              (for-each (lambda (chunk)
    746747                          (if (pair? chunk)
    747                               (let ((p (if (eq? 'file (car chunk))
    748                                            (open-input-file (cdr chunk))
    749                                            ;; Should be a port otherwise
    750                                            (cdr chunk))))
     748                              (let ((p (case (car chunk)
     749                                         ((file) (open-input-file (cdr chunk)))
     750                                         ((port) (cdr chunk))
     751                                         ((procedure) ((cdr chunk)))
     752                                         (else (http-client-error
     753                                                'write-chunks
     754                                                "The a file chunk must be either a string representing a filename, an open port, or a thunk that returns an open port"
     755                                                '()
     756                                                'multipart-file-error)))))
    751757                                (handle-exceptions exn
    752                                   (begin (close-input-port p) (raise exn))
     758                                    (begin (close-input-port p) (raise exn))
    753759                                  (sendfile p output-port))
    754760                                (close-input-port p))
    755761                              (display chunk output-port)))
    … …  
    770776     (fold (lambda (chunks total-size)
    771777             (fold (lambda (chunk total-size)
    772778                     (if (pair? chunk)
    773                          (if (eq? 'port (car chunk))
    774                              (let ((str-len (maybe-string-port-length (cdr chunk))))
    775                                (if str-len
    776                                    (+ total-size str-len)
    777                                    ;; We can't calculate port lengths
    778                                    ;; for non-string-ports.  Let's just
    779                                    ;; punt and hope the server won't
    780                                    ;; return "411 Length Required"...
    781                                    ;; (TODO: maybe try seeking it?)
    782                                    (return #f)))
    783                              ;; Should be a file otherwise.
    784                              (+ total-size (file-size (cdr chunk))))
     779                         (if (eq? 'file (car chunk))
     780                             (+ total-size (file-size (cdr chunk)))
     781                             (let ((p (if (eq? 'port (car chunk)) (cdr chunk) ((cdr chunk)))))
     782                               (let ((str-len (maybe-string-port-length (cdr chunk))))
     783                                 (if str-len
     784                                     (+ total-size str-len)
     785                                     ;; We can't calculate port lengths
     786                                     ;; for non-string-ports.  Let's just
     787                                     ;; punt and hope the server won't
     788                                     ;; return "411 Length Required"...
     789                                     ;; (TODO: maybe try seeking it?)
     790                                     (return #f)))))
    785791                         (+ total-size (string-length chunk))))
    786792                   total-size
    787793                   chunks))