├── .gitignore ├── README.md ├── bench-img.png ├── cl-tbnl-gserver-tmgr.asd ├── src ├── tmgr-wkr.lisp └── tmgr.lisp └── tests └── tmgr-test.lisp /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.dx32fsl 3 | *.dx64fsl 4 | *.lx32fsl 5 | *.lx64fsl 6 | *.x86f 7 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # cl-tbnl-gserver-tmgr 2 | Hunchentoot cl-gserver based taskmanager (experimental) 3 | 4 | ## Usage 5 | 6 | Create an accessor using this taskmanager like so: 7 | 8 | ``` 9 | (let ((acceptor (make-instance 'tbnl:easy-acceptor 10 | :port 4242 11 | :taskmaster (make-instance 'cl-tbnl-gserver-tmgr.tmgr:gserver-tmgr 12 | :max-thread-count 8)))) 13 | (tbnl:start acceptor)) 14 | ``` 15 | 16 | With `:max-thread-count` you can control how many request processing actors (like thread-pool) should be spawned. 17 | 18 | 19 | ## Some benchmarks 20 | 21 | Hardware: iMac Pro - Generation 1 - Xeon 8 cores 22 | OS: macOS Catalina (10.15) 23 | CL: SBCL 2.0.6 24 | 25 | ### Hunchentoot with default multi-threaded taskmanager: 26 | ``` 27 | wrk -t4 -c100 -d10 "http://localhost:4242/yo" 28 | Running 10s test @ http://localhost:4242/yo 29 | 4 threads and 100 connections 30 | Thread Stats Avg Stdev Max +/- Stdev 31 | Latency 33.63ms 64.77ms 580.44ms 86.79% 32 | Req/Sec 12.16k 10.56k 54.88k 75.28% 33 | 470142 requests in 10.08s, 65.91MB read 34 | Socket errors: connect 0, read 85, write 0, timeout 0 35 | Requests/sec: 46635.24 36 | Transfer/sec: 6.54MB 37 | 38 | wrk -t4 -c10 -d10 "http://localhost:4242/yo" 39 | Running 10s test @ http://localhost:4242/yo 40 | 4 threads and 10 connections 41 | Thread Stats Avg Stdev Max +/- Stdev 42 | Latency 233.03us 759.27us 13.93ms 96.07% 43 | Req/Sec 19.09k 556.09 20.40k 67.33% 44 | 767444 requests in 10.10s, 107.59MB read 45 | Requests/sec: 75961.66 46 | Transfer/sec: 10.65MB 47 | ---------- Can't handle ------------ 48 | wrk -t16 -c400 -d10 "http://localhost:4242/yo" 49 | Running 10s test @ http://localhost:4242/yo 50 | 16 threads and 400 connections 51 | Thread Stats Avg Stdev Max +/- Stdev 52 | Latency 28.71ms 80.52ms 750.72ms 90.82% 53 | Req/Sec 3.90k 3.99k 32.81k 87.00% 54 | 571817 requests in 10.10s, 80.66MB read 55 | Socket errors: connect 165, read 3371, write 80, timeout 1 56 | Non-2xx or 3xx responses: 2972 57 | Requests/sec: 56635.62 58 | Transfer/sec: 7.99MB 59 | ``` 60 | 61 | 62 | ### Hunchentoot with GServer based taskmanager with 8 workers (random order): 63 | ``` 64 | wrk -t4 -c100 -d10 "http://localhost:4242/yo" 65 | Running 10s test @ http://localhost:4242/yo 66 | 4 threads and 100 connections 67 | Thread Stats Avg Stdev Max +/- Stdev 68 | Latency 163.33us 1.37ms 101.71ms 99.26% 69 | Req/Sec 18.52k 11.51k 40.69k 74.25% 70 | 737186 requests in 10.01s, 103.35MB read 71 | Socket errors: connect 0, read 112, write 0, timeout 0 72 | Requests/sec: 73647.69 73 | Transfer/sec: 10.32MB 74 | 75 | wrk -t4 -c10 -d10 "http://localhost:4242/yo" 76 | Running 10s test @ http://localhost:4242/yo 77 | 4 threads and 10 connections 78 | Thread Stats Avg Stdev Max +/- Stdev 79 | Latency 457.93us 3.52ms 96.69ms 97.21% 80 | Req/Sec 19.16k 6.69k 27.72k 58.75% 81 | 763236 requests in 10.01s, 107.00MB read 82 | Requests/sec: 76257.12 83 | Transfer/sec: 10.69MB 84 | --------------------------------------- 85 | wrk -t16 -c400 -d10 "http://localhost:4242/yo" 86 | Running 10s test @ http://localhost:4242/yo 87 | 16 threads and 400 connections 88 | Thread Stats Avg Stdev Max +/- Stdev 89 | Latency 106.74us 651.85us 98.07ms 99.86% 90 | Req/Sec 19.41k 16.96k 70.09k 74.31% 91 | 774766 requests in 10.10s, 108.61MB read 92 | Socket errors: connect 165, read 242, write 0, timeout 0 93 | Requests/sec: 76711.31 94 | Transfer/sec: 10.75MB 95 | ``` 96 | 97 | ### Woo with 8 workers 98 | 99 | ``` 100 | wrk -t4 -c100 -d10 "http://localhost:5000" 101 | Running 10s test @ http://localhost:5000 102 | 4 threads and 100 connections 103 | Thread Stats Avg Stdev Max +/- Stdev 104 | Latency 1.30ms 0.87ms 9.08ms 82.67% 105 | Req/Sec 20.57k 1.06k 23.20k 66.75% 106 | 819004 requests in 10.01s, 121.06MB read 107 | Requests/sec: 81838.94 108 | Transfer/sec: 12.10MB 109 | 110 | wrk -t4 -c10 -d10 "http://localhost:5000" 111 | Running 10s test @ http://localhost:5000 112 | 4 threads and 10 connections 113 | Thread Stats Avg Stdev Max +/- Stdev 114 | Latency 221.40us 356.67us 4.66ms 90.30% 115 | Req/Sec 15.19k 310.79 15.81k 74.01% 116 | 610637 requests in 10.10s, 90.26MB read 117 | Requests/sec: 60444.28 118 | Transfer/sec: 8.93MB 119 | ------------- massive connection errors -------------------- 120 | wrk -t16 -c400 -d10 "http://localhost:5000" 121 | Running 10s test @ http://localhost:5000 122 | 16 threads and 400 connections 123 | Thread Stats Avg Stdev Max +/- Stdev 124 | Latency 4.16ms 2.43ms 42.78ms 84.66% 125 | Req/Sec 3.43k 1.70k 7.08k 50.25% 126 | 546714 requests in 10.02s, 80.82MB read 127 | Socket errors: connect 165, read 32513, write 0, timeout 0 128 | Requests/sec: 54581.30 129 | Transfer/sec: 8.07MB 130 | ``` 131 | 132 | CCL is ~2-3 times slower on all configs. 133 | 134 | Measured with wrk tool. 135 | 136 | t = threads 137 | c = connections 138 | mt = default multi-threaded hunchentoot taskmanager 139 | gserver-8 = taskmanager based on 8 GServer handlers 140 | 141 | ![Benchmark](bench-img.png) 142 | -------------------------------------------------------------------------------- /bench-img.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/mdbergmann/cl-tbnl-gserver-tmgr/1ae71c9324e876761cd1ee51768a34f0793e6879/bench-img.png -------------------------------------------------------------------------------- /cl-tbnl-gserver-tmgr.asd: -------------------------------------------------------------------------------- 1 | (defsystem "cl-tbnl-gserver-tmgr" 2 | :version "0.1.1" 3 | :author "Manfred Bergmann" 4 | :license "MIT" 5 | :description "Hunchentoot pooled multi-threaded taskmanager based on cl-gserver." 6 | :depends-on ("hunchentoot" 7 | "sento" 8 | "log4cl") 9 | :components ((:module "src" 10 | :serial t 11 | :components 12 | ((:file "tmgr-wkr") 13 | (:file "tmgr")))) 14 | :in-order-to ((test-op (test-op "cl-tbnl-gserver-tmgr/tests")))) 15 | 16 | (defsystem "cl-tbnl-gserver-tmgr/tests" 17 | :author "Manfred Bergmann" 18 | :license "MIT" 19 | :depends-on ("cl-tbnl-gserver-tmgr" 20 | "fiveam" 21 | "drakma") 22 | :components ((:module "tests" 23 | :components 24 | ((:file "tmgr-test")))) 25 | :description "Test system for cl-tbnl-gserver-tmgr" 26 | :perform (test-op (op c) (symbol-call :fiveam :run! 27 | (uiop:find-symbol* '#:tmgr-tests 28 | '#:cl-tbnl-gserver-tmgr.tmgr-test)))) 29 | 30 | -------------------------------------------------------------------------------- /src/tmgr-wkr.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :cl-tbnl-gserver-tmgr.tmgr-wkr 2 | (:use :cl :sento.actor) 3 | (:nicknames :gstmgr-wkr) 4 | (:export #:tmgr-worker 5 | #:make-tmgr-worker 6 | #:get-processed-requests)) 7 | 8 | (in-package :cl-tbnl-gserver-tmgr.tmgr-wkr) 9 | 10 | (defstruct worker-state 11 | (processed-requests 0 :type integer)) 12 | 13 | (defclass tmgr-worker (actor) ()) 14 | 15 | (defun make-tmgr-worker (asystem) 16 | (ac:actor-of asystem 17 | :state (make-worker-state) 18 | :receive #'receive 19 | :dispatcher :pinned 20 | :state (make-worker-state))) 21 | 22 | (defun receive (message) 23 | (case (first message) 24 | (:process (process-request 25 | (second message) 26 | (third message))))) 27 | 28 | (defun process-request (acceptor socket) 29 | (handler-case 30 | (progn 31 | (with-slots (processed-requests) *state* 32 | (tbnl:process-connection acceptor socket) 33 | (setf *state* (make-worker-state 34 | :processed-requests 35 | (1+ processed-requests))))) 36 | (t (c) 37 | (log:error "Error: " c)))) 38 | 39 | ;; --------------------------- 40 | ;; worker facade ------------- 41 | ;; --------------------------- 42 | 43 | (defun get-processed-requests (worker) 44 | (with-slots (act-cell:state) worker 45 | (slot-value act-cell:state 'processed-requests))) 46 | -------------------------------------------------------------------------------- /src/tmgr.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | (defpackage :cl-tbnl-gserver-tmgr.tmgr 3 | (:use :cl :log4cl :hunchentoot :gstmgr-wkr) 4 | (:nicknames :gstmgr) 5 | (:export #:gserver-tmgr 6 | #:router)) 7 | 8 | (in-package :cl-tbnl-gserver-tmgr.tmgr) 9 | 10 | (defparameter *gserver-tmgr-poolsize* 8) 11 | 12 | (defclass gserver-tmgr (multi-threaded-taskmaster) 13 | ((asystem :initform (asys:make-actor-system '(:dispatchers (:shared (:workers 0))))) 14 | (router :initform nil 15 | :reader router 16 | :documentation 17 | "the actor router. it contains as many workers as is specified in `:max-thread-count'.") 18 | (max-thread-count :initarg :max-thread-count 19 | :type integer 20 | :initform *gserver-tmgr-poolsize* 21 | :accessor taskmaster-max-thread-count 22 | :documentation 23 | "The number of gservers that should be spawned to handle requests. 24 | A number of * 2 could be a good value.") 25 | (thread-count :initform 0 26 | :type integer 27 | :accessor taskmaster-thread-count 28 | :documentation "The currently running number of gservers.") 29 | (test-acceptor :initarg :test-acceptor 30 | :initform nil 31 | :documentation "Internal, only for testing to inject a fake acceptor."))) 32 | 33 | (defmethod initialize-instance :after ((self gserver-tmgr) &key) 34 | (with-slots (asystem router test-acceptor max-thread-count) self 35 | (when test-acceptor 36 | (log:warn "Injecting test acceptor: " test-acceptor) 37 | (setf (tbnl::taskmaster-acceptor self) test-acceptor)) 38 | 39 | (log:info "Spawning ~a routees." max-thread-count) 40 | (unless router 41 | (setf router (router:make-router))) 42 | (dotimes (i max-thread-count) 43 | (router:add-routee router (make-tmgr-worker asystem))))) 44 | 45 | (defmethod taskmaster-thread-count :around ((self gserver-tmgr)) 46 | (length (slot-value self 'max-thread-count))) 47 | 48 | (defmethod execute-acceptor ((self gserver-tmgr)) 49 | (format t "execute acceptor...~%") 50 | (call-next-method)) 51 | 52 | (defmethod handle-incoming-connection ((self gserver-tmgr) socket) 53 | ;;(format t "handle-incoming-connection...~%") 54 | (act:tell (router self) `(:process ,(taskmaster-acceptor self) ,socket))) 55 | 56 | (defmethod shutdown ((self gserver-tmgr)) 57 | (with-slots (router) self 58 | (router:stop router))) 59 | -------------------------------------------------------------------------------- /tests/tmgr-test.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :cl-tbnl-gserver-tmgr.tmgr-test 2 | (:use :cl :fiveam :gstmgr :gstmgr-wkr :drakma) 3 | (:export #:run! 4 | #:all-tests 5 | #:nil)) 6 | (in-package :cl-tbnl-gserver-tmgr.tmgr-test) 7 | 8 | (def-suite tmgr-tests 9 | :description "Sento Taskmanager tests.") 10 | 11 | (in-suite tmgr-tests) 12 | 13 | (defparameter *process-connection-called* 0) 14 | 15 | (defclass fake-acceptor (tbnl:acceptor) ()) 16 | (defmethod tbnl:process-connection (fake-acceptor socket) 17 | (declare (ignore fake-acceptor socket)) 18 | (incf *process-connection-called*)) 19 | 20 | (def-fixture start-stop-tmgr (pool-size) 21 | (let ((cut (make-instance 'gserver-tmgr 22 | :test-acceptor (make-instance 'fake-acceptor) 23 | :max-thread-count pool-size))) 24 | (unwind-protect 25 | (&body) 26 | (tbnl:shutdown cut)))) 27 | 28 | (test create-tmgr 29 | "Creates the taskmanager" 30 | (with-fixture start-stop-tmgr (1) 31 | (is (not (null cut))))) 32 | 33 | (test tmgr-has-number-of-gservers-we-need 34 | "When creating the taskmanager we start the desired number of gservers" 35 | (with-fixture start-stop-tmgr (8) 36 | ;;(is (= 8 (tbnl:taskmaster-thread-count cut))) 37 | (is (= 8 (length (router:routees (router cut))))))) 38 | 39 | (test tmgr-can-respond-to-ask-for-state 40 | "Test that tmgr can respond with it's state." 41 | (with-fixture start-stop-tmgr (1) 42 | (is (every (lambda (o) (= 0 (get-processed-requests o))) 43 | (router:routees (router cut)))))) 44 | 45 | (test tmgr-calls-process-connection-on-acceptor 46 | "Tests that 'process-connection' is called on the acceptor instance." 47 | (with-fixture start-stop-tmgr (1) 48 | (let ((worker (first (router:routees (router cut))))) 49 | (tbnl:handle-incoming-connection cut (make-instance 'usocket:usocket)) 50 | (sleep 0.5) 51 | 52 | (is (= 1 (get-processed-requests worker)))))) 53 | 54 | (tbnl:define-easy-handler (say-yo :uri "/yo") (name) 55 | (setf (hunchentoot:content-type*) "text/plain") 56 | (format nil "Hey~@[ ~A~]!" name)) 57 | 58 | (test server-can-make-real-client-requests 59 | "Tests that server can really handle the requests." 60 | (let ((acceptor (make-instance 'tbnl:easy-acceptor 61 | :port 4242 62 | :access-log-destination nil 63 | :taskmaster (make-instance 'gserver-tmgr 64 | :max-thread-count 8)))) 65 | (unwind-protect 66 | (progn 67 | (tbnl:start acceptor) 68 | (is (every (lambda (x) (string= "Hey!" x)) 69 | (loop repeat 100 70 | collect (drakma:http-request "http://127.0.0.1:4242/yo"))))) 71 | (tbnl:stop acceptor)))) 72 | 73 | 74 | ;;(run! 'create-tmgr) 75 | ;;(run! 'tmgr-has-number-of-gservers-we-need) 76 | ;;(run! 'tmgr-can-respond-to-ask-for-state) 77 | ;;(run! 'tmgr-calls-process-connection-on-acceptor) 78 | ;;(run! 'server-can-make-real-client-requests) 79 | 80 | (defparameter *my-acceptor* nil) 81 | 82 | (defun start-single-threaded () 83 | (setf *my-acceptor* (make-instance 'hunchentoot:easy-acceptor 84 | :port 4242 85 | :taskmaster (make-instance 'tbnl:single-threaded-taskmaster) 86 | :access-log-destination nil)) 87 | 88 | (bt:make-thread (lambda () 89 | (tbnl:start *my-acceptor*)) 90 | :name "Foo")) 91 | 92 | (defun start-multi-threaded () 93 | (setf *my-acceptor* (make-instance 'hunchentoot:easy-acceptor 94 | :port 4242 95 | :access-log-destination nil)) 96 | 97 | (bt:make-thread (lambda () 98 | (tbnl:start *my-acceptor*)) 99 | :name "Foo")) 100 | 101 | (defun start-gserver-threaded () 102 | (setf *my-acceptor* (make-instance 'hunchentoot:easy-acceptor 103 | :port 4242 104 | :taskmaster (make-instance 'gserver-tmgr) 105 | :access-log-destination nil)) 106 | 107 | (bt:make-thread (lambda () 108 | (tbnl:start *my-acceptor*)) 109 | :name "Foo")) 110 | 111 | ;; (defun start-quux-threaded () 112 | ;; (setf lparallel:*kernel* (lparallel:make-kernel 8)) 113 | ;; (setf *my-acceptor* (make-instance 'hunchentoot:easy-acceptor 114 | ;; :port 4242 115 | ;; :taskmaster 116 | ;; (make-instance 'quux-hunchentoot:thread-pooling-taskmaster 117 | ;; :max-thread-count 8 118 | ;; :max-accept-count 100000) 119 | ;; :access-log-destination nil)) 120 | 121 | ;; (bt:make-thread (lambda () 122 | ;; (tbnl:start *my-acceptor*)) 123 | ;; :name "Foo")) 124 | --------------------------------------------------------------------------------