├── .github ├── FUNDING.yml └── workflows │ └── ci.yml ├── images ├── benchmark.png └── benchmark-multicore.png ├── benchmark ├── unicorn │ ├── config.rb │ ├── run │ ├── app.ru │ └── nginx.conf ├── racket │ ├── run │ ├── hello.rkt │ └── typed-hello.rkt ├── woo │ ├── run │ └── hello.ros ├── go │ ├── run │ └── hello.go ├── phusion-passenger │ └── run ├── tornado │ └── run ├── wookie │ └── run ├── run-benchmark ├── hunchentoot │ └── run └── node │ └── run ├── clack-handler-woo.asd ├── .gitignore ├── woo-test.asd ├── t ├── woo.lisp ├── ipv6.lisp └── generate-certificates.sh ├── src ├── specials.lisp ├── util.lisp ├── syscall │ ├── types.lisp │ ├── package.lisp │ └── main.lisp ├── ev │ ├── condition.lisp │ ├── util.lisp │ ├── event-loop.lisp │ ├── socket.lisp │ └── tcp.lisp ├── queue.lisp ├── ssl.lisp ├── ev.lisp ├── signal.lisp ├── llsocket │ ├── cffi.lisp │ ├── package.lisp │ └── grovel.lisp ├── worker.lisp ├── response.lisp └── woo.lisp ├── LICENSE.txt ├── .travis.yml ├── woo.asd ├── README.md └── benchmark.md /.github/FUNDING.yml: -------------------------------------------------------------------------------- 1 | github: [fukamachi] 2 | -------------------------------------------------------------------------------- /images/benchmark.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fukamachi/woo/HEAD/images/benchmark.png -------------------------------------------------------------------------------- /benchmark/unicorn/config.rb: -------------------------------------------------------------------------------- 1 | worker_processes 4 2 | preload_app true 3 | listen "/tmp/app.sock" 4 | -------------------------------------------------------------------------------- /images/benchmark-multicore.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/fukamachi/woo/HEAD/images/benchmark-multicore.png -------------------------------------------------------------------------------- /benchmark/racket/run: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | BASEDIR=$(dirname $0) 4 | WORKER=${1:-1} 5 | 6 | exec racket "$BASEDIR/hello.rkt" -------------------------------------------------------------------------------- /benchmark/unicorn/run: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | BASEDIR=$(dirname $0) 4 | exec unicorn -E production -c "$BASEDIR/config.rb" "$BASEDIR/app.ru" -------------------------------------------------------------------------------- /benchmark/woo/run: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | BASEDIR=$(dirname $0) 4 | WORKER=${1:-1} 5 | 6 | exec "$BASEDIR/hello.ros" --worker "$WORKER" 7 | -------------------------------------------------------------------------------- /benchmark/go/run: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | BASEDIR=$(dirname $0) 4 | WORKER=${1:-1} 5 | 6 | go build -o "$BASEDIR/hello" "$BASEDIR/hello.go" 7 | exec "$BASEDIR/hello" --worker "$WORKER" -------------------------------------------------------------------------------- /benchmark/phusion-passenger/run: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | BASEDIR=$(dirname $0) 4 | WORKER=${1:-1} 5 | exec passenger start -e production -R "$BASEDIR/../unicorn/app.ru" --max-pool-size "$WORKER" --min-instances "$WORKER" -------------------------------------------------------------------------------- /clack-handler-woo.asd: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage clack-handler-woo-asd 3 | (:use :cl :asdf)) 4 | (in-package :clack-handler-woo-asd) 5 | 6 | (defsystem clack-handler-woo 7 | :depends-on (:woo)) 8 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.dx32fsl 3 | *.dx64fsl 4 | *.lx32fsl 5 | *.lx64fsl 6 | *.x86f 7 | *~ 8 | .#* 9 | roswell/woo 10 | benchmark/go/hello 11 | benchmark/benchmark.log 12 | .qlot/ 13 | qlfile 14 | qlfile.lock 15 | t/certs/ 16 | -------------------------------------------------------------------------------- /woo-test.asd: -------------------------------------------------------------------------------- 1 | (defsystem "woo-test" 2 | :depends-on ("woo" 3 | "clack-test" 4 | "rove") 5 | :components 6 | ((:file "t/woo") 7 | (:file "t/ipv6")) 8 | :perform (test-op (op c) (symbol-call '#:rove '#:run c))) 9 | -------------------------------------------------------------------------------- /benchmark/unicorn/app.ru: -------------------------------------------------------------------------------- 1 | # -*- mode: ruby -*- 2 | # 3 | # unicorn -E production -c benchmark/unicorn/config.rb benchmark/unicorn/app.ru 4 | # 5 | # http://localhost:8080/ 6 | 7 | class HelloApp 8 | def call(env) 9 | [ 10 | 200, 11 | {}, 12 | ['Hello, World'] 13 | ] 14 | end 15 | end 16 | run HelloApp.new 17 | -------------------------------------------------------------------------------- /benchmark/unicorn/nginx.conf: -------------------------------------------------------------------------------- 1 | worker_processes 4; 2 | 3 | events { 4 | worker_connections 1024; 5 | } 6 | 7 | http { 8 | access_log off; 9 | sendfile on; 10 | tcp_nopush on; 11 | tcp_nodelay on; 12 | etag off; 13 | upstream app { 14 | server unix:/tmp/app.sock; 15 | } 16 | server { 17 | listen 5000; 18 | location / { 19 | proxy_pass http://app; 20 | } 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /benchmark/go/hello.go: -------------------------------------------------------------------------------- 1 | package main 2 | 3 | import ( 4 | "fmt" 5 | "net/http" 6 | "runtime" 7 | "flag" 8 | ) 9 | 10 | func hello(w http.ResponseWriter, r *http.Request) { 11 | fmt.Fprintf(w, "Hello, World") 12 | } 13 | 14 | func main() { 15 | worker := flag.Int("worker", 1, "worker count") 16 | flag.Parse() 17 | runtime.GOMAXPROCS(*worker) 18 | 19 | http.HandleFunc("/", hello) 20 | http.ListenAndServe(":5000", nil) 21 | } 22 | -------------------------------------------------------------------------------- /benchmark/tornado/run: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | # -*- mode: python -*- 3 | import tornado.ioloop 4 | import tornado.web 5 | 6 | class MainHandler(tornado.web.RequestHandler): 7 | def get(self): 8 | self.write("Hello, World") 9 | 10 | application = tornado.web.Application([ 11 | (r"/", MainHandler), 12 | ]) 13 | 14 | if __name__ == "__main__": 15 | application.listen(5000) 16 | tornado.ioloop.IOLoop.instance().start() 17 | -------------------------------------------------------------------------------- /benchmark/wookie/run: -------------------------------------------------------------------------------- 1 | #|-*- mode:lisp -*-|# 2 | #| 3 | exec ros -Q -- $0 "$@" 4 | |# 5 | 6 | ;; 7 | ;; http://localhost:5000/ 8 | 9 | (ql:quickload :wookie :silent t) 10 | 11 | (defpackage :wookie-test 12 | (:use :cl :wookie)) 13 | (in-package :wookie-test) 14 | 15 | (defroute (:get "/") (req res) 16 | (send-response res :body "Hello, World")) 17 | 18 | (defun main (&rest argv) 19 | (declare (ignore argv)) 20 | (as:with-event-loop (:catch-app-errors t) 21 | (start-server (make-instance 'listener :port 5000)))) 22 | -------------------------------------------------------------------------------- /t/woo.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage woo-test 3 | (:use :cl 4 | :rove)) 5 | (in-package :woo-test) 6 | 7 | (deftest woo-server-tests 8 | (clack.test.suite:run-server-tests :woo)) 9 | 10 | (deftest woo-ssl-server-tests 11 | (let ((clack.test:*clackup-additional-args* 12 | '(:ssl-cert-file #P"t/certs/localhost.crt" 13 | :ssl-key-file #P"t/certs/localhost.key")) 14 | (dex:*not-verify-ssl* t) 15 | (clack.test:*use-https* t)) 16 | (clack.test.suite:run-server-tests :woo))) 17 | -------------------------------------------------------------------------------- /src/specials.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage woo.specials 3 | (:use :cl) 4 | (:export :*app* 5 | :*debug* 6 | :*listener* 7 | :*cluster* 8 | :default-thread-bindings)) 9 | (in-package :woo.specials) 10 | 11 | (defvar *app* nil) 12 | (defvar *debug* nil) 13 | (defun default-thread-bindings () 14 | `((*standard-output* . ,*standard-output*) 15 | (*error-output* . ,*error-output*) 16 | (*app* . ,*app*) 17 | (*debug* . ,*debug*))) 18 | 19 | (defvar *listener* nil) 20 | (defvar *cluster* nil) 21 | -------------------------------------------------------------------------------- /benchmark/run-benchmark: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | BENCHMARK_DIR=$(dirname $0) 4 | 5 | REPEAT=${REPEAT:-3} 6 | SERVER_PORT=${SERVER_PORT:-5000} 7 | THREADS=${THREADS:-4} 8 | CONNECTIONS=${CONNECTIONS:-10} 9 | 10 | echo "$ $@" 11 | $@ >>"$BENCHMARK_DIR/benchmark.log" 2>&1 & 12 | SERVER_PID=$! 13 | 14 | while true; do 15 | nc -z 127.0.0.1 $SERVER_PORT >/dev/null 2>&1 && break 16 | sleep 1 17 | done 18 | 19 | echo "Started a server ($@) at $SERVER_PID." 20 | 21 | for i in `seq 1 $REPEAT`; do 22 | echo "\nRunning wrk ($i/$REPEAT)..." 23 | wrk -c "$CONNECTIONS" -t "$THREADS" -d 10 "http://127.0.0.1:$SERVER_PORT" 24 | done 25 | 26 | kill "$SERVER_PID" 27 | -------------------------------------------------------------------------------- /src/util.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage woo.util 3 | (:use #:cl)) 4 | (in-package :woo.util) 5 | 6 | (defun integer-string-p (string) 7 | (declare (type #+ecl string #-ecl simple-string string) 8 | (optimize (speed 3) (safety 2))) 9 | (when (zerop (length string)) 10 | (return-from integer-string-p nil)) 11 | (locally (declare (optimize (safety 0))) 12 | (let ((end (length string))) 13 | (declare (type integer end)) 14 | (do ((i 0 (1+ i))) 15 | ((= i end) t) 16 | (declare (type integer i)) 17 | (let ((char (aref string i))) 18 | (declare (type character char)) 19 | (unless (char<= #\0 char #\9) 20 | (return-from integer-string-p nil))))))) 21 | -------------------------------------------------------------------------------- /src/syscall/types.lisp: -------------------------------------------------------------------------------- 1 | (include "sys/types.h" "sys/fcntl.h" "errno.h") 2 | #+(or freebsd bsd) 3 | (include "sys/socket.h") 4 | 5 | (in-package :woo.syscall) 6 | 7 | (ctype size-t "size_t") 8 | (ctype ssize-t "ssize_t") 9 | (ctype pid-t "pid_t") 10 | (ctype off-t "off_t") 11 | (ctype mode-t "mode_t") 12 | 13 | #+(or freebsd bsd) 14 | (constant (+SF-MNOWAIT+ "SF_MNOWAIT")) 15 | 16 | (constant (+O-RDONLY+ "O_RDONLY")) 17 | (constant (EWOULDBLOCK "EWOULDBLOCK")) 18 | (constant (EPIPE "EPIPE")) 19 | (constant (EINTR "EINTR")) 20 | (constant (EPROTO "EPROTO")) 21 | (constant (ECONNABORTED "ECONNABORTED")) 22 | (constant (ECONNREFUSED "ECONNREFUSED")) 23 | (constant (ECONNRESET "ECONNRESET")) 24 | (constant (ENOTCONN "ENOTCONN")) 25 | (constant (EAGAIN "EAGAIN")) 26 | -------------------------------------------------------------------------------- /t/ipv6.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage woo-test.ipv6 3 | (:use :cl 4 | :rove) 5 | (:import-from :clack.test 6 | :testing-app 7 | :*clackup-additional-args*) 8 | (:import-from :clack.test.suite 9 | :localhost)) 10 | (in-package :woo-test.ipv6) 11 | 12 | (let ((clack.test:*clackup-additional-args* '(:address "::")) 13 | (clack.test:*clack-test-handler* :woo)) 14 | (deftest ipv6-tests 15 | (testing-app "IPv6" 16 | (lambda (env) 17 | (declare (ignore env)) 18 | '(200 (:content-type "text/plain") ("Hello" "World"))) 19 | (multiple-value-bind (body status) 20 | (dex:get (localhost)) 21 | (ok (eql status 200)) 22 | (ok (equal body "HelloWorld")))))) 23 | -------------------------------------------------------------------------------- /benchmark/hunchentoot/run: -------------------------------------------------------------------------------- 1 | #|-*- mode:lisp -*-|# 2 | #| 3 | exec ros -Q -- $0 "$@" 4 | |# 5 | 6 | ;; 7 | ;; http://localhost:5000/ 8 | 9 | (ql:quickload :hunchentoot :silent t) 10 | 11 | (hunchentoot:define-easy-handler (say-hello :uri "/") () 12 | (setf (hunchentoot:content-type*) "text/plain") 13 | "Hello, World") 14 | 15 | (defun main (&optional multi-threaded-p &rest argv) 16 | (declare (ignore argv)) 17 | (hunchentoot:start (apply #'make-instance 'hunchentoot:easy-acceptor 18 | :port 5000 19 | :access-log-destination nil 20 | (if multi-threaded-p 21 | '() 22 | (list :taskmaster (make-instance 'hunchentoot:single-threaded-taskmaster))))) 23 | (loop (sleep 60))) 24 | -------------------------------------------------------------------------------- /src/ev/condition.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage woo.ev.condition 3 | (:use :cl) 4 | (:export :woo-error 5 | :tcp-error 6 | :socket-closed 7 | :os-error)) 8 | (in-package :woo.ev.condition) 9 | 10 | (define-condition woo-error (error) 11 | ((description :initarg :description) 12 | (code :initarg :code 13 | :initform nil)) 14 | (:report (lambda (condition stream) 15 | (with-slots (description code) condition 16 | (format stream 17 | "~A~:[~;~:* (Code: ~A)~]" 18 | description code))))) 19 | 20 | (define-condition tcp-error (woo-error) ()) 21 | (define-condition socket-closed (tcp-error) 22 | ((description :initform "socket is already closed"))) 23 | 24 | (define-condition os-error (woo-error) ()) 25 | -------------------------------------------------------------------------------- /t/generate-certificates.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | mkdir t/certs 4 | cd t/certs 5 | 6 | openssl genrsa -out localCA.key 2048 7 | openssl req -batch -new -key localCA.key -out localCA.csr \ 8 | -subj "/C=JP/ST=Tokyo/L=Chuo-ku/O=\"Woo\"/OU=Development/CN=localhost" 9 | openssl x509 -req -days 3650 -signkey localCA.key -in localCA.csr -out localCA.crt 10 | openssl x509 -text -noout -in localCA.crt 11 | openssl genrsa -out localhost.key 2048 12 | openssl req -batch -new -key localhost.key -out localhost.csr \ 13 | -subj "/C=JP/ST=Tokyo/L=Chuo-ku/O=\"Woo\"/OU=Development/CN=localhost" 14 | echo 'subjectAltName = DNS:localhost, DNS:localhost.localdomain, IP:127.0.0.1, DNS:app, DNS:app.localdomain' > localhost.csx 15 | openssl x509 -req -days 1825 -CA localCA.crt -CAkey localCA.key -CAcreateserial -in localhost.csr -extfile localhost.csx -out localhost.crt 16 | -------------------------------------------------------------------------------- /src/syscall/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage woo.syscall 3 | (:nicknames :wsys) 4 | (:use :cl) 5 | (:shadow :close 6 | :write 7 | :read 8 | :open) 9 | (:import-from :cffi 10 | :defcfun) 11 | (:export :close 12 | :write 13 | :read 14 | :kill 15 | :chmod 16 | :set-fd-nonblock 17 | :EWOULDBLOCK 18 | :EPIPE 19 | :EINTR 20 | :EPROTO 21 | :ECONNABORTED 22 | :ECONNREFUSED 23 | :ECONNRESET 24 | :ENOTCONN 25 | :EAGAIN 26 | 27 | :fork 28 | :memset 29 | :bzero 30 | 31 | :errno 32 | 33 | :getpid 34 | :getppid 35 | 36 | :sendfile 37 | :open)) 38 | (in-package :woo.syscall) 39 | -------------------------------------------------------------------------------- /benchmark/node/run: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env nodejs 2 | // https://github.com/jakubkulhan/hit-server-bench/blob/master/node/main.js 3 | // 4 | // http://localhost:5000/ 5 | 6 | var cluster = require('cluster'); 7 | var http = require('http'); 8 | 9 | process.argv[process.argv.length - 1] 10 | var workerCount = parseInt(process.argv[process.argv.length - 1]); 11 | 12 | var handler = function (req, res) { 13 | res.writeHead(200); 14 | return res.end("Hello, World"); 15 | } 16 | 17 | if (!isNaN(workerCount)) { 18 | if (cluster.isMaster) { 19 | for (var i = 0; i < workerCount; i++) { 20 | cluster.fork(); 21 | } 22 | 23 | cluster.on('exit', function(worker, code, signal) { 24 | console.log('worker ' + worker.process.pid + ' died'); 25 | }); 26 | } else { 27 | http.createServer(handler).listen(5000); 28 | } 29 | } 30 | else { 31 | http.createServer(handler).listen(5000); 32 | } 33 | -------------------------------------------------------------------------------- /src/queue.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage woo.queue 3 | (:use :cl) 4 | #+sbcl 5 | (:import-from :sb-concurrency 6 | :make-queue 7 | :queue-empty-p 8 | :enqueue 9 | :dequeue) 10 | (:export :make-queue 11 | :queue-empty-p 12 | :enqueue 13 | :dequeue)) 14 | (in-package :woo.queue) 15 | 16 | #-sbcl 17 | (progn 18 | (defstruct queue 19 | (raw-queue (cl-speedy-queue:make-queue 128)) 20 | (lock (bt2:make-lock))) 21 | 22 | (defun enqueue (object queue) 23 | (with-slots (raw-queue lock) queue 24 | (bt2:with-lock-held (lock) 25 | (cl-speedy-queue:enqueue object raw-queue)))) 26 | 27 | (defun dequeue (queue) 28 | (with-slots (raw-queue lock) queue 29 | (bt2:with-lock-held (lock) 30 | (cl-speedy-queue:dequeue raw-queue)))) 31 | 32 | (defun queue-empty-p (queue) 33 | (cl-speedy-queue:queue-empty-p (queue-raw-queue queue)))) 34 | -------------------------------------------------------------------------------- /benchmark/racket/hello.rkt: -------------------------------------------------------------------------------- 1 | #lang racket/base 2 | 3 | (require 4 | (only-in web-server/http 5 | response/full) 6 | (only-in web-server/http/request-structs 7 | make-header) 8 | (only-in web-server/servlet-env 9 | serve/servlet)) 10 | 11 | (define fixed-response 12 | (response/full 13 | 200 ;; code 14 | (string->bytes/utf-8 "OK") ;; message 15 | (current-seconds) ;; timestamp in s 16 | #f ;; mime or #f 17 | (list (make-header ;; list of headers 18 | (string->bytes/utf-8 "Server") 19 | (string->bytes/utf-8 "Racket"))) 20 | (list ;; body: list of bytes 21 | (string->bytes/utf-8 "Hello world!\n")))) 22 | 23 | ;; hello: request? -> response? 24 | (define (hello req) 25 | fixed-response) 26 | 27 | (module+ main 28 | (serve/servlet 29 | hello 30 | #:port 5000 31 | #:command-line? #t 32 | #:servlet-regexp #rx"")) 33 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Copyright 2014 Eitaro Fukamachi & contributers 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 4 | 5 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 8 | -------------------------------------------------------------------------------- /.github/workflows/ci.yml: -------------------------------------------------------------------------------- 1 | name: CI 2 | 3 | on: [push, pull_request] 4 | 5 | jobs: 6 | test: 7 | name: ${{ matrix.lisp }} 8 | runs-on: ubuntu-latest 9 | strategy: 10 | matrix: 11 | lisp: [sbcl-bin] 12 | 13 | steps: 14 | - uses: actions/checkout@v4 15 | - name: Install dependencies from APT 16 | run: sudo apt-get install -y libev-dev gcc libc6-dev 17 | - name: Generate server certificates 18 | run: sh ./t/generate-certificates.sh 19 | - name: Install Roswell 20 | env: 21 | LISP: ${{ matrix.lisp }} 22 | ROSWELL_INSTALL_DIR: /usr 23 | run: | 24 | curl -L https://raw.githubusercontent.com/roswell/roswell/master/scripts/install-for-ci.sh | sh 25 | - name: Install Ultralisp 26 | run: ros -e '(ql-dist:install-dist "http://dist.ultralisp.org/" :prompt nil)' 27 | - name: Install Rove 28 | run: ros install rove 29 | - name: Run tests 30 | env: 31 | LISP: ${{ matrix.lisp }} 32 | run: | 33 | PATH="~/.roswell/bin:$PATH" 34 | rove woo-test.asd 35 | -------------------------------------------------------------------------------- /src/ssl.lisp: -------------------------------------------------------------------------------- 1 | (defpackage woo.ssl 2 | (:use :cl) 3 | (:import-from :cl+ssl 4 | :with-new-ssl 5 | :install-nonblock-flag 6 | :ssl-set-fd 7 | :ssl-set-accept-state 8 | :*default-cipher-list* 9 | :ssl-set-cipher-list 10 | :with-pem-password 11 | :install-key-and-cert) 12 | (:import-from :woo.ev.socket 13 | :socket-fd 14 | :socket-ssl-handle) 15 | (:export :init-ssl-handle)) 16 | (in-package :woo.ssl) 17 | 18 | (defun init-ssl-handle (socket ssl-cert-file ssl-key-file ssl-key-password) 19 | (let ((client-fd (socket-fd socket))) 20 | (with-new-ssl (handle) 21 | (install-nonblock-flag client-fd) 22 | (ssl-set-fd handle client-fd) 23 | (ssl-set-accept-state handle) 24 | (when *default-cipher-list* 25 | (ssl-set-cipher-list handle *default-cipher-list*)) 26 | (setf (socket-ssl-handle socket) handle) 27 | (with-pem-password ((or ssl-key-password "")) 28 | (install-key-and-cert 29 | handle 30 | ssl-key-file 31 | ssl-cert-file)) 32 | socket))) 33 | -------------------------------------------------------------------------------- /benchmark/woo/hello.ros: -------------------------------------------------------------------------------- 1 | #|-*- mode:lisp -*-|# 2 | #| 3 | exec ros -Q -- $0 "$@" 4 | |# 5 | 6 | (ql:quickload '(:uiop :woo) :silent t) 7 | 8 | (defun starts-with (x starts) 9 | (and (<= (length starts) (length x)) 10 | (string= x starts :end1 (length starts)))) 11 | 12 | (defun parse-argv (args) 13 | (flet ((parse-int-value (option value) 14 | (handler-case (parse-integer value) 15 | (error (e) 16 | (error "Invalid value for ~S: ~S~% ~A" option value e))))) 17 | (loop for option = (pop args) 18 | for value = (pop args) 19 | while option 20 | if (not (starts-with option "--")) 21 | do (error "Invalid option: ~S" option) 22 | else 23 | if (equal option "--worker") 24 | append (list :worker-num (parse-int-value option value)) 25 | else 26 | if (equal option "--port") 27 | append (list :port (parse-int-value option value)) 28 | else 29 | do (error "Unknown option: ~S" option)))) 30 | 31 | (defun main (&rest argv) 32 | (let ((args (parse-argv argv))) 33 | (apply #'woo:run (lambda (env) 34 | (declare (ignore env)) 35 | '(200 () ("Hello, World"))) 36 | :debug nil 37 | args))) 38 | -------------------------------------------------------------------------------- /src/ev/util.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage woo.ev.util 3 | (:use :cl) 4 | (:import-from :lev 5 | :ev-io 6 | :fd) 7 | (:import-from :cffi 8 | :defcallback 9 | :foreign-slot-value) 10 | (:export :io-fd 11 | :define-c-callback)) 12 | (in-package :woo.ev.util) 13 | 14 | (declaim (inline io-fd)) 15 | (defun io-fd (io) 16 | (cffi:foreign-slot-value io '(:struct lev:ev-io) 'lev::fd)) 17 | 18 | ;; Copied from cl-async-util 19 | ;; Copyright (c) 2012 Lyon Bros. Enterprises, LLC 20 | ;; https://github.com/orthecreedence/cl-async/blob/master/LICENSE 21 | (defmacro define-c-callback (name return-val (&rest args) &body body) 22 | "Define a top-level function with the given and also define a C callback that 23 | calls the function directly. The idea is that CFFI callbacks aren't directly 24 | callable/debuggable, but it's obnoxious to have to define and callback *and* 25 | a function right next to each other." 26 | (let ((arg-names (loop for x in args collect (car x)))) 27 | `(progn 28 | (declaim (inline ,name)) 29 | (defun ,name ,arg-names 30 | ,@body) 31 | (prog1 32 | (cffi:defcallback ,name ,return-val ,args 33 | (,name ,@arg-names)) 34 | (declaim (notinline ,name)))))) 35 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: common-lisp 2 | sudo: required 3 | 4 | os: 5 | - linux 6 | - osx 7 | 8 | env: 9 | global: 10 | - PATH=~/.roswell/bin:$PATH 11 | - ROSWELL_BRANCH=release 12 | - ROSWELL_INSTALL_DIR=$HOME/.roswell 13 | - WRK_VERSION=4.0.2 14 | matrix: 15 | - LISP=sbcl 16 | 17 | addons: 18 | apt: 19 | packages: 20 | - libev-dev 21 | 22 | install: 23 | - if [ "$TRAVIS_OS_NAME" = "osx" ]; then brew install libev; fi 24 | - curl -L https://raw.githubusercontent.com/snmsts/roswell/$ROSWELL_BRANCH/scripts/install-for-ci.sh | sh 25 | 26 | # wrk, go for benchmarking 27 | - if [ "$TRAVIS_OS_NAME" = "linux" ]; then 28 | curl -L "https://github.com/wg/wrk/archive/$WRK_VERSION.tar.gz" | tar xzf -; 29 | mkdir -p "$ROSWELL_INSTALL_DIR/bin"; 30 | (cd "wrk-$WRK_VERSION/" && make && cp wrk "$ROSWELL_INSTALL_DIR/bin"); 31 | sudo apt-get install golang; 32 | fi 33 | 34 | - ros install rove 35 | - ros install cffi-grovel 36 | - ros install fukamachi/fast-http 37 | - ros install fukamachi/clack 38 | - ros install fukamachi/dexador 39 | 40 | before_script: 41 | - ros run -- --version 42 | 43 | script: 44 | - ros -s woo-test 45 | - rove woo-test.asd 46 | - if [ "$TRAVIS_OS_NAME" = "linux" ]; then benchmark/run-benchmark benchmark/woo/run; fi 47 | - if [ "$TRAVIS_OS_NAME" = "linux" ]; then benchmark/run-benchmark benchmark/go/run; fi 48 | -------------------------------------------------------------------------------- /src/ev.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage woo.ev 3 | (:nicknames :wev) 4 | (:use :cl) 5 | (:import-from :woo.ev.tcp 6 | :tcp-server 7 | :close-tcp-server 8 | :with-sockaddr 9 | :*connection-timeout*) 10 | (:import-from :woo.ev.socket 11 | :socket 12 | :socket-open-p 13 | :socket-remote-addr 14 | :socket-remote-port 15 | :socket-data 16 | :close-socket 17 | :write-socket-data 18 | :write-socket-byte 19 | :write-socket-stream 20 | :flush-buffer 21 | :with-async-writing) 22 | (:import-from :woo.ev.event-loop 23 | :with-event-loop 24 | :*buffer-size* 25 | :*evloop* 26 | :*data-registry*) 27 | (:import-from :woo.ev.condition 28 | :tcp-error 29 | :socket-closed) 30 | (:export :socket 31 | :socket-open-p 32 | :socket-remote-addr 33 | :socket-remote-port 34 | :with-event-loop 35 | :tcp-server 36 | :close-tcp-server 37 | :write-socket-data 38 | :write-socket-byte 39 | :write-socket-stream 40 | :with-async-writing 41 | :socket-data 42 | :close-socket 43 | :*buffer-size* 44 | :*connection-timeout* 45 | :*evloop* 46 | :*data-registry* 47 | :with-sockaddr 48 | 49 | ;; conditions 50 | :tcp-error 51 | :socket-closed)) 52 | (in-package :woo.ev) 53 | -------------------------------------------------------------------------------- /benchmark/racket/typed-hello.rkt: -------------------------------------------------------------------------------- 1 | #lang typed/racket/base 2 | 3 | (require/typed net/url-structs 4 | [#:struct path/param 5 | ([path : (U String (U 'up 'same))] 6 | [param : (Listof String)])] 7 | [#:struct url 8 | ([scheme : (U False String)] 9 | [user : (U False String)] 10 | [host : (U False String)] 11 | [port : (U False Exact-Nonnegative-Integer)] 12 | [path-absolute? : Boolean] 13 | [path : (Listof path/param)] 14 | [query : (Listof (Pairof Symbol (U False String)))] 15 | [fragment : (U False String)])]) 16 | (require/typed web-server/http 17 | [#:struct header 18 | ([field : Bytes] 19 | [value : Bytes])] 20 | [#:struct binding 21 | ([id : Bytes])] 22 | [#:struct request 23 | ([method : Bytes] 24 | [uri : url] 25 | [headers/raw : (Listof header)] 26 | [bindings/raw-promise : (Promise (Listof binding))] 27 | [post-data/raw : (U False Bytes)] 28 | [host-ip : String] 29 | [host-port : Number] 30 | [client-ip : String])] 31 | [#:struct response 32 | ([code : Number] 33 | [message : Bytes] 34 | [seconds : Number] 35 | [mime : (U False Bytes)] 36 | [headers : (Listof Bytes)] 37 | [output : (-> Boolean Any)])] 38 | [response/output (-> (-> Output-Port Void) response)]) 39 | 40 | 41 | (: hello (-> request response)) 42 | (define (hello req) 43 | (response/output (lambda (out) (display "Hello world!\n" out)))) 44 | 45 | (module+ main 46 | (require/typed web-server/servlet-env 47 | [serve/servlet (-> (-> request response) 48 | (#:port Number) 49 | (#:command-line? Boolean) 50 | (#:servlet-regexp Regexp) 51 | Void)]) 52 | (serve/servlet 53 | hello 54 | #:port 5000 55 | #:command-line? #t 56 | #:servlet-regexp #rx"")) 57 | -------------------------------------------------------------------------------- /src/signal.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage woo.signal 3 | (:use :cl 4 | :woo.specials) 5 | (:import-from :woo.worker 6 | :stop-cluster 7 | :kill-cluster) 8 | (:import-from :woo.ev 9 | :close-socket 10 | :*data-registry*) 11 | (:export :make-signal-watchers 12 | :start-signal-watchers 13 | :stop-signal-watchers)) 14 | (in-package :woo.signal) 15 | 16 | (defvar *signals* 17 | '((2 . sigint-cb) 18 | (3 . sigquit-cb) 19 | (15 . sigint-cb))) 20 | 21 | (cffi:defcallback sigquit-cb :void ((evloop :pointer) (signal :pointer) (events :int)) 22 | (declare (ignore signal events)) 23 | (vom:info "Terminating quiet workers...") 24 | (lev:ev-io-stop evloop *listener*) 25 | (if *cluster* 26 | (woo.worker:stop-cluster *cluster*) 27 | ;; Close existing all sockets for singlethreaded process. 28 | (maphash (lambda (fd socket) 29 | (declare (ignore fd)) 30 | (wev:close-socket socket)) 31 | wev:*data-registry*)) 32 | (lev:ev-break evloop lev:+EVBREAK-ALL+)) 33 | 34 | (cffi:defcallback sigint-cb :void ((evloop :pointer) (signal :pointer) (events :int)) 35 | (declare (ignore signal events)) 36 | (vom:info "Terminating workers immediately...") 37 | (lev:ev-io-stop evloop *listener*) 38 | (if *cluster* 39 | (woo.worker:kill-cluster *cluster*) 40 | (maphash (lambda (fd socket) 41 | (declare (ignore fd)) 42 | (wev:close-socket socket)) 43 | wev:*data-registry*)) 44 | (lev:ev-break evloop lev:+EVBREAK-ALL+)) 45 | 46 | (defun make-signal-watchers () 47 | (let* ((watcher-count (length *signals*)) 48 | (watchers 49 | (make-array watcher-count))) 50 | (dotimes (i watcher-count watchers) 51 | (setf (aref watchers i) (cffi:foreign-alloc '(:struct lev:ev-signal)))))) 52 | 53 | (defun start-signal-watchers (evloop watchers) 54 | (loop for (sig . cb) in *signals* 55 | for i from 0 56 | do (lev:ev-signal-init (aref watchers i) cb sig) 57 | (lev:ev-signal-start evloop (aref watchers i)))) 58 | 59 | (defun stop-signal-watchers (evloop watchers) 60 | (map nil (lambda (watcher) 61 | (lev:ev-signal-stop evloop watcher) 62 | (cffi:foreign-free watcher)) 63 | watchers)) 64 | -------------------------------------------------------------------------------- /woo.asd: -------------------------------------------------------------------------------- 1 | (defsystem "woo" 2 | :version "0.12.0" 3 | :author "Eitaro Fukamachi" 4 | :license "MIT" 5 | :defsystem-depends-on ("cffi-grovel") 6 | :depends-on ("lev" 7 | "clack-socket" 8 | "swap-bytes" 9 | "cffi" 10 | "static-vectors" 11 | "bordeaux-threads" 12 | "fast-http" 13 | "quri" 14 | "fast-io" 15 | "smart-buffer" 16 | "trivial-utf-8" 17 | "trivial-mimes" 18 | "vom" 19 | "alexandria" 20 | (:feature :sbcl "sb-posix") 21 | (:feature (:and :linux (:not :asdf3)) "uiop") 22 | (:feature :sbcl "sb-concurrency") 23 | (:feature (:not :sbcl) "cl-speedy-queue") 24 | (:feature (:not :woo-no-ssl) "cl+ssl")) 25 | :components ((:module "src" 26 | :components 27 | ((:file "woo" :depends-on ("ev" "response" "worker" "ssl" "signal" "specials" "util")) 28 | (:file "response" :depends-on ("ev")) 29 | (:file "ev" :depends-on ("ev-packages")) 30 | (:file "worker" :depends-on ("ev" "queue" "specials")) 31 | (:file "queue") 32 | (:module "ev-packages" 33 | :pathname "ev" 34 | :depends-on ("syscall" "llsocket") 35 | :components 36 | ((:file "event-loop") 37 | (:file "socket" :depends-on ("event-loop" "condition" "util")) 38 | (:file "tcp" :depends-on ("event-loop" "socket" "util" "condition")) 39 | (:file "condition") 40 | (:file "util"))) 41 | (:file "ssl" 42 | :depends-on ("ev-packages") 43 | :if-feature (:not :woo-no-ssl)) 44 | (:module "llsocket" 45 | :depends-on ("syscall") 46 | :serial t 47 | :components 48 | ((:file "package") 49 | (:cffi-grovel-file "grovel") 50 | (:file "cffi"))) 51 | (:module "syscall" 52 | :serial t 53 | :components 54 | ((:file "package") 55 | (:cffi-grovel-file "types") 56 | (:file "main"))) 57 | (:file "signal" :depends-on ("ev" "worker" "specials")) 58 | (:file "specials") 59 | (:file "util")))) 60 | :description "An asynchronous HTTP server written in Common Lisp" 61 | :in-order-to ((test-op (test-op "woo-test")))) 62 | -------------------------------------------------------------------------------- /src/llsocket/cffi.lisp: -------------------------------------------------------------------------------- 1 | (in-package :woo.llsocket) 2 | 3 | (cffi:defcfun ("accept" accept) :int 4 | (socket :int) 5 | (address :pointer) ;; sockaddr 6 | (addrlen :pointer)) 7 | 8 | #+linux 9 | (cffi:defcfun ("accept4" accept4) :int 10 | (socket :int) 11 | (address :pointer) ;; sockaddr 12 | (addrlen :pointer) 13 | (flags :int)) 14 | 15 | (cffi:defcfun ("bind" bind) :int 16 | (socket :int) 17 | (address :pointer) ;; sockaddr 18 | (addrlen socklen-t)) 19 | 20 | (cffi:defcfun ("connect" connect) :int 21 | (socket :int) 22 | (address :pointer) ;; sockaddr 23 | (addrlen socklen-t)) 24 | 25 | (cffi:defcfun ("getpeername" getpeername) :int 26 | (socket :int) 27 | (address :pointer) ;; sockaddr 28 | (addrlen socklen-t)) 29 | 30 | (cffi:defcfun ("getsockname" getsockname) :int 31 | (socket :int) 32 | (address :pointer) ;; sockaddr 33 | (addrlen socklen-t)) 34 | 35 | (cffi:defcfun ("getsockopt" getsockopt) :int 36 | (socket :int) 37 | (level :int) 38 | (optname :int) 39 | (optval :pointer) 40 | (optlen :int)) 41 | 42 | (cffi:defcfun ("inet_ntoa" inet-ntoa) :string 43 | (addr :int64)) 44 | 45 | (cffi:defcfun ("inet_ntop" inet-ntop) :string 46 | (af :int) 47 | (src :pointer) 48 | (dst :string) 49 | (size socklen-t)) 50 | 51 | (cffi:defcfun ("listen" listen) :int 52 | (socket :int) 53 | (backlog :int)) 54 | 55 | (cffi:defcfun ("recvfrom" recvfrom) ssize-t 56 | (socket :int) 57 | (buffer :pointer) 58 | (length size-t) 59 | (flags :int) 60 | (address :pointer) ;; sockaddr 61 | (addrlen socklen-t)) 62 | 63 | (cffi:defcfun ("recvmsg" recvmsg) ssize-t 64 | (socket :int) 65 | (message :pointer) 66 | (flags :int)) 67 | 68 | (cffi:defcfun ("sendto" sendto) ssize-t 69 | (socket :int) 70 | (buffer :pointer) 71 | (length size-t) 72 | (flags :int) 73 | (destaddr :pointer) ;; sockaddr 74 | (destlen socklen-t)) 75 | 76 | (cffi:defcfun ("sendmsg" sendmsg) ssize-t 77 | (socket :int) 78 | (message :pointer) 79 | (flags :int)) 80 | 81 | (cffi:defcfun ("setsockopt" setsockopt) :int 82 | (socket :int) 83 | (level :int) 84 | (optname :int) 85 | (optval :pointer) 86 | (optlen socklen-t)) 87 | 88 | (cffi:defcfun ("shutdown" shutdown) :int 89 | (socket :int) 90 | (how :int)) 91 | 92 | (cffi:defcfun ("socket" socket) :int 93 | (domain :int) ;; +AF-*+ 94 | (type :int) ;; +SOCK-*+ 95 | (protocol :int)) 96 | 97 | (cffi:defcfun ("socketpair" socketpair) :int 98 | (domain :int) ;; +AF-*+ 99 | (type :int) ;; +SOCK-*+ 100 | (protocol :int) 101 | (fd :int)) 102 | 103 | (cffi:defcfun ("getaddrinfo" getaddrinfo) :int 104 | (node :string) 105 | (service :string) 106 | (hints (:pointer addrinfo)) 107 | (res (:pointer (:pointer addrinfo)))) 108 | 109 | (cffi:defcfun ("freeaddrinfo" freeaddrinfo) :void 110 | (res (:pointer addrinfo))) 111 | -------------------------------------------------------------------------------- /src/ev/event-loop.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage woo.ev.event-loop 3 | (:use :cl) 4 | (:import-from :lev 5 | :ev-loop-new 6 | :ev-run 7 | :+EVFLAG-FORKCHECK+) 8 | (:import-from :cffi 9 | :foreign-free) 10 | (:import-from :static-vectors 11 | :make-static-vector 12 | :free-static-vector) 13 | (:export :with-event-loop 14 | :check-event-loop-running 15 | 16 | :*evloop* 17 | :*buffer-size* 18 | :*input-buffer* 19 | :*data-registry* 20 | 21 | :callbacks 22 | :remove-callbacks 23 | :deref-data-from-pointer 24 | :remove-pointer-from-registry)) 25 | (in-package :woo.ev.event-loop) 26 | 27 | (defparameter *evloop* nil) 28 | (defvar *buffer-size* (* 1024 64)) 29 | (defparameter *input-buffer* nil) 30 | 31 | (defvar *callbacks* nil) 32 | (defvar *data-registry* nil) 33 | 34 | (defun (setf callbacks) (callbacks pointer) 35 | (setf (gethash pointer *callbacks*) callbacks)) 36 | 37 | (defun callbacks (pointer) 38 | (declare (optimize (speed 3) (safety 0))) 39 | (when *callbacks* 40 | (gethash pointer (the hash-table *callbacks*)))) 41 | 42 | (defun remove-callbacks (pointer) 43 | (declare (optimize (speed 3) (safety 0))) 44 | (when *callbacks* 45 | (remhash pointer (the hash-table *callbacks*)))) 46 | 47 | (defun deref-data-from-pointer (pointer) 48 | (declare (optimize (speed 3) (safety 0))) 49 | (when *data-registry* 50 | (gethash pointer (the hash-table *data-registry*)))) 51 | 52 | (defun (setf deref-data-from-pointer) (data pointer) 53 | (setf (gethash pointer *data-registry*) data)) 54 | 55 | (defun remove-pointer-from-registry (pointer) 56 | (declare (optimize (speed 3) (safety 0))) 57 | (when *data-registry* 58 | (remhash pointer (the hash-table *data-registry*)))) 59 | 60 | (defmacro with-event-loop ((&key enable-fork cleanup-fn) &body body) 61 | `(let ((*evloop* (lev:ev-loop-new (if ,enable-fork 62 | lev:+EVFLAG-FORKCHECK+ 63 | 0))) 64 | (*callbacks* (make-hash-table :test 'eql)) 65 | (*data-registry* (make-hash-table :test 'eql)) 66 | (*input-buffer* (make-static-vector *buffer-size*))) 67 | (unwind-protect (progn 68 | ,@body 69 | (lev:ev-run *evloop* 0)) 70 | (let ((close-socket-fn (intern #.(string :close-socket) (find-package #.(string :woo.ev.socket))))) 71 | (maphash (lambda (fd socket) 72 | (declare (ignore fd)) 73 | (funcall close-socket-fn socket)) 74 | *data-registry*)) 75 | ,@(when cleanup-fn 76 | `((funcall ,cleanup-fn))) 77 | (free-static-vector *input-buffer*) 78 | (cffi:foreign-free *evloop*)))) 79 | 80 | (defun check-event-loop-running () 81 | (unless *evloop* 82 | (error "Event loop not running"))) 83 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Woo 2 | 3 | [![CI](https://github.com/fukamachi/woo/actions/workflows/ci.yml/badge.svg)](https://github.com/fukamachi/woo/actions/workflows/ci.yml) 4 | 5 | Woo is a fast non-blocking HTTP server built on top of [libev](http://software.schmorp.de/pkg/libev.html). Although Woo is written in Common Lisp, it aims to be the fastest web server written in any programming language. 6 | 7 | ## Warning 8 | 9 | This software is still BETA quality. 10 | 11 | ## How fast? 12 | 13 | ![Benchmark graph](images/benchmark.png) 14 | 15 | See [benchmark.md](benchmark.md) for the detail. 16 | 17 | ## Usage 18 | 19 | Use `clack:clackup` or `woo:run` to start a web server. The first argument is a Lack "app". See [Lack's README](https://github.com/fukamachi/lack#readme) for instruction on how to build it. 20 | 21 | Remember to pass ":debug nil" to turn off the debugger mode on production environments (it's on by default). Otherwise, your server will go down on internal errors. 22 | 23 | ### Start a server 24 | 25 | ```common-lisp 26 | (ql:quickload :woo) 27 | 28 | (woo:run 29 | (lambda (env) 30 | (declare (ignore env)) 31 | '(200 (:content-type "text/plain") ("Hello, World")))) 32 | ``` 33 | 34 | ### Start with Clack 35 | 36 | ```common-lisp 37 | (ql:quickload :clack) 38 | 39 | (clack:clackup 40 | (lambda (env) 41 | (declare (ignore env)) 42 | '(200 (:content-type "text/plain") ("Hello, World"))) 43 | :server :woo 44 | :use-default-middlewares nil) 45 | ``` 46 | 47 | ### Cluster 48 | 49 | ```common-lisp 50 | (woo:run 51 | (lambda (env) 52 | (declare (ignore env)) 53 | '(200 (:content-type "text/plain") ("Hello, World"))) 54 | :worker-num 4) 55 | ``` 56 | 57 | ### SSL Support 58 | 59 | Use SSL key arguments of `woo:run` or `clack:clackup`. 60 | 61 | ```commonlisp 62 | (woo:run app 63 | :ssl-cert-file #P"path/to/cert.pem" 64 | :ssl-key-file #P"path/to/key.pem" 65 | :ssl-key-password "password") 66 | 67 | (clack:clackup app 68 | :ssl-cert-file #P"path/to/cert.pem" 69 | :ssl-key-file #P"path/to/key.pem" 70 | :ssl-key-password "password") 71 | ``` 72 | 73 | To disable the HTTPS support to omit a dependency on CL+SSL, add `woo-no-ssl` to `cl:*features*`. 74 | 75 | ## Signal handling 76 | 77 | When the master process gets these signals, it kills worker processes and quits afterwards. 78 | 79 | - QUIT: graceful shutdown, waits for all requests are finished. 80 | - INT/TERM: shutdown immediately. 81 | 82 | ## Benchmarks 83 | 84 | See [benchmark.md](benchmark.md). 85 | 86 | ## Installation 87 | 88 | ### Requirements 89 | 90 | * UNIX (GNU Linux, Mac, \*BSD) 91 | * SBCL 92 | * [libev](http://libev.schmorp.de) 93 | * OpenSSL or LibreSSL (Optional) 94 | * To turn off SSL, add `:woo-no-ssl` to `cl:*features*` before loading Woo. 95 | 96 | ### Installing via Quicklisp 97 | 98 | ```common-lisp 99 | (ql:quickload :woo) 100 | ``` 101 | 102 | ## Docker example 103 | 104 | * [Dockerfile](https://github.com/quickdocs/quickdocs-api/blob/master/docker/Dockerfile.production) for Quickdocs's API server. 105 | 106 | ## See Also 107 | 108 | * [Lack](https://github.com/fukamachi/lack): Building a web application 109 | * [Clack](https://github.com/fukamachi/clack): An abstraction layer for web servers 110 | * [libev](http://software.schmorp.de/pkg/libev.html) 111 | 112 | ## Author 113 | 114 | * Eitaro Fukamachi (e.arrows@gmail.com) 115 | 116 | ## Copyright 117 | 118 | Copyright (c) 2014 Eitaro Fukamachi & [contributors](https://github.com/fukamachi/woo/graphs/contributors) 119 | 120 | ## License 121 | 122 | Licensed under the MIT License. 123 | -------------------------------------------------------------------------------- /src/syscall/main.lisp: -------------------------------------------------------------------------------- 1 | (in-package :woo.syscall) 2 | 3 | (defcfun (%open "open") :int 4 | (path :string) 5 | (flags :int) 6 | (mode mode-t)) 7 | 8 | (defun open (path &optional (flags +O-RDONLY+) (mode #o666)) 9 | (check-type mode fixnum) 10 | (%open (cffi-sys:native-namestring (translate-logical-pathname path)) flags mode)) 11 | 12 | (defcfun ("close") :int 13 | (fd :int)) 14 | 15 | (defcfun ("write") ssize-t 16 | (fd :int) 17 | (buf :pointer) 18 | (count size-t)) 19 | 20 | (defcfun ("read") ssize-t 21 | (fd :int) 22 | (buf :pointer) 23 | (count :unsigned-int)) 24 | 25 | (defcfun ("fcntl" %fcntl/noarg) :int 26 | (fd :int) 27 | (cmd :int)) 28 | 29 | (defcfun ("fcntl" %fcntl/int) :int 30 | (fd :int) 31 | (cmd :int) 32 | (arg :int)) 33 | 34 | (defcfun ("kill" kill) :int 35 | (pid :int) 36 | (sig :int)) 37 | 38 | (defcfun ("chmod" chmod) :int 39 | (path :string) 40 | (mode mode-t)) 41 | 42 | (defconstant F-GETFL 3.) 43 | (defconstant F-SETFL 4.) 44 | (defconstant O-NONBLOCK 4.) 45 | 46 | (defun set-fd-nonblock (fd enabled) 47 | (declare (optimize (speed 3) (safety 0))) 48 | (let ((current-flags (%fcntl/noarg fd F-GETFL))) 49 | (declare (type fixnum current-flags)) 50 | (if (< current-flags 0) 51 | -1 52 | (let ((new-flags 53 | (if enabled 54 | (logxor current-flags O-NONBLOCK) 55 | (logand current-flags (lognot O-NONBLOCK))))) 56 | (declare (type fixnum new-flags)) 57 | (if (= new-flags current-flags) 58 | (%fcntl/int fd F-SETFL new-flags) 59 | 0))))) 60 | 61 | (defcfun (fork "fork") pid-t) 62 | 63 | (defcfun (memset "memset") :pointer 64 | (buffer :pointer) 65 | (value :int) 66 | (count size-t)) 67 | 68 | (defun bzero (buffer count) 69 | (memset buffer 0 count)) 70 | 71 | ;; errno(3) is not a C function in some environments (ex. Mac). 72 | ;; libfixposix can be a workaround for it, but I don't like to add a dependency on it 73 | ;; just for it. 74 | #+(or sbcl ccl lispworks) 75 | (declaim (ftype (function () fixnum) errno)) 76 | (defun errno () 77 | #+sbcl (sb-impl::get-errno) 78 | #+ccl (ccl::%get-errno) 79 | #+lispworks (lw:errno-value) 80 | #-(or sbcl ccl lispworks) nil) 81 | 82 | (defcfun (getpid "getpid") pid-t) 83 | 84 | (defcfun (getppid "getppid") pid-t) 85 | 86 | #+linux 87 | (defcfun (%sendfile "sendfile") ssize-t 88 | (infd :int) 89 | (outfd :int) 90 | (offset :pointer) 91 | (nbytes size-t)) 92 | #+darwin 93 | (defcfun (%sendfile "sendfile") ssize-t 94 | (outfd :int) 95 | (infd :int) 96 | (offset off-t) 97 | (len :pointer) 98 | (hdtr :pointer) 99 | (flags :int)) 100 | #+(and (or freebsd bsd) (not darwin)) 101 | (defcfun (%sendfile "sendfile") ssize-t 102 | (infd :int) 103 | (outfd :int) 104 | (offset off-t) 105 | (nbytes size-t) 106 | (hdtr :pointer) 107 | (sbytes :pointer) 108 | (flags :int)) 109 | 110 | (defun sendfile (infd outfd offset nbytes) 111 | #+linux 112 | (cffi:with-foreign-object (off 'off-t) 113 | (setf (cffi:mem-aref off 'off-t) offset) 114 | (%sendfile outfd infd off nbytes)) 115 | #+darwin 116 | (cffi:with-foreign-object (len 'off-t) 117 | (setf (cffi:mem-aref len 'off-t) nbytes) 118 | (let ((retval (%sendfile infd outfd offset len (cffi:null-pointer) 0))) 119 | (declare (type fixnum retval)) 120 | (if (= retval -1) 121 | -1 122 | (cffi:mem-aref len 'off-t)))) 123 | #+(and (or freebsd bsd) (not darwin)) 124 | (cffi:with-foreign-object (sbytes 'off-t) 125 | (let ((retval (%sendfile infd outfd offset nbytes (cffi:null-pointer) sbytes +SF-MNOWAIT+))) 126 | (declare (type fixnum retval)) 127 | (if (= retval -1) 128 | -1 129 | (cffi:mem-aref sbytes 'off-t)))) 130 | #-(or linux darwin freebsd bsd) 131 | (error "sendfile is not supported")) 132 | -------------------------------------------------------------------------------- /src/llsocket/package.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage woo.llsocket 3 | (:nicknames :wsock) 4 | (:use :cl) 5 | (:shadow :listen) 6 | (:export :+AF-UNIX+ 7 | :+AF-INET+ 8 | :+AF-INET6+ 9 | 10 | :+SOCK-STREAM+ 11 | :+SOCK-DGRAM+ 12 | :+SOCK-RAW+ 13 | :+SOCK-RDM+ 14 | :+SOCK-SEQPACKET+ 15 | :+SOCK-CLOEXEC+ 16 | :+SOCK-NONBLOCK+ 17 | 18 | :+SO-DEBUG+ 19 | :+SO-ACCEPTCONN+ 20 | :+SO-REUSEADDR+ 21 | :+SO-REUSEPORT+ 22 | :+SO-KEEPALIVE+ 23 | :+SO-DONTROUTE+ 24 | :+SO-BROADCAST+ 25 | :+SO-USELOOPBACK+ 26 | :+SO-LINGER+ 27 | :+SO-OOBINLINE+ 28 | 29 | :+SO-SNDBUF+ 30 | :+SO-RCVBUF+ 31 | :+SO-SNDLOWAT+ 32 | :+SO-RCVTIMEO+ 33 | :+SO-ERROR+ 34 | :+SO-TYPE+ 35 | 36 | :+SOMAXCONN+ 37 | 38 | :+SOL-SOCKET+ 39 | :+SOL-TCP+ 40 | :+SOL-IP+ 41 | :+SOL-RAW+ 42 | 43 | :+IPPROTO-IP+ 44 | :+IPPROTO-IPV6+ 45 | :+IPPROTO-ICMP+ 46 | :+IPPROTO-ICMPV6+ 47 | :+IPPROTO-RAW+ 48 | :+IPPROTO-TCP+ 49 | :+IPPROTO-UDP+ 50 | 51 | :+INADDR-ANY+ 52 | :+INADDR-BROADCAST+ 53 | :+INADDR-NONE+ 54 | :+IN-LOOPBACKNET+ 55 | :+INADDR-LOOPBACK+ 56 | :+INADDR-UNSPEC-GROUP+ 57 | :+INADDR-ALLHOSTS-GROUP+ 58 | :+INADDR-ALLRTRS-GROUP+ 59 | :+INADDR-MAX-LOCAL-GROUP+ 60 | 61 | :+IP-HDRINCL+ 62 | :+IP-RECVERR+ 63 | 64 | :sockaddr 65 | :sockaddr-storage 66 | :sockaddr-in 67 | :in6-addr 68 | :sockaddr-in6 69 | :sockaddr-un 70 | :addrinfo 71 | 72 | :+MSG-OOB+ 73 | :+MSG-PEEK+ 74 | :+MSG-DONTROUTE+ 75 | :+MSG-EOR+ 76 | :+MSG-TRUNC+ 77 | :+MSG-CTRUNC+ 78 | :+MSG-WAITALL+ 79 | 80 | :+AI-PASSIVE+ 81 | :+AI-CANONNAME+ 82 | :+AI-NUMERICHOST+ 83 | :+AI-V4MAPPED+ 84 | :+AI-ALL+ 85 | :+AI-ADDRCONFIG+ 86 | 87 | :msghdr 88 | :cmsghdr 89 | 90 | :+SHUT-RD+ 91 | :+SHUT-WR+ 92 | :+SHUT-RDWR+ 93 | 94 | :socklen-t 95 | 96 | :accept 97 | #+linux 98 | :accept4 99 | :bind 100 | :connect 101 | :getpeername 102 | :getsockname 103 | :getsockopt 104 | :inet-ntoa 105 | :inet-ntop 106 | :listen 107 | :recvfrom 108 | :recvmsg 109 | :sendto 110 | :sendmsg 111 | :setsockopt 112 | :shutdown 113 | :socket 114 | :socketpair 115 | :getaddrinfo 116 | :freeaddrinfo 117 | 118 | :so-reuseport-available-p)) 119 | (in-package :woo.llsocket) 120 | 121 | (defun so-reuseport-available-p () 122 | #+linux 123 | (let ((kernel-version 124 | (with-output-to-string (s) 125 | (uiop:run-program "uname -r" 126 | :output s 127 | :ignore-error-status t)))) 128 | (setq kernel-version 129 | (if (= 0 (length kernel-version)) 130 | nil 131 | (subseq kernel-version 0 (1- (length kernel-version))))) 132 | (when kernel-version 133 | (multiple-value-bind (major read-count) 134 | (parse-integer kernel-version :junk-allowed t) 135 | (let ((minor (parse-integer kernel-version :start (1+ read-count) :junk-allowed t))) 136 | (and major minor 137 | (or (< 3 major) 138 | (and (= 3 major) 139 | (<= 9 minor)))))))) 140 | #-linux nil) 141 | -------------------------------------------------------------------------------- /src/llsocket/grovel.lisp: -------------------------------------------------------------------------------- 1 | #+(or bsd freebsd) 2 | (progn 3 | (include "time.h") 4 | (include "sys/time.h")) 5 | 6 | (include "sys/socket.h" "netinet/in.h" "netdb.h") 7 | 8 | (in-package :woo.llsocket) 9 | 10 | ;; Address families 11 | (constant (+AF-UNIX+ "AF_UNIX")) 12 | (constant (+AF-INET+ "AF_INET")) 13 | (constant (+AF-INET6+ "AF_INET6")) 14 | 15 | ;; Types 16 | (constant (+SOCK-STREAM+ "SOCK_STREAM")) 17 | (constant (+SOCK-DGRAM+ "SOCK_DGRAM")) 18 | (constant (+SOCK-RAW+ "SOCK_RAW")) 19 | (constant (+SOCK-RDM+ "SOCK_RDM")) 20 | (constant (+SOCK-SEQPACKET+ "SOCK_SEQPACKET")) 21 | (constant (+SOCK-CLOEXEC+ "SOCK_CLOEXEC") :optional t) 22 | (constant (+SOCK-NONBLOCK+ "SOCK_NONBLOCK") :optional t) 23 | 24 | ;; Option flags per-socket 25 | (constant (+SO-DEBUG+ "SO_DEBUG")) 26 | (constant (+SO-ACCEPTCONN+ "SO_ACCEPTCONN")) 27 | (constant (+SO-REUSEADDR+ "SO_REUSEADDR")) 28 | (constant (+SO-REUSEPORT+ "SO_REUSEPORT")) 29 | (constant (+SO-KEEPALIVE+ "SO_KEEPALIVE")) 30 | (constant (+SO-DONTROUTE+ "SO_DONTROUTE")) 31 | (constant (+SO-BROADCAST+ "SO_BROADCAST")) 32 | (constant (+SO-USELOOPBACK+ "SO_USELOOPBACK")) 33 | (constant (+SO-LINGER+ "SO_LINGER")) 34 | (constant (+SO-OOBINLINE+ "SO_OOBINLINE")) 35 | 36 | ;; Additional options, not kept in so_options 37 | (constant (+SO-SNDBUF+ "SO_SNDBUF")) 38 | (constant (+SO-RCVBUF+ "SO_RCVBUF")) 39 | (constant (+SO-SNDLOWAT+ "SO_SNDLOWAT")) 40 | (constant (+SO-RCVLOWAT+ "SO_RCVLOWAT")) 41 | (constant (+SO-SNDTIMEO+ "SO_SNDTIMEO")) 42 | (constant (+SO-RCVTIMEO+ "SO_RCVTIMEO")) 43 | (constant (+SO-ERROR+ "SO_ERROR")) 44 | (constant (+SO-TYPE+ "SO_TYPE")) 45 | 46 | ;; Maximum queue length specifiable by listen 47 | (constant (+SOMAXCONN+ "SOMAXCONN")) 48 | 49 | ;; Level number for (get/set)sockopt() to apply to socket itself 50 | (constant (+SOL-SOCKET+ "SOL_SOCKET") 51 | :documentation "get/setsockopt socket level constant.") 52 | (constant (+SOL-TCP+ "SOL_TCP") 53 | :documentation "get/setsockopt TCP level constant." 54 | :optional t) 55 | (constant (+SOL-IP+ "SOL_IP") 56 | :documentation "get/setsockopt IP level constant." 57 | :optional t) 58 | (constant (+SOL-RAW+ "SOL_RAW") 59 | :documentation "get/setsockopt raw level constant." 60 | :optional t) 61 | 62 | (constant (+IPPROTO-IP+ "IPPROTO_IP")) 63 | (constant (+IPPROTO-IPV6+ "IPPROTO_IPV6")) 64 | (constant (+IPPROTO-ICMP+ "IPPROTO_ICMP")) 65 | (constant (+IPPROTO-ICMPV6+ "IPPROTO_ICMPV6")) 66 | (constant (+IPPROTO-RAW+ "IPPROTO_RAW")) 67 | (constant (+IPPROTO-TCP+ "IPPROTO_TCP")) 68 | (constant (+IPPROTO-UDP+ "IPPROTO_UDP")) 69 | 70 | (constant (+INADDR-ANY+ "INADDR_ANY")) 71 | (constant (+INADDR-BROADCAST+ "INADDR_BROADCAST")) 72 | (constant (+INADDR-NONE+ "INADDR_NONE")) 73 | (constant (+IN-LOOPBACKNET+ "IN_LOOPBACKNET")) 74 | (constant (+INADDR-LOOPBACK+ "INADDR_LOOPBACK")) 75 | (constant (+INADDR-UNSPEC-GROUP+ "INADDR_UNSPEC_GROUP")) 76 | (constant (+INADDR-ALLHOSTS-GROUP+ "INADDR_ALLHOSTS_GROUP")) 77 | (constant (+INADDR-ALLRTRS-GROUP+ "INADDR_ALLRTRS_GROUP")) 78 | (constant (+INADDR-MAX-LOCAL-GROUP+ "INADDR_MAX_LOCAL_GROUP")) 79 | 80 | ;; IP options 81 | (constant (+IP-HDRINCL+ "IP_HDRINCL")) 82 | (constant (+IP-RECVERR+ "IP_RECVERR") :optional t) 83 | 84 | ;; addrinfo flags 85 | (constant (+AI-PASSIVE+ "AI_PASSIVE")) 86 | (constant (+AI-CANONNAME+ "AI_CANONNAME")) 87 | (constant (+AI-NUMERICHOST+ "AI_NUMERICHOST")) 88 | (constant (+AI-V4MAPPED+ "AI_V4MAPPED")) 89 | (constant (+AI-ALL+ "AI_ALL")) 90 | (constant (+AI-ADDRCONFIG+ "AI_ADDRCONFIG")) 91 | 92 | ;; POSIX types 93 | (ctype size-t "size_t") 94 | (ctype ssize-t "ssize_t") 95 | 96 | ;; Types (sys/socket.h) 97 | (ctype socklen-t "socklen_t") 98 | (ctype sa-family-t "sa_family_t") 99 | 100 | ;; Types (netinet/in.h) 101 | (ctype sa-family-t "sa_family_t") 102 | (ctype in-port-t "in_port_t") 103 | (ctype in-addr-t "in_addr_t") 104 | 105 | (cstruct sockaddr "struct sockaddr" 106 | (family "sa_family" :type sa-family-t)) 107 | 108 | (cstruct sockaddr-storage "struct sockaddr_storage" 109 | (family "ss_family" :type sa-family-t)) 110 | 111 | (cstruct sockaddr-in "struct sockaddr_in" 112 | (family "sin_family" :type sa-family-t) 113 | (port "sin_port" :type in-port-t) 114 | (addr "sin_addr" :type in-addr-t)) 115 | 116 | (cunion in6-addr "struct in6_addr" 117 | (addr8 "s6_addr" :type :uint8 :count :auto)) 118 | 119 | (cstruct sockaddr-in6 "struct sockaddr_in6" 120 | (family "sin6_family" :type sa-family-t) 121 | (port "sin6_port" :type in-port-t) 122 | (flowinfo "sin6_flowinfo" :type :uint32) 123 | (addr "sin6_addr" :type (:union in6-addr)) 124 | (scope-id "sin6_scope_id" :type :uint32)) 125 | 126 | (cstruct addrinfo "struct addrinfo" 127 | (flags "ai_flags" :type :int) 128 | (family "ai_family" :type :int) 129 | (socktype "ai_socktype" :type :int) 130 | (protocol "ai_protocol" :type :int) 131 | (addrlen "ai_addrlen" :type socklen-t) 132 | (addr "ai_addr" :type :pointer) 133 | (canonname "ai_canonname" :type :string) 134 | (next "ai_next" :type :pointer)) 135 | 136 | (include "sys/un.h") 137 | 138 | (cstruct sockaddr-un "struct sockaddr_un" 139 | (family "sun_family" :type sa-family-t) 140 | (path "sun_path" :type :char)) 141 | 142 | ;; Message headers 143 | (constant (+MSG-OOB+ "MSG_OOB")) 144 | (constant (+MSG-PEEK+ "MSG_PEEK")) 145 | (constant (+MSG-DONTROUTE+ "MSG_DONTROUTE")) 146 | (constant (+MSG-EOR+ "MSG_EOR")) 147 | (constant (+MSG-TRUNC+ "MSG_TRUNC")) 148 | (constant (+MSG-CTRUNC+ "MSG_CTRUNC")) 149 | (constant (+MSG-WAITALL+ "MSG_WAITALL")) 150 | 151 | (cstruct msghdr "struct msghdr" 152 | (name "msg_name" :type :pointer) 153 | (namelen "msg_namelen" :type socklen-t) 154 | (iov "msg_iov" :type :pointer) 155 | (iovlen "msg_iovlen" :type size-t) 156 | (control "msg_control" :type :pointer) 157 | (controllen "msg_controllen" :type socklen-t) 158 | (flags "msg_flags" :type :int)) 159 | 160 | (cstruct cmsghdr "struct cmsghdr" 161 | (len "cmsg_len" :type socklen-t) 162 | (level "cmsg_level" :type :int) 163 | (type "cmsg_type" :type :int)) 164 | 165 | (constant (+SHUT-RD+ "SHUT_RD")) 166 | (constant (+SHUT-WR+ "SHUT_WR")) 167 | (constant (+SHUT-RDWR+ "SHUT_RDWR")) 168 | -------------------------------------------------------------------------------- /src/worker.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage woo.worker 3 | (:use :cl 4 | :woo.specials) 5 | (:import-from :woo.ev 6 | :*evloop* 7 | :with-sockaddr) 8 | (:import-from :woo.queue 9 | :make-queue 10 | :queue-empty-p 11 | :enqueue 12 | :dequeue) 13 | (:export :make-cluster 14 | :stop-cluster 15 | :kill-cluster 16 | :add-job-to-cluster)) 17 | (in-package :woo.worker) 18 | 19 | (defparameter *worker* nil) 20 | 21 | (defvar *worker-counter* 0) 22 | 23 | (defstruct (worker (:constructor %make-worker)) 24 | (id (incf *worker-counter*)) 25 | (queue (make-queue)) 26 | evloop 27 | dequeue-async 28 | stop-async 29 | process-fn 30 | thread 31 | (status :running)) 32 | 33 | (defun add-job (worker job) 34 | (enqueue job (worker-queue worker))) 35 | 36 | (defun notify-new-job (worker) 37 | (lev:ev-async-send (worker-evloop worker) (worker-dequeue-async worker))) 38 | 39 | (defun stop-worker (worker) 40 | (vom:debug "[~D] Stopping a worker..." (worker-id worker)) 41 | (with-slots (evloop stop-async status) worker 42 | (setf status :stopping) 43 | (lev:ev-async-send evloop stop-async))) 44 | 45 | (defun kill-worker (worker) 46 | (vom:debug "[~D] Killing a worker..." (worker-id worker)) 47 | (with-slots (status thread) worker 48 | (setf status :stopping) 49 | (bt2:destroy-thread thread))) 50 | 51 | (cffi:defcallback worker-dequeue :void ((evloop :pointer) (listener :pointer) (events :int)) 52 | (declare (ignore evloop listener events)) 53 | (loop with queue = (worker-queue *worker*) 54 | until (queue-empty-p queue) 55 | for socket = (dequeue queue) 56 | do (funcall (worker-process-fn *worker*) socket))) 57 | 58 | (cffi:defcallback worker-stop :void ((evloop :pointer) (listener :pointer) (events :int)) 59 | (declare (ignore listener events)) 60 | ;; Close existing all sockets. 61 | (maphash (lambda (fd socket) 62 | (declare (ignore fd)) 63 | (wev:close-socket socket)) 64 | wev:*data-registry*) 65 | 66 | ;; Stop all events. 67 | (lev:ev-break evloop lev:+EVBREAK-ALL+)) 68 | 69 | (defun finalize-worker (worker) 70 | (with-slots (evloop queue dequeue-async stop-async thread status) worker 71 | (unless (queue-empty-p queue) 72 | (if *cluster* 73 | (loop until (queue-empty-p queue) 74 | do (add-job-to-cluster *cluster* (dequeue queue))) 75 | (vom:warn "Finalizing a worker having some jobs."))) 76 | 77 | (cffi:foreign-free dequeue-async) 78 | (cffi:foreign-free stop-async) 79 | (setf evloop nil 80 | dequeue-async nil 81 | stop-async nil 82 | thread nil 83 | status :stopped))) 84 | 85 | (defun make-worker (process-fn when-died) 86 | (let* ((dequeue-async (cffi:foreign-alloc '(:struct lev:ev-async))) 87 | (stop-async (cffi:foreign-alloc '(:struct lev:ev-async))) 88 | (worker (%make-worker :dequeue-async dequeue-async 89 | :stop-async stop-async 90 | :process-fn process-fn)) 91 | (worker-lock (bt2:make-lock))) 92 | (lev:ev-async-init dequeue-async 'worker-dequeue) 93 | (lev:ev-async-init stop-async 'worker-stop) 94 | (setf (worker-thread worker) 95 | (bt2:make-thread 96 | (lambda () 97 | (bt2:acquire-lock worker-lock) 98 | (let ((*worker* worker)) 99 | (wev:with-sockaddr 100 | (unwind-protect 101 | (wev:with-event-loop () 102 | (setf (worker-evloop worker) *evloop*) 103 | (bt2:release-lock worker-lock) 104 | (lev:ev-async-start *evloop* dequeue-async) 105 | (lev:ev-async-start *evloop* stop-async)) 106 | (unless (eq (worker-status worker) :stopping) 107 | (vom:debug "[~D] Worker has died" (worker-id worker)) 108 | (funcall when-died worker)) 109 | (finalize-worker worker) 110 | (vom:debug "[~D] Bye." (worker-id worker)))))) 111 | :initial-bindings (default-thread-bindings) 112 | :name "woo-worker")) 113 | (sleep 0.1) 114 | (bt2:acquire-lock worker-lock) 115 | worker)) 116 | 117 | (defstruct (cluster (:constructor %make-cluster 118 | (&optional 119 | workers 120 | &aux 121 | (circular-workers 122 | (apply #'alexandria:circular-list workers))))) 123 | (workers '() :read-only t) 124 | (circular-workers '())) 125 | 126 | (defun (setf cluster-workers) (workers cluster) 127 | (setf (slot-value cluster 'workers) workers) 128 | (setf (cluster-circular-workers cluster) 129 | (apply #'alexandria:circular-list workers))) 130 | 131 | (defun add-job-to-cluster (cluster job) 132 | (let* ((workers (cluster-circular-workers cluster)) 133 | (worker (car workers))) 134 | (add-job worker job) 135 | (notify-new-job worker) 136 | (setf (cluster-circular-workers cluster) 137 | (cdr workers)))) 138 | 139 | (defun make-cluster (worker-num process-fn) 140 | (let ((cluster (%make-cluster))) 141 | (labels ((make-new-worker () 142 | (vom:debug "Starting a new worker...") 143 | (make-worker process-fn 144 | (lambda (worker) 145 | (setf (cluster-workers cluster) 146 | (cons (make-new-worker) 147 | (remove worker (cluster-workers cluster) :test #'eq))))))) 148 | (setf (cluster-workers cluster) 149 | (loop repeat worker-num 150 | collect (make-new-worker)))) 151 | cluster)) 152 | 153 | (defun cluster-running-workers (cluster) 154 | (remove-if-not #'worker-thread (cluster-workers cluster))) 155 | 156 | (defun stop-cluster (cluster) 157 | (let ((workers (cluster-running-workers cluster))) 158 | (mapc #'stop-worker workers) 159 | (loop repeat 100 160 | while (find-if #'worker-thread workers) 161 | do (sleep 0.1) 162 | finally 163 | (mapc #'kill-worker (cluster-running-workers cluster))))) 164 | 165 | (defun kill-cluster (cluster) 166 | (mapc #'kill-worker (cluster-running-workers cluster))) 167 | -------------------------------------------------------------------------------- /src/response.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage woo.response 3 | (:use :cl) 4 | (:import-from :trivial-utf-8 5 | :string-to-utf-8-bytes 6 | :utf-8-byte-length) 7 | (:export :*empty-chunk* 8 | :*empty-bytes* 9 | :*crlf* 10 | :write-socket-string 11 | :write-socket-crlf 12 | :response-headers-bytes 13 | :write-response-headers 14 | :write-body-chunk 15 | :write-string-body-chunk 16 | :start-chunked-response 17 | :finish-response)) 18 | (in-package :woo.response) 19 | 20 | (declaim (inline wev:write-socket-data wev:write-socket-byte)) 21 | 22 | (defun status-code-to-text (code) 23 | (cond 24 | ((< code 200) 25 | (case code 26 | (100 "Continue") 27 | (101 "Switching Protocols") 28 | (102 "Processing"))) 29 | ((< code 300) 30 | (case code 31 | (200 "OK") 32 | (201 "Created") 33 | (202 "Accepted") 34 | (203 "Non-Authoritative Information") 35 | (204 "No Content") 36 | (205 "Reset Content") 37 | (206 "Partial Content") 38 | (207 "Multi-Status") 39 | (208 "Already Reported") 40 | (226 "IM Used"))) 41 | ((< code 400) 42 | (case code 43 | (300 "Multiple Choices") 44 | (301 "Moved Permanently") 45 | (302 "Found") 46 | (303 "See Other") 47 | (304 "Not Modified") 48 | (305 "Use Proxy") 49 | (307 "Temporary Redirect") 50 | (308 "Permanent Redirect"))) 51 | ((< code 500) 52 | (case code 53 | (400 "Bad Request") 54 | (401 "Unauthorized") 55 | (402 "Payment Required") 56 | (403 "Forbidden") 57 | (404 "Not Found") 58 | (405 "Method Not Allowed") 59 | (406 "Not Acceptable") 60 | (407 "Proxy Authentication Required") 61 | (408 "Request Time-out") 62 | (409 "Conflict") 63 | (410 "Gone") 64 | (411 "Length Required") 65 | (412 "Precondition Failed") 66 | (413 "Request Entity Too Large") 67 | (414 "Request-URI Too Large") 68 | (415 "Unsupported Media Type") 69 | (416 "Requested range not satisfiable") 70 | (417 "Expectation Failed") 71 | (418 "I'm a teapot") 72 | (421 "Misdirected Request") 73 | (422 "Unprocessable Entity") 74 | (423 "Locked") 75 | (424 "Failed Dependency") 76 | (426 "Upgrade Required") 77 | (451 "Unavailable For Legal Reasons"))) 78 | (T 79 | (case code 80 | (500 "Internal Server Error") 81 | (501 "Not Implemented") 82 | (502 "Bad Gateway") 83 | (503 "Service Unavailable") 84 | (504 "Gateway Time-out") 85 | (505 "HTTP Version not supported") 86 | (506 "Variant Also Negotiates") 87 | (507 "Insufficient Storage") 88 | (508 "Loop Detected") 89 | (509 "Bandwidth Limit Exceeded") 90 | (510 "Not Extended"))))) 91 | 92 | (defvar *status-line* (make-hash-table :test 'eql)) 93 | 94 | (defun http/1.1 (code) 95 | (let ((status-text (status-code-to-text code))) 96 | (when status-text 97 | (format nil "HTTP/1.1 ~A ~A~C~C" 98 | code 99 | status-text 100 | #\Return 101 | #\Linefeed)))) 102 | 103 | (loop for status from 100 to 510 104 | for status-line = (http/1.1 status) 105 | when status-line 106 | do (setf (gethash status *status-line*) 107 | (trivial-utf-8:string-to-utf-8-bytes status-line))) 108 | 109 | (defvar *empty-chunk* 110 | #.(trivial-utf-8:string-to-utf-8-bytes (format nil "0~C~C~C~C" 111 | #\Return #\Linefeed 112 | #\Return #\Linefeed))) 113 | 114 | (defvar *empty-bytes* 115 | #.(trivial-utf-8:string-to-utf-8-bytes "")) 116 | 117 | (defvar *crlf* 118 | (trivial-utf-8:string-to-utf-8-bytes (format nil "~C~C" #\Return #\Linefeed))) 119 | 120 | (declaim (inline write-socket-string write-socket-crlf)) 121 | 122 | (defun write-socket-string (socket string) 123 | (declare (optimize (speed 3) (safety 0))) 124 | (loop for char of-type character across string 125 | do (wev:write-socket-byte socket (char-code char)))) 126 | 127 | (defun write-socket-crlf (socket) 128 | (declare (optimize (speed 3) (safety 0))) 129 | (wev:write-socket-data socket *crlf*)) 130 | 131 | (declaim (type (simple-array character (29)) *date-header*)) 132 | (defvar *date-header* 133 | (make-array 29 134 | :element-type 'character 135 | :initial-contents "Thu, 01 Jan 1970 00:00:00 GMT")) 136 | 137 | (declaim (inline integer-to-character)) 138 | (defun integer-to-character (int) 139 | (declare (type fixnum int) 140 | (optimize (speed 3) (safety 0))) 141 | (the character (code-char (+ 48 int)))) 142 | 143 | (defun current-rfc-1123-timestamp () 144 | (declare (optimize (speed 3) (safety 0))) 145 | (macrolet ((write-date (val start &optional (len '*)) 146 | `(replace *date-header* 147 | (the (simple-array character (,len)) ,val) 148 | :start1 ,start)) 149 | (write-char-to-date (char idx) 150 | `(setf (aref *date-header* ,idx) ,char)) 151 | (write-int-to-date (val start) 152 | (check-type start integer) 153 | `(if (< ,val 10) 154 | (progn 155 | (write-char-to-date #\0 ,start) 156 | (write-char-to-date (integer-to-character ,val) ,(1+ start))) 157 | (multiple-value-bind (quotient remainder) 158 | (floor ,val 10) 159 | (write-char-to-date (integer-to-character quotient) ,start) 160 | (write-char-to-date (integer-to-character remainder) ,(1+ start)))))) 161 | (multiple-value-bind (sec minute hour day month year weekday) 162 | (decode-universal-time (get-universal-time) 0) 163 | (declare (type fixnum sec minute hour day month year weekday)) 164 | (write-date (svref #("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun") weekday) 165 | 0 3) 166 | (write-int-to-date day 5) 167 | (write-date (svref #("" "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec") 168 | month) 169 | 8 3) 170 | (multiple-value-bind (quotient remainder) 171 | (floor (the (unsigned-byte 64) year) 1000) 172 | (write-char-to-date (integer-to-character quotient) 12) 173 | (multiple-value-bind (quotient remainder) 174 | (floor remainder 100) 175 | (write-char-to-date (integer-to-character quotient) 13) 176 | (multiple-value-bind (quotient remainder) 177 | (floor remainder 10) 178 | (write-char-to-date (integer-to-character quotient) 14) 179 | (write-char-to-date (integer-to-character remainder) 15)))) 180 | (write-int-to-date hour 17) 181 | (write-int-to-date minute 20) 182 | (write-int-to-date sec 23))) 183 | *date-header*) 184 | 185 | (defun response-headers-bytes (socket status headers &optional keep-alive-p) 186 | (wev:write-socket-data socket (gethash status *status-line*)) 187 | ;; Send default headers 188 | (wev:write-socket-data socket #.(string-to-utf-8-bytes "Date: ")) 189 | (write-socket-string socket (the simple-string (current-rfc-1123-timestamp))) 190 | (write-socket-crlf socket) 191 | 192 | (when keep-alive-p 193 | (wev:write-socket-data 194 | socket 195 | #.(string-to-utf-8-bytes 196 | (format nil "Connection: keep-alive~C~C" #\Return #\Linefeed)))) 197 | 198 | (loop for (k v) on headers by #'cddr 199 | when v 200 | do (write-socket-string socket (format nil "~:(~A~): ~A" k v)) 201 | (write-socket-crlf socket))) 202 | 203 | (defun write-response-headers (socket status headers &optional keep-alive-p) 204 | (response-headers-bytes socket status headers keep-alive-p) 205 | (write-socket-crlf socket)) 206 | 207 | (defun write-body-chunk (socket chunk &key (start 0) (end (length chunk))) 208 | (declare (optimize speed) 209 | (type fixnum start end) 210 | (type vector chunk)) 211 | (unless (= start end) 212 | (wev:write-socket-data socket (map '(simple-array (unsigned-byte 8) (*)) 213 | #'char-code 214 | (format nil "~X~C~C" (the fixnum (- end start)) #\Return #\Linefeed))) 215 | (wev:write-socket-data socket chunk :start start :end end) 216 | (wev:write-socket-data socket *crlf*))) 217 | 218 | (defun write-string-body-chunk (socket chunk) 219 | (declare (optimize speed) 220 | (type string chunk)) 221 | (unless (= 0 (length chunk)) 222 | (wev:write-socket-data socket (map '(simple-array (unsigned-byte 8) (*)) 223 | #'char-code 224 | (format nil "~X~C~C" (utf-8-byte-length chunk) #\Return #\Linefeed))) 225 | (write-socket-string socket chunk) 226 | (wev:write-socket-data socket *crlf*))) 227 | 228 | (defun finish-response (socket &optional (body *empty-bytes*)) 229 | (wev:write-socket-data socket body 230 | :write-cb (lambda (socket) 231 | (wev:close-socket socket)))) 232 | 233 | (declaim (notinline wev:write-socket-data wev:write-socket-byte)) 234 | -------------------------------------------------------------------------------- /benchmark.md: -------------------------------------------------------------------------------- 1 | # Benchmarks 2 | 3 | Comparison of the server performance to return "Hello, World" for every requests. Here's the results of requests/sec scores. 4 | 5 | ![Benchmark Results](images/benchmark.png) 6 | 7 | Here's the new graph when using multiple CPU cores: 8 | 9 | ![Benchmark Results (multicore)](images/benchmark-multicore.png) 10 | 11 | All benchmarks were done with the below command of [wrk](https://github.com/wg/wrk). 12 | 13 | ``` 14 | wrk -c [10 or 100] -t 4 -d 10 http://127.0.0.1:5000 15 | ``` 16 | 17 | The benchmarking environment is: 18 | 19 | * Sakura VPS 16GB (CPU: 8 Core / Memory: 16GB) 20 | * Ubuntu 16.04.2 LTS (GNU/Linux 4.4.0-36-generic) 21 | * wrk 4.0.0 22 | * nginx 1.10.0 23 | * Python 2.7.12 24 | * PyPy 5.1.2 25 | * Tornado 4.4.1 26 | * SBCL 1.3.9 27 | * Quicklisp 2016-08-25 28 | * Node.js 4.2.6 29 | * Go 1.6.2 30 | * Racket 6.12 31 | * Ruby 2.3.1p112 32 | * Unicorn 5.1.0 33 | * libuv 1.8.0 34 | * libev 4.22 35 | 36 | ``` 37 | $ cat /proc/version 38 | Linux version 4.4.0-36-generic (buildd@lcy01-01) (gcc version 5.4.0 20160609 (Ubuntu 5.4.0-6ubuntu1~16.04.2) ) #55-Ubuntu SMP Thu Aug 11 18:01:55 UTC 2016 39 | $ sudo apt-get install wrk nginx python2.7 python-pip pypy nodejs golang racket ruby ruby-dev libuv1-dev libev-dev 40 | $ sudo apt-get install -y autotools-dev automake libcurl4-gnutls-dev curl make 41 | $ pip install tornado 42 | $ sudo gem install unicorn rack 43 | ``` 44 | 45 | ## Wookie (Common Lisp) 46 | 47 | ``` 48 | $ benchmark/run-benchmark benchmark/wookie/run 49 | ``` 50 | 51 | ``` 52 | Running 10s test @ http://127.0.0.1:5000 53 | 4 threads and 10 connections 54 | Thread Stats Avg Stdev Max +/- Stdev 55 | Latency 2.28ms 1.47ms 35.53ms 95.53% 56 | Req/Sec 0.93k 73.03 1.11k 75.25% 57 | 37105 requests in 10.01s, 2.69MB read 58 | Requests/sec: 3707.70 59 | Transfer/sec: 275.18KB 60 | ``` 61 | 62 | ``` 63 | Running 10s test @ http://127.0.0.1:5000 64 | 4 threads and 100 connections 65 | Thread Stats Avg Stdev Max +/- Stdev 66 | Latency 27.57ms 4.48ms 82.00ms 84.93% 67 | Req/Sec 0.91k 131.34 1.77k 65.50% 68 | 36332 requests in 10.03s, 2.63MB read 69 | Requests/sec: 3622.04 70 | Transfer/sec: 268.82KB 71 | ``` 72 | 73 | ## Tornado (Python) 74 | 75 | ``` 76 | $ benchmark/run-benchmark python2.7 benchmark/tornado/run 77 | ``` 78 | 79 | ``` 80 | Running 10s test @ http://127.0.0.1:5000 81 | 4 threads and 10 connections 82 | Thread Stats Avg Stdev Max +/- Stdev 83 | Latency 3.70ms 195.32us 6.61ms 93.77% 84 | Req/Sec 542.43 16.24 626.00 52.75% 85 | 21605 requests in 10.01s, 4.27MB read 86 | Requests/sec: 2157.56 87 | Transfer/sec: 436.15KB 88 | ``` 89 | 90 | ``` 91 | Running 10s test @ http://127.0.0.1:5000 92 | 4 threads and 100 connections 93 | Thread Stats Avg Stdev Max +/- Stdev 94 | Latency 47.30ms 2.72ms 80.61ms 95.09% 95 | Req/Sec 529.76 61.37 696.00 84.25% 96 | 21100 requests in 10.04s, 4.17MB read 97 | Requests/sec: 2102.45 98 | Transfer/sec: 425.01KB 99 | ``` 100 | 101 | ## Hunchentoot (Common Lisp) 102 | 103 | ``` 104 | $ benchmark/run-benchmark benchmark/hunchentoot/run 105 | ``` 106 | 107 | ``` 108 | Running 10s test @ http://127.0.0.1:5000 109 | 4 threads and 10 connections 110 | Thread Stats Avg Stdev Max +/- Stdev 111 | Latency 1.80ms 692.10us 15.53ms 98.18% 112 | Req/Sec 1.12k 67.36 1.17k 92.52% 113 | 44589 requests in 10.10s, 7.48MB read 114 | Requests/sec: 4414.92 115 | Transfer/sec: 758.81KB 116 | ``` 117 | 118 | ``` 119 | Running 10s test @ http://127.0.0.1:5000 120 | 4 threads and 100 connections 121 | Thread Stats Avg Stdev Max +/- Stdev 122 | Latency 28.87ms 93.72ms 1.61s 95.60% 123 | Req/Sec 1.10k 275.26 1.74k 73.44% 124 | 40945 requests in 10.03s, 6.87MB read 125 | Socket errors: connect 0, read 0, write 0, timeout 3 126 | Requests/sec: 4082.88 127 | Transfer/sec: 701.74KB 128 | ``` 129 | 130 | ## Tornado (PyPy) 131 | 132 | ``` 133 | $ benchmark/run-benchmark pypy benchmark/tornado/run 134 | ``` 135 | 136 | ``` 137 | Running 10s test @ http://127.0.0.1:5000 138 | 4 threads and 10 connections 139 | Thread Stats Avg Stdev Max +/- Stdev 140 | Latency 706.99us 500.39us 15.64ms 99.32% 141 | Req/Sec 2.94k 132.70 3.51k 92.80% 142 | 117746 requests in 10.10s, 23.24MB read 143 | Requests/sec: 11657.78 144 | Transfer/sec: 2.30MB 145 | ``` 146 | 147 | ``` 148 | Running 10s test @ http://127.0.0.1:5000 149 | 4 threads and 100 connections 150 | Thread Stats Avg Stdev Max +/- Stdev 151 | Latency 9.42ms 1.78ms 45.47ms 96.15% 152 | Req/Sec 2.68k 256.60 3.01k 88.25% 153 | 106610 requests in 10.02s, 21.05MB read 154 | Requests/sec: 10636.27 155 | Transfer/sec: 2.10MB 156 | ``` 157 | 158 | ## Node.js http module 159 | 160 | ``` 161 | $ benchmark/run-benchmark benchmark/node/run 162 | ``` 163 | 164 | ``` 165 | Running 10s test @ http://127.0.0.1:5000 166 | 4 threads and 10 connections 167 | Thread Stats Avg Stdev Max +/- Stdev 168 | Latency 655.88us 58.56us 3.40ms 96.02% 169 | Req/Sec 3.06k 76.70 3.18k 81.93% 170 | 122947 requests in 10.10s, 15.24MB read 171 | Requests/sec: 12173.13 172 | Transfer/sec: 1.51MB 173 | ``` 174 | 175 | ``` 176 | Running 10s test @ http://127.0.0.1:5000 177 | 4 threads and 100 connections 178 | Thread Stats Avg Stdev Max +/- Stdev 179 | Latency 8.33ms 648.44us 20.02ms 90.64% 180 | Req/Sec 3.02k 191.95 3.79k 72.25% 181 | 120074 requests in 10.02s, 14.89MB read 182 | Requests/sec: 11984.32 183 | Transfer/sec: 1.49MB 184 | ``` 185 | 186 | ## Woo (Common Lisp) 187 | 188 | ``` 189 | $ benchmark/run-benchmark benchmark/woo/run 190 | ``` 191 | 192 | ``` 193 | Running 10s test @ http://127.0.0.1:5000 194 | 4 threads and 10 connections 195 | Thread Stats Avg Stdev Max +/- Stdev 196 | Latency 298.09us 280.55us 11.49ms 99.22% 197 | Req/Sec 7.10k 595.38 15.62k 85.29% 198 | 283126 requests in 10.10s, 35.10MB read 199 | Requests/sec: 28032.34 200 | Transfer/sec: 3.48MB 201 | ``` 202 | 203 | ``` 204 | Running 10s test @ http://127.0.0.1:5000 205 | 4 threads and 100 connections 206 | Thread Stats Avg Stdev Max +/- Stdev 207 | Latency 2.60ms 594.86us 17.18ms 96.36% 208 | Req/Sec 9.71k 715.15 15.16k 76.25% 209 | 386785 requests in 10.02s, 47.95MB read 210 | Requests/sec: 38591.20 211 | Transfer/sec: 4.78MB 212 | ``` 213 | 214 | ## Go 215 | 216 | ``` 217 | $ benchmark/run-benchmark benchmark/go/run 218 | ``` 219 | 220 | ``` 221 | Running 10s test @ http://127.0.0.1:5000 222 | 4 threads and 10 connections 223 | Thread Stats Avg Stdev Max +/- Stdev 224 | Latency 1.09ms 7.09ms 111.96ms 98.27% 225 | Req/Sec 7.89k 1.75k 21.69k 96.27% 226 | 315671 requests in 10.10s, 38.84MB read 227 | Requests/sec: 31253.92 228 | Transfer/sec: 3.84MB 229 | ``` 230 | 231 | ``` 232 | Running 10s test @ http://127.0.0.1:5000 233 | 4 threads and 100 connections 234 | Thread Stats Avg Stdev Max +/- Stdev 235 | Latency 3.24ms 1.86ms 20.24ms 62.52% 236 | Req/Sec 7.82k 1.05k 27.62k 98.50% 237 | 312051 requests in 10.10s, 38.39MB read 238 | Requests/sec: 30897.12 239 | Transfer/sec: 3.80MB 240 | ``` 241 | 242 | ## Hunchentoot (multi-threaded-taskmaster) 243 | 244 | ``` 245 | $ benchmark/run-benchmark benchmark/hunchentoot/run true 246 | ``` 247 | 248 | ``` 249 | Running 10s test @ http://127.0.0.1:5000 250 | 4 threads and 10 connections 251 | Thread Stats Avg Stdev Max +/- Stdev 252 | Latency 574.56us 2.16ms 50.15ms 96.26% 253 | Req/Sec 7.38k 1.19k 10.46k 69.23% 254 | 295875 requests in 10.10s, 44.30MB read 255 | Requests/sec: 29294.85 256 | Transfer/sec: 4.39MB 257 | ``` 258 | 259 | ``` 260 | Running 10s test @ http://127.0.0.1:5000 261 | 4 threads and 100 connections 262 | Thread Stats Avg Stdev Max +/- Stdev 263 | Latency 12.36ms 52.93ms 943.13ms 97.07% 264 | Req/Sec 8.13k 3.31k 19.63k 69.21% 265 | 322897 requests in 10.09s, 48.35MB read 266 | Requests/sec: 32007.10 267 | Transfer/sec: 4.79MB 268 | ``` 269 | 270 | ## Unicorn + nginx (Ruby, worker_processes=4) 271 | 272 | nginx's worker\_processes=4 273 | Unicorn's worker\_processes=4 274 | 275 | ``` 276 | $ sudo nginx -c $PWD/benchmark/unicorn/nginx.conf 277 | $ benchmark/run-benchmark benchmark/unicorn/run 278 | ``` 279 | 280 | ``` 281 | Running 10s test @ http://127.0.0.1:5000 282 | 4 threads and 10 connections 283 | Thread Stats Avg Stdev Max +/- Stdev 284 | Latency 220.02us 260.33us 11.86ms 98.23% 285 | Req/Sec 9.67k 1.22k 12.66k 70.90% 286 | 386771 requests in 10.10s, 59.37MB read 287 | Requests/sec: 38294.10 288 | Transfer/sec: 5.88MB 289 | ``` 290 | 291 | ``` 292 | Running 10s test @ http://127.0.0.1:5000 293 | 4 threads and 100 connections 294 | Thread Stats Avg Stdev Max +/- Stdev 295 | Latency 1.63ms 3.35ms 103.23ms 98.31% 296 | Req/Sec 18.58k 6.26k 42.99k 72.50% 297 | 740129 requests in 10.04s, 113.61MB read 298 | Requests/sec: 73711.39 299 | Transfer/sec: 11.31MB 300 | ``` 301 | 302 | ## Node.js http module (4 cluster) 303 | 304 | ``` 305 | $ benchmark/run-benchmark benchmark/node/run 4 306 | ``` 307 | 308 | ``` 309 | Running 10s test @ http://127.0.0.1:5000 310 | 4 threads and 10 connections 311 | Thread Stats Avg Stdev Max +/- Stdev 312 | Latency 200.97us 487.76us 27.56ms 99.33% 313 | Req/Sec 11.07k 1.42k 21.98k 85.54% 314 | 441803 requests in 10.10s, 54.77MB read 315 | Requests/sec: 43744.19 316 | Transfer/sec: 5.42MB 317 | ``` 318 | 319 | ``` 320 | Running 10s test @ http://127.0.0.1:5000 321 | 4 threads and 100 connections 322 | Thread Stats Avg Stdev Max +/- Stdev 323 | Latency 2.05ms 417.67us 21.24ms 86.82% 324 | Req/Sec 12.25k 729.79 20.32k 75.50% 325 | 487426 requests in 10.04s, 60.43MB read 326 | Requests/sec: 48546.08 327 | Transfer/sec: 6.02MB 328 | ``` 329 | 330 | ## Woo (Common Lisp, worker-num=4) 331 | 332 | ``` 333 | $ benchmark/run-benchmark benchmark/woo/run 4 334 | ``` 335 | 336 | ``` 337 | Running 10s test @ http://127.0.0.1:5000 338 | 4 threads and 10 connections 339 | Thread Stats Avg Stdev Max +/- Stdev 340 | Latency 323.90us 2.25ms 54.48ms 98.25% 341 | Req/Sec 16.33k 1.71k 20.82k 80.20% 342 | 656401 requests in 10.10s, 81.38MB read 343 | Requests/sec: 64989.82 344 | Transfer/sec: 8.06MB 345 | ``` 346 | 347 | ``` 348 | Running 10s test @ http://127.0.0.1:5000 349 | 4 threads and 100 connections 350 | Thread Stats Avg Stdev Max +/- Stdev 351 | Latency 1.12ms 1.38ms 21.69ms 95.08% 352 | Req/Sec 27.85k 2.26k 36.49k 70.75% 353 | 1108090 requests in 10.03s, 137.38MB read 354 | Requests/sec: 110528.03 355 | Transfer/sec: 13.70MB 356 | ``` 357 | 358 | ## Go (GOMAXPROCS=4) 359 | 360 | ``` 361 | $ benchmark/run-benchmark benchmark/go/run 4 362 | ``` 363 | 364 | ``` 365 | Running 10s test @ http://127.0.0.1:5000 366 | 4 threads and 10 connections 367 | Thread Stats Avg Stdev Max +/- Stdev 368 | Latency 112.86us 511.71us 19.42ms 99.11% 369 | Req/Sec 24.50k 2.75k 31.57k 68.56% 370 | 984705 requests in 10.08s, 121.14MB read 371 | Requests/sec: 97647.04 372 | Transfer/sec: 12.01MB 373 | ``` 374 | 375 | ``` 376 | Running 10s test @ http://127.0.0.1:5000 377 | 4 threads and 100 connections 378 | Thread Stats Avg Stdev Max +/- Stdev 379 | Latency 1.26ms 2.15ms 62.68ms 95.64% 380 | Req/Sec 26.73k 3.98k 36.94k 65.75% 381 | 1064894 requests in 10.04s, 131.01MB read 382 | Requests/sec: 106036.86 383 | Transfer/sec: 13.05MB 384 | ``` 385 | 386 | ## Racket 387 | 388 | ``` 389 | $ benchmark/run-benchmark benchmark/racket/run 390 | ``` 391 | 392 | ``` 393 | Running 10s test @ http://127.0.0.1:5000 394 | 4 threads and 10 connections 395 | Thread Stats Avg Stdev Max +/- Stdev 396 | Latency 6.51ms 13.02ms 147.67ms 91.74% 397 | Req/Sec 561.37 131.01 808.00 64.65% 398 | 22335 requests in 10.06s, 3.22MB read 399 | Requests/sec: 2219.30 400 | Transfer/sec: 327.26KB 401 | ``` 402 | 403 | ``` 404 | Running 10s test @ http://127.0.0.1:5000 405 | 4 threads and 100 connections 406 | Thread Stats Avg Stdev Max +/- Stdev 407 | Latency 66.70ms 52.98ms 503.75ms 89.11% 408 | Req/Sec 434.91 179.08 700.00 62.37% 409 | 17013 requests in 10.06s, 2.45MB read 410 | Requests/sec: 1691.04 411 | Transfer/sec: 249.36KB 412 | ``` 413 | -------------------------------------------------------------------------------- /src/ev/socket.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage woo.ev.socket 3 | (:use :cl) 4 | (:import-from :woo.ev.event-loop 5 | :*evloop* 6 | :deref-data-from-pointer 7 | :remove-pointer-from-registry) 8 | (:import-from :woo.ev.util 9 | :io-fd 10 | :define-c-callback) 11 | (:import-from :woo.syscall 12 | #+nil :close 13 | #+nil :write 14 | :errno 15 | :EWOULDBLOCK 16 | :EINTR 17 | :ECONNABORTED 18 | :ECONNREFUSED 19 | :ECONNRESET) 20 | (:import-from :woo.ev.condition 21 | :socket-closed) 22 | (:import-from :lev 23 | :ev-now 24 | :ev-io 25 | :ev-io-init 26 | :ev-io-start 27 | :ev-io-stop 28 | :ev-timer 29 | :ev-timer-stop 30 | :+EV-READ+ 31 | :+EV-WRITE+) 32 | (:import-from :fast-io 33 | :make-output-buffer 34 | :fast-write-sequence 35 | :fast-write-byte 36 | :finish-output-buffer) 37 | (:import-from :cffi 38 | :with-pointer-to-vector-data 39 | :incf-pointer 40 | :foreign-free) 41 | (:export :socket 42 | :make-socket 43 | :socket-read-watcher 44 | :socket-write-watcher 45 | :socket-timeout-timer 46 | :socket-last-activity 47 | :socket-remote-addr 48 | :socket-remote-port 49 | :socket-data 50 | :socket-read-cb 51 | :socket-open-p 52 | :socket-ssl-handle 53 | :check-socket-open 54 | 55 | :write-socket-data 56 | :write-socket-byte 57 | :write-socket-stream 58 | :flush-buffer 59 | :with-async-writing 60 | :send-static-file 61 | :close-socket)) 62 | (in-package :woo.ev.socket) 63 | 64 | (defstruct (socket (:constructor %make-socket)) 65 | (watchers (make-array 3 66 | :element-type 'cffi:foreign-pointer 67 | :initial-contents (list (cffi:foreign-alloc '(:struct lev:ev-io)) 68 | (cffi:foreign-alloc '(:struct lev:ev-io)) 69 | (cffi:foreign-alloc '(:struct lev:ev-timer)))) 70 | :type (simple-array cffi:foreign-pointer (3))) 71 | (last-activity (lev:ev-now *evloop*) :type double-float) 72 | (fd nil :type fixnum) 73 | remote-addr 74 | remote-port 75 | data 76 | (tcp-read-cb nil :type symbol) 77 | (read-cb nil :type (or null function)) 78 | (write-cb nil :type (or null function)) 79 | (ssl-handle nil :type (or null cffi:foreign-pointer)) 80 | (open-p t :type boolean) 81 | 82 | (buffer (make-output-buffer #+lispworks :output #+lispworks :static)) 83 | (sendfile-fd nil :type (or null fixnum)) 84 | (sendfile-size nil :type (or null integer)) 85 | (sendfile-offset 0 :type (or null integer))) 86 | 87 | (defun buffer-empty-p (socket) 88 | (declare (optimize (speed 3) (safety 0) (debug 0))) 89 | (= (the fixnum (fast-io::output-buffer-len (socket-buffer socket))) 0)) 90 | 91 | (defun make-socket (&rest initargs &key tcp-read-cb fd &allow-other-keys) 92 | (let ((socket (apply #'%make-socket initargs))) 93 | (lev:ev-io-init (socket-read-watcher socket) 94 | tcp-read-cb 95 | fd 96 | lev:+EV-READ+) 97 | (lev:ev-io-init (socket-write-watcher socket) 98 | 'async-write-cb 99 | fd 100 | lev:+EV-WRITE+) 101 | socket)) 102 | 103 | (declaim (inline socket-read-watcher socket-write-watcher socket-timeout-timer)) 104 | 105 | (defun socket-read-watcher (socket) 106 | (svref (socket-watchers socket) 0)) 107 | 108 | (defun socket-write-watcher (socket) 109 | (svref (socket-watchers socket) 1)) 110 | 111 | (defun socket-timeout-timer (socket) 112 | (svref (socket-watchers socket) 2)) 113 | 114 | (defun free-watchers (socket) 115 | (let ((read-watcher (socket-read-watcher socket)) 116 | (write-watcher (socket-write-watcher socket)) 117 | (timeout-timer (socket-timeout-timer socket))) 118 | (lev:ev-io-stop *evloop* read-watcher) 119 | (lev:ev-io-stop *evloop* write-watcher) 120 | (lev:ev-timer-stop *evloop* timeout-timer) 121 | (cffi:foreign-free read-watcher) 122 | (cffi:foreign-free write-watcher) 123 | (cffi:foreign-free timeout-timer))) 124 | 125 | (defun close-socket (socket) 126 | (when (socket-open-p socket) 127 | (setf (socket-open-p socket) nil) 128 | (free-watchers socket) 129 | (let ((fd (socket-fd socket))) 130 | (wsys:close fd) 131 | (remove-pointer-from-registry fd)) 132 | (setf (socket-read-cb socket) nil 133 | (socket-write-cb socket) nil 134 | (socket-buffer socket) nil 135 | (socket-data socket) nil) 136 | (let ((sendfile-fd (socket-sendfile-fd socket))) 137 | (when sendfile-fd 138 | (wsys:close sendfile-fd) 139 | (setf (socket-sendfile-fd socket) nil)))) 140 | t) 141 | 142 | (defun check-socket-open (socket) 143 | (unless (socket-open-p socket) 144 | (error 'socket-closed))) 145 | 146 | (defun write-socket-data (socket data &key (start 0) (end (length data)) 147 | (write-cb nil write-cb-specified-p)) 148 | (declare (optimize speed) 149 | (type vector data) 150 | (type fixnum start end)) 151 | (when (socket-open-p socket) 152 | (when write-cb-specified-p 153 | (setf (socket-write-cb socket) write-cb)) 154 | (if (typep data '(simple-array (unsigned-byte 8) (*))) 155 | (fast-write-sequence data 156 | (socket-buffer socket) 157 | start end) 158 | (loop for i from start upto (1- end) 159 | for byte of-type (unsigned-byte 8) = (aref data i) 160 | do (fast-write-byte byte (socket-buffer socket)))))) 161 | 162 | (defun write-socket-byte (socket byte &key (write-cb nil write-cb-specified-p)) 163 | (declare (optimize speed) 164 | (type (unsigned-byte 8) byte)) 165 | (when (socket-open-p socket) 166 | (when write-cb-specified-p 167 | (setf (socket-write-cb socket) write-cb)) 168 | (fast-write-byte byte (socket-buffer socket)))) 169 | 170 | (defun write-socket-stream (socket stream &key (write-cb nil write-cb-specified-p)) 171 | (declare (optimize speed) 172 | (type file-stream stream)) 173 | (when (socket-open-p socket) 174 | (when write-cb-specified-p 175 | (setf (socket-write-cb socket) write-cb)) 176 | (let ((file-size (file-length stream)) 177 | (buffer (socket-buffer socket))) 178 | (unless (= (file-position stream) file-size) 179 | (loop 180 | (let* ((start (fast-io::output-buffer-fill buffer)) 181 | (end 182 | (read-sequence (fast-io::output-buffer-vector buffer) 183 | stream 184 | :start start))) 185 | (setf (fast-io::output-buffer-fill buffer) end) 186 | (incf (fast-io::output-buffer-len buffer) 187 | (- end start))) 188 | (cond 189 | ((= (file-position stream) file-size) 190 | (return)) 191 | ;; Prevent from loading a too large file on memory. 192 | ;; TODO: Allow to set the threshold by users. 193 | ((< 1048576 (fast-io::output-buffer-len buffer)) 194 | (and (flush-buffer socket) 195 | (reset-buffer socket))) 196 | (t 197 | (fast-io::extend buffer)))))))) 198 | 199 | (declaim (inline reset-buffer)) 200 | (defun reset-buffer (socket) 201 | (let ((buffer (socket-buffer socket))) 202 | (when buffer 203 | (setf (fast-io::output-buffer-vector buffer) (fast-io::make-octet-vector fast-io:*default-output-buffer-size*) 204 | (fast-io::output-buffer-fill buffer) 0 205 | (fast-io::output-buffer-len buffer) 0 206 | (fast-io::output-buffer-queue buffer) nil 207 | (fast-io::output-buffer-last buffer) nil)))) 208 | 209 | (defun flush-buffer (socket) 210 | (declare (optimize speed)) 211 | (check-socket-open socket) 212 | (let ((data (finish-output-buffer (socket-buffer socket))) 213 | (fd (socket-fd socket))) 214 | (declare (type (simple-array (unsigned-byte 8) (*)) data)) 215 | (cffi:with-pointer-to-vector-data (data-sap data) 216 | (let* ((len (length data)) 217 | (completedp nil) 218 | (ssl-handle (socket-ssl-handle socket)) 219 | (n 220 | #+woo-no-ssl 221 | (wsys:write fd data-sap len) 222 | #-woo-no-ssl 223 | (if ssl-handle 224 | (cl+ssl::ssl-write ssl-handle 225 | data-sap 226 | len) 227 | (wsys:write fd data-sap len)))) 228 | (declare (type fixnum len) 229 | (type fixnum n)) 230 | (case n 231 | (-1 232 | (if ssl-handle 233 | #+woo-no-ssl (close-socket socket) 234 | #-woo-no-ssl 235 | (let ((errno (cl+ssl::ssl-get-error ssl-handle n))) 236 | (declare (type fixnum errno)) 237 | (cond 238 | ((or (= errno cl+ssl::+ssl-error-zero-return+) 239 | (= errno cl+ssl::+ssl-error-ssl+)) 240 | (close-socket socket)) 241 | ((= errno cl+ssl::+ssl-error-want-write+)) 242 | (t 243 | (vom:error "Unexpected error (Code: ~D)" errno) 244 | (close-socket socket)))) 245 | (let ((errno (wsys:errno))) 246 | (return-from flush-buffer 247 | (cond 248 | ((or (= errno wsys:EWOULDBLOCK) 249 | (= errno wsys:EINTR)) 250 | nil) 251 | ((or (= errno wsys:ECONNABORTED) 252 | (= errno wsys:ECONNREFUSED) 253 | (= errno wsys:ECONNRESET) 254 | (= errno wsys:EPIPE) 255 | (= errno wsys:ENOTCONN)) 256 | (vom:error "Connection is already closed (Code: ~D)" errno) 257 | (close-socket socket) 258 | t) 259 | (t 260 | (vom:error "Unexpected error (Code: ~D)" errno) 261 | (close-socket socket) 262 | t)))))) 263 | (otherwise 264 | (setf (socket-last-activity socket) (lev:ev-now *evloop*)) 265 | (if (= n len) 266 | (setq completedp t) 267 | (progn 268 | (reset-buffer socket) 269 | (fast-write-sequence data 270 | (socket-buffer socket) 271 | n))))) 272 | completedp)))) 273 | 274 | (defun send-file (socket) 275 | (declare (optimize speed)) 276 | (let* ((infd (socket-sendfile-fd socket)) 277 | (offset (socket-sendfile-offset socket)) 278 | (n (wsys:sendfile infd (socket-fd socket) offset 279 | (min (- (socket-sendfile-size socket) offset) 280 | (* 1024 100))))) 281 | (declare (type fixnum n)) 282 | (cond 283 | ((= n -1) 284 | (let ((errno (wsys:errno))) 285 | (declare (type fixnum errno)) 286 | (return-from send-file 287 | (cond 288 | ((or (= errno wsys:EWOULDBLOCK) 289 | (= errno wsys:EINTR)) 290 | nil) 291 | ((or (= errno wsys:ECONNABORTED) 292 | (= errno wsys:ECONNREFUSED) 293 | (= errno wsys:ECONNRESET) 294 | (= errno wsys:EPIPE) 295 | (= errno wsys:ENOTCONN)) 296 | (vom:error "Connection is already closed (Code: ~D)" errno) 297 | (close-socket socket) 298 | t) 299 | (t 300 | (vom:error "Unexpected error (Code: ~D)" errno) 301 | (close-socket socket) 302 | t))))) 303 | (t 304 | (setf (socket-last-activity socket) (lev:ev-now *evloop*)) 305 | (let ((completedp (= (socket-sendfile-size socket) 306 | (incf (socket-sendfile-offset socket) n)))) 307 | (when completedp 308 | (wsys:close infd) 309 | (setf (socket-sendfile-fd socket) nil)) 310 | completedp))))) 311 | 312 | (defun async-write (socket) 313 | (declare (optimize speed)) 314 | (unless (socket-open-p socket) 315 | (return-from async-write t)) 316 | 317 | ;; Send from buffer 318 | (unless (buffer-empty-p socket) 319 | (unless (flush-buffer socket) 320 | (return-from async-write nil)) 321 | (reset-buffer socket)) 322 | ;; Send a static file? 323 | (when (socket-sendfile-fd socket) 324 | (unless (send-file socket) 325 | (return-from async-write nil))) 326 | 327 | ;; Transfer has been completed. 328 | (when (socket-write-cb socket) 329 | (funcall (the function (socket-write-cb socket)) socket)) 330 | ;; Need to check if 'socket' is still open because it may be closed in write-cb. 331 | (when (socket-open-p socket) 332 | (setf (socket-write-cb socket) nil) 333 | (lev:ev-io-stop *evloop* (socket-write-watcher socket))) 334 | t) 335 | 336 | (define-c-callback async-write-cb :void ((evloop :pointer) (io :pointer) (events :int)) 337 | (declare (optimize speed) 338 | (ignore events)) 339 | (let* ((fd (io-fd io)) 340 | (socket (deref-data-from-pointer fd))) 341 | (unless socket 342 | (lev:ev-io-stop evloop io) 343 | (cffi:foreign-free io) 344 | (return-from async-write-cb)) 345 | 346 | (async-write socket))) 347 | 348 | (defmacro with-async-writing ((socket &key write-cb force-streaming) &body body) 349 | `(progn 350 | ,@body 351 | (setf (socket-write-cb ,socket) ,write-cb) 352 | ,(if force-streaming 353 | `(unless (async-write ,socket) 354 | (lev:ev-io-start *evloop* (socket-write-watcher ,socket))) 355 | `(lev:ev-io-start *evloop* (socket-write-watcher ,socket))))) 356 | 357 | (defun send-static-file (socket fd size) 358 | (with-slots (sendfile-fd sendfile-size sendfile-offset) socket 359 | (when sendfile-fd 360 | (warn "Trying to send another file while sending a file.") 361 | (wsys:close sendfile-fd)) 362 | (setf sendfile-fd fd 363 | sendfile-size size 364 | sendfile-offset 0))) 365 | -------------------------------------------------------------------------------- /src/ev/tcp.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage woo.ev.tcp 3 | (:use :cl) 4 | (:import-from :woo.ev.event-loop 5 | :check-event-loop-running 6 | :deref-data-from-pointer 7 | :callbacks 8 | :*evloop* 9 | :*input-buffer*) 10 | (:import-from :woo.ev.socket 11 | :make-socket 12 | :close-socket 13 | :socket-ssl-handle 14 | :socket-fd 15 | :socket-read-cb 16 | :socket-read-watcher 17 | :socket-timeout-timer 18 | :socket-last-activity) 19 | (:import-from :woo.ev.condition 20 | :os-error) 21 | (:import-from :woo.syscall 22 | :set-fd-nonblock 23 | #+nil :close 24 | #+nil :read 25 | :errno 26 | :EWOULDBLOCK 27 | :ECONNABORTED 28 | :ECONNREFUSED 29 | :ECONNRESET 30 | :EPROTO 31 | :EINTR) 32 | (:import-from :woo.llsocket 33 | #-linux :accept 34 | #+linux :accept4 35 | :bind 36 | #+nil :listen 37 | :+SOCK-CLOEXEC+ 38 | :+SOCK-NONBLOCK+ 39 | :socket 40 | :sockaddr-in 41 | :sockaddr-in6 42 | :sockaddr-storage 43 | :inet-ntoa 44 | :inet-ntop 45 | :setsockopt 46 | :addrinfo 47 | :getaddrinfo 48 | :freeaddrinfo 49 | :+AF-INET+ 50 | :+AF-INET6+ 51 | :+AI-PASSIVE+ 52 | :+SOCK-STREAM+ 53 | :+SOL-SOCKET+ 54 | :+SO-REUSEADDR+) 55 | (:import-from :woo.ev.util 56 | :define-c-callback 57 | :io-fd) 58 | (:import-from :lev 59 | :ev-io 60 | :ev-now 61 | :ev-io-init 62 | :ev-io-start 63 | :ev-io-stop 64 | :ev-timer 65 | :ev-timer-init 66 | :ev-timer-again 67 | :+EV-READ+ 68 | :+EV-TIMER+) 69 | (:import-from :swap-bytes 70 | :htonl 71 | :htons) 72 | (:import-from :cffi 73 | :foreign-alloc 74 | :foreign-free 75 | :foreign-slot-value 76 | :foreign-slot-pointer 77 | :with-foreign-object 78 | :with-foreign-slots 79 | :mem-aref 80 | :mem-ref 81 | :null-pointer 82 | :foreign-type-size 83 | :foreign-string-to-lisp) 84 | (:export :tcp-server 85 | :close-tcp-server 86 | :with-sockaddr 87 | :start-listening-socket 88 | :*connection-timeout*)) 89 | (in-package :woo.ev.tcp) 90 | 91 | (declaim (type double-float *connection-timeout*)) 92 | (defvar *connection-timeout* (coerce (* 15 60) 'double-float)) 93 | 94 | (define-c-callback tcp-read-cb :void ((evloop :pointer) (watcher :pointer) (events :int)) 95 | (declare (ignore evloop events)) 96 | (let* ((fd (io-fd watcher)) 97 | (buffer-len (length *input-buffer*)) 98 | (socket (deref-data-from-pointer fd)) 99 | (read-cb (socket-read-cb socket)) 100 | (ssl-handle (socket-ssl-handle socket))) 101 | (loop 102 | (let ((n 103 | #+woo-no-ssl 104 | (wsys:read fd (static-vectors:static-vector-pointer *input-buffer*) buffer-len) 105 | #-woo-no-ssl 106 | (if ssl-handle 107 | (cl+ssl::ssl-read ssl-handle (static-vectors:static-vector-pointer *input-buffer*) buffer-len) 108 | (wsys:read fd (static-vectors:static-vector-pointer *input-buffer*) buffer-len)))) 109 | (declare (type fixnum n)) 110 | (case n 111 | (-1 112 | (if ssl-handle 113 | #+woo-no-ssl (close-socket socket) 114 | #-woo-no-ssl 115 | (let ((errno (cl+ssl::ssl-get-error ssl-handle n))) 116 | (declare (type fixnum errno)) 117 | (cond 118 | ((or (= errno cl+ssl::+ssl-error-zero-return+) 119 | (= errno cl+ssl::+ssl-error-ssl+)) 120 | (close-socket socket)) 121 | ((= errno cl+ssl::+ssl-error-want-read+)) 122 | (t 123 | (vom:error "Unexpected error (Code: ~D)" errno) 124 | (close-socket socket)))) 125 | (let ((errno (wsys:errno))) 126 | (declare (type fixnum errno)) 127 | (cond 128 | ((or (= errno wsys:EWOULDBLOCK) 129 | (= errno wsys:EINTR))) 130 | ((or (= errno wsys:ECONNABORTED) 131 | (= errno wsys:ECONNREFUSED) 132 | (= errno wsys:ECONNRESET)) 133 | (vom:error "Connection is already closed (Code: ~D)" errno) 134 | (close-socket socket)) 135 | ((= errno wsys:EAGAIN) 136 | ;; Just to nothing 137 | ) 138 | (t 139 | (vom:error "Unexpected error (Code: ~D)" errno) 140 | (close-socket socket))))) 141 | (return)) 142 | (0 143 | ;; EOF 144 | (setf (socket-last-activity socket) (lev:ev-now *evloop*)) 145 | (close-socket socket) 146 | (return)) 147 | (otherwise 148 | (setf (socket-last-activity socket) (lev:ev-now *evloop*)) 149 | (when read-cb 150 | (funcall (the function read-cb) socket *input-buffer* :start 0 :end n)) 151 | (unless (= n buffer-len) 152 | (return)))))))) 153 | 154 | (define-c-callback timeout-cb :void ((evloop :pointer) (timer :pointer) (events :int)) 155 | (declare (ignore events)) 156 | (let* ((now (lev:ev-now evloop)) 157 | (fd (io-fd (cffi:foreign-slot-value timer '(:struct lev:ev-timer) 'lev::data))) 158 | (socket (deref-data-from-pointer fd)) 159 | (timeout (+ (socket-last-activity socket) *connection-timeout*))) 160 | (declare (type double-float now timeout)) 161 | (if (< timeout now) 162 | (progn 163 | (vom:info "Timeout, closing connection") 164 | (close-socket socket)) 165 | (progn 166 | (setf (cffi:foreign-slot-value timer '(:struct lev:ev-timer) 'lev::repeat) 167 | (- timeout now)) 168 | (lev:ev-timer-again evloop timer))))) 169 | 170 | (defvar *dummy-sockaddr*) 171 | (defvar *dummy-socklen*) 172 | (defvar *dummy-sockstring*) 173 | 174 | (defmacro with-sockaddr (&body body) 175 | `(let* ((*dummy-sockaddr* (cffi:foreign-alloc '(:struct wsock:sockaddr-storage))) 176 | (*dummy-socklen* (cffi:foreign-alloc 'wsock:socklen-t)) 177 | (*dummy-sockstring* (cffi:foreign-alloc :char :count 46))) 178 | (wsys:bzero *dummy-sockaddr* (cffi:foreign-type-size '(:struct wsock:sockaddr-storage))) 179 | (setf (cffi:mem-aref *dummy-socklen* 'wsock:socklen-t) (cffi:foreign-type-size '(:struct wsock:sockaddr-storage))) 180 | (dotimes (i 46) 181 | (setf (mem-ref *dummy-sockstring* :char i) 0)) 182 | (unwind-protect 183 | (progn ,@body) 184 | (cffi:foreign-free *dummy-sockaddr*) 185 | (cffi:foreign-free *dummy-socklen*) 186 | (cffi:foreign-free *dummy-sockstring*)))) 187 | 188 | (defun get-remote-addr-and-port () 189 | (declare (optimize (speed 3) (safety 2) (debug 2))) 190 | (let ((family (cffi:foreign-slot-value *dummy-sockaddr* '(:struct wsock:sockaddr-storage) 'wsock::family))) 191 | (declare (type fixnum family)) 192 | (cond 193 | ((= family wsock:+AF-INET6+) 194 | (wsock:inet-ntop 195 | family 196 | (cffi:foreign-slot-pointer *dummy-sockaddr* '(:struct wsock:sockaddr-in6) 'wsock::addr) 197 | *dummy-sockstring* 198 | (cffi:mem-aref *dummy-socklen* :int)) 199 | (values 200 | (cffi:foreign-string-to-lisp *dummy-sockstring*) 201 | (cffi:foreign-slot-value *dummy-sockaddr* '(:struct wsock:sockaddr-in6) 'wsock::port))) 202 | ((= family wsock:+AF-INET+) 203 | (values 204 | (wsock:inet-ntoa 205 | (cffi:foreign-slot-value *dummy-sockaddr* '(:struct wsock::sockaddr-in) 'wsock::addr)) 206 | (cffi:foreign-slot-value *dummy-sockaddr* '(:struct wsock:sockaddr-in) 'wsock::port))) 207 | (t (values nil nil))))) 208 | 209 | (define-c-callback tcp-accept-cb :void ((evloop :pointer) (listener :pointer) (events :int)) 210 | (declare (ignore evloop events)) 211 | (let* ((fd (io-fd listener)) 212 | (client-fd #+linux (wsock:accept4 fd 213 | *dummy-sockaddr* 214 | *dummy-socklen* 215 | (logxor wsock:+SOCK-CLOEXEC+ wsock:+SOCK-NONBLOCK+)) 216 | #-linux (wsock:accept fd 217 | *dummy-sockaddr* 218 | *dummy-socklen*))) 219 | (case client-fd 220 | (-1 (let ((errno (wsys:errno))) 221 | (cond 222 | ((or (= errno wsys:EWOULDBLOCK) 223 | (= errno wsys:ECONNABORTED) 224 | (= errno wsys:EPROTO) 225 | (= errno wsys:EINTR))) 226 | (t 227 | (vom:error "Can't accept connection (Code: ~D)" errno))))) 228 | (otherwise 229 | #-linux (set-fd-nonblock client-fd t) 230 | 231 | ;; In case the client disappeared before closing the socket, 232 | ;; a socket object remains in the data registry. 233 | ;; I need to check if OS is gonna reuse the file descriptor. 234 | (let ((existing-socket (deref-data-from-pointer client-fd))) 235 | (when existing-socket 236 | (close-socket existing-socket))) 237 | (multiple-value-bind (remote-addr remote-port) 238 | (get-remote-addr-and-port) 239 | (let ((socket (make-socket :fd client-fd :tcp-read-cb 'tcp-read-cb 240 | :remote-addr remote-addr :remote-port remote-port))) 241 | (let* ((callbacks (callbacks fd)) 242 | (read-cb (getf callbacks :read-cb)) 243 | (connect-cb (getf callbacks :connect-cb))) 244 | (when read-cb 245 | (setf (socket-read-cb socket) read-cb)) 246 | (when connect-cb 247 | (funcall (the function connect-cb) socket))))))))) 248 | 249 | (defun start-listening-socket (socket) 250 | (setf (deref-data-from-pointer (socket-fd socket)) socket) 251 | (lev:ev-io-start *evloop* (socket-read-watcher socket)) 252 | (let ((timer (socket-timeout-timer socket))) 253 | (lev:ev-timer-init timer 'timeout-cb *connection-timeout* 0.0d0) 254 | (setf (cffi:foreign-slot-value timer '(:struct lev:ev-timer) 'lev::data) (socket-read-watcher socket)) 255 | (timeout-cb *evloop* timer lev:+EV-TIMER+))) 256 | 257 | (defun listen-on (address port &key (backlog 128) sockopt) 258 | (cffi:with-foreign-object (ai '(:pointer (:struct wsock:addrinfo))) 259 | (cffi:with-foreign-object (hints '(:struct wsock:addrinfo)) 260 | (wsys:bzero hints (cffi:foreign-type-size '(:struct wsock:addrinfo))) 261 | (cffi:with-foreign-slots ((wsock::family wsock::socktype wsock::flags) hints (:struct wsock:addrinfo)) 262 | (setf wsock::family (if (and (stringp address) 263 | (quri.domain:ipv6-addr-p address)) 264 | wsock:+AF-INET6+ 265 | wsock:+AF-INET+) 266 | wsock::socktype wsock:+SOCK-STREAM+ 267 | wsock::flags wsock:+AI-PASSIVE+)) 268 | (let ((err (wsock:getaddrinfo (or address 269 | (cffi:null-pointer)) 270 | (write-to-string port) 271 | hints ai))) 272 | (unless (= err 0) 273 | (error 'os-error 274 | :description "getaddrinfo() failed" 275 | :code err)))) 276 | (let ((ai (cffi:mem-ref ai :pointer))) 277 | (cffi:with-foreign-slots ((wsock::family 278 | wsock::socktype 279 | wsock::protocol 280 | wsock::addr 281 | wsock::addrlen) 282 | ai 283 | (:struct wsock:addrinfo)) 284 | (let ((fd (wsock:socket wsock::family wsock::socktype wsock::protocol))) 285 | (when (= fd -1) 286 | (error 'os-error 287 | :description (format nil "Cannot create listening socket (family=~S / socktype=~S / protocol=~S)" 288 | wsock::family 289 | wsock::socktype 290 | wsock::protocol) 291 | :code (wsys:errno))) 292 | (let ((res (wsys:set-fd-nonblock fd t))) 293 | (when (= res -1) 294 | (error 'os-error 295 | :description "Cannot set fd nonblock" 296 | :code (wsys:errno)))) 297 | (cffi:with-foreign-object (on :int) 298 | (setf (cffi:mem-aref on :int) 1) 299 | (when (= (wsock:setsockopt fd wsock:+SOL-SOCKET+ sockopt on (cffi:foreign-type-size :int)) -1) 300 | (error 'os-error 301 | :description "Cannot set socket option" 302 | :code (wsys:errno)))) 303 | (when (= (wsock:bind fd wsock::addr wsock::addrlen) -1) 304 | (error 'os-error 305 | :description (format nil "Cannot bind fd to the address ~S" address) 306 | :code (wsys:errno))) 307 | (wsock:listen fd backlog) 308 | 309 | (wsock:freeaddrinfo ai) 310 | 311 | fd))))) 312 | 313 | (defun listen-on-fd (fd &key (backlog 128)) 314 | (set-fd-nonblock fd t) 315 | (wsock:listen fd backlog) 316 | fd) 317 | 318 | (defun listen-on-unix (path &key (backlog 128) sockopt) 319 | (let ((fd (wsock:socket wsock:+AF-UNIX+ wsock:+SOCK-STREAM+ 0))) 320 | (when (= fd -1) 321 | (error 'os-error 322 | :description "Cannot create listening socket" 323 | :code (wsys:errno))) 324 | (let ((res (wsys:set-fd-nonblock fd t))) 325 | (when (= res -1) 326 | (error 'os-error 327 | :description "Cannot set fd nonblock" 328 | :code (wsys:errno)))) 329 | (cffi:with-foreign-object (on :int) 330 | (setf (cffi:mem-aref on :int) 1) 331 | (when (= (wsock:setsockopt fd wsock:+SOL-SOCKET+ sockopt on (cffi:foreign-type-size :int)) -1) 332 | (error 'os-error 333 | :description "Cannot set socket option" 334 | :code (wsys:errno)))) 335 | (when (probe-file path) 336 | (delete-file path)) 337 | (let ((path (namestring path))) 338 | ;; TODO: check if the path is too long 339 | (cffi:with-foreign-object (sun '(:struct wsock:sockaddr-un)) 340 | (wsys:bzero sun (cffi:foreign-type-size '(:struct wsock:sockaddr-un))) 341 | (setf (cffi:foreign-slot-value sun '(:struct wsock:sockaddr-un) 'wsock::family) 342 | wsock:+AF-UNIX+) 343 | (let ((sun-name-ptr (cffi:foreign-slot-pointer sun '(:struct wsock:sockaddr-un) 'wsock::path))) 344 | (dotimes (i (length path)) 345 | (setf (cffi:mem-aref sun-name-ptr :char i) (char-code (elt path i))))) 346 | (when (= (wsock:bind fd sun (+ (cffi:foreign-type-size 'wsock::sa-family-t) 347 | (length path) 348 | 1)) 349 | -1) 350 | (error 'os-error 351 | :description (format nil "Cannot bind fd to ~S" path) 352 | :code (wsys:errno))) 353 | (wsys:chmod path #o777))) 354 | (wsock:listen fd backlog) 355 | fd)) 356 | 357 | (defun make-listener (address port &key backlog fd sockopt) 358 | (let ((fd (if fd 359 | (listen-on-fd fd :backlog backlog) 360 | (listen-on address port :backlog backlog :sockopt sockopt))) 361 | (listener (cffi:foreign-alloc '(:struct lev:ev-io)))) 362 | (lev:ev-io-init listener 'tcp-accept-cb fd lev:+EV-READ+) 363 | listener)) 364 | 365 | (defun tcp-server (address-port read-cb &key connect-cb (backlog 128) fd (sockopt wsock:+SO-REUSEADDR+)) 366 | (check-event-loop-running) 367 | (etypecase address-port 368 | (cons 369 | (let* ((address (car address-port)) 370 | (port (cdr address-port)) 371 | (listener (make-listener address port :backlog backlog :fd fd :sockopt sockopt))) 372 | (lev:ev-io-start *evloop* listener) 373 | (setf (callbacks (io-fd listener)) (list :read-cb read-cb :connect-cb connect-cb)) 374 | listener)) 375 | (pathname 376 | (let ((fd (listen-on-unix address-port :backlog backlog :sockopt sockopt)) 377 | (listener (cffi:foreign-alloc '(:struct lev:ev-io)))) 378 | (lev:ev-io-init listener 'tcp-accept-cb fd lev:+EV-READ+) 379 | (lev:ev-io-start *evloop* listener) 380 | (setf (callbacks (io-fd listener)) (list :read-cb read-cb :connect-cb connect-cb)) 381 | listener)))) 382 | 383 | (defun close-tcp-server (watcher) 384 | (when watcher 385 | (let ((fd (io-fd watcher))) 386 | (when fd 387 | (wsys:close fd))) 388 | (cffi:foreign-free watcher))) 389 | -------------------------------------------------------------------------------- /src/woo.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage woo 3 | (:nicknames :clack.handler.woo) 4 | (:use :cl 5 | :woo.specials 6 | :woo.signal) 7 | (:import-from :woo.response 8 | :*empty-chunk* 9 | :write-socket-string 10 | :write-socket-crlf 11 | :response-headers-bytes 12 | :write-response-headers 13 | :write-body-chunk 14 | :write-string-body-chunk 15 | :finish-response) 16 | (:import-from :woo.ev 17 | :*buffer-size* 18 | :*connection-timeout* 19 | :*evloop* 20 | :socket-remote-addr 21 | :socket-remote-port 22 | :with-sockaddr) 23 | #-woo-no-ssl 24 | (:import-from :woo.ssl) 25 | (:import-from :woo.util 26 | :integer-string-p) 27 | (:import-from :quri 28 | :uri 29 | :uri-path 30 | :uri-query) 31 | (:import-from :fast-http 32 | :make-http-request 33 | :make-parser 34 | :http-method 35 | :http-resource 36 | :http-headers 37 | :http-major-version 38 | :http-minor-version 39 | :parsing-error 40 | :fast-http-error) 41 | (:import-from :smart-buffer 42 | :make-smart-buffer 43 | :write-to-buffer 44 | :finalize-buffer) 45 | (:import-from :trivial-utf-8 46 | :string-to-utf-8-bytes 47 | :utf-8-bytes-to-string 48 | :utf-8-byte-length) 49 | (:import-from :alexandria 50 | :hash-table-plist 51 | :copy-stream 52 | :if-let) 53 | (:export :run 54 | :stop 55 | :*buffer-size* 56 | :*connection-timeout* 57 | :*default-backlog-size* 58 | :*default-worker-num*)) 59 | (in-package :woo) 60 | 61 | (defvar *default-backlog-size* 128) 62 | (defvar *default-worker-num* nil) 63 | 64 | (defun run (app &key (debug t) 65 | (port 5000) (address "127.0.0.1") 66 | listen ;; UNIX domain socket 67 | (backlog *default-backlog-size*) fd 68 | (worker-num *default-worker-num*) 69 | ssl-key-file 70 | ssl-cert-file 71 | ssl-key-password) 72 | (declare (ignorable ssl-key-password)) 73 | (assert (and (integerp backlog) 74 | (plusp backlog) 75 | (<= backlog 128))) 76 | (assert (or (and (integerp worker-num) 77 | (< 0 worker-num)) 78 | (null worker-num))) 79 | (when (stringp listen) 80 | (setf listen (pathname listen))) 81 | (check-type listen (or pathname null)) 82 | 83 | (let ((*app* app) 84 | (*debug* debug) 85 | (*listener* nil) 86 | (ssl (or ssl-key-file ssl-cert-file))) 87 | (labels ((start-socket (socket) 88 | #-woo-no-ssl 89 | (when ssl 90 | (woo.ssl:init-ssl-handle socket 91 | ssl-cert-file 92 | ssl-key-file 93 | ssl-key-password)) 94 | (setup-parser socket) 95 | (woo.ev.tcp:start-listening-socket socket)) 96 | (start-multithread-server () 97 | (unless (getf vom::*config* :woo.signal) 98 | (vom:config :woo.signal :info)) 99 | (let ((*cluster* (woo.worker:make-cluster worker-num #'start-socket)) 100 | (signal-watchers (make-signal-watchers))) 101 | (wev:with-sockaddr 102 | (unwind-protect 103 | (wev:with-event-loop (:cleanup-fn 104 | (lambda () 105 | (stop-signal-watchers *evloop* signal-watchers))) 106 | (start-signal-watchers *evloop* signal-watchers) 107 | (setq *listener* 108 | (wev:tcp-server (or listen 109 | (cons address port)) 110 | #'read-cb 111 | :connect-cb 112 | (lambda (socket) 113 | (woo.worker:add-job-to-cluster *cluster* socket)) 114 | :backlog backlog 115 | :fd fd 116 | :sockopt wsock:+SO-REUSEADDR+))) 117 | (wev:close-tcp-server *listener*) 118 | (woo.worker:stop-cluster *cluster*))))) 119 | (start-singlethread-server () 120 | (let ((signal-watchers (make-signal-watchers))) 121 | (wev:with-sockaddr 122 | (unwind-protect 123 | (wev:with-event-loop (:cleanup-fn 124 | (lambda () 125 | (stop-signal-watchers *evloop* signal-watchers))) 126 | (start-signal-watchers *evloop* signal-watchers) 127 | (setq *listener* 128 | (wev:tcp-server (or listen 129 | (cons address port)) 130 | #'read-cb 131 | :connect-cb #'start-socket 132 | :backlog backlog 133 | :fd fd 134 | :sockopt wsock:+SO-REUSEADDR+))) 135 | (wev:close-tcp-server *listener*)))))) 136 | (when ssl 137 | #+woo-no-ssl 138 | (warn "SSL certificate is specified but Woo's SSL feature is off. Ignored.") 139 | #-woo-no-ssl 140 | (progn 141 | (cl+ssl::ensure-initialized) 142 | (when ssl-key-file 143 | (setf ssl-key-file 144 | (uiop:native-namestring 145 | (or (probe-file ssl-key-file) 146 | (error "SSL private key file '~A' does not exist." ssl-key-file))))) 147 | (when ssl-cert-file 148 | (setf ssl-cert-file 149 | (uiop:native-namestring 150 | (or (probe-file ssl-cert-file) 151 | (error "SSL certificate '~A' does not exist." ssl-cert-file))))))) 152 | (if worker-num 153 | (start-multithread-server) 154 | (start-singlethread-server))))) 155 | 156 | (defun read-cb (socket data &key (start 0) (end (length data))) 157 | (let ((parser (wev:socket-data socket))) 158 | (handler-case (funcall parser data :start start :end end) 159 | (fast-http:parsing-error (e) 160 | (vom:error "HTTP parse error: ~A" e) 161 | (let ((body #.(map '(simple-array (unsigned-byte 8) (*)) 162 | #'char-code 163 | "400 Bad Request"))) 164 | (wev:with-async-writing (socket :write-cb #'wev:close-socket) 165 | (write-response-headers socket 400 166 | (list :connection "close" 167 | :content-length (length body))) 168 | (wev:write-socket-data socket body))))))) 169 | 170 | (define-condition woo-error (simple-error) ()) 171 | (define-condition invalid-http-version (woo-error) ()) 172 | 173 | (defun error-invalid-http-version (major minor) 174 | (error 'invalid-http-version 175 | :format-control "INVALID-HTTP-VERSION: major ~A minor ~A" 176 | :format-arguments (list major minor))) 177 | 178 | (defun http-version-keyword (major minor) 179 | (unless (= major 1) 180 | (error-invalid-http-version major minor)) 181 | (case minor 182 | (1 :HTTP/1.1) 183 | (0 :HTTP/1.0) 184 | (otherwise (error-invalid-http-version major minor)))) 185 | 186 | (defun setup-parser (socket) 187 | (let ((http (make-http-request)) 188 | (body-buffer (make-smart-buffer))) 189 | (setf (wev:socket-data socket) 190 | (make-parser http 191 | :body-callback 192 | (lambda (data start end) 193 | (declare (type (simple-array (unsigned-byte 8) (*)) data)) 194 | (if (smart-buffer::buffer-on-memory-p body-buffer) 195 | (write-to-buffer body-buffer (subseq data start end) 0 (- end start)) 196 | (write-to-buffer body-buffer data start end))) 197 | :finish-callback 198 | (flet ((main (env) 199 | (handle-response http socket 200 | (if *debug* 201 | (funcall *app* env) 202 | (if-let (res (handler-case (funcall *app* env) 203 | (error (error) 204 | (vom:error (princ-to-string error)) 205 | nil))) 206 | res 207 | '(500 nil nil)))))) 208 | (lambda () 209 | (block result 210 | (let ((raw-body (finalize-buffer body-buffer))) 211 | (setq body-buffer (make-smart-buffer)) 212 | (handler-bind 213 | ((error ;; handle errors inside woo 214 | (lambda (e) 215 | (unless *debug* 216 | (vom:crit (princ-to-string e)) 217 | (return-from result (handle-response http socket '(500 nil nil))))))) 218 | (let ((env (nconc (list :raw-body raw-body) 219 | (handle-request http socket)))) 220 | (main env))))))))))) 221 | 222 | (defun stop (server) 223 | (wev:close-tcp-server server)) 224 | 225 | 226 | ;; 227 | ;; Handling requests 228 | 229 | (defun parse-host-header (host) 230 | (declare (type simple-string host) 231 | (optimize (speed 3) (safety 0))) 232 | (let ((pos (position #\: host :from-end t))) 233 | (unless pos 234 | (return-from parse-host-header 235 | (values host nil))) 236 | 237 | (locally (declare (type fixnum pos)) 238 | (let ((port (loop with port of-type fixnum = 0 239 | for i from (1+ pos) to (1- (length host)) 240 | for char = (aref host i) 241 | do (if (digit-char-p char) 242 | (setq port (+ (* 10 port) 243 | (- (char-code char) (char-code #\0)))) 244 | (return nil)) 245 | finally 246 | (return port)))) 247 | (if port 248 | (values (subseq host 0 pos) 249 | port) 250 | (values host nil)))))) 251 | 252 | (defun handle-request (http socket) 253 | (let ((host (gethash "host" (http-headers http))) 254 | (headers (http-headers http)) 255 | (uri (http-resource http))) 256 | (declare (type simple-string uri)) 257 | 258 | (multiple-value-bind (scheme userinfo hostname port path query fragment) 259 | (quri:parse-uri uri) 260 | (declare (ignore scheme userinfo hostname port fragment)) 261 | (multiple-value-bind (server-name server-port) 262 | (if (stringp host) 263 | (parse-host-header host) 264 | (values nil nil)) 265 | (list :request-method (http-method http) 266 | :script-name "" 267 | :server-name server-name 268 | :server-port (or server-port 80) 269 | :server-protocol (http-version-keyword (http-major-version http) (http-minor-version http)) 270 | :path-info (if (and (stringp path) 271 | (string/= path "")) 272 | (quri:url-decode path :lenient t) 273 | "/") 274 | :query-string query 275 | :url-scheme "http" 276 | :remote-addr (socket-remote-addr socket) 277 | :remote-port (socket-remote-port socket) 278 | :request-uri uri 279 | :clack.streaming t 280 | :clack.nonblocking t 281 | :clack.io socket 282 | :content-length (let ((content-length (gethash "content-length" headers))) 283 | (etypecase content-length 284 | (string (if (integer-string-p content-length) 285 | (parse-integer content-length) 286 | (error "Invalid Content-Length header: ~S" content-length))) 287 | (integer content-length) 288 | (null nil))) 289 | :content-type (gethash "content-type" headers) 290 | :headers headers))))) 291 | 292 | 293 | ;; 294 | ;; Handling responses 295 | 296 | (defun handle-response (http socket clack-res) 297 | (handler-case 298 | (etypecase clack-res 299 | (list (handle-normal-response http socket clack-res)) 300 | (function (funcall clack-res (lambda (clack-res) 301 | (handler-case 302 | (handle-normal-response http socket clack-res) 303 | (wev:socket-closed ())))))) 304 | (wev:tcp-error (e) 305 | (vom:error (princ-to-string e))))) 306 | 307 | #+sbcl 308 | (defvar *stat* (make-instance 'sb-posix:stat)) 309 | #+sbcl 310 | (defun fd-file-size (fd) 311 | (sb-posix:fstat fd *stat*) 312 | (sb-posix:stat-size *stat*)) 313 | #+ccl 314 | (defun fd-file-size (fd) 315 | (multiple-value-bind (successp mode size) 316 | (ccl::%fstat fd) 317 | (declare (ignore mode)) 318 | (unless successp 319 | (error "'fstat' failed")) 320 | size)) 321 | #+lispworks 322 | (defun file-size (path) 323 | (sys:file-size path)) 324 | #-(or sbcl ccl lispworks) 325 | (defun file-size (path) 326 | (with-open-file (in path) 327 | (file-length in))) 328 | 329 | (defun make-streaming-writer (socket) 330 | (lambda (body &key (start 0 has-start) (end nil has-end) (close nil)) 331 | (if body 332 | (wev:with-async-writing (socket :force-streaming t) 333 | (etypecase body 334 | (string 335 | (write-string-body-chunk socket 336 | (if (or has-start has-end) 337 | (subseq body start end) 338 | body))) 339 | (vector (write-body-chunk socket body 340 | :start start 341 | :end (or end (length body))))) 342 | (when close 343 | (finish-response socket *empty-chunk*))) 344 | (when close 345 | (wev:with-async-writing (socket) 346 | (finish-response socket *empty-chunk*)))))) 347 | 348 | (defun list-body-chunk-to-octets (chunk) 349 | (typecase chunk 350 | (string (string-to-utf-8-bytes chunk)) 351 | (null) 352 | (otherwise 353 | (warn "Invalid data in Clack response: ~S" chunk)))) 354 | 355 | (defun handle-normal-response (http socket clack-res) 356 | (let ((no-body '#:no-body) 357 | (close (or (= (http-minor-version http) 0) 358 | (string-equal (gethash "connection" (http-headers http)) "close")))) 359 | (destructuring-bind (status headers &optional (body no-body)) 360 | clack-res 361 | (when (eq body no-body) 362 | (setf (getf headers :transfer-encoding) "chunked") 363 | (setf (getf headers :content-length) nil) 364 | (wev:with-async-writing (socket) 365 | (write-response-headers socket status headers)) 366 | (return-from handle-normal-response 367 | (make-streaming-writer socket))) 368 | 369 | (etypecase body 370 | (null 371 | (wev:with-async-writing (socket :write-cb (and close 372 | (lambda (socket) 373 | (wev:close-socket socket)))) 374 | (unless (= status 304) 375 | (setf (getf headers :content-length) 0)) 376 | (write-response-headers socket status headers (not close)))) 377 | (pathname 378 | (cond 379 | ((woo.ev.socket:socket-ssl-handle socket) 380 | (with-open-file (in body :element-type '(unsigned-byte 8)) 381 | (let ((size (file-length in))) 382 | (unless (getf headers :content-length) 383 | (setf (getf headers :content-length) size)) 384 | (unless (getf headers :content-type) 385 | (setf (getf headers :content-type) (mimes:mime body))) 386 | (wev:with-async-writing (socket :write-cb (and close 387 | (lambda (socket) 388 | (wev:close-socket socket)))) 389 | (write-response-headers socket status headers (not close)) 390 | ;; Future task: Use OpenSSL's SSL_sendfile which uses Kernel TLS. 391 | (wev:write-socket-stream socket in))))) 392 | (t 393 | (let* ((fd (wsys:open body)) 394 | (size #+lispworks (sys:file-size body) 395 | #+(or sbcl ccl) (fd-file-size fd) 396 | #-(or sbcl ccl lispworks) (file-size body))) 397 | (unless (getf headers :content-length) 398 | (setf (getf headers :content-length) size)) 399 | (unless (getf headers :content-type) 400 | (setf (getf headers :content-type) (mimes:mime body))) 401 | (wev:with-async-writing (socket :write-cb (and close 402 | (lambda (socket) 403 | (wev:close-socket socket)))) 404 | (write-response-headers socket status headers (not close)) 405 | (woo.ev.socket:send-static-file socket fd size)))))) 406 | (list 407 | (wev:with-async-writing (socket :write-cb (and close 408 | (lambda (socket) 409 | (wev:close-socket socket)))) 410 | (cond 411 | ((getf headers :content-length) 412 | (response-headers-bytes socket status headers (not close)) 413 | (write-socket-crlf socket) 414 | (loop for chunk in body 415 | for data = (list-body-chunk-to-octets chunk) 416 | when data 417 | do (wev:write-socket-data socket data))) 418 | (t 419 | (cond 420 | ((= (http-minor-version http) 1) 421 | ;; Transfer-Encoding: chunked 422 | (response-headers-bytes socket status headers (not close)) 423 | (wev:write-socket-data socket #.(string-to-utf-8-bytes "Transfer-Encoding: chunked")) 424 | (write-socket-crlf socket) 425 | (write-socket-crlf socket) 426 | (loop for chunk in body 427 | for data = (list-body-chunk-to-octets chunk) 428 | when (and data (/= 0 (length data))) 429 | do (write-socket-string socket (the simple-string (format nil "~X" (length data)))) 430 | (write-socket-crlf socket) 431 | (wev:write-socket-data socket data) 432 | (write-socket-crlf socket)) 433 | (wev:write-socket-byte socket #.(char-code #\0)) 434 | (write-socket-crlf socket) 435 | (write-socket-crlf socket)) 436 | (t 437 | ;; calculate Content-Length 438 | (response-headers-bytes socket status headers (not close)) 439 | (wev:write-socket-data socket #.(string-to-utf-8-bytes "Content-Length: ")) 440 | (write-socket-string 441 | socket 442 | (write-to-string (loop for chunk in body 443 | sum (if (stringp chunk) 444 | (utf-8-byte-length chunk) 445 | 0)))) 446 | (write-socket-crlf socket) 447 | (write-socket-crlf socket) 448 | (loop for chunk in body 449 | for data = (list-body-chunk-to-octets chunk) 450 | when data 451 | do (wev:write-socket-data socket data)))))))) 452 | ((vector (unsigned-byte 8)) 453 | (wev:with-async-writing (socket :write-cb (and close 454 | (lambda (socket) 455 | (wev:close-socket socket)))) 456 | (response-headers-bytes socket status headers (not close)) 457 | (unless (getf headers :content-length) 458 | (wev:write-socket-data socket #.(string-to-utf-8-bytes "Content-Length: ")) 459 | (write-socket-string socket (write-to-string (length body))) 460 | (write-socket-crlf socket)) 461 | (write-socket-crlf socket) 462 | (wev:write-socket-data socket body))))))) 463 | 464 | (defmethod clack.socket:read-callback ((socket woo.ev.socket:socket)) 465 | (wev:socket-data socket)) 466 | 467 | (defmethod (setf clack.socket:read-callback) (callback (socket woo.ev.socket:socket)) 468 | (setf (wev:socket-data socket) callback)) 469 | 470 | (defmethod clack.socket:write-sequence-to-socket ((socket woo.ev.socket:socket) data &key callback) 471 | (woo.ev.socket:check-socket-open socket) 472 | (wev:with-async-writing (socket :write-cb (and callback 473 | (lambda (socket) 474 | (declare (ignore socket)) 475 | (funcall callback)))) 476 | (wev:write-socket-data socket data))) 477 | 478 | (defmethod clack.socket:write-byte-to-socket ((socket woo.ev.socket:socket) byte &key callback) 479 | (woo.ev.socket:check-socket-open socket) 480 | (wev:with-async-writing (socket :write-cb (and callback 481 | (lambda (socket) 482 | (declare (ignore socket)) 483 | (funcall callback)))) 484 | (wev:write-socket-byte socket byte))) 485 | 486 | (defmethod clack.socket:write-sequence-to-socket-buffer ((socket woo.ev.socket:socket) data) 487 | (wev:write-socket-data socket data)) 488 | 489 | (defmethod clack.socket:write-byte-to-socket-buffer ((socket woo.ev.socket:socket) byte) 490 | (wev:write-socket-byte socket byte)) 491 | 492 | (defmethod clack.socket:flush-socket-buffer ((socket woo.ev.socket:socket) &key callback) 493 | (woo.ev.socket:check-socket-open socket) 494 | (wev:with-async-writing (socket :write-cb (and callback 495 | (lambda (socket) 496 | (declare (ignore socket)) 497 | (funcall callback)))) 498 | nil)) 499 | 500 | (defmethod clack.socket:close-socket ((socket woo.ev.socket:socket)) 501 | (when (woo.ev.socket:socket-open-p socket) 502 | (woo.ev.socket:close-socket socket))) 503 | 504 | (defmethod clack.socket:socket-async-p ((socket woo.ev.socket:socket)) 505 | t) 506 | --------------------------------------------------------------------------------