Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-22 07:09:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Binary-safe send-file.

Browse source
This commit is contained in:
Alex Shinn 2014-04-06 22:17:17 +09:00
parent 46a8b11645
commit 7685d1f097
1 changed files with 7 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
lib/chibi/io/io.scm
View file

@ -175,17 +175,18 @@
(out (if (pair? o) (car o) (current-output-port))) (out (if (pair? o) (car o) (current-output-port)))
(fd (if (port? in) (port-fileno in) in)) (fd (if (port? in) (port-fileno in) in))
(sock (if (port? out) (port-fileno out) out))) (sock (if (port? out) (port-fileno out) out)))
(define (copy-bytes)
(let ((b (read-u8 in)))
(cond ((not (eof-object? b))
(write-u8 b out)
(copy-bytes)))))
(if (and fd sock (is-a-socket? sock)) (if (and fd sock (is-a-socket? sock))
(let lp ((start 0)) (let lp ((start 0))
(let ((res (%send-file fd sock start))) (let ((res (%send-file fd sock start)))
(cond (cond
((not res) (lp start)) ((not res) (copy-bytes))
((not (zero? res)) (lp (+ start res)))))) ((not (zero? res)) (lp (+ start res))))))
(let lp () (copy-bytes))))
(let ((str (read-string 8192 in)))
(cond ((not (eof-object? str))
(display str out)
(lp))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; higher order port operations ;; higher order port operations