kmx.io/cl-thot/thot-select.lisp

• Show log

  Commit

• Hash : ddfa2d41
  Author : Thomas de Grivel
  Date : 2018-06-16T14:18:49
  

  thot-simple -> thot-select

Download

• thot-select.lisp

• ;;
  ;;  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)
    (loop
       (when *stop*
         (return))
       (handler-case
           (let* ((req (make-instance 'request :stream request-stream))
                  (reply (make-instance 'reply :stream reply-stream))
                  (reader (request-reader req reply))
                  (result (funcall (the function reader))))
             (unless (eq :keep-alive result)
               (return)))
         (warning (w)
           (msg warn w)
           (continue))
         (error (e)
           (msg error e)
           (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) 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))))))))
  
  (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)
  

Download