diff options
author | Ben Sima <ben@bsima.me> | 2020-04-15 09:54:10 -0700 |
---|---|---|
committer | Ben Sima <ben@bsima.me> | 2020-04-15 10:06:56 -0700 |
commit | f4b8c0df041b063c0b47d2ec6c818a9c202fd833 (patch) | |
tree | 01ad246a83fda29c079847b3397ca6509a7f6106 /Com/Simatime/Serval.scm | |
parent | 6ed475ca94209ce92e75f48764cb9d361029ea26 (diff) |
Re-namespacing
Moving away from the DNS-driven namespacing toward more condensed names,
mostly because I don't like typing so much.
Diffstat (limited to 'Com/Simatime/Serval.scm')
-rw-r--r-- | Com/Simatime/Serval.scm | 194 |
1 files changed, 0 insertions, 194 deletions
diff --git a/Com/Simatime/Serval.scm b/Com/Simatime/Serval.scm deleted file mode 100644 index 81f5e13..0000000 --- a/Com/Simatime/Serval.scm +++ /dev/null @@ -1,194 +0,0 @@ -;; -;; Serval - fast container management -;; -;; `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 -;; -;; TODO -;; - save-kit function (write kit to /var/lib/serval/<name>.kit) -;; - profiles in /nix/var/nix/profiles/per-kit -;; - each of the below commented functions for state manipulation -;; -(define-module (Com Simatime 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 ((Com Simatime Core) - #:select (second rest fmt prn first comment nil)) - #:use-module ((Com Simatime Test) - #:select (testing)) - #:use-module ((Com Simatime Shell) #:prefix Shell.) - #:export (main)) - -(define *data-dir* "/var/lib/serval") -(define *nix-profiles-dir* "/nix/var/nix/profiles") - -;; TODO: I would really like a better command line parser... -;; getopt-long sucks -(define (main args) - ;; pop first arg if its the executable - (let* ([args (if (equal? (first args) "Com/Simatime/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 "TODO: scale running kits")] - ["ssh" (run-in-kit! args)] - ["info" (prn "TODO: show kit")] - ["ls" ("TODO: list available kits")] - [else (prn "help")]))) - -(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-syntax for - (syntax-rules () - ((_ a b) (map b a)) - ((_ a ... b) (map b a ...)))) - -(define (zip a b) - "Combine a and b into a single list of pairs." - ;; TODO: zip-list, zip-with, in Core - (apply map cons (list a b))) - -(define (serialize kit) - "Turns a kit into an association list." - (let* ((fields (record-type-fields @Kit)) - (values (for 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))))) - -;; TODO -(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 - -TODO: ensure kit-name is unique -" - (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) - ;; TODO: load kit and update with new config file - (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)))) |