From 45649dd09c4d8294cfab3277a1c46f6e6ee1df6c Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Mon, 21 Dec 2020 10:07:29 -0600 Subject: [PATCH] Initial functionality, basic client, data model and startup --- .aws-remote | 13 ++------ bin/candle | 76 +++++++++++++++++++++++++++++++++++++++++++ bin/candle-server | 42 ++++++++++++++++++++++++ candle.asd | 9 +++++ src/main/base.lisp | 4 +++ src/main/package.lisp | 4 +++ src/main/server.lisp | 15 +++++++++ 7 files changed, 152 insertions(+), 11 deletions(-) create mode 100755 bin/candle create mode 100755 bin/candle-server create mode 100644 candle.asd create mode 100644 src/main/base.lisp create mode 100644 src/main/package.lisp create mode 100644 src/main/server.lisp diff --git a/.aws-remote b/.aws-remote index 213ac11..befb8a4 100644 --- a/.aws-remote +++ b/.aws-remote @@ -34,18 +34,9 @@ (:file-transfer "remote-config/sbcl/sbclrc" ".sbclrc") (:cmd "mkdir -p .sbcl/{site,systems}")) - (:git-extra - (:cmd "git config --global user.name \"Frank Duncan\"") - (:cmd "git config --global user.email \"frank.d.duncan@gmail.com\"") - (:cmd "git config --global receive.denyCurrentBranch updateInstead")) - - (:ci - (:cmd "mkdir ci") - (:cmd "cd ci ; git init ; git checkout -b silent") - (:local-cmd "git push silent silent")) - (:sbcldeps (:file-transfer "/home/herbie/personal/sbcldeps" "sbcldeps") - (:cmd "cd sbcldeps ; ./deploy.sh")))) + (:cmd "cd sbcldeps ; ./deploy.sh") + (:cmd "cd sbcldeps ; ./preload.sh")))) ; vim:ft=lisp diff --git a/bin/candle b/bin/candle new file mode 100755 index 0000000..4272f7f --- /dev/null +++ b/bin/candle @@ -0,0 +1,76 @@ +#!/usr/bin/sbcl --script + +(setf *compile-print* nil) +(require 'asdf) +(asdf:initialize-source-registry + `(:source-registry (:tree ,(car (directory "."))) :INHERIT-CONFIGURATION)) +(asdf:load-system :candle) +(asdf:load-system :opera) + +(in-package #:candle) + +(defun main-options () + '((:name :help :short "h" :long "help" :description "Print this usage.") + (:name :port :short "p" :long "port" :takes-argument t :variable-name "PORT" + :description "Port on which to listen for commands. Defaults to 25004") + (:positional "" :required t :description "Command to send to candle server"))) + +(defun project-options() + '((:name :help :short "h" :long "help" :description "Print this usage.") + (:name :add :long "add" :takes-argument t :description + "Add a project. is the name of the project, which must not include colons, while is the location of the repository for cloning. This location must be accessible by the machine running candle." + :variable-name ":"))) + +(defun main-usage () + (format t "~A" + (opera:usage + "candle" + (main-options) + "Interacts with candle server. The available commands are: + project List, show or add projects + job List or show jobs"))) + +(defgeneric execute-command (command args)) + +(defmethod execute-command (command args) + (format *error-output* "Unknown command '~(~A~)'. See 'candle --help'.~%" command)) + +(defun add-project (project-definition) + (let + ((pos (position #\: project-definition))) + (cond + ((not pos) (format *error-output* "Project definition ~A is not valid. See 'candle project --help'.~%" project-definition)) + (t + (let + ((response (communication:query `(add-project ,(subseq project-definition 0 pos) ,(subseq project-definition (1+ pos)))))) + (format t "Add project ~A at src definition ~A~%" (project-name response) (project-src response))))))) + +(defmethod execute-command ((command (eql :project)) args) + (multiple-value-bind (options remaining-args error) (opera:process-arguments (project-options) args) + (cond + ((eql error :unknown-option) (format *error-output* "Unknown option: ~A. See 'candle project --help'.~%" (car remaining-args))) + ((eql error :required-argument-missing) (format *error-output* "Missing argument for ~A. See 'candle project --help'.~%" (car remaining-args))) + ((opera:option-present :help options) (format t "~A" (opera:usage "candle project" (project-options)))) + ((opera:option-present :add options) (add-project (opera:option-argument :add options)))))) + +(defmethod execute-command ((command (eql :job)) args) + (format t "~A~%" (communication:query '(+ 2 2)))) + +(multiple-value-bind (options remaining-args error) (opera:process-arguments (main-options) (cdr sb-ext:*posix-argv*)) + (cond + ((opera:option-present :help options) (main-usage)) + ((eql error :unknown-option) (format *error-output* "Unknown option: ~A. See 'candle --help'.~%" (car remaining-args))) + ((and (opera:option-present :port options) (not (parse-integer (opera:option-argument :port options) :junk-allowed t))) + (format *error-output* "--port requires a number. See 'candle-server -h'~%")) + ((not remaining-args) (format *error-output* "Command required. See 'candle --help'.~%")) + (t + (let + ((communication:*query-port* + (or + (and + (opera:option-present :port options) + (parse-integer (opera:option-argument :port options) :junk-allowed t)) + 25004))) + (execute-command (intern (string-upcase (car remaining-args)) :keyword) (cdr remaining-args)))))) + +; vim:ft=lisp diff --git a/bin/candle-server b/bin/candle-server new file mode 100755 index 0000000..4d00ac0 --- /dev/null +++ b/bin/candle-server @@ -0,0 +1,42 @@ +#!/usr/bin/sbcl --script + +(setf *compile-print* nil) +(require 'asdf) +(asdf:initialize-source-registry + `(:source-registry (:tree ,(car (directory "src"))) :INHERIT-CONFIGURATION)) +(asdf:load-system :candle) +(asdf:load-system :opera) + +(defpackage #:candle-server-cli (:use #:common-lisp)) +(in-package #:candle-server-cli) + +(defvar *options* + '((:name :help :short "h" :long "help" :description "Print this usage.") + (:name :port :short "p" :long "port" :takes-argument t :variable-name "PORT" + :description "Port on which to listen for commands. Defaults to 25004"))) + +(defun usage () + (format t "~A" + (opera:usage + "candle-server" + *options* + "Starts a candle continuous integration server. Use 'candle' to interact with the server."))) + +(multiple-value-bind (options remaining-args error) (opera:process-arguments *options* (cdr sb-ext:*posix-argv*)) + (cond + ((opera:option-present :help options) (usage)) + (remaining-args + (format *error-output* "Don't understand ~A. See 'candle-server -h'~%" (car remaining-args)) + (sb-ext:exit :code 1)) + ((and (opera:option-present :port options) (not (parse-integer (opera:option-argument :port options) :junk-allowed t))) + (format *error-output* "--port requires a number. See 'candle-server -h'~%")) + (t + (let + ((port (or (and + (opera:option-present :port options) + (parse-integer (opera:option-argument :port options) :junk-allowed t)) + 25004))) + (format t "Starting server on port ~A~%" port) + (candle:server port nil))))) + +; vim:ft=lisp diff --git a/candle.asd b/candle.asd new file mode 100644 index 0000000..7ffb165 --- /dev/null +++ b/candle.asd @@ -0,0 +1,9 @@ +(asdf:defsystem candle + :name "Command Line Common Lisp Continuous Integration Tool" + :version "0.1" + :maintainer "Frank Duncan (frank@consxy.com)" + :author "Frank Duncan (frank@consxy.com)" + :serial t + :pathname "src/main" + :components ((:file "package") (:file "base") (:file "server")) + :depends-on (:herbie-utility)) diff --git a/src/main/base.lisp b/src/main/base.lisp new file mode 100644 index 0000000..f06371b --- /dev/null +++ b/src/main/base.lisp @@ -0,0 +1,4 @@ +(in-package #:candle) + +(lame-db:defdbstruct project name src) +(lame-db:defdbstruct job status sha when-run (project :join project)) diff --git a/src/main/package.lisp b/src/main/package.lisp new file mode 100644 index 0000000..490a5bc --- /dev/null +++ b/src/main/package.lisp @@ -0,0 +1,4 @@ +(defpackage #:candle (:use :cl) + (:export #:server + #:add-project + )) diff --git a/src/main/server.lisp b/src/main/server.lisp new file mode 100644 index 0000000..87d245e --- /dev/null +++ b/src/main/server.lisp @@ -0,0 +1,15 @@ +(in-package #:candle) + +(defun server (port &optional (background t)) + (lame-db:load-known-dbs "/home/herbie/.lame-db/data") + (communication:start-listener port background) + (sb-thread:make-thread + (lambda () + (do () (nil) + (progn + (sleep (* 5 60)) + (lame-db:save-known-dbs "/home/herbie/.lame-db/data")))) + :name "Save Thread")) + +(defun add-project (name src) + (make-project :name name :src src)) -- 2.25.1