Checkpoint some refactoring

modules/ordo/connection.scm

@@ -1,8 +1,11 @@
 (define-module (ordo connection)
   #:use-module (oop goops)
+  #:use-module (ice-9 exceptions)
   #:use-module (ice-9 popen)
   #:use-module (ice-9 rdelim)
-  #:use-module (srfi srfi-1) ; list operations
+  #:use-module (logging logger)
+  #:use-module (srfi srfi-1)  ; list operations
+  #:use-module (srfi srfi-26) ; cut
   #:use-module (srfi srfi-71) ; extended let
   #:use-module ((srfi srfi-197) #:select (chain-when))
   #:use-module (ssh session)
@@ -10,6 +13,7 @@
   #:use-module (ssh auth)
   #:use-module (ssh popen)
   #:use-module (ssh sftp)
+  #:use-module (ordo util flatten)
   #:use-module (ordo util shell-quote)
   #:export (<connection>
             local-connection
@@ -20,10 +24,7 @@
             connection-call-with-input-file
             connection-call-with-output-file
             call-with-connection
-            must
-            run
-            must1
-            run1))
+            run))
 
 (define-class <connection> ()
   (sudo #:getter sudo? #:init-keyword #:sudo))
@@ -122,33 +123,26 @@
     (lambda () (proc c))
     (lambda () (close-connection! c))))
 
-(define (keyword-arg kw args)
+(define* (keyword-arg kw args #:optional (default #f))
   (cond
-   ((< (length args) 2) #f)
+   ((< (length args) 2) default)
    ((equal? (first args) kw) (second args))
    (else (keyword-arg kw (cddr args)))))
 
 (define (run conn prog . args)
-  (let* ((args kwargs (break keyword? args))
-         (pwd (keyword-arg #:pwd kwargs))
-         (env (keyword-arg #:env kwargs)))
-    (connection-run conn pwd env prog args)))
-
-(define (run1 . args)
-  (let ((out rc (apply run args)))
-    (values (first out) rc)))
-
-(define (must conn prog . args)
-  (let* ((args kwargs (break keyword? args))
+  (let* ((args (flatten args))
+         (args kwargs (break keyword? args))
+         (args (remove unspecified? args))
          (pwd (keyword-arg #:pwd kwargs))
          (env (keyword-arg #:env kwargs))
-         (error-msg (keyword-arg #:error-msg kwargs))
+         (return (keyword-arg #:return kwargs identity))
+         (check? (keyword-arg #:check? kwargs #t))
          (out rc (connection-run conn pwd env prog args)))
-    (if (zero? rc)
-        out
-        (error (if error-msg
-                   (format #f "~a: ~a" error-msg out)
-                   (format #f "~a error: ~a" prog out))))))
-
-(define (must1 . args)
-  (first (apply must args)))
+    (log-msg 'INFO "Command " prog " exited " rc)
+    (if check?
+        (if (zero? rc)
+            (return out)
+            (raise-exception (make-exception
+                              (make-external-error)
+                              (make-exception-with-message (format #f "Non-zero exit (~a) from ~a" rc prog)))))
+        (values (return out) rc))))

modules/ordo/util/flatten.scm

@@ -0,0 +1,10 @@
+(define-module (ordo util flatten)
+  #:export (flatten))
+
+(define (flatten lst)
+  (cond
+   ((null? lst) '())
+   ((list? (car lst))
+    (append (flatten (car lst)) (flatten (cdr lst))))
+   (else
+    (cons (car lst) (flatten (cdr lst))))))

tryme.scm

@@ -1,9 +1,28 @@
 (use-modules
  (ice-9 filesystem)
+ (logging logger)
+ (srfi srfi-26)
  (ordo)
  (ordo connection)
  (ordo logger))
 
+(define* (install-aws-cli conn #:key (url "https://awscli.amazonaws.com/awscli-exe-linux-x86_64.zip") update? install-dir bin-dir)
+  (let ((tmp-dir (run conn "mktemp" "-d" #:return car #:check? #t)))
+    (dynamic-wind
+      (const #t)
+      (lambda ()
+        (let ((zipfile (file-name-join* tmp-dir (file-basename url))))
+          (run conn "wget" "-O" zipfile url #:check? #t)
+          (run conn "unzip" zipfile "-d" tmp-dir #:check? #t)
+          (run conn (file-name-join* tmp-dir "aws" "install")
+               (when install-dir `("-i" ,install-dir))
+               (when bin-dir `("-b" ,bin-dir))
+               (when update? "-u")
+               #:check? #t)))
+      (lambda ()
+        (for-each (cut log-msg 'INFO <>)
+                  (run conn "echo" "rm" "-rf" tmp-dir #:check? #t))))))
+
 (define test-playbook
   (playbook
    #:name "Test Playbook"