Hash :
f2c281a4
Author :
Thomas de Grivel
Date :
2019-01-16T17:29:53
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
;;
;; Thot - http web server
;; Copyright 2017,2018 Thomas de Grivel <thoxdg@gmail.com> 0614550127
;;
(in-package :thot)
(defun request-loop-simple (request-stream reply-stream addr)
(with-simple-restart (abort "Abort request loop")
(loop
(when *stop*
(return))
(handler-bind
((warning (lambda (w)
(msg warn w)
(continue)))
(error (lambda (e)
(msg error e)
(unless (debug-p :conditions)
(return)))))
(let* ((req (make-instance 'request :stream request-stream
:remote-addr addr))
(reply (make-instance 'reply :stream reply-stream))
(reader (request-reader req reply))
(result (funcall (the function reader))))
(stream-flush reply-stream)
(unless (eq :keep-alive result)
(return)))))))
(defun fd= (a b)
(= (the unistd:file-descriptor a) (the unistd:file-descriptor b)))
(defun acceptor-loop-select (fd &optional pipe)
(declare (type unistd:file-descriptor fd))
(let ((readfds))
(push fd readfds)
(when pipe
(push (the unistd:file-descriptor pipe) readfds))
(loop
(when *stop*
(return))
(unistd:with-selected (readfds () () 100)
(readable writable errors)
(when (and pipe
(find pipe readable :test #'fd=))
(return))
(when (find fd readable :test #'fd=)
(socket:with-accept (clientfd addr) fd
(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-simple request-stream
reply-stream
(socket:sockaddr-to-string
addr)))))))))
(defun configure-select ()
(setf *acceptor-loop* #'acceptor-loop-select))
(eval-when (:load-toplevel :execute)
(configure-select))
;(trace acceptor-loop-select request-loop-simple cffi-socket:accept unistd:write stream-flush stream-flush-output unistd:close)