X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=candle;a=blobdiff_plain;f=src%2Fmain%2Fserver.lisp;h=e1b8cb696cdcbcf1ebe1f6fc53f92c23ae0b385a;hp=3f022f387b4b70aab74f24b4d349f2d40dc9b92c;hb=a50fef6f3bacc24a838e81092104f3082b15bad4;hpb=4aa3c53883d919803cac77f47ad16ce33047f6ce diff --git a/src/main/server.lisp b/src/main/server.lisp index 3f022f3..e1b8cb6 100644 --- a/src/main/server.lisp +++ b/src/main/server.lisp @@ -1,6 +1,23 @@ (in-package #:candle) (defun server (port &optional (background t)) + "SERVER PORT &optional BACKGROUND => UNUSED + +ARGUMENTS AND VALUES: + + PORT: the port to start the communication server on + BACKGROUND: a boolean, defaulting to T + UNUSED: the result is unused + +DESCRIPTION: + + Starts the server, listening for commands from the client on PORT. + + If BACKGROUND is T, then the communication thread starts in the background, + which is useful when starting the server from an already running process. + Generally, if running from a script, you'll want BACKGROUND to be NIL, + so that the process doesn't exit immediately." + (when (not *candle-dir*) (error "Need a candle dir")) (let* ((data-dir (format nil "~Adata" *candle-dir*)) @@ -56,6 +73,23 @@ (raise-candle-error :project-does-not-exist)))) (defun add-project (name src) + "ADD-PROJECT NAME SRC => RESULT + +ARGUMENTS AND VALUES: + + NAME: a string, representing the name of the project + SRC: a pathname, or pathstring, holding the location of the project + RESULT: if no error generated, returns t + +DESCRIPTION: + + Creates and adds a project to the database. NAME must be a + unique alphanumeric (hyphens allowed) string. SRC must be a git + accessible location for the running user, requiring keys to be set + up or it be located on the local disk. + + In addition to adding to the database, it will also clone the project + and analyze it intially (calling REFRESH-PROJECT)." (when (not (cl-ppcre:scan "^[0-9A-Za-z-]*$" name)) (raise-candle-error :invalid-project-name)) @@ -73,6 +107,19 @@ t) (defun refresh-project (name) + "REFRESH-PROJECT NAME => RESULT + +ARGUMENTS AND VALUES: + + NAME: a string, representing the name of the project + RESULT: unused + +DESCRIPTION: + + Refreshes the project from git's origin. Fetches, and then + analysis all branches available to create jobs for any new + commits that those branches are set to. Then wakes up the + processor thread to start working through those jobs." (let* ((project (find-project-by-name-or-die name)) (branches (find-branch-by-project project))) @@ -101,6 +148,17 @@ (awaken-processor-thread)) (defun delete-project (name) + "DELETE-PROJECT NAME => RESULT + +ARGUMENTS AND VALUES: + + NAME: a string, representing the name of the project + RESULT: unused + +DESCRIPTION: + + Removes a project from the database and the disk. NAME must + be an existing project." (let ((project (find-project-by-name-or-die name))) (sb-ext:delete-directory (project-dir project) :recursive t) @@ -112,6 +170,26 @@ (list (project-name (job-project job)) (job-sha job) (job-status job) (job-create-date job))) (defun project-branch-information (name) + "PROJECT-BRANCH-INFORMATION NAME => BRANCHES-INFORMATION + + BRANCHES-INFORMATION: BRANCH-INFORMATION* + BRANCH-INFORMATION: (BRANCH-NAME JOB-INFORMATION) + JOB-INFORMATION: (JOB-PROJECT-NAME SHA STATUS CREATED-DATE) + STATUS: :queued | :failed | :succeeded | :no-candle-file | :in-progress + +ARGUMENTS AND VALUES: + + NAME: a string, the project for which we want information + BRANCH-NAME: a string, the name of the branch + JOB-PROJECT-NAME: a string, the project name for the attached job + SHA: a string, the sha for this job + CREATED-DATE: a universal time, the moment the job was first created + +DESCRIPTION: + + Returns the information for all the branches in the given project, + which includes the job information for the commit that the branch + is currently pointing to." (let ((project (find-project-by-name-or-die name))) (mapcar @@ -122,6 +200,22 @@ (remove-if-not #'branch-in-git (find-branch-by-project project))))) (defun project-job-information (name) + "PROJECT-JOB-INFORMATION NAME => JOBS-INFORMATION + + JOBS-INFORMATION: JOB-INFORMATION* + JOB-INFORMATION: (JOB-PROJECT-NAME SHA STATUS CREATED-DATE) + STATUS: :queued | :failed | :succeeded | :no-candle-file | :in-progress + +ARGUMENTS AND VALUES: + + NAME: a string, the project for which we want information + JOB-PROJECT-NAME: a string, the project name for the attached job + SHA: a string, the sha for this job + CREATED-DATE: a universal time, the moment the job was first created + +DESCRIPTION: + + Returns the information for all the jobs in the given project." (let ((project (find-project-by-name-or-die name))) (mapcar #'job->job-information @@ -143,13 +237,56 @@ job)) (defun get-job-log (project-name sha) + "GET-JOB-LOG PROJECT-NAME SHA => LOG + +ARGUMENTS AND VALUES: + + PROJECT-NAME: a string, representing the name of the project + SHA: a string, the commit sha for the job + LOG: the log from the run process + +DESCRIPTION: + + Returns the log for the job specified. When the job wasn't run + (for instance, if no candle file), just returns NIL. The SHA + can be truncated, and if there are collisions, one of them will be + returned." (job-log (find-job-by-project-and-sha project-name sha))) (defun retry-job (project-name sha) + "RETRY-JOB PROJECT-NAME SHA => UNUSED + +ARGUMENTS AND VALUES: + + PROJECT-NAME: a string, representing the name of the project + SHA: a string, the commit sha for the job + UNUSED: the result is unused + +DESCRIPTION: + + Sets the job specified by PROJECT-NAME and SHA to :queued, which will + then be run. Also awakes the processor thread to process it immediately + if available." (set-job-status (find-job-by-project-and-sha project-name sha) :queued) (awaken-processor-thread)) (defun list-projects () + "LIST-PROJECTS => PROJECTS-INFORMATION + + PROJECTS-INFORMATION: PROJECT-INFORMATION* + PROJECT-INFORMATION: (NAME SRC FAILURES) + +ARGUMENTS AND VALUES: + + NAME: a string, representing the name of the project + SRC: the git origin remote location + FAILURES: the number of failing branches + +DESCRIPTION: + + Returns the information for all the projects in the system, as + is needed by the cli. Returns it as a list of lists, as specified + above." (mapcar (lambda (project) (list @@ -158,7 +295,18 @@ (failures (project-name project)))) *all-project*)) -(defun failures (project-name) +(defun failures (&optional project-name) + "FAILURES &optional NAME => NUM-FAILURES + +ARGUMENTS AND VALUES: + + NAME: a string, representing the name of the project + NUM-FAILURES: the number of failures + +DESCRIPTION: + + Returns the number of failing branches. When NAME is specified, + the branches are limited to the project it refers to." (let ((project (find-project-by-name-or-die project-name))) (length