diff options
Diffstat (limited to 'desmo-apply.scm')
| -rw-r--r-- | desmo-apply.scm | 55 |
1 files changed, 51 insertions, 4 deletions
diff --git a/desmo-apply.scm b/desmo-apply.scm index 0eed930..24ae760 100644 --- a/desmo-apply.scm +++ b/desmo-apply.scm @@ -1,7 +1,54 @@ (module desmo-apply (run-apply) (import scheme - (chicken base)) - (define (run-apply opts) - (print "TODO") - 'todo)) + (chicken base) + shell + test + utils) + + (define (run-apply cfg) + (let* ((cluster (assoc 'cluster cfg)) + (nodes (cdr cluster))) + + (map gather-node-facts nodes) + + (print "TODO") + 'todo)) + + (define (get-ssh-command node) + (let* ((alist (cdr node)) + (ssh-user-pair (assoc 'ssh-user alist)) + (ssh-hostname-pair (assoc 'ssh-hostname alist)) + (ssh-command-pair (assoc 'ssh-command alist))) + (cond ((not ssh-user-pair) + '(cfg-error "ssh-user not specified")) + ((not ssh-hostname-pair) + '(cfg-error "ssh-hostname not specified")) + ((not ssh-command-pair) + '(cfg-error "ssh-command not specified")) + (else + (string-append (cadr ssh-command-pair) + " " + (cadr ssh-user-pair) + "@" + (cadr ssh-hostname-pair)))))) + + (inline-tests + (test-group + "get-ssh-command" + (test "returns error if ssh-user not specified" 'cfg-error + (car (get-ssh-command '(node (ssh-hostname "foo") (ssh-command "bar"))))) + (test "returns error if ssh-hostname not specified" 'cfg-error + (car (get-ssh-command '(node (ssh-user "foo") (ssh-command "bar"))))) + (test "returns error if ssh-command not specified" 'cfg-error + (car (get-ssh-command '(node (ssh-user "foo") (ssh-hostname "bar"))))) + (test "returns ssh command if all specified" "ssh foo@bar" + (get-ssh-command '(node (ssh-user "foo") (ssh-hostname "bar") (ssh-command "ssh")))))) + + (define (gather-node-facts node) + (let* ((ssh-command (get-ssh-command node)) + (jls-command "jls") + (combined (string-append ssh-command " " jls-command)) + (result (capture ,combined))) + ; TODO parse result + (not (equal? result #!eof))))) |