simple-chunked-transfer.rkt

#lang racket/base

(define max-chunk-len (sub1 (expt 2 16)))

(define (produce in-port out-port)
  (define buffer (make-bytes max-chunk-len))
  
  (let loop ([chunk-length (read-bytes-avail! buffer in-port 0 max-chunk-len)])
    (cond
      [(eof-object? chunk-length)
       (fprintf (current-error-port) "writing final zero-length chunk\n")
       (write-bytes (integer->integer-bytes 0 2 #f #t) out-port)
       (flush-output out-port)]
      [else
       (fprintf (current-error-port) "writing chunk of ~a bytes\n" chunk-length)
       (write-bytes (integer->integer-bytes chunk-length 2 #f #t) out-port)
       (write-bytes buffer out-port 0 chunk-length)
       (loop (read-bytes-avail! buffer in-port 0 max-chunk-len))])))

(define (consume in-port out-port)
  (define (next-chunk-length)
    (define chunk-len-bstr (read-bytes 2 in-port))
    (integer-bytes->integer chunk-len-bstr #f #t))

  (define buffer (make-bytes max-chunk-len))

  (let loop ([chunk-len (next-chunk-length)])
    (fprintf (current-error-port) "reading a chunk of ~a bytes\n" chunk-len)
    (cond
      [(zero? chunk-len)
       (close-output-port out-port)]
      [else
       (read-bytes! buffer in-port 0 chunk-len)
       (write-bytes buffer out-port 0 chunk-len)
       (loop (next-chunk-length))])))

;;;
(require racket/tcp)

(define test-file "/Users/jaz/Desktop/IMG_1066.png")

(define (run-server)
  (define listener (tcp-listen 6666 4 #t))
  (let loop ()
    (define-values (in out) (tcp-accept listener))
    (with-input-from-file test-file
      (λ ()
        (produce (current-input-port) out)
        (close-input-port in)
        (close-output-port out)))
    (loop)))

(define (run-client)
  (define-values (in out) (tcp-connect "localhost" 6666))
  (with-output-to-file "/tmp/output-file" #:exists 'replace
    (λ ()
      (consume in (current-output-port))))
  (close-input-port in)
  (close-output-port out))

(thread (λ () (run-server)))
(run-client)