From f4b8c0df041b063c0b47d2ec6c818a9c202fd833 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Wed, 15 Apr 2020 09:54:10 -0700 Subject: Re-namespacing Moving away from the DNS-driven namespacing toward more condensed names, mostly because I don't like typing so much. --- Biz/Serval.scm | 194 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 194 insertions(+) create mode 100644 Biz/Serval.scm (limited to 'Biz/Serval.scm') diff --git a/Biz/Serval.scm b/Biz/Serval.scm new file mode 100644 index 0000000..87cc238 --- /dev/null +++ b/Biz/Serval.scm @@ -0,0 +1,194 @@ +;; +;; 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 - kit state (serialized s-expr) +;; /var/lib/serval// - root directory for the kit +;; /nix/var/nix/profiles/per-kit/ - symlink to cfg in /nix/store +;; +;; TODO +;; - save-kit function (write kit to /var/lib/serval/.kit) +;; - profiles in /nix/var/nix/profiles/per-kit +;; - each of the below commented functions for state manipulation +;; +(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 ((Alpha Core) + #:select (second rest fmt prn first comment nil)) + #:use-module ((Alpha Test) + #:select (testing)) + #:use-module ((Alpha 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) "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 "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 --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)))) -- cgit v1.2.3