From faf0b97ad184ac447b28f133d9ee4c9534a9328b Mon Sep 17 00:00:00 2001 From: Colin Okay Date: Mon, 31 Oct 2022 16:18:12 -0500 Subject: Fix: hunchentoot:handle-static-file, private (and temp?) version --- hunchentoot-handle-static-file.lisp | 53 +++++++++++++++++++++++++++++++++++++ vampire.asd | 3 ++- 2 files changed, 55 insertions(+), 1 deletion(-) create mode 100644 hunchentoot-handle-static-file.lisp diff --git a/hunchentoot-handle-static-file.lisp b/hunchentoot-handle-static-file.lisp new file mode 100644 index 0000000..4db0425 --- /dev/null +++ b/hunchentoot-handle-static-file.lisp @@ -0,0 +1,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))))) diff --git a/vampire.asd b/vampire.asd index 4679228..f9f9717 100644 --- a/vampire.asd +++ b/vampire.asd @@ -16,7 +16,8 @@ #:ironclad #:jonathan #:swank) - :components ((:file "package") + :components ((:file "hunchentoot-handle-static-file") + (:file "package") (:file "definition-macros") (:file "utilities") (:file "downloader") -- cgit v1.2.3