grant/lispostory
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

set up build and deployment

Browse Source
This commit is contained in:
Grant Horner
2026-01-05 12:15:44 -05:00
parent ed877693c4
commit 6a2ab4b673
8 changed files with 14545 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

@@ -1,2 +1,4 @@
ocicl
*.json
lispostory
*.fasl

1
build_linux/.containerignore Normal file
View File

@@ -0,0 +1 @@
lispostory

14130
build_linux/asdf.lisp Normal file
View File

File diff suppressed because it is too large Load Diff

67
build_linux/build.lisp Normal file
View File

@@ -0,0 +1,67 @@
#+linux
(declaim
(sb-ext:muffle-conditions cl:warning)
(sb-ext:muffle-conditions cl:style-warning)
(sb-ext:muffle-conditions sb-ext:compiler-note))
#+linux
(load #P"/build/build_linux/asdf.lisp")
#+linux
(progn
(labels ((all-subdirectories (path)
(let ((subdirs (uiop:subdirectories path)))
(append subdirs
(mapcan #'all-subdirectories subdirs)))))
(setf asdf:*central-registry*
(list* #p"/build/"
(all-subdirectories "ocicl"))))
(asdf:load-system :lispostory))
#+linux
(lispostory:create-exe-and-die)
#+darwin
(defun split-and-strip (str)
(mapcar (lambda (s) (string-trim '(#\Newline) s))
(remove-if (lambda (s) (string-equal "" s)) (uiop:split-string str :separator " "))))
#+darwin
(defun run-shell-program (shell-cmd)
(let ((cmd (split-and-strip shell-cmd)))
(multiple-value-bind (output error-output exit-code)
(uiop:run-program cmd
:output :string
:error-output :string
:ignore-error-status t)
(format t "Output: ~a~%" output)
(when (not (string-equal error-output ""))
(format t "Error: ~a~%" error-output))
(format t "Exit code: ~a~%" exit-code))))
#+darwin
(defun run-builder ()
(let* ((shell-cmd "container run --arch amd64
--volume /Users/grant/programming/projects/lispostory:/build lispostory-builder
sbcl --load /build/build_linux/build.lisp"))
(run-shell-program shell-cmd)))
#+darwin
(defun build-builder ()
(run-shell-program "container build -a amd64 --tag lispostory-builder --file ./linux-builder.Dockerfile ."))
#+darwin
(defun deploy ()
(run-shell-program "rsync -t /Users/grant/programming/projects/lispostory/lispostory
hgranthorner.dev:/root/lispostory/lispostory"))
#+darwin
(defun test-deployment ()
(run-shell-program "ssh hgranthorner.dev ./lispostory/lispostory --version"))
(comment
(build-builder)
(run-builder)
(deploy)
(test-deployment))

4
build_linux/linux-builder.Dockerfile Normal file
View File

@@ -0,0 +1,4 @@
FROM docker.io/ubuntu:latest
WORKDIR /build
RUN apt update && apt install sbcl -y
CMD sbcl --load /build/build_linux/build.lisp

326
build_linux/ocicl-runtime.lisp Normal file
View File

@@ -0,0 +1,326 @@
;;; ocicl-runtime.lisp
;;;
;;; SPDX-License-Identifier: MIT
;;;
;;; Copyright (C) 2023, 2024, 2025, 2026 Anthony Green <green@moxielogic.com>
;;;
;;; Permission is hereby granted, free of charge, to any person obtaining
;;; a copy of this software and associated documentation files (the
;;; "Software"), to deal in the Software without restriction, including
;;; without limitation the rights to use, copy, modify, merge, publish,
;;; distribute, sublicense, and/or sell copies of the Software, and to
;;; permit persons to whom the Software is furnished to do so, subject to
;;; the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
;;; IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY CLAIM, DAMAGES OR
;;; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
;;; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
;;; OTHER DEALINGS IN THE SOFTWARE.
;;; Check if the ASDF version is satisfied. Compile/load the bundled ASDF version if not.
(require 'asdf)
;; Except that clasp and ECL need their own ASDFs for now.
#-(or clasp ecl)
(unless (asdf:version-satisfies (asdf:asdf-version) "3.3.5")
(let* ((asdf-file (merge-pathnames "asdf.lisp" *load-truename*))
(orig-asdf-fasl (compile-file-pathname asdf-file))
(asdf-fasl (make-pathname :defaults orig-asdf-fasl
:name (format nil "asdf-~A-~A-~A"
(lisp-implementation-type)
(lisp-implementation-version)
(machine-type)))))
(handler-bind ((warning #'muffle-warning))
(cond
((uiop:file-exists-p asdf-fasl)
(load asdf-fasl :verbose nil))
((uiop:file-exists-p asdf-file)
(load (compile-file asdf-file :verbose nil :output-file asdf-fasl) :verbose nil))
(t nil)))
(unless (asdf:version-satisfies (asdf:asdf-version) "3.3.5")
(warn "OCICL: ASDF version not satisfied. Found v~A but v3.3.5 is required." (asdf:asdf-version)))))
;; Temporary fix for a mysterious problem
#+clasp
(when (find-package :sb-bsd-sockets)
(asdf:register-immutable-system :sb-bsd-sockets))
(defpackage #:ocicl-runtime
(:use #:cl)
(:documentation "Runtime support for ocicl system discovery and installation")
(:export #:*download* #:*verbose* #:*force-global* #:+version+ #:system-list))
(in-package #:ocicl-runtime)
(defvar *download* t)
(defvar *verbose* nil)
(defvar *force-global* nil)
(defconstant +version+ "2.14.1")
(defconstant +required-programs+ (list "ocicl"))
(defvar *systems-csv* "ocicl.csv")
(defvar *relative-systems-dir* (make-pathname :directory '(:relative "ocicl")))
(defvar *local-ocicl-systems* nil)
(defvar *local-systems-dir* nil)
(defvar *local-systems-csv* nil)
(defvar *local-systems-csv-timestamp* 0)
(defvar *global-ocicl-systems* nil)
(defvar *global-systems-dir* nil)
(defvar *global-systems-csv* nil)
(defvar *global-systems-csv-timestamp* 0)
(defun split-on-delimiter (line delim)
"Split LINE on DELIM character, returning list of trimmed substrings."
(let ((start 0)
(end 0)
(result nil))
(loop for c across line
for i from 0
do (when (char= c delim)
(setf end i)
(push (string-trim " " (subseq line start end)) result)
(setf start (1+ i)))
finally (push (string-trim " " (subseq line start)) result))
(nreverse result)))
(defun replace-plus-with-string (str)
"Replace + characters with _plus_ and strip trailing underscore if present."
(let ((mangled (with-output-to-string (s)
(loop for c across str do
(if (char= c #\+)
(write-string "_plus_" s)
(write-char c s))))))
(if (char= (char mangled (1- (length mangled))) #\_)
(subseq mangled 0 (1- (length mangled)))
mangled)))
(defun mangle (str)
"Mangle system name STR for filesystem use (handle + and / characters)."
(replace-plus-with-string (first (split-on-delimiter str #\/))))
(defun split-csv-line (line)
"Split a CSV line on commas."
(split-on-delimiter line #\,))
(defun should-log ()
"Whether or not OCICL should output useful log info to *VERBOSE*."
(and *verbose* (or (eq t *verbose*) (output-stream-p *verbose*))))
(defun read-systems-csv (systems-csv)
"Read SYSTEMS-CSV file and return hash table mapping system names to (version . path)."
(when (should-log)
(format *verbose* "; loading ~A~%" systems-csv))
(let ((ht (make-hash-table :test #'equal)))
(dolist (line (uiop:read-file-lines systems-csv))
(let ((vlist (split-csv-line line)))
(setf (gethash (first vlist) ht) (cons (cadr vlist) (caddr vlist)))))
ht))
(defun program-exists-p (program-name)
"Check if PROGRAM-NAME exists and is executable."
(handler-case
(multiple-value-bind (_ err code)
(uiop:run-program (list program-name) :ignore-error-status t)
(declare (ignore _ err))
(not (member code '(126 127))))
(error ()
;; If we can't run the program at all, it doesn't exist
nil)))
(defun warn-if-program-doesnt-exist (program-name)
"If VERBOSE, print a warning if PROGRAM-NAME doesn't exist or isn't executable."
(when (and (should-log) (not (program-exists-p program-name)))
(format *verbose* "~&; ***************************************************************~%")
(format *verbose* "; WARNING: `~A` could not be found!~%" program-name)
(format *verbose* "; ***************************************************************~%")
(terpri)))
(defun warn-if-missing-required-programs ()
"Invoke WARN-IF-PROGRAM-DOESNT-EXIST on +REQUIRED-PROGRAMS+."
(mapc #'warn-if-program-doesnt-exist +required-programs+))
(defun verify-ocicl-version ()
"Verify ocicl binary version matches runtime version and warn if out of sync."
(warn-if-missing-required-programs)
(handler-case
(let ((ocicl-version-output (uiop:run-program '("ocicl" "version")
:output '(:string)
:error-output *error-output*))
(ocicl-version-string (format nil "ocicl version: ~A~%" ocicl-runtime:+version+)))
(unless (string= ocicl-version-string (subseq ocicl-version-output 0 (length ocicl-version-string)))
(format t "~&; ***************************************************************~%")
(format t "; WARNING: Your ocicl binary and ocicl-runtime are out of sync.~%")
(format t "; Run `ocicl setup` and restart.~%")
(format t "; ***************************************************************~%")
(terpri)))
(error (e)
(when (should-log)
(format *verbose* "; Error checking ocicl version: ~A~%" e)))))
(defun sanitize-system-name (name)
"Sanitize system name to prevent command injection."
(let ((name-str (princ-to-string name)))
;; Only allow alphanumeric, dash, underscore, dot, plus, and slash
(if (every (lambda (c) (or (alphanumericp c) (find c "-_.+/"))) name-str)
name-str
(error "Invalid system name: ~A" name-str))))
(defun ocicl-install (name)
"Install system NAME using the ocicl command."
(verify-ocicl-version)
(let* ((safe-name (sanitize-system-name name))
(cmd `("ocicl" ,@(when *verbose* '("-v"))
,@(when *force-global* '("--global"))
"install"
,safe-name)))
(warn-if-missing-required-programs)
(when (should-log)
(format *verbose* "; running: ~A~%" cmd))
(handler-case
(uiop:run-program cmd
:output (or *verbose* '(:string))
:error-output *error-output*)
(error (e)
(when (should-log)
(format *verbose* "; Error installing ~A: ~A~%" safe-name e))
(error e))))
(setf *local-systems-csv-timestamp* 0))
(defun get-ocicl-dir ()
"Find the ocicl directory."
(let ((ocicl-dir (merge-pathnames (make-pathname :directory '(:relative "ocicl"))
(uiop:xdg-data-home))))
(uiop:ensure-all-directories-exist (list ocicl-dir))
ocicl-dir))
(defmethod parent ((file pathname))
"Return the parent directory of FILE."
(if (uiop:directory-pathname-p file)
(uiop:pathname-parent-directory-pathname file)
(uiop:pathname-directory-pathname file)))
(defun find-workdir (workdir)
"Search for ocicl.csv or systems.csv starting from WORKDIR and moving up the directory chain.
Returns the directory containing ocicl.csv or systems.csv if found. If none is
found, return WORKDIR."
(declare (optimize (speed 3) (safety 0)))
(loop for dir = (truename workdir) :then parent-dir
for parent-dir = (parent dir)
for systems-csv = (merge-pathnames (make-pathname :name "systems" :type "csv") dir)
for ocicl-csv = (merge-pathnames (make-pathname :name "ocicl" :type "csv") dir)
;; Need pathname return value, not just boolean
for existing-csv = (or (probe-file ocicl-csv) (probe-file systems-csv)) ; lint:suppress use-uiop-file-exists-p
until (or existing-csv
(null parent-dir)
(equal parent-dir dir))
finally (return
(uiop:ensure-directory-pathname
(cond (existing-csv
(setf *systems-csv* existing-csv
*relative-systems-dir* (make-pathname
:directory
`(:relative ,(pathname-name existing-csv))))
dir)
(t workdir))))))
(defun initialize-globals ()
"Initialize global variables for local and global system directories and CSV files."
(unless *local-systems-dir*
(let ((workdir (find-workdir (uiop:getcwd))))
(setf *local-systems-dir* (merge-pathnames *relative-systems-dir* workdir))
(setf *local-systems-csv* (merge-pathnames *systems-csv* workdir))))
(unless *global-systems-dir*
(let* ((config-file (merge-pathnames "ocicl-globaldir.cfg" (get-ocicl-dir)))
(globaldir (if (uiop:file-exists-p config-file)
(handler-case
(uiop:ensure-absolute-pathname (uiop:read-file-line config-file))
(error (e)
(when (should-log)
(format *verbose* "; Error reading config file ~A: ~A~%" config-file e))
(get-ocicl-dir)))
(get-ocicl-dir))))
(setf *global-systems-dir* (merge-pathnames *relative-systems-dir* globaldir))
(setf *global-systems-csv* (merge-pathnames *systems-csv* globaldir))))
(when (uiop:file-exists-p *local-systems-csv*)
(let ((timestamp (file-write-date *local-systems-csv*)))
(when (> timestamp *local-systems-csv-timestamp*)
(handler-case
(progn
(setf *local-ocicl-systems* (read-systems-csv *local-systems-csv*))
(setf *local-systems-csv-timestamp* timestamp))
(error (e)
(when (should-log)
(format *verbose* "; Error reading local systems CSV ~A: ~A~%" *local-systems-csv* e)))))))
(when (uiop:file-exists-p *global-systems-csv*)
(let ((timestamp (file-write-date *global-systems-csv*)))
(when (> timestamp *global-systems-csv-timestamp*)
(handler-case
(progn
(setf *global-ocicl-systems* (read-systems-csv *global-systems-csv*))
(setf *global-systems-csv-timestamp* timestamp))
(error (e)
(when (should-log)
(format *verbose* "; Error reading global systems CSV ~A: ~A~%" *global-systems-csv* e))))))))
(defun find-asdf-system-file (name download-p)
"Find ASDF system file for NAME, optionally downloading if DOWNLOAD-P is true."
(initialize-globals)
(labels ((try-load (systems systems-dir)
(let ((match (and systems (gethash (mangle name) systems)))) ; lint:suppress
(when match
(let ((pn (merge-pathnames (rest match) systems-dir)))
(when (should-log)
(format *verbose* "; checking for ~A: " pn))
(if (uiop:file-exists-p pn)
(progn
(when (should-log) (format *verbose* "found~%"))
pn)
(when (should-log) (format *verbose* "missing~%"))))))))
(or (try-load *local-ocicl-systems* *local-systems-dir*)
(try-load *global-ocicl-systems* *global-systems-dir*)
(when download-p
(ocicl-install name)
(setf *local-ocicl-systems* (read-systems-csv *local-systems-csv*))
(find-asdf-system-file name nil)))))
(defun starts-with-p (prefix string)
"Return true if STRING starts with PREFIX."
(and (<= (length prefix) (length string))
(string= prefix (subseq string 0 (length prefix)))))
(defun system-definition-searcher (name)
"Search for ASDF system definition file for NAME, using ocicl if needed."
(unless (or (starts-with-p "asdf/" name) (string= "asdf" name) (string= "uiop" name))
(let* ((*verbose* (or *verbose* asdf:*verbose-out*))
(system-file (find-asdf-system-file name *download*)))
(when (and system-file
(string= (pathname-name system-file) name))
system-file))))
(setf asdf:*system-definition-search-functions*
(append asdf:*system-definition-search-functions*
(list 'system-definition-searcher)))
(defun system-list ()
"Return list of all known system names from local and global registries."
(initialize-globals)
(append (when *local-ocicl-systems*
(loop for key being the hash-keys of *local-ocicl-systems*
collect key))
(when *global-ocicl-systems*
(loop for key being the hash-keys of *global-ocicl-systems*
collect key))))
(pushnew :OCICL *features*)

12
main.lisp
View File

@@ -6,9 +6,17 @@
(defun main ()
(sb-ext:disable-debugger)
(let ((args (rest sb-ext:*posix-argv*)))
(let ((program-name (car sb-ext:*posix-argv*))
(args (rest sb-ext:*posix-argv*)))
(when (member "--fail" args :test #'string=)
(error "Simulated error!"))))
(error "Simulated error!"))
(when (member "--version" args :test #'string=)
(let ((write-time (file-write-date program-name)))
(multiple-value-bind (second minute hour date month year)
(decode-universal-time write-time)
(let ((dt (format nil "~4,'0d-~2,'0d-~2,'0d ~2,'0d:~2,'0d:~2,'0d"
year month date hour minute second)))
(format t "lispostory, created ~a~%" dt)))))))
(defun create-exe-and-die ()
(sb-ext:save-lisp-and-die

4
spawns.lisp
View File

@@ -103,3 +103,7 @@ separate csvs."
:if-exists :overwrite
:if-does-not-exist :create)
spawn-data))
(comment
(defvar spawn-ds (make-spawn-data-source))
(refresh spawn-ds))