projects
/
candle
/ blobdiff
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix bug where inactive branches were counted as failures
[candle]
/
src
/
main
/
server.lisp
diff --git
a/src/main/server.lisp
b/src/main/server.lisp
index 320ffbda285c2dcfad6da964243779ce155de0ed..338516bed5eae32303ce221773db87296cb09b63 100644
(file)
--- a/
src/main/server.lisp
+++ b/
src/main/server.lisp
@@
-3,17
+3,22
@@
(defun server (port &optional (background t))
(when (not *candle-dir*) (error "Need a candle dir"))
(let*
(defun server (port &optional (background t))
(when (not *candle-dir*) (error "Need a candle dir"))
(let*
- ((data-dir (format nil "~Adata" *candle-dir*)))
+ ((data-dir (format nil "~Adata" *candle-dir*))
+ (log-dir (format nil "~Alogs/" *candle-dir*)))
(ensure-directories-exist *candle-dir*)
(ensure-directories-exist data-dir)
(ensure-directories-exist *candle-dir*)
(ensure-directories-exist data-dir)
+ (ensure-directories-exist log-dir)
+ (setf log-utils:*log-dir* log-dir)
+ (log:add-appender #'log-utils:file-appender)
+ (log:info "Starting server on port ~A" port)
(lame-db:load-known-dbs data-dir)
(lame-db:load-known-dbs data-dir)
- (
format t "Starting processor in ~(~A~) mode~%
" *job-system*)
+ (
log:info "Starting processor in ~(~A~) mode
" *job-system*)
(start-save-thread data-dir)
(start-processor-thread)
(communication:start-listener port background)))
(defun start-save-thread (data-dir)
(start-save-thread data-dir)
(start-processor-thread)
(communication:start-listener port background)))
(defun start-save-thread (data-dir)
- (
format t "Starting Save Thread~%
")
+ (
log:info "Starting Save Thread
")
(let*
((mutex (sb-thread:make-mutex))
(waitq (sb-thread:make-waitqueue))
(let*
((mutex (sb-thread:make-mutex))
(waitq (sb-thread:make-waitqueue))
@@
-25,19
+30,19
@@
:while active
:do
(sb-thread:with-mutex (mutex)
:while active
:do
(sb-thread:with-mutex (mutex)
- (sb-thread:condition-wait waitq mutex)
))
-
(lame-db:save-known-dbs data-dir
))
+ (sb-thread:condition-wait waitq mutex)
+
(lame-db:save-known-dbs data-dir))
))
:name "Save Thread")))
(sb-thread:make-thread
(lambda ()
(loop
:name "Save Thread")))
(sb-thread:make-thread
(lambda ()
(loop
- (sleep (*
1
60))
+ (sleep (*
5
60))
(sb-thread:with-mutex (mutex)
(sb-thread:condition-broadcast waitq))))
:name "Save Thread Trigger")
(push
(lambda ()
(sb-thread:with-mutex (mutex)
(sb-thread:condition-broadcast waitq))))
:name "Save Thread Trigger")
(push
(lambda ()
- (
format t "Shutting down save thread~%
")
+ (
log:info "Shutting down save thread
")
(sb-thread:with-mutex (mutex)
(setf active nil)
(sb-thread:condition-broadcast waitq))
(sb-thread:with-mutex (mutex)
(setf active nil)
(sb-thread:condition-broadcast waitq))
@@
-102,7
+107,7
@@
(nremove-project project)))
(defun job->job-information (job)
(nremove-project project)))
(defun job->job-information (job)
- (list (job-sha job) (job-status job) (job-create-date job)))
+ (list (
project-name (job-project job)) (
job-sha job) (job-status job) (job-create-date job)))
(defun project-branch-information (name)
(let
(defun project-branch-information (name)
(let
@@
-156,5
+161,5
@@
((project (find-project-by-name-or-die project-name)))
(length
(remove-if-not
((project (find-project-by-name-or-die project-name)))
(length
(remove-if-not
- (lambda (branch) (
eql :failed (job-status (branch-job branch
))))
+ (lambda (branch) (
and (branch-in-git branch) (eql :failed (job-status (branch-job branch)
))))
(if project (find-branch-by-project project) *all-branch*)))))
(if project (find-branch-by-project project) *all-branch*)))))