diff options
Diffstat (limited to 'Biz/Serval.scm')
| -rw-r--r-- | Biz/Serval.scm | 179 |
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)))) |