(define (buffer-input-port in cap)
  (let* ((fd (condition-case (port->fileno in)
               (exn (exn type) #f)))
         (buf (make-string cap))
         (pos #f)
         (end 0)
         (fill-buffer! (lambda ()
                         (when (or (not pos)
                                   (and (> end 0)
                                        (= pos end)))
                           (if fd
                               (begin
                                 (thread-wait-for-i/o! fd #:input)
                                 (let ((x (file-read fd cap buf)))
                                   (set! end (cadr x))
                                   (set! pos 0)))
                               (begin
                                 (peek-char in)
                                 (let* ((str (read-buffered in))
                                        (len (string-length str)))
                                   ;; Some ports (e.g. those of the
                                   ;; `unix-sockets` egg) don't
                                   ;; implement `read-buffered` and
                                   ;; will always return an empty
                                   ;; string here even after
                                   ;; `peek-char` returned a
                                   ;; char. That's why we can just
                                   ;; replace `buf` with `str` in the
                                   ;; else branch, assuming that
                                   ;; `read-buffered` will
                                   ;; consistently behave like
                                   ;; that. In case `peek-char`
                                   ;; returned #!eof, `read-string!`
                                   ;; will return 0 and thus make this
                                   ;; port produce #!eof, too.
                                   (if (zero? len)
                                       (begin
                                         (set! end (read-string! 1 buf in))
                                         (set! pos 0))
                                       (begin
                                         (set! buf str)
                                         (set! end len)
                                         (set! pos 0)))))))))
         (read-buffer! (lambda (max)
                         (if (and (zero? pos) (<= end max))
                             (begin
                               (set! pos end)
                               buf)
                             (let ((old-pos pos))
                               (set! pos (min end (+ pos max)))
                               (substring buf old-pos pos)))))
         (%read-char (lambda ()
                       (fill-buffer!)
                       (if (zero? end)
                           #!eof
                           (let ((char (string-ref buf pos)))
                             (set! pos (+ pos 1))
                             char))))
         (%char-ready? (lambda ()
                         (and pos
                              (or (< pos end)
                                  (and (char-ready? in)
                                       (begin
                                         (fill-buffer!)
                                         (< pos end)))))))
         (%close (lambda ()
                   (close-input-port in)
                   (set! pos 0)
                   (set! end 0)
                   (set! buf #f)))
         (%peek-char (lambda ()
                       (fill-buffer!)
                       (if (zero? end)
                           #!eof
                           (string-ref buf pos))))
         (%read-string! (lambda (port num out offset)
                          (let loop ((rem num)
                                     (offset offset))
                            (if (zero? rem)
                                num
                                (begin
                                  (fill-buffer!)
                                  (if (zero? end)
                                      (- num rem)
                                      (let* ((str (read-buffer! rem))
                                             (len (string-length str)))
                                        (string-copy! out offset str)
                                        (loop (- rem len)
                                              (+ offset len)))))))))
         (%read-line (lambda (port max)
                       (let loop ((result '())
                                  (rem max))
                         (fill-buffer!)
                         (if (or (zero? end) (and rem (zero? rem)))
                             (reverse-string-append result)
                             (let* ((idx (substring-index "\n" buf pos))
                                    (new-pos (or idx end))
                                    (new-pos (if rem
                                                 (min (+ pos rem) new-pos)
                                                 new-pos))
                                    (old-pos pos)
                                    (new-rem (if idx
                                                 0
                                                 (and rem (- rem (- new-pos old-pos))))))
                               (set! pos (if idx
                                             (+ 1 new-pos)
                                             new-pos))
                               (loop (cons (substring buf old-pos new-pos) result)
                                     new-rem))))))
         (%read-buffered (lambda (port)
                           (cond ((not pos) "")
                                 ((= pos end) "")
                                 (else
                                  (let ((old-pos pos))
                                    (set! pos end)
                                    (substring buf old-pos end)))))))
    (make-input-port %read-char
                     %char-ready?
                     %close
                     %peek-char
                     %read-string!
                     %read-line
                     %read-buffered)))