cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Re-work the fibers scheduling

Browse source 
Use a single thread for receiving and responding to requests, and delegate the
processing of the requests to a separate set of threads.

I'm hoping this will avoid the processing of requests affecting accepting new
connections, or the sending of responses.
This commit is contained in:
Christopher Baines 2024-07-16 21:50:36 +01:00
parent d8e9de4ed6
commit e81c6377bf
1 changed files with 116 additions and 81 deletions
Download patch file Download diff file Expand all files Collapse all files

197
guix-data-service/web/server.scm
View file

@ -20,12 +20,14 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
#:use-module (ice-9 match)
#:use-module (ice-9 threads)
#:use-module (web http)
#:use-module (web request)
#:use-module (web uri)
#:use-module (system repl error-handling)
#:use-module (ice-9 atomic)
#:use-module (fibers)
#:use-module (fibers channels)
#:use-module (fibers scheduler)
#:use-module (fibers conditions)
#:use-module ((guix build syscalls)
@ -98,101 +100,133 @@
(%guix-data-service-metrics-registry registry)
(let ((finished? (make-condition)))
(let ((finished? (make-condition))
(render-metrics (make-render-metrics registry))
(request-scheduler #f))
(call-with-sigint
(lambda ()
(call-with-new-thread
(lambda ()
(run-fibers
(lambda ()
(let* ((current (current-scheduler))
(schedulers
(cons current (scheduler-remote-peers current))))
(set! request-scheduler current)
(for-each
(lambda (i sched)
(spawn-fiber
(lambda ()
(catch 'system-error
(lambda ()
(set-thread-name
(string-append "rp " (number->string i))))
(const #t)))
sched))
(iota (length schedulers))
schedulers))
(wait finished?))
#:hz 0
#:parallelism 4)))
(run-fibers
(lambda ()
(let* ((current (current-scheduler))
(schedulers
(cons current (scheduler-remote-peers current))))
(for-each
(lambda (i sched)
(spawn-fiber
(lambda ()
(catch 'system-error
(lambda ()
(set-thread-name
(string-append "fibers " (number->string i))))
(const #t)))
sched))
(iota (length schedulers))
schedulers))
(catch 'system-error
(lambda ()
(set-thread-name
(string-append "server")))
(const #t))
(parameterize
((connection-pool
(make-resource-pool
(lambda ()
(open-postgresql-connection
"web"
postgresql-statement-timeout))
(floor (/ postgresql-connections 2))
#:idle-seconds 30
#:destructor
(lambda (conn)
(close-postgresql-connection conn "web"))))
(while (not request-scheduler)
(sleep 0.1))
(reserved-connection-pool
(make-resource-pool
(lambda ()
(open-postgresql-connection
"web-reserved"
postgresql-statement-timeout))
(floor (/ postgresql-connections 2))
#:idle-seconds 600
#:destructor
(lambda (conn)
(close-postgresql-connection conn "web-reserved"))))
(let ((requests-metric
(make-counter-metric registry "requests_total")))
(resource-pool-default-timeout 5))
(let ((resource-pool-checkout-failures-metric
(make-counter-metric registry
"resource_pool_checkout_timeouts_total"
#:labels '(pool_name))))
(%resource-pool-timeout-handler
(lambda (pool proc timeout)
(let ((pool-name
(cond
((eq? pool (connection-pool)) "normal")
((eq? pool (reserved-connection-pool)) "reserved")
(else #f))))
(when pool-name
(metric-increment
resource-pool-checkout-failures-metric
#:label-values `((pool_name . ,pool-name))))))))
(spawn-fiber
(lambda ()
(with-resource-from-pool (connection-pool) conn
(backfill-guix-revision-package-derivation-distribution-counts
conn))))
(let ((render-metrics
(make-render-metrics registry))
(requests-metric
(make-counter-metric registry "requests_total")))
(with-exception-handler
(lambda (exn)
(simple-format
(current-error-port)
"\n
(with-exception-handler
(lambda (exn)
(simple-format
(current-error-port)
"\n
error: guix-data-service could not start: ~A
Check if it's already running, or whether another process is using that
port. Also, the port used can be changed by passing the --port option.\n"
exn)
(primitive-exit 1))
(lambda ()
exn)
(primitive-exit 1))
(lambda ()
(parameterize
((connection-pool
(make-resource-pool
(lambda ()
(open-postgresql-connection
"web"
postgresql-statement-timeout))
(floor (/ postgresql-connections 2))
#:idle-seconds 30
#:destructor
(lambda (conn)
(close-postgresql-connection conn "web"))))
(reserved-connection-pool
(make-resource-pool
(lambda ()
(open-postgresql-connection
"web-reserved"
postgresql-statement-timeout))
(floor (/ postgresql-connections 2))
#:idle-seconds 600
#:destructor
(lambda (conn)
(close-postgresql-connection conn "web-reserved"))))
(resource-pool-default-timeout 5))
(let ((resource-pool-checkout-failures-metric
(make-counter-metric registry
"resource_pool_checkout_timeouts_total"
#:labels '(pool_name))))
(%resource-pool-timeout-handler
(lambda (pool proc timeout)
(let ((pool-name
(cond
((eq? pool (connection-pool)) "normal")
((eq? pool (reserved-connection-pool)) "reserved")
(else #f))))
(when pool-name
(metric-increment
resource-pool-checkout-failures-metric
#:label-values `((pool_name . ,pool-name))))))))
(spawn-fiber
(lambda ()
(with-resource-from-pool (connection-pool) conn
(backfill-guix-revision-package-derivation-distribution-counts
conn)))
request-scheduler)
(run-server/patched
(lambda (request body)
(metric-increment requests-metric)
(handler request finished? body controller
secret-key-base
startup-completed
render-metrics))
(let ((reply (make-channel)))
(spawn-fiber
(lambda ()
(call-with-values
(lambda ()
(handler request finished? body controller
secret-key-base
startup-completed
render-metrics))
(lambda vals
(put-message reply vals))))
request-scheduler
#:parallel? #t)
(apply values (get-message reply))))
#:host host
#:port port))
#:unwind? #t)))
@ -202,5 +236,6 @@ port. Also, the port used can be changed by passing the --port option.\n"
(spawn-port-monitoring-fiber port finished?)
(wait finished?))
#:parallelism 4))
#:hz 5
#:parallelism 1))
finished?)))