suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Renaming output-file/partial

Browse Source 
svn: r6433
This commit is contained in:
Jay McCarthy 2007-06-01 14:43:53 +00:00
parent 7b8e565170
commit e5bec6476d
2 changed files with 11 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/web-server/dispatchers/dispatch-files.ss
View File

@ -4,7 +4,6 @@
(lib "plt-match.ss")
(lib "contract.ss"))
(require "dispatch.ss"
"../configuration/responders.ss"
"../private/util.ss"
"../private/mime-types.ss"
"../request-structs.ss"
@ -32,7 +31,8 @@
[(file-exists? path)
(match (headers-assq* #"Range" (request-headers/raw req))
[#f
(output-file conn path method (get-mime-type path))]
(output-file conn path method (get-mime-type path)
0 +inf.0)]
[range
(match (bytes->string/utf-8 (header-value range))
[(regexp "^bytes=(.*)-(.*)$" (list s start end))
@ -44,11 +44,12 @@
(if (string=? "" end)
+inf.0
(string->number end)))
(output-file/partial conn path method (get-mime-type path)
(output-file conn path method (get-mime-type path)
startn endn)]
[r
; XXX: Unhandled range: r
(output-file conn path method (get-mime-type path))])])]
(output-file conn path method (get-mime-type path)
0 +inf.0)])])]
[(directory-exists? path)
(let/ec esc
(for-each (lambda (dir-default)

27
collects/web-server/private/response.ss
View File

@ -12,8 +12,7 @@
(provide/contract
[rename ext:output-response output-response (connection? any/c . -> . any)]
[rename ext:output-response/method output-response/method (connection? response? symbol? . -> . any)]
[rename ext:output-file output-file (connection? path? symbol? bytes? . -> . any)]
[rename ext:output-file/partial output-file/partial (connection? path? symbol? bytes? integer? integer? . -> . any)])
[rename ext:output-file output-file (connection? path? symbol? bytes? integer? integer? . -> . any)])
;; Table 1. head responses:
; ------------------------------------------------------------------------------
@ -180,25 +179,10 @@
data-length
(response/full-body resp/f))))
; XXX Get rid of method restriction
;; **************************************************
;; output-file: connection path symbol bytes -> void
(define (output-file conn file-path method mime-type)
(output-headers conn 200 "Okay"
`(("Content-Length: " ,(file-size file-path)))
(file-or-directory-modify-seconds file-path)
mime-type)
(when (eq? method 'get)
; Give it one second per byte.
(adjust-connection-timeout! conn (file-size file-path))
(with-handlers ([void (lambda (e) (network-error 'output-file (exn-message e)))])
(call-with-input-file file-path
(lambda (i-port) (copy-port i-port (connection-o-port conn)))))))
;; **************************************************
;; output-file/partial: connection path symbol bytes integer integer -> void
(define (output-file/partial conn file-path method mime-type
start end-or-inf)
;; output-file: connection path symbol bytes integer integer -> void
(define (output-file conn file-path method mime-type
start end-or-inf)
(define total-len (file-size file-path))
(define end (if (equal? +inf.0 end-or-inf)
total-len
@ -222,9 +206,6 @@
(define ext:output-file
(ext:wrap output-file))
(define ext:output-file/partial
(ext:wrap output-file/partial))
;; **************************************************
;; output-response/method: connection response/full symbol -> void
;; If it is a head request output headers only, otherwise output as usual