provider: condvar-based timeout (needs dex:post fix)
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s

This commit is contained in:
2026-05-04 20:12:12 -04:00
parent 78705f55ec
commit d8929aeb24
2 changed files with 38 additions and 40 deletions

View File

@@ -54,9 +54,10 @@
(handler-case (handler-case
(let* ((result nil) (let* ((result nil)
(lock (bt:make-lock "llm-lock")) (lock (bt:make-lock "llm-lock"))
(done nil) (cvar (bt:make-condition-variable))
(thread (bt:make-thread (thread (bt:make-thread
(lambda () (lambda ()
(unwind-protect
(handler-case (handler-case
(let* ((response (dex:post url :headers headers :content body (let* ((response (dex:post url :headers headers :content body
:connect-timeout (min 10 timeout) :connect-timeout (min 10 timeout)
@@ -66,17 +67,15 @@
(first-choice (car choices)) (first-choice (car choices))
(message (cdr (assoc :message first-choice))) (message (cdr (assoc :message first-choice)))
(content (cdr (assoc :content message)))) (content (cdr (assoc :content message))))
(setf result (if content (setf result (list :status :success :content content)))
(list :status :success :content content)
(list :status :error :message (format nil "~a: No content" provider)))))
(error (c) (error (c)
(setf result (list :status :error :message (format nil "~a Error: ~a" provider c))))) (setf result (list :status :error :message (format nil "~a Error: ~a" provider c)))))
(bt:with-lock-held (lock) (setf done t))) (bt:with-lock-held (lock)
(bt:condition-notify cvar))))
:name (format nil "llm-~a" provider)))) :name (format nil "llm-~a" provider))))
(loop for waited from 0 below timeout (bt:with-lock-held (lock)
when (bt:with-lock-held (lock) done) (unless result
do (return result) (bt:condition-wait cvar lock :timeout timeout)))
do (sleep 0.5))
(or result (or result
(list :status :error :message (format nil "~a: Request timed out after ~d seconds" provider timeout)))) (list :status :error :message (format nil "~a: Request timed out after ~d seconds" provider timeout))))
(error (c) (error (c)

View File

@@ -82,9 +82,10 @@ Providers register themselves at boot. No API key? That provider doesn't registe
(handler-case (handler-case
(let* ((result nil) (let* ((result nil)
(lock (bt:make-lock "llm-lock")) (lock (bt:make-lock "llm-lock"))
(done nil) (cvar (bt:make-condition-variable))
(thread (bt:make-thread (thread (bt:make-thread
(lambda () (lambda ()
(unwind-protect
(handler-case (handler-case
(let* ((response (dex:post url :headers headers :content body (let* ((response (dex:post url :headers headers :content body
:connect-timeout (min 10 timeout) :connect-timeout (min 10 timeout)
@@ -94,17 +95,15 @@ Providers register themselves at boot. No API key? That provider doesn't registe
(first-choice (car choices)) (first-choice (car choices))
(message (cdr (assoc :message first-choice))) (message (cdr (assoc :message first-choice)))
(content (cdr (assoc :content message)))) (content (cdr (assoc :content message))))
(setf result (if content (setf result (list :status :success :content content)))
(list :status :success :content content)
(list :status :error :message (format nil "~a: No content" provider)))))
(error (c) (error (c)
(setf result (list :status :error :message (format nil "~a Error: ~a" provider c))))) (setf result (list :status :error :message (format nil "~a Error: ~a" provider c)))))
(bt:with-lock-held (lock) (setf done t))) (bt:with-lock-held (lock)
(bt:condition-notify cvar))))
:name (format nil "llm-~a" provider)))) :name (format nil "llm-~a" provider))))
(loop for waited from 0 below timeout (bt:with-lock-held (lock)
when (bt:with-lock-held (lock) done) (unless result
do (return result) (bt:condition-wait cvar lock :timeout timeout)))
do (sleep 0.5))
(or result (or result
(list :status :error :message (format nil "~a: Request timed out after ~d seconds" provider timeout)))) (list :status :error :message (format nil "~a: Request timed out after ~d seconds" provider timeout))))
(error (c) (error (c)