Commit b59a21017887d4da68692815cb35d1b7015fe28f
2018-06-03T22:53:06
add debug info, support clisp
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
diff --git a/package.lisp b/package.lisp
index 3f46cb4..0344e51 100644
--- a/package.lisp
+++ b/package.lisp
@@ -28,6 +28,7 @@
:common-lisp
:dirent
:html-entities
+ :str
:unistd-stream)
#.(cl-stream:shadowing-import-from)
(:export
diff --git a/thot-simple.lisp b/thot-simple.lisp
index e5da306..4c67188 100644
--- a/thot-simple.lisp
+++ b/thot-simple.lisp
@@ -21,17 +21,17 @@
(return))
(when (find fd readable)
(socket:with-accept (clientfd) fd
- (with-stream (request-stream
- (babel-input-stream
- (unistd-input-stream clientfd)))
- (with-stream (reply-stream
- (babel-output-stream
- (multi-buffered-output-stream
- (unistd-output-stream clientfd))))
- (request-loop request-stream reply-stream)))))))))
+ (let ((request-stream
+ (babel-input-stream
+ (unistd-input-stream clientfd)))
+ (reply-stream
+ (babel-output-stream
+ (multi-buffered-output-stream
+ (unistd-output-stream clientfd)))))
+ (request-loop request-stream reply-stream)
+ (stream-flush reply-stream))))))))
#'acceptor-loop-simple-fun)))
(setq *acceptor-loop* 'acceptor-loop-simple)
-;(trace acceptor-loop request-loop read write cffi-socket:accept unistd:close)
-
+;(trace acceptor-loop-simple request-loop cffi-socket:accept unistd:write stream-flush stream-flush-output unistd:close)
diff --git a/thot.asd b/thot.asd
index 5b4998b..111492c 100644
--- a/thot.asd
+++ b/thot.asd
@@ -23,6 +23,7 @@
"cl-stream"
"html-entities"
"rol-uri"
+ "str"
"unistd-stream")
:components
((:file "package")
diff --git a/thot.lisp b/thot.lisp
index 02c861b..5b0ba28 100644
--- a/thot.lisp
+++ b/thot.lisp
@@ -325,9 +325,11 @@
(setf (reply-headers-sent) t)
(header "")))
-(defun content (string)
+(defun content (&rest parts)
(end-headers)
- (stream-write-sequence (reply-stream) string))
+ (walk-str (lambda (x)
+ (stream-write-sequence (reply-stream) x))
+ parts))
(defun 404-not-found ()
(status "404 Not found")
@@ -340,11 +342,6 @@ The requested url ~S was not found on this server."
(defun 404-not-found-handler ()
'(404-not-found))
-(defun str (&rest parts)
- (with-output-to-string (s)
- (dolist (p parts)
- (stream-write-sequence s p))))
-
(defun h (string)
(expand-entities string))
@@ -378,12 +375,7 @@ The requested url ~S was not found on this server."
(defun directory-index (local remote dir)
(header "Content-Type: text/html")
- (content
- (with-output-to-string (out)
- (flet ((w (&rest parts)
- (dolist (part parts)
- (stream-write-sequence out part))))
- (w "<html>
+ (content "<html>
<head>
<title>" (h remote) (h dir) "</title>
</head>
@@ -468,10 +460,10 @@ The requested url ~S was not found on this server."
(defvar *port*)
(defun start (&key (host "0.0.0.0") (port 8000))
- (setq *stop* nil)
(when (debug-p :thot)
- (format t "~&Thot starting on ~A:~A with ~A~%"
- host port *acceptor-loop*))
+ (format t "~&Thot start ~A ~A~%" host port)
+ (force-output))
+ (setq *stop* nil)
(let ((*host* host)
(*port* port))
(socket:with-socket (fd socket:+af-inet+
@@ -479,8 +471,13 @@ The requested url ~S was not found on this server."
0)
(socket:bind-inet fd host port)
(socket:listen fd 128)
+ (when (debug-p :thot)
+ (format t "~A~%" *acceptor-loop*))
(funcall (funcall *acceptor-loop* fd)))))
(defun set-nonblocking (fd)
(let ((flags (fcntl:getfl fd)))
(fcntl:setfl fd (logior fcntl:+o-nonblock+ flags))))
+
+;(trace socket:socket socket:bind socket:bind-inet unistd:close unistd:c-close)
+;(trace header content)