Commit 79cff4db4244f2c7222dbedbe415db1f17cb950e
2018-05-30T16:21:51
more compatible stream functions
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 147 148 149 150 151 152
diff --git a/thot-epoll.lisp b/thot-epoll.lisp
index 3eebbb0..34ef075 100644
--- a/thot-epoll.lisp
+++ b/thot-epoll.lisp
@@ -115,7 +115,7 @@
(t
(epoll-del epoll worker))))
(t
- (case (stream-flush-output-buffer stream)
+ (case (stream-flush-output stream)
((nil) nil)
((:eof) (epoll-del epoll worker))
((:non-blocking) :non-blocking)
diff --git a/thot.lisp b/thot.lisp
index cf30e21..527b7f7 100644
--- a/thot.lisp
+++ b/thot.lisp
@@ -152,7 +152,8 @@
(declare (type symbol name element))
(let ((state (gensym "STATE-")))
`(,name ()
- (multiple-value-bind (,element ,state) (read ,stream)
+ (multiple-value-bind (,element ,state)
+ (stream-read ,stream)
(case ,state
((nil) ,@body)
((:eof) :eof)
@@ -174,26 +175,26 @@
(name "")
(value ""))
(flet ((get-buffer ()
- (prog1 (string-output-stream-string buffer)
+ (prog1 (sequence-output-stream-sequence buffer)
(sequence-output-stream-reset buffer))))
(with-readers-for stream
((method (char)
(cond ((char= #\Space char)
(setf (request-method% request) (get-buffer))
(target))
- (t (write buffer char)
+ (t (stream-write buffer char)
(method))))
(target (char)
(cond ((char= #\Space char)
(setf (request-target% request) (get-buffer))
(version))
- (t (write buffer char)
+ (t (stream-write buffer char)
(target))))
(version (char)
(cond ((char= #\Return char)
(setf (request-http-version% request) (get-buffer))
(version-lf))
- (t (write buffer char)
+ (t (stream-write buffer char)
(version))))
(version-lf (char)
(cond ((char= #\Newline char)
@@ -206,23 +207,23 @@
(t (error "Missing request line LF"))))
(next-header (char)
(cond ((char= #\Return char) (end-of-headers))
- (t (write buffer char)
+ (t (stream-write buffer char)
(header-name))))
(header-name (char)
(cond ((char= #\: char)
(setq name (get-buffer))
(header-spaces))
- (t (write buffer char)
+ (t (stream-write buffer char)
(header-name))))
(header-spaces (char)
(cond ((char= #\Space char) (header-spaces))
- (t (write buffer char)
+ (t (stream-write buffer char)
(header-value))))
(header-value (char)
(cond ((char= #\Return char)
(setq value (get-buffer))
(header-lf))
- (t (write buffer char)
+ (t (stream-write buffer char)
(header-value))))
(header-lf (char)
(cond ((char= #\Newline char)
@@ -299,10 +300,10 @@
(error 'status-already-sent status line)))
(setf (reply-status) line)
(let ((stream (reply-stream)))
- (write-sequence stream (request-http-version))
- (write stream #\Space)
- (write-sequence stream line)
- (write-sequence stream +crlf+)))
+ (stream-write-sequence stream (request-http-version))
+ (stream-write stream #\Space)
+ (stream-write-sequence stream line)
+ (stream-write-sequence stream +crlf+)))
(defun header (line)
(unless (reply-status)
@@ -316,8 +317,8 @@
(return))
(pop headers))))
(let ((stream (reply-stream)))
- (write-sequence stream line)
- (write-sequence stream +crlf+)))
+ (stream-write-sequence stream line)
+ (stream-write-sequence stream +crlf+)))
(defun end-headers ()
(unless (reply-headers-sent)
@@ -326,7 +327,7 @@
(defun content (string)
(end-headers)
- (write-sequence (reply-stream) string))
+ (stream-write-sequence (reply-stream) string))
(defun 404-not-found ()
(status "404 Not found")
@@ -342,7 +343,7 @@ The requested url ~S was not found on this server."
(defun str (&rest parts)
(with-output-to-string (s)
(dolist (p parts)
- (write-sequence s p))))
+ (stream-write-sequence s p))))
(defun h (string)
(expand-entities string))
@@ -353,9 +354,10 @@ 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 (o)
+ (with-output-to-string (out)
(flet ((w (&rest parts)
- (write-str o parts)))
+ (dolist (part parts)
+ (stream-write-sequence out part))))
(w "<html>
<head>
<title>" (h dir) "</title>
@@ -416,7 +418,7 @@ The requested url ~S was not found on this server."
(when (debug-p (or :thot :http))
(format t "~&~S -> ~S~%" handler-form handler))
(call handler)
- (flush (reply-stream% reply))
+ (stream-flush (reply-stream% reply))
(return)))))
(if (string-equal "keep-alive" (request-header 'connection))
:keep-alive