On Tue, Jan 29, 2019 at 4:17 AM Christopher Lemmer Webber <
cweb...@dustycloud.org> wrote:

>
> Any thoughts on how I should move forward?


I think that using a `data-procedure/c` of a particular sort should allow
you to implement this without needing access to the struct internals or
needing to read everything into memory at once.

(Though, it would be a bit nicer if the write proc allowed you to specify
an offset and length into the string/byte string.)

Something like:
===
#lang racket/base

(require net/http-client
         file/sha1
         racket/random)

(define (http-conn-send/multipart! hc uri multipart-body
                                   #:version [version #"1.1"]
                                   #:method [method #"POST"]
                                   #:close? [close? #f]
                                   #:headers [headers '()]
                                   #:content-decode [decodes '(gzip)]
                                   #:boundary [boundary (random-boundary)])
  (define content-type-header
    (string-append
     "Content-Type: multipart/form-data; boundary="
     boundary))

  (http-conn-send! hc uri
                   #:version version
                   #:method method
                   #:close? close?
                   #:headers (cons content-type-header headers)
                   #:content-decode decodes
                   #:data (multipart-body->data-proc boundary
multipart-body)))

(define (mime-escape s)
  (regexp-replace* #rx"[\"\\]" s "\\\\\\0"))

(define (make-string-part field-name field-value)
  (λ (write-chunk boundary)
    (write-chunk
     (format
      (string-append "--~a\r\n"
                     "Content-Disposition: form-data; name=\"~a\"\r\n"
                      "Content-Type: text/plain; charset=utf-8\r\n"
                      "\r\n"
                      "~a\r\n")
      boundary
      (mime-escape field-name)
      field-value))))


(define (make-file-part field-name file-name content-type in)
  (λ (write-chunk boundary)
    (write-chunk
     (format
      (string-append "--~a\r\n"
                     "Content-Disposition: form-data; name=\"~a\";
filename=\"~a\"\r\n"
                      "Content-Type: ~a\r\n"
                      "\r\n")
      boundary
      (mime-escape field-name)
      (mime-escape file-name)
      content-type))

    (define buffer (make-bytes 4096))
    (let loop ([n (read-bytes-avail! buffer in)])
      (cond
        [(eof-object? n)
         n]
        [else
         (write-chunk (subbytes buffer 0 n))
         (loop (read-bytes-avail! buffer in))]))

    (write-chunk "\r\n")))

(define (multipart-body->data-proc boundary parts)
  (λ (write-chunk)
    (for ([part parts])
      (part write-chunk boundary))
    (write-chunk (format "--~a--\r\n" boundary))))

(define (random-boundary)
  (string-append
   "--------------------------"
   (bytes->hex-string
    (crypto-random-bytes 8))))

-- 
You received this message because you are subscribed to the Google Groups 
"Racket Users" group.
To unsubscribe from this group and stop receiving emails from it, send an email 
to racket-users+unsubscr...@googlegroups.com.
For more options, visit https://groups.google.com/d/optout.

Reply via email to