summaryrefslogtreecommitdiff
path: root/Biz/Serval.scm
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2024-12-04 15:52:52 -0500
committerBen Sima <ben@bsima.me>2024-12-21 10:08:05 -0500
commit81cf94523f5a794e5b0c69dbd9a94619135a23c7 (patch)
tree22544f9d741827ebfe65f73f0202b2b095a09cf8 /Biz/Serval.scm
parent47c48abf836f5918120c0550c57d4eda32d3f10e (diff)
Prune unused stuff
This was all dead weight, just delete it and move on.
Diffstat (limited to 'Biz/Serval.scm')
-rw-r--r--Biz/Serval.scm179
1 files changed, 0 insertions, 179 deletions
diff --git a/Biz/Serval.scm b/Biz/Serval.scm
deleted file mode 100644
index 93eb3ac..0000000
--- a/Biz/Serval.scm
+++ /dev/null
@@ -1,179 +0,0 @@
-;;
-;; Serval - fast container management
-;;
-;; : out serval
-;;
-;; `Container management' simply refers to tracking the configuration
-;; for individual containers and their running state.
-;;
-;; Serval stores container configuration in a directory, which forms the
-;; database. Each container is associated with a `.kit' file, which is a
-;; serialized s-expr of a `@Kit' record type.
-;;
-;; Runtime state is offloaded to systemd, and certain commands simply
-;; reach out to `systemctl' and `machinectl' for this functionality.
-;;
-;; Serval does not concern itself with deployment. For that, use `nix copy'.
-;;
-;; Currently Serval only supports a single physical machine: if we want
-;; to cluster containers across machines, we must find a way to store
-;; and reason about the host in addition to the container. This might
-;; mean absorbing some functionality that systemd currently performs for
-;; us.
-;;
-;; FILES
-;;
-;; /var/lib/serval/<kit-name>.kit - kit state (serialized s-expr)
-;; /var/lib/serval/<kit-name>/ - root directory for the kit
-;; /nix/var/nix/profiles/per-kit/<kit-name> - symlink to cfg in /nix/store
-;;
-(define-module (Biz Serval)
- #:use-module ((ice-9 getopt-long))
- #:use-module ((ice-9 match)
- #:select (match))
- #:use-module ((srfi srfi-9)
- #:select (define-record-type))
- #:use-module ((bs core)
- #:select (first second rest turn fmt prn comment))
- #:use-module ((bs test)
- #:select (testing))
- #:use-module ((bs shell) #:prefix Shell.)
- #:export (main))
-
-(define *data-dir* "/var/lib/serval")
-(define *nix-profiles-dir* "/nix/var/nix/profiles")
-
-(define (main args)
- ;; pop first arg if its the executable
- (let* ([args (if (equal? (first args) "Biz/Serval.scm")
- (rest args)
- args)]
- [cmd (first args)])
- (match cmd
- ["new" (new-kit! args)]
- ["del" (del-kit! args)]
- ["start" (start-kit! args)]
- ["stop" (stop-kit! args)]
- ["scale" (prn "scale running kits")]
- ["ssh" (run-in-kit! args)]
- ["info" (prn "show kit")]
- ["ls" ("list available kits")]
- [else (prn "help text")])))
-
-(define-record-type @Kit
- (Kit name nix-path system-path host-address
- host-port local-address auto-start)
- kit?
- ;; a unique name for this kit
- (name kit-name)
- ;; location in the nix store
- (nix-path get-nix-path set-nix-path!)
- ;; this is like /etc/nixos/conf.nix in NixOS proper. At
- ;; initialization, this is just `/var/lib/serval/$kit'. Afterwards,
- ;; it's `/nix/var/nix/profiles/per-kit/$kit'.
- (system-path get-system-path set-system-path!)
- ;; host IP
- (host-address get-host-address set-host-address!)
- ;; host port
- (host-port get-host-port set-host-port!)
- ;; the private IP
- (local-address get-local-address set-local-address!)
- ;; should this kit start when the host starts?
- (auto-start get-auto-start set-auto-start!))
-
-(define (zip a b)
- "Combine a and b into a single list of pairs."
- (apply map cons (list a b)))
-
-(define (serialize kit)
- "Turns a kit into an association list."
- (let* ((fields (record-type-fields @Kit))
- (values (turn fields
- (lambda (field) ((record-accessor @Kit field) kit)))))
- (zip fields values)))
-
-(define (deserialize alist)
- "Creates a @Kit from an association list."
- (apply Kit (map rest alist)))
-
-(define (save-kit! kit)
- (call-with-output-file (fmt "~a/~a.kit" *data-dir* (kit-name kit))
- (lambda (a) (write (serialize kit) a))))
-
-(define (load-kit! kit-name)
- (call-with-input-file (fmt "~a/~a.kit" *data-dir* kit-name)
- (lambda (a) (deserialize (read a)))))
-
-(define (find-available-address)
- "10.233.0.1")
-
-;; top-level commands, each take an argstr
-
-(define (setup!)
- "Initial setup, only need to run once."
- (Shell.exec (fmt "mkdir -p ~a" *nix-profiles-dir*))
- (Shell.exec (fmt "mkdir -p ~a" *data-dir*)))
-
-(define (new-kit! args)
- "Creates a new kit:
-1. first arg is name
-2. second arg is nix-path
-3. rest args parsed by getopt-long
-"
- (let* ([name (first args)]
- [nix-path (second args)]
- [option-spec '((auto-start (single-char #\a) (value #f)))]
- [options (getopt-long args option-spec)]
- [auto-start (option-ref options 'auto-start #f)]
- [local-address (find-available-address)]
- [kit (Kit name nix-path "fixme-system-path" "fixme-host-address"
- "fixme-host-port" local-address auto-start)])
- (save-kit! kit)
- (prn ;; Shell.exec
- (fmt "nix-env -p ~a/per-kit/system --set ~a"
- *nix-profiles-dir* (get-system-path kit)))
- kit))
-
-(define (del-kit! args)
- (let ([name (first args)])
- (Shell.exec (fmt "rm ~a/~a" *data-dir* name))))
-
-(define (list-kits)
- (Shell.exec (fmt "ls ~a" *data-dir*)))
-
-(define (update-kit! args)
- (let ([kit #nil])
- (Shell.exec
- (fmt "nix-env -p ~a/system -I nixos-config=~a -f <nixpkgs/nixos> --set -A system"
- *nix-profiles-dir*
- (get-system-path #nil)))))
-
-(define (run-in-kit! args)
- (let ([kit #nil])
- (Shell.exec
- (fmt "systemd-run --machine ~a --pty --quiet -- ~{~a~}"
- (kit-name kit) args))))
-
-(define (is-kit-running? kit)
- (Shell.exec
- (fmt "systemctl show kit@~a" (kit-name kit))))
-
-(define (start-kit! kit)
- (Shell.exec
- (fmt "systemctl start kit@~a" (kit-name kit))))
-
-(define (stop-kit! kit)
- (let* ([force-stop #f]
- [cmd (if force-stop
- (fmt "machinectl terminate ~a" (kit-name kit))
- (fmt "systemctl stop kit@~a" (kit-name kit)))])
- (Shell.exec cmd)))
-
-(define (restart-kit! kit)
- (stop-kit! kit)
- (start-kit! kit))
-
-(define (get-leader kit)
- "Return the PID of the init process of the kit."
- (Shell.exec
- (fmt "machinectl show ~a -p Leader" (kit-name kit))))