Initial functionality, basic client, data model and startup
authorFrank Duncan <frank@kank.net>
Mon, 21 Dec 2020 16:07:29 +0000 (10:07 -0600)
committerFrank Duncan <frank@kank.net>
Mon, 21 Dec 2020 16:07:29 +0000 (10:07 -0600)
.aws-remote
bin/candle [new file with mode: 0755]
bin/candle-server [new file with mode: 0755]
candle.asd [new file with mode: 0644]
src/main/base.lisp [new file with mode: 0644]
src/main/package.lisp [new file with mode: 0644]
src/main/server.lisp [new file with mode: 0644]

index 213ac1149dad2c7495d020a7d636a20db0b3e2b1..befb8a4f65db5d4e147d526c95ea3733a86e7215 100644 (file)
    (: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 (executable)
index 0000000..4272f7f
--- /dev/null
@@ -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 "<command>" :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.  <name> is the name of the project, which must not include colons, while <src> is the location of the repository for cloning.  This location must be accessible by the machine running candle."
+    :variable-name "<name>:<src>")))
+
+(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 (executable)
index 0000000..4d00ac0
--- /dev/null
@@ -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 (file)
index 0000000..7ffb165
--- /dev/null
@@ -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 (file)
index 0000000..f06371b
--- /dev/null
@@ -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 (file)
index 0000000..490a5bc
--- /dev/null
@@ -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 (file)
index 0000000..87d245e
--- /dev/null
@@ -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))