projects
/
candle
/ blobdiff
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Satisfy style checker
[candle]
/
src
/
main
/
server.lisp
diff --git
a/src/main/server.lisp
b/src/main/server.lisp
index 3df97f820b7236be8543f1d75680b4a3d496acdc..3f022f387b4b70aab74f24b4d349f2d40dc9b92c 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))
@@
-72,7
+77,9
@@
((project (find-project-by-name-or-die name))
(branches (find-branch-by-project project)))
(git project "fetch" "origin" "--prune")
((project (find-project-by-name-or-die name))
(branches (find-branch-by-project project)))
(git project "fetch" "origin" "--prune")
- (multiple-value-bind (success code out err) (git project "branch" "-r" "--format" "%(refname) %(objectname)" "--list" "origin/*")
+ (multiple-value-bind
+ (success code out err)
+ (git project "branch" "-r" "--format" "%(refname) %(objectname)" "--list" "origin/*")
(declare (ignore code err))
(when (not success) (raise-candle-error :project-failed-to-get-branches))
(mapcar (lambda (branch) (set-branch-in-git branch nil)) branches)
(declare (ignore code err))
(when (not success) (raise-candle-error :project-failed-to-get-branches))
(mapcar (lambda (branch) (set-branch-in-git branch nil)) branches)
@@
-130,8
+137,8
@@
(find-if
(lambda (job-sha)
(and (<= (length sha) (length job-sha)) (string= sha (subseq job-sha 0 (length sha)))))
(find-if
(lambda (job-sha)
(and (<= (length sha) (length job-sha)) (string= sha (subseq job-sha 0 (length sha)))))
- (find-job-by-project project)
- :key #'job-sha))))
+
(find-job-by-project project)
+
:key #'job-sha))))
(when (not job) (raise-candle-error :job-does-not-exist))
job))
(when (not job) (raise-candle-error :job-does-not-exist))
job))
@@
-156,5
+163,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*)))))