blob: 4db0425567246bffb96ac3903d6c9563476efd82 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
;;;; hunchentoot-handle-static-file.lisp -- a rewrite for our purposes
(in-package :hunchentoot)
;;; MY OWN PRIVATE REIMPLEMENTATION MADE TO IGNORE ERRORS WHEN THE
;;; BROWSER CLOSES A SOCKET
(defun hunchentoot:handle-static-file (pathname &optional content-type callback)
"A function which acts like a Hunchentoot handler for the file
denoted by PATHNAME. Sends a content type header corresponding to
CONTENT-TYPE or \(if that is NIL) tries to determine the content type
via the suffix of the file.
CALLBACK is run just before sending the file, and can be used
to set headers or check authorization;
arguments are the filename and the (guessed) content-type."
(when (or (wild-pathname-p pathname)
(not (fad:file-exists-p pathname))
(fad:directory-exists-p pathname))
;; file does not exist
(setf (return-code*) +http-not-found+)
(abort-request-handler))
(unless content-type
(setf content-type (mime-type pathname)))
(let ((time (or (file-write-date pathname)
(get-universal-time)))
bytes-to-send)
(setf (content-type*) (or (and content-type
(maybe-add-charset-to-content-type-header content-type (reply-external-format*)))
"application/octet-stream")
(header-out :last-modified) (rfc-1123-date time)
(header-out :accept-ranges) "bytes")
(handle-if-modified-since time)
(unless (null callback)
(funcall callback pathname content-type))
(with-open-file (file pathname
:direction :input
:element-type 'octet)
(setf bytes-to-send (maybe-handle-range-header file)
(content-length*) bytes-to-send)
(handler-case
(let ((out (send-headers))
(buf (make-array +buffer-length+ :element-type 'octet)))
(loop
(when (zerop bytes-to-send)
(return))
(let* ((chunk-size (min +buffer-length+ bytes-to-send)))
(unless (eql chunk-size (read-sequence buf file :end chunk-size))
(error "can't read from input file"))
(write-sequence buf out :end chunk-size)
(decf bytes-to-send chunk-size)))
(finish-output out))
(error (e)
(format *error-output* "Caught error while sending static file: ~a~%" e)
nil)))))
|
