diff options
| -rw-r--r-- | .gitignore | 2 | ||||
| -rw-r--r-- | .vscode/settings.json | 11 | ||||
| -rw-r--r-- | LICENSE | 11 | ||||
| -rw-r--r-- | README.md | 17 | ||||
| -rwxr-xr-x | build.sh | 18 | ||||
| -rw-r--r-- | desmo-apply.scm | 4 | ||||
| -rw-r--r-- | desmo-logs.scm | 4 | ||||
| -rw-r--r-- | desmo-status.scm | 4 | ||||
| -rw-r--r-- | desmoctl.scm | 89 | ||||
| -rw-r--r-- | modules.list | 3 | ||||
| -rwxr-xr-x | run.scm | 9 |
11 files changed, 129 insertions, 43 deletions
@@ -1 +1 @@ -desmoctl +build/
\ No newline at end of file diff --git a/.vscode/settings.json b/.vscode/settings.json new file mode 100644 index 0000000..6f314e1 --- /dev/null +++ b/.vscode/settings.json @@ -0,0 +1,11 @@ +{ + "emeraldwalk.runonsave": { + "commands": [ + { + "match": ".scm", + "isAsync": true, + "cmd": "'/Applications/Racket v8.11.1/bin/raco' fixw ${file}", + }, + ] + } +}
\ No newline at end of file @@ -0,0 +1,11 @@ +Copyright 2024 Desmofylakas Core Team + +Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
\ No newline at end of file @@ -6,14 +6,23 @@ A tool for controlling a desmofylakas cluster written in Chicken Scheme. Install [Chicken Scheme](https://wiki.call-cc.org/platforms). -Run the tool in the interpreter with tests: +Run the tool in the interpreter: - INLINE_TESTS=1 csi -s desmoctl.scm + INLINE_TESTS=1 csi -s run.scm # with tests + csi -s run.scm # without tests -Compile the tool for production. +Compile a statically linked binary for production: - csc -O3 -o desmoctl desmoctl.scm + ./build.sh ## Usage See `desmoctl help`. + +## Development + +When adding new modules, add the module names to `modules.list`. The defined module name must match the filename. + +## Copyright + +© Desmofylakas Core Team 2024
\ No newline at end of file diff --git a/build.sh b/build.sh new file mode 100755 index 0000000..1f36c6f --- /dev/null +++ b/build.sh @@ -0,0 +1,18 @@ +#!/bin/bash + +set -euxo pipefail + +CSC_FLAGS=-O3 +BUILD_DIR=build + +mkdir -p ${BUILD_DIR} +cd ${BUILD_DIR} + +modules=$(cat ../modules.list) + +for mod in $modules; do + csc ${CSC_FLAGS} -c -static -J ../${mod}.scm -unit ${mod} -o ${mod}.o +done + +csc ${CSC_FLAGS} -o desmoctl -static -uses desmo-apply ../desmoctl.scm +chmod +x desmoctl diff --git a/desmo-apply.scm b/desmo-apply.scm new file mode 100644 index 0000000..48d646c --- /dev/null +++ b/desmo-apply.scm @@ -0,0 +1,4 @@ +(module desmo-apply (run-apply) + (import scheme) + (define (run-apply opts) 'todo)) + diff --git a/desmo-logs.scm b/desmo-logs.scm new file mode 100644 index 0000000..e3aff7a --- /dev/null +++ b/desmo-logs.scm @@ -0,0 +1,4 @@ +(module desmo-logs (run-logs) + (import scheme) + (define (run-logs opts) 'todo)) + diff --git a/desmo-status.scm b/desmo-status.scm new file mode 100644 index 0000000..b8ffd3d --- /dev/null +++ b/desmo-status.scm @@ -0,0 +1,4 @@ +(module desmo-status (run-status) + (import scheme) + (define (run-status opts) 'todo)) + diff --git a/desmoctl.scm b/desmoctl.scm index 94efba9..ca8fdb0 100644 --- a/desmoctl.scm +++ b/desmoctl.scm @@ -1,7 +1,11 @@ -(import (chicken process-context) +(import scheme + (chicken base) + (chicken process-context) (chicken format) matchable - test) + test + desmo-apply + ) (define should-run-inline-tests? (let ((v (get-environment-variable "INLINE_TESTS"))) @@ -12,24 +16,23 @@ (syntax-rules () ((_ expr ...) (if should-run-inline-tests? - (begin - expr ...))))) + (begin expr ...))))) ; CLI arg parser -(define usage-string (format (string-append - "Usage: desmoctl [-f cfg-path] SUBCOMMAND~%~%" - "Subcommands:~%" - " apply Apply the cluster config~%" - " status Show cluster status~%" - " logs Show cluster logs~%" - " help Show this help text~%~%" - "Top-level flags:~%" - " -f cfg-path Path to the cluster config file (default: desmo.scm)"))) +(define usage-string + (format (string-append + "Usage: desmoctl [-f cfg-path] SUBCOMMAND~%~%" + "Subcommands:~%" + " apply Apply the cluster config~%" + " status Show cluster status~%" + " logs Show cluster logs~%" + " help Show this help text~%~%" + "Top-level flags:~%" + " -f cfg-path Path to the cluster config file (default: desmo.scm)"))) -(define initial-opts '( - (cfg-path "desmo.scm") -)) +(define initial-opts + '((cfg-path "desmo.scm"))) (define (is-flag-like? args) (let ([first-char (string-ref (car args) 0)]) @@ -37,48 +40,55 @@ (inline-tests (test-group "is-flag-like?" - (test "returns true for valid list" #t (is-flag-like? '("-f" "desmo.scm"))) - (test "returns false for invalid list" #f (is-flag-like? '("apply"))))) + (test "returns true for valid list" #t (is-flag-like? '("-f" "desmo.scm"))) + (test "returns false for invalid list" #f (is-flag-like? '("apply"))))) ;;; Returns a list of parsed options and the remaining arguments. (define (parse-top-level-flags opts args) (match args [() - `(parse-ok ,opts '())] + `(parse-ok ,opts '())] [("-f" cfg-path . rest) - (parse-top-level-flags (cons `(cfg-path ,cfg-path) opts) - rest)] + (parse-top-level-flags (cons `(cfg-path ,cfg-path) opts) + rest)] [(? is-flag-like?) - `(parse-error ,usage-string)] + `(parse-error ,usage-string)] [_ - `(parse-ok ,opts ,args)])) + `(parse-ok ,opts ,args)])) (inline-tests (test-group "parse-top-level-flags" - (test "returns parse-error for invalid flag" 'parse-error - (car (parse-top-level-flags initial-opts '("--invalid-flag")))) - (test "returns parse-ok for empty args" 'parse-ok - (car (parse-top-level-flags initial-opts '()))) - (test "returns parse-ok for valid flag" 'parse-ok - (car (parse-top-level-flags initial-opts '("-f" "foobar.scm" "status")))) - (test "returns parse-ok for valid flag and subcommand" 'parse-ok - (car (parse-top-level-flags initial-opts '("-f" "desmo.scm" "apply")))))) + (test "returns parse-error for invalid flag" 'parse-error + (car (parse-top-level-flags initial-opts '("--invalid-flag")))) + (test "returns parse-ok for empty args" 'parse-ok + (car (parse-top-level-flags initial-opts '()))) + (test "returns parse-ok for valid flag" 'parse-ok + (car (parse-top-level-flags initial-opts '("-f" "foobar.scm" "status")))) + (test "returns parse-ok for valid flag and subcommand" 'parse-ok + (car (parse-top-level-flags initial-opts '("-f" "desmo.scm" "apply")))))) (define (parse-subcommand args) (match args [("apply") - '(parse-ok cmd-apply ())] + '(parse-ok cmd-apply ())] [("status" . rest) - (print "TODO status subcommand") - (exit 0)] + (print "TODO status subcommand") + (exit 0)] [("logs" . rest) - (print "TODO logs subcommand") - (exit 0)] + (print "TODO logs subcommand") + (exit 0)] [("help" . rest) - (print usage-string) - (exit 0)] + (print usage-string) + (exit 0)] [_ `(parse-error ,usage-string)])) +(inline-tests + (test-group "parse-subcommand" + (test "returns parse-error for invalid subcommand" 'parse-error + (car (parse-subcommand '("invalid-subcommand")))) + (test "returns parse-ok for valid subcommand" 'parse-ok + (car (parse-subcommand '("apply")))))) + (define top-level-flags-parse-result (parse-top-level-flags initial-opts (command-line-arguments))) (cond [(eq? (car top-level-flags-parse-result) 'parse-error) @@ -115,3 +125,6 @@ [other (print `(eval-error ,(format "invalid subcommand: ~A" other)))])) (display (format "debug: eval-cmd: ~A ~%" (eval-subcommand cli-subcommand cli-opts))) + +(print (run-apply 'benis)) + diff --git a/modules.list b/modules.list new file mode 100644 index 0000000..3b22352 --- /dev/null +++ b/modules.list @@ -0,0 +1,3 @@ +desmo-status +desmo-logs +desmo-apply
\ No newline at end of file @@ -0,0 +1,9 @@ +#!/usr/bin/env csi -s + +(import (chicken io)) + +(let ((modules (read-lines (open-input-file "modules.list")))) + (for-each load modules)) + +(load "desmoctl.scm") + |