Commit c210e4a9a302b281d293ab0346344acf8ea477c7
2018-06-08T00:59:33
file and mime-type
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 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146
diff --git a/mime.lisp b/mime.lisp
new file mode 100644
index 0000000..d24bf5a
--- /dev/null
+++ b/mime.lisp
@@ -0,0 +1,61 @@
+
+(in-package :thot)
+
+(defpackage :file-extensions
+ #.(let (symbols)
+ (when (find-package :file-extensions)
+ (do-external-symbols (s :file-extensions)
+ (push s symbols)))
+ `(:export ,@symbols)))
+
+(defgeneric ext (x))
+
+(defmethod ext ((x string))
+ (cond ((string= "" x))
+ ((char= #\. (char x 0))
+ (let ((sym (intern x :file-extensions)))
+ (export sym :file-extensions)
+ sym))
+ (t
+ (ext (str #\. x)))))
+
+(defmethod ext ((x symbol))
+ (ext (symbol-name x)))
+
+(defun mime-type-p (symbol)
+ (find #\/ (symbol-name symbol)))
+
+(defvar *mime-types*
+ (make-hash-table :test 'eq))
+
+(defmacro mime-type (ext)
+ `(gethash ,ext *mime-types*))
+
+(defun safe-read (stream eof)
+ (let ((*read-eval* nil)
+ (*readtable* (copy-readtable nil)))
+ (flet ((read-comment (stream char)
+ (declare (ignore char))
+ (cl:read-line stream)
+ (cl:read stream nil nil t)))
+ (set-macro-character #\# #'read-comment)
+ (cl:read stream nil eof))))
+
+(defun load-mime.types (path)
+ (let ((in (cl:open path)))
+ (unwind-protect
+ (let ((eof (gensym))
+ (mime-type nil))
+ (loop
+ (let ((sym (safe-read in eof)))
+ (cond ((eq eof sym) (return))
+ ((not (symbolp sym)))
+ ((mime-type-p sym) (setf mime-type sym))
+ (mime-type (let ((ext (ext sym)))
+ (format t "~S ~S~%" ext mime-type)
+ (setf (mime-type ext)
+ mime-type)))))))
+ (cl:close in))))
+
+#+openbsd
+(load-mime.types "/usr/share/misc/mime.types")
diff --git a/thot.asd b/thot.asd
index 1043f50..70a829d 100644
--- a/thot.asd
+++ b/thot.asd
@@ -28,7 +28,8 @@
"unistd-stream")
:components
((:file "package")
- (:file "thot" :depends-on ("package"))
+ (:file "mime" :depends-on ("package"))
+ (:file "thot" :depends-on ("mime"))
(:file "thot-simple" :depends-on ("thot"))
(:file "thot-threaded" :depends-on ("thot-simple"))
#+linux (:file "thot-epoll" :depends-on ("thot-threaded"))))
diff --git a/thot.lisp b/thot.lisp
index ff0d4fd..2eee9f0 100644
--- a/thot.lisp
+++ b/thot.lisp
@@ -414,11 +414,57 @@ The requested url "
(when (debug-p :directory)
(format t "subdir ~S~%" subdir)
(force-output))
- (when (probe-dir (str local subdir))
- `(directory-index ,local ,remote ,subdir))))))
+ (with-stat (stat nil) local-path
+ (when (s-isdir (stat-mode stat))
+ `(directory-index ,local ,remote ,subdir)))))))
+
+(defun fd-file-size (fd)
+ (let ((end (unistd:lseek fd 0 unistd:+seek-end+)))
+ (unistd:lseek fd 0 unistd:+seek-set+)
+ end))
+
+(defun stream-file-size (stream)
+ (fd-file-size (stream-fd stream)))
+
+(defun path-name (path)
+ (let ((start (position #\/ path :from-end t)))
+ (when start
+ (subseq path (1+ start)))))
+
+(defun path-extension (path)
+ (let* ((name (path-name path))
+ (start (position #\. name :from-end t)))
+ (when start
+ (ext (subseq path start)))))
+
+(defun file (path)
+ (let* ((ext (path-extension path))
+ (type (mime-type ext)))
+ (header "Content-Type: " type)
+ (with-stream (in (unistd-stream-open path :read t))
+ (let ((size (stream-file-size in)))
+ (header "Content-Length: " size))
+ (end-headers)
+ (stream-copy in (reply-stream)))))
+
+(defun file-handler (local remote)
+ (let ((uri (request-uri)))
+ (when (debug-p :file)
+ (format t "uri ~S local ~S remote ~S~%" uri local remote)
+ (force-output))
+ (when (prefix-p remote uri)
+ (let* ((path (subseq uri (length remote)))
+ (local-path (str local path)))
+ (when (debug-p :file)
+ (format t "local-path ~S~%" local-path)
+ (force-output))
+ (with-stat (stat nil) local-path
+ (when (s-isreg (stat-mode stat))
+ `(file ,local-path)))))))
(defparameter *url-handlers*
- '((directory-handler "/" "/")
+ '((file-handler "/var/www/htdocs/" "/")
+ (directory-handler "/var/www/htdocs/" "/")
(404-not-found-handler)))
(defun call (list)