grokking simplicity and refactoring

packages/lab-tool/utils/config-new.scm

@@ -0,0 +1,43 @@
+;; utils/config.scm - Configuration management facade
+
+(define-module (utils config)
+  #:use-module (utils config defaults)
+  #:use-module (utils config loader)
+  #:use-module (utils config accessor)
+  #:use-module (utils config state)
+  #:re-export (;; State management
+               get-current-config
+               set-current-config!
+               reload-config!
+               
+               ;; Stateful accessors (work with current config)
+               get-config-value
+               get-machine-config
+               get-all-machines
+               get-ssh-config
+               validate-machine-name
+               get-homelab-root
+               
+               ;; Pure accessors (require explicit config parameter)
+               get-config-value-pure
+               get-machine-config-pure
+               get-all-machines-pure
+               get-ssh-config-pure
+               validate-machine-name-pure
+               
+               ;; Loading functions
+               load-config
+               load-config-from-file
+               
+               ;; Default configuration
+               default-config))
+
+;; This module acts as a facade for configuration management,
+;; aggregating specialized modules that follow single responsibility:
+;; - defaults: Pure data definitions
+;; - loader: File I/O operations  
+;; - accessor: Pure configuration value access
+;; - state: Mutable state management
+;;
+;; Both pure and impure functions are available, allowing callers
+;; to choose the appropriate level of functional purity.

packages/lab-tool/utils/config.scm

@@ -0,0 +1,129 @@
+;; utils/config.scm - Configuration management for Home Lab Tool
+
+(define-module (utils config)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (srfi srfi-1)
+  #:use-module (utils logging)
+  #:use-module (utils json)
+  #:export (load-config
+            get-config-value
+            machine-configs
+            get-machine-config
+            get-all-machines
+            validate-machine-name
+            get-homelab-root
+            get-ssh-config))
+
+;; Default configuration
+(define default-config
+  `((homelab-root . "/home/geir/Home-lab")
+    (machines . ((congenital-optimist 
+                  (type . local)
+                  (hostname . "localhost")
+                  (services . (workstation development)))
+                 (sleeper-service
+                  (type . remote)
+                  (hostname . "sleeper-service.tail807ea.ts.net")
+                  (ssh-alias . "admin-sleeper")
+                  (services . (nfs zfs storage)))
+                 (grey-area
+                  (type . remote)
+                  (hostname . "grey-area.tail807ea.ts.net")
+                  (ssh-alias . "admin-grey")
+                  (services . (ollama forgejo git)))
+                 (reverse-proxy
+                  (type . remote)
+                  (hostname . "reverse-proxy.tail807ea.ts.net")
+                  (ssh-alias . "admin-reverse")
+                  (services . (nginx proxy ssl)))))
+    (deployment . ((default-mode . "boot")
+                   (timeout . 300)
+                   (retry-count . 3)))
+    (monitoring . ((interval . 30)
+                   (timeout . 10)))
+    (mcp . ((port . 3001)
+            (host . "localhost")
+            (log-level . "info")))))
+
+;; Current loaded configuration
+(define current-config default-config)
+
+;; Load configuration from file or use defaults
+(define (load-config . args)
+  (let ((config-file (if (null? args) 
+                         (string-append (getenv "HOME") "/.config/homelab/config.json")
+                         (car args))))
+    (if (file-exists? config-file)
+        (begin
+          (log-debug "Loading configuration from ~a" config-file)
+          (catch #t
+            (lambda ()
+              (let ((json-data (call-with-input-file config-file get-string-all)))
+                (set! current-config (json-string->scm-safe json-data))
+                (log-info "Configuration loaded successfully")))
+            (lambda (key . args)
+              (log-warn "Failed to load config file, using defaults: ~a" key)
+              (set! current-config default-config))))
+        (begin
+          (log-debug "No config file found, using defaults")
+          (set! current-config default-config)))
+    current-config))
+
+;; Get a configuration value by path
+(define (get-config-value path . default)
+  (let ((result (fold (lambda (key acc)
+                        (if (and acc (list? acc))
+                            (assoc-ref acc key)
+                            #f))
+                      current-config path)))
+    (if result 
+        result 
+        (if (null? default) #f (car default)))))
+
+;; Get machine configurations
+(define (machine-configs)
+  (get-config-value '(machines)))
+
+;; Get configuration for a specific machine
+(define (get-machine-config machine-name)
+  (let ((machine-symbol (if (symbol? machine-name)
+                            machine-name
+                            (string->symbol machine-name))))
+    (assoc-ref (machine-configs) machine-symbol)))
+
+;; Get list of all machine names
+(define (get-all-machines)
+  (map (lambda (machine-entry)
+         (symbol->string (car machine-entry)))
+       (machine-configs)))
+
+;; Validate that a machine name exists
+(define (validate-machine-name machine-name)
+  (let ((machines (get-all-machines)))
+    (if (member machine-name machines)
+        #t
+        (begin
+          (log-error "Unknown machine: ~a" machine-name)
+          (log-error "Available machines: ~a" (string-join machines ", "))
+          #f))))
+
+;; Get home lab root directory
+(define (get-homelab-root)
+  (get-config-value '(homelab-root) "/home/geir/Home-lab"))
+
+;; Get SSH configuration for a machine
+(define (get-ssh-config machine-name)
+  (let ((machine-config (get-machine-config machine-name)))
+    (if machine-config
+        (let ((type (assoc-ref machine-config 'type))
+              (hostname (assoc-ref machine-config 'hostname))
+              (ssh-alias (assoc-ref machine-config 'ssh-alias)))
+          `((type . ,type)
+            (hostname . ,hostname)
+            (ssh-alias . ,ssh-alias)
+            (is-local . ,(eq? type 'local))))
+        #f)))
+
+;; Initialize configuration on module load
+(load-config)

packages/lab-tool/utils/config/accessor.scm

@@ -0,0 +1,74 @@
+;; utils/config/accessor.scm - Configuration value access (pure functions)
+
+(define-module (utils config accessor)
+  #:use-module (srfi srfi-1)
+  #:export (get-config-value-pure
+            get-machine-config-pure
+            get-all-machines-pure
+            get-ssh-config-pure
+            validate-machine-name-pure))
+
+;; Pure function: Get configuration value by path
+;; Input: config alist, path list, optional default value
+;; Output: configuration value or default
+(define (get-config-value-pure config path . default)
+  "Pure function to get configuration value by path"
+  (let ((result (fold (lambda (key acc)
+                        (if (and acc (list? acc))
+                            (assoc-ref acc key)
+                            #f))
+                      config path)))
+    (if result 
+        result 
+        (if (null? default) #f (car default)))))
+
+;; Pure function: Get machine configurations
+;; Input: config alist
+;; Output: machines alist
+(define (get-machine-configs-pure config)
+  "Pure function to get machine configurations"
+  (get-config-value-pure config '(machines)))
+
+;; Pure function: Get configuration for specific machine
+;; Input: config alist, machine-name (string or symbol)
+;; Output: machine configuration alist or #f
+(define (get-machine-config-pure config machine-name)
+  "Pure function to get machine configuration"
+  (let ((machine-symbol (if (symbol? machine-name)
+                            machine-name
+                            (string->symbol machine-name)))
+        (machines (get-machine-configs-pure config)))
+    (assoc-ref machines machine-symbol)))
+
+;; Pure function: Get list of all machine names
+;; Input: config alist
+;; Output: list of machine name strings
+(define (get-all-machines-pure config)
+  "Pure function to get all machine names"
+  (map (lambda (machine-entry)
+         (symbol->string (car machine-entry)))
+       (get-machine-configs-pure config)))
+
+;; Pure function: Validate machine name exists
+;; Input: config alist, machine-name string
+;; Output: #t if valid, #f otherwise
+(define (validate-machine-name-pure config machine-name)
+  "Pure function to validate machine name"
+  (let ((machines (get-all-machines-pure config)))
+    (member machine-name machines)))
+
+;; Pure function: Get SSH configuration for machine
+;; Input: config alist, machine-name (string or symbol)
+;; Output: SSH configuration alist or #f
+(define (get-ssh-config-pure config machine-name)
+  "Pure function to get SSH configuration for machine"
+  (let ((machine-config (get-machine-config-pure config machine-name)))
+    (if machine-config
+        (let ((type (assoc-ref machine-config 'type))
+              (hostname (assoc-ref machine-config 'hostname))
+              (ssh-alias (assoc-ref machine-config 'ssh-alias)))
+          `((type . ,type)
+            (hostname . ,hostname)
+            (ssh-alias . ,ssh-alias)
+            (is-local . ,(eq? type 'local))))
+        #f)))

packages/lab-tool/utils/config/defaults.scm

@@ -0,0 +1,35 @@
+;; utils/config/defaults.scm - Configuration defaults (pure data)
+
+(define-module (utils config defaults)
+  #:export (default-config))
+
+;; Pure data: Default configuration structure
+(define default-config
+  `((homelab-root . "/home/geir/Home-lab")
+    (machines . ((congenital-optimist 
+                  (type . local)
+                  (hostname . "localhost")
+                  (services . (workstation development)))
+                 (sleeper-service
+                  (type . remote)
+                  (hostname . "sleeper-service.tail807ea.ts.net")
+                  (ssh-alias . "admin-sleeper")
+                  (services . (nfs zfs storage)))
+                 (grey-area
+                  (type . remote)
+                  (hostname . "grey-area.tail807ea.ts.net")
+                  (ssh-alias . "admin-grey")
+                  (services . (ollama forgejo git)))
+                 (reverse-proxy
+                  (type . remote)
+                  (hostname . "reverse-proxy.tail807ea.ts.net")
+                  (ssh-alias . "admin-reverse")
+                  (services . (nginx proxy ssl)))))
+    (deployment . ((default-mode . "boot")
+                   (timeout . 300)
+                   (retry-count . 3)))
+    (monitoring . ((interval . 30)
+                   (timeout . 10)))
+    (mcp . ((port . 3001)
+            (host . "localhost")
+            (log-level . "info")))))

packages/lab-tool/utils/config/loader.scm

@@ -0,0 +1,60 @@
+;; utils/config/loader.scm - Configuration loading (file I/O operations)
+
+(define-module (utils config loader)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (utils logging)
+  #:use-module (utils json)
+  #:use-module (utils config defaults)
+  #:export (load-config-from-file
+            load-config))
+
+;; Pure function: Parse configuration from JSON string
+;; Input: json-string
+;; Output: parsed configuration alist or #f if invalid
+(define (parse-config-json json-string)
+  "Pure function to parse configuration from JSON string"
+  (catch #t
+    (lambda () (json-string->scm-safe json-string))
+    (lambda (key . args) #f)))
+
+;; Pure function: Validate configuration structure
+;; Input: config alist
+;; Output: #t if valid, #f otherwise
+(define (validate-config config)
+  "Pure function to validate configuration structure"
+  (and (list? config)
+       (assoc-ref config 'homelab-root)
+       (assoc-ref config 'machines)))
+
+;; Impure function: Load configuration from file
+;; Input: file-path string
+;; Output: configuration alist or default-config if file doesn't exist/invalid
+(define (load-config-from-file file-path)
+  "Load configuration from file (with side effects: file I/O, logging)"
+  (if (file-exists? file-path)
+      (catch #t
+        (lambda ()
+          (log-debug "Loading configuration from ~a" file-path)
+          (let* ((json-data (call-with-input-file file-path get-string-all))
+                 (parsed-config (parse-config-json json-data)))
+            (if (and parsed-config (validate-config parsed-config))
+                (begin
+                  (log-info "Configuration loaded successfully")
+                  parsed-config)
+                (begin
+                  (log-warn "Invalid configuration file, using defaults")
+                  default-config))))
+        (lambda (key . args)
+          (log-warn "Failed to load config file, using defaults: ~a" key)
+          default-config))
+      (begin
+        (log-debug "No config file found at ~a, using defaults" file-path)
+        default-config)))
+
+;; Impure function: Load configuration with default path
+(define (load-config . args)
+  "Load configuration with optional file path"
+  (let ((config-file (if (null? args) 
+                         (string-append (getenv "HOME") "/.config/homelab/config.json")
+                         (car args))))
+    (load-config-from-file config-file)))

packages/lab-tool/utils/config/state.scm

@@ -0,0 +1,69 @@
+;; utils/config/state.scm - Configuration state management
+
+(define-module (utils config state)
+  #:use-module (utils config defaults)
+  #:use-module (utils config loader)
+  #:use-module (utils config accessor)
+  #:use-module (utils logging)
+  #:export (get-current-config
+            set-current-config!
+            reload-config!
+            get-config-value
+            get-machine-config
+            get-all-machines
+            get-ssh-config
+            validate-machine-name
+            get-homelab-root))
+
+;; Mutable state: Current loaded configuration
+(define current-config default-config)
+
+;; Impure function: Get current configuration
+(define (get-current-config)
+  "Get current loaded configuration"
+  current-config)
+
+;; Impure function: Set current configuration
+(define (set-current-config! config)
+  "Set current configuration (impure)"
+  (set! current-config config))
+
+;; Impure function: Reload configuration from file
+(define (reload-config! . args)
+  "Reload configuration from file"
+  (let ((new-config (apply load-config args)))
+    (set-current-config! new-config)
+    new-config))
+
+;; Impure wrappers for pure accessor functions
+(define (get-config-value path . default)
+  "Get configuration value from current config"
+  (apply get-config-value-pure current-config path default))
+
+(define (get-machine-config machine-name)
+  "Get machine configuration from current config"
+  (get-machine-config-pure current-config machine-name))
+
+(define (get-all-machines)
+  "Get all machine names from current config"
+  (get-all-machines-pure current-config))
+
+(define (get-ssh-config machine-name)
+  "Get SSH configuration from current config"
+  (get-ssh-config-pure current-config machine-name))
+
+(define (validate-machine-name machine-name)
+  "Validate machine name against current config"
+  (if (validate-machine-name-pure current-config machine-name)
+      #t
+      (begin
+        (log-error "Unknown machine: ~a" machine-name)
+        (log-error "Available machines: ~a" (string-join (get-all-machines) ", "))
+        #f)))
+
+(define (get-homelab-root)
+  "Get home lab root directory from current config"
+  (get-config-value '(homelab-root) "/home/geir/Home-lab"))
+
+;; Initialize configuration on module load
+(reload-config!)

packages/lab-tool/utils/json-new.scm

@@ -0,0 +1,48 @@
+;; utils/json.scm - JSON utilities facade
+
+(define-module (utils json)
+  #:use-module (utils json parse)
+  #:use-module (utils json serialize)
+  #:use-module (utils json file-io)
+  #:use-module (utils json validation)
+  #:use-module (utils json manipulation)
+  #:use-module (utils json pretty-print)
+  #:re-export (;; Parsing
+               parse-json-pure
+               json-string->scm-safe
+               
+               ;; Serialization
+               scm->json-string-pure
+               scm->json-string
+               
+               ;; File I/O (both pure and impure versions)
+               read-json-file-pure
+               write-json-file-pure
+               read-json-file
+               write-json-file
+               
+               ;; Validation (pure functions)
+               validate-required-keys
+               validate-types
+               validate-json-schema
+               
+               ;; Manipulation (pure functions)
+               merge-json-objects
+               flatten-json-paths
+               json-path-ref
+               json-path-set
+               
+               ;; Pretty printing
+               json-pretty-print))
+
+;; This module acts as a facade for JSON functionality,
+;; aggregating specialized modules that follow single responsibility:
+;; - parse: Pure JSON string parsing
+;; - serialize: Pure scheme-to-JSON conversion
+;; - file-io: File reading/writing with pure and impure versions
+;; - validation: Pure schema validation functions
+;; - manipulation: Pure object manipulation functions
+;; - pretty-print: Output formatting
+;;
+;; All functions are designed to be composable and testable,
+;; with pure versions available for functional programming patterns.

packages/lab-tool/utils/json.scm

@@ -0,0 +1,141 @@
+;; utils/json.scm - JSON processing utilities for Home Lab Tool
+
+(define-module (utils json)
+  #:use-module (json)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (ice-9 format)
+  #:use-module (srfi srfi-1)
+  #:use-module (utils logging)
+  #:export (read-json-file
+            write-json-file
+            json-pretty-print
+            scm->json-string
+            json-string->scm-safe
+            validate-json-schema
+            merge-json-objects))
+
+;; Read JSON from file with error handling
+(define (read-json-file filename)
+  (catch #t
+    (lambda ()
+      (log-debug "Reading JSON file: ~a" filename)
+      (call-with-input-file filename
+        (lambda (port)
+          (json->scm port))))
+    (lambda (key . args)
+      (log-error "Failed to read JSON file ~a: ~a ~a" filename key args)
+      #f)))
+
+;; Write Scheme object to JSON file
+(define (write-json-file filename obj . options)
+  (let ((pretty (if (null? options) #t (car options))))
+    (catch #t
+      (lambda ()
+        (log-debug "Writing JSON file: ~a" filename)
+        (call-with-output-file filename
+          (lambda (port)
+            (if pretty
+                (scm->json obj port #:pretty #t)
+                (scm->json obj port))))
+        #t)
+      (lambda (key . args)
+        (log-error "Failed to write JSON file ~a: ~a ~a" filename key args)
+        #f))))
+
+;; Pretty print JSON to current output port
+(define (json-pretty-print obj)
+  (scm->json obj (current-output-port) #:pretty #t)
+  (newline))
+
+;; Convert Scheme object to JSON string
+(define (scm->json-string obj . options)
+  (let ((pretty (if (null? options) #f (car options))))
+    (catch #t
+      (lambda ()
+        (call-with-output-string
+          (lambda (port)
+            (if pretty
+                (scm->json obj port #:pretty #t)
+                (scm->json obj port)))))
+      (lambda (key . args)
+        (log-error "Failed to convert to JSON: ~a ~a" key args)
+        #f))))
+
+;; Safely convert JSON string to Scheme with error handling
+(define (json-string->scm-safe json-str)
+  (catch #t
+    (lambda ()
+      (json-string->scm json-str))
+    (lambda (key . args)
+      (log-error "Failed to parse JSON string: ~a ~a" key args)
+      #f)))
+
+;; Basic JSON schema validation
+(define (validate-json-schema obj schema)
+  "Validate JSON object against a simple schema.
+   Schema format: ((required-keys ...) (optional-keys ...) (types ...))"
+  (let ((required-keys (car schema))
+        (optional-keys (if (> (length schema) 1) (cadr schema) '()))
+        (type-specs (if (> (length schema) 2) (caddr schema) '())))
+    
+    ;; Check required keys
+    (let ((missing-keys (filter (lambda (key)
+                                  (not (assoc-ref obj key)))
+                                required-keys)))
+      (if (not (null? missing-keys))
+          (begin
+            (log-error "Missing required keys: ~a" missing-keys)
+            #f)
+          (begin
+            ;; Check types if specified
+            (let ((type-errors (filter-map
+                               (lambda (type-spec)
+                                 (let ((key (car type-spec))
+                                       (expected-type (cadr type-spec)))
+                                   (let ((value (assoc-ref obj key)))
+                                     (if (and value (not (eq? (type-of value) expected-type)))
+                                         (format #f "Key ~a: expected ~a, got ~a" 
+                                                key expected-type (type-of value))
+                                         #f))))
+                               type-specs)))
+              (if (not (null? type-errors))
+                  (begin
+                    (log-error "Type validation errors: ~a" type-errors)
+                    #f)
+                  #t)))))))
+
+;; Merge two JSON objects (association lists)
+(define (merge-json-objects obj1 obj2)
+  "Merge two JSON objects, with obj2 values taking precedence"
+  (let ((merged (copy-tree obj1)))
+    (for-each (lambda (pair)
+                (let ((key (car pair))
+                      (value (cdr pair)))
+                  (set! merged (assoc-set! merged key value))))
+              obj2)
+    merged))
+
+;; Convert nested alist to flat key paths for easier access
+(define (flatten-json-paths obj . prefix)
+  "Convert nested object to flat list of (path . value) pairs"
+  (let ((current-prefix (if (null? prefix) '() (car prefix))))
+    (fold (lambda (pair acc)
+            (let ((key (car pair))
+                  (value (cdr pair)))
+              (let ((new-path (append current-prefix (list key))))
+                (if (and (list? value) (not (null? value)) (pair? (car value)))
+                    ;; Nested object - recurse
+                    (append (flatten-json-paths value new-path) acc)
+                    ;; Leaf value
+                    (cons (cons new-path value) acc)))))
+          '()
+          obj)))
+
+;; Get nested value using path list
+(define (json-path-ref obj path)
+  "Get value from nested object using list of keys as path"
+  (fold (lambda (key acc)
+          (if (and acc (list? acc))
+              (assoc-ref acc key)
+              #f))
+        obj path))

packages/lab-tool/utils/json/file-io.scm

@@ -0,0 +1,57 @@
+;; utils/json/file-io.scm - JSON file I/O operations
+
+(define-module (utils json file-io)
+  #:use-module (json)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (utils logging)
+  #:export (read-json-file-pure
+            write-json-file-pure
+            read-json-file
+            write-json-file))
+
+;; Pure function: Read JSON from file without logging
+;; Input: filename string
+;; Output: parsed object or #f if failed
+(define (read-json-file-pure filename)
+  "Pure function to read JSON from file"
+  (catch #t
+    (lambda ()
+      (call-with-input-file filename
+        (lambda (port) (json->scm port))))
+    (lambda (key . args) #f)))
+
+;; Pure function: Write JSON to file without logging
+;; Input: filename string, obj (scheme object), pretty boolean
+;; Output: #t if successful, #f if failed
+(define (write-json-file-pure filename obj pretty)
+  "Pure function to write JSON to file"
+  (catch #t
+    (lambda ()
+      (call-with-output-file filename
+        (lambda (port)
+          (if pretty
+              (scm->json obj port #:pretty #t)
+              (scm->json obj port))))
+      #t)
+    (lambda (key . args) #f)))
+
+;; Impure wrapper: Read JSON file with logging
+(define (read-json-file filename)
+  "Read JSON from file with logging"
+  (log-debug "Reading JSON file: ~a" filename)
+  (let ((result (read-json-file-pure filename)))
+    (if result
+        (log-debug "Successfully read JSON file: ~a" filename)
+        (log-error "Failed to read JSON file: ~a" filename))
+    result))
+
+;; Impure wrapper: Write JSON file with logging
+(define (write-json-file filename obj . options)
+  "Write JSON to file with logging"
+  (let ((pretty (if (null? options) #t (car options))))
+    (log-debug "Writing JSON file: ~a" filename)
+    (let ((result (write-json-file-pure filename obj pretty)))
+      (if result
+          (log-debug "Successfully wrote JSON file: ~a" filename)
+          (log-error "Failed to write JSON file: ~a" filename))
+      result)))

packages/lab-tool/utils/json/manipulation.scm

@@ -0,0 +1,63 @@
+;; utils/json/manipulation.scm - Pure JSON manipulation functions
+
+(define-module (utils json manipulation)
+  #:use-module (srfi srfi-1)
+  #:export (merge-json-objects
+            flatten-json-paths
+            json-path-ref
+            json-path-set))
+
+;; Pure function: Merge two JSON objects
+;; Input: obj1 (alist), obj2 (alist)
+;; Output: merged alist with obj2 values taking precedence
+(define (merge-json-objects obj1 obj2)
+  "Pure function to merge two JSON objects"
+  (let ((merged (copy-tree obj1)))
+    (fold (lambda (pair acc)
+            (let ((key (car pair))
+                  (value (cdr pair)))
+              (assoc-set! acc key value)))
+          merged
+          obj2)))
+
+;; Pure function: Convert nested alist to flat key paths
+;; Input: obj (nested alist), optional prefix (list of keys)
+;; Output: list of (path . value) pairs
+(define (flatten-json-paths obj . prefix)
+  "Pure function to flatten nested object to path-value pairs"
+  (let ((current-prefix (if (null? prefix) '() (car prefix))))
+    (fold (lambda (pair acc)
+            (let ((key (car pair))
+                  (value (cdr pair)))
+              (let ((new-path (append current-prefix (list key))))
+                (if (and (list? value) (not (null? value)) (pair? (car value)))
+                    ;; Nested object - recurse
+                    (append (flatten-json-paths value new-path) acc)
+                    ;; Leaf value
+                    (cons (cons new-path value) acc)))))
+          '()
+          obj)))
+
+;; Pure function: Get nested value using path
+;; Input: obj (nested alist), path (list of keys)
+;; Output: value at path or #f if not found
+(define (json-path-ref obj path)
+  "Pure function to get value from nested object using key path"
+  (fold (lambda (key acc)
+          (if (and acc (list? acc))
+              (assoc-ref acc key)
+              #f))
+        obj path))
+
+;; Pure function: Set nested value using path
+;; Input: obj (nested alist), path (list of keys), value
+;; Output: new alist with value set at path
+(define (json-path-set obj path value)
+  "Pure function to set value in nested object using key path"
+  (if (null? path)
+      value
+      (let* ((key (car path))
+             (rest-path (cdr path))
+             (current-value (assoc-ref obj key))
+             (new-value (json-path-set (or current-value '()) rest-path value)))
+        (assoc-set! (copy-tree obj) key new-value))))

packages/lab-tool/utils/json/parse.scm

@@ -0,0 +1,21 @@
+;; utils/json/parse.scm - Pure JSON parsing functions
+
+(define-module (utils json parse)
+  #:use-module (json)
+  #:export (json-string->scm-safe
+            parse-json-pure))
+
+;; Pure function: Safely parse JSON string
+;; Input: json-string
+;; Output: parsed scheme object or #f if invalid
+(define (parse-json-pure json-string)
+  "Pure function to parse JSON string without side effects"
+  (catch #t
+    (lambda () 
+      (if (string? json-string)
+          (json-string->scm json-string)
+          #f))
+    (lambda (key . args) #f)))
+
+;; Alias for compatibility
+(define json-string->scm-safe parse-json-pure)

packages/lab-tool/utils/json/pretty-print.scm

@@ -0,0 +1,13 @@
+;; utils/json/pretty-print.scm - JSON pretty printing
+
+(define-module (utils json pretty-print)
+  #:use-module (json)
+  #:export (json-pretty-print))
+
+;; Impure function: Pretty print JSON to current output port
+;; Input: obj (scheme object)
+;; Output: unspecified (side effect: prints to current-output-port)
+(define (json-pretty-print obj)
+  "Pretty print JSON object to current output port"
+  (scm->json obj (current-output-port) #:pretty #t)
+  (newline))

packages/lab-tool/utils/json/serialize.scm

@@ -0,0 +1,27 @@
+;; utils/json/serialize.scm - Pure JSON serialization functions
+
+(define-module (utils json serialize)
+  #:use-module (json)
+  #:use-module (ice-9 textual-ports)
+  #:export (scm->json-string-pure
+            scm->json-string))
+
+;; Pure function: Convert scheme object to JSON string
+;; Input: obj (scheme object), pretty (boolean)
+;; Output: JSON string or #f if conversion fails
+(define (scm->json-string-pure obj pretty)
+  "Pure function to convert scheme object to JSON string"
+  (catch #t
+    (lambda ()
+      (call-with-output-string
+        (lambda (port)
+          (if pretty
+              (scm->json obj port #:pretty #t)
+              (scm->json obj port)))))
+    (lambda (key . args) #f)))
+
+;; Wrapper with optional pretty parameter
+(define (scm->json-string obj . options)
+  "Convert scheme object to JSON string with optional pretty printing"
+  (let ((pretty (if (null? options) #f (car options))))
+    (scm->json-string-pure obj pretty)))

packages/lab-tool/utils/json/validation.scm

@@ -0,0 +1,67 @@
+;; utils/json/validation.scm - Pure JSON validation functions
+
+(define-module (utils json validation)
+  #:use-module (ice-9 format)
+  #:use-module (srfi srfi-1)
+  #:export (validate-required-keys
+            validate-types
+            validate-json-schema))
+
+;; Pure function: Check for required keys
+;; Input: obj (alist), required-keys (list of symbols)
+;; Output: list of missing keys (empty if all present)
+(define (get-missing-keys obj required-keys)
+  "Pure function to find missing required keys"
+  (filter (lambda (key)
+            (not (assoc-ref obj key)))
+          required-keys))
+
+;; Pure function: Validate required keys
+;; Input: obj (alist), required-keys (list of symbols)
+;; Output: #t if all present, #f otherwise
+(define (validate-required-keys obj required-keys)
+  "Pure function to validate required keys are present"
+  (null? (get-missing-keys obj required-keys)))
+
+;; Pure function: Check type specifications
+;; Input: obj (alist), type-specs (list of (key expected-type) pairs)
+;; Output: list of type error messages (empty if all valid)
+(define (get-type-errors obj type-specs)
+  "Pure function to find type validation errors"
+  (filter-map
+   (lambda (type-spec)
+     (let ((key (car type-spec))
+           (expected-type (cadr type-spec)))
+       (let ((value (assoc-ref obj key)))
+         (if (and value (not (eq? (type-of value) expected-type)))
+             (format #f "Key ~a: expected ~a, got ~a" 
+                     key expected-type (type-of value))
+             #f))))
+   type-specs))
+
+;; Pure function: Validate types
+;; Input: obj (alist), type-specs (list of (key expected-type) pairs)
+;; Output: #t if all types valid, #f otherwise
+(define (validate-types obj type-specs)
+  "Pure function to validate object types"
+  (null? (get-type-errors obj type-specs)))
+
+;; Pure function: Complete schema validation
+;; Input: obj (alist), schema (list with required-keys, optional-keys, types)
+;; Output: (values valid? error-messages)
+(define (validate-json-schema obj schema)
+  "Pure function to validate JSON object against schema"
+  (let ((required-keys (car schema))
+        (optional-keys (if (> (length schema) 1) (cadr schema) '()))
+        (type-specs (if (> (length schema) 2) (caddr schema) '())))
+    
+    (let ((missing-keys (get-missing-keys obj required-keys))
+          (type-errors (get-type-errors obj type-specs)))
+      
+      (if (or (not (null? missing-keys)) (not (null? type-errors)))
+          (values #f (append 
+                      (if (not (null? missing-keys))
+                          (list (format #f "Missing required keys: ~a" missing-keys))
+                          '())
+                      type-errors))
+          (values #t '())))))

packages/lab-tool/utils/logging-new.scm

@@ -0,0 +1,42 @@
+;; utils/logging.scm - Logging facade (aggregates modular components)
+
+(define-module (utils logging)
+  #:use-module (utils logging format)
+  #:use-module (utils logging level)
+  #:use-module (utils logging state)
+  #:use-module (utils logging output)
+  #:use-module (utils logging core)
+  #:use-module (utils logging spinner)
+  #:re-export (;; Core logging functions
+               log-debug
+               log-info
+               log-warn
+               log-error
+               log-success
+               
+               ;; State management
+               get-current-log-level
+               set-log-level!
+               should-log?
+               
+               ;; Pure functions (for testing and functional composition)
+               should-log-pure
+               validate-log-level
+               format-timestamp
+               format-log-message
+               get-color
+               log-message-pure
+               
+               ;; Utilities
+               with-spinner))
+
+;; This module acts as a facade for logging functionality,
+;; aggregating specialized modules that follow single responsibility:
+;; - format: Pure formatting functions and color codes
+;; - level: Pure log level management and validation
+;; - state: Mutable state management for current log level
+;; - output: Pure output formatting and port writing
+;; - core: Main logging functions with side effects
+;; - spinner: Progress indication for long operations
+;;
+;; Both pure and impure functions are available for maximum flexibility.

packages/lab-tool/utils/logging.scm

@@ -0,0 +1,91 @@
+;; utils/logging.scm - Logging utilities for Home Lab Tool
+
+(define-module (utils logging)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 popen)
+  #:use-module (srfi srfi-19)
+  #:export (log-debug
+            log-info
+            log-warn
+            log-error
+            log-success
+            set-log-level!
+            with-spinner))
+
+;; ANSI color codes
+(define color-codes
+  '((reset . "\x1b[0m")
+    (bold . "\x1b[1m")
+    (red . "\x1b[31m")
+    (green . "\x1b[32m")
+    (yellow . "\x1b[33m")
+    (blue . "\x1b[34m")
+    (magenta . "\x1b[35m")
+    (cyan . "\x1b[36m")))
+
+;; Current log level
+(define current-log-level 'info)
+
+;; Log levels with numeric values for comparison
+(define log-levels
+  '((debug . 0)
+    (info . 1)
+    (warn . 2)
+    (error . 3)))
+
+;; Get color code by name
+(define (get-color name)
+  (assoc-ref color-codes name))
+
+;; Set the current log level
+(define (set-log-level! level)
+  (set! current-log-level level))
+
+;; Check if a message should be logged at current level
+(define (should-log? level)
+  (<= (assoc-ref log-levels current-log-level)
+      (assoc-ref log-levels level)))
+
+;; Format timestamp for log messages
+(define (format-timestamp)
+  (date->string (current-date) "~H:~M:~S"))
+
+;; Core logging function with color support
+(define (log-with-color level color prefix message . args)
+  (when (should-log? level)
+    (let ((timestamp (format-timestamp))
+          (formatted-msg (apply format #f message args))
+          (color-start (get-color color))
+          (color-end (get-color 'reset)))
+      (format (current-error-port) "~a~a[lab]~a ~a ~a~%"
+              color-start prefix color-end timestamp formatted-msg))))
+
+;; Specific logging functions
+(define (log-debug message . args)
+  (apply log-with-color 'debug 'cyan "DEBUG" message args))
+
+(define (log-info message . args)
+  (apply log-with-color 'info 'blue "INFO " message args))
+
+(define (log-warn message . args)
+  (apply log-with-color 'warn 'yellow "WARN " message args))
+
+(define (log-error message . args)
+  (apply log-with-color 'error 'red "ERROR" message args))
+
+(define (log-success message . args)
+  (apply log-with-color 'info 'green "SUCCESS" message args))
+
+;; Spinner utility for long-running operations
+(define (with-spinner message thunk)
+  (log-info "~a..." message)
+  (let ((start-time (current-time)))
+    (catch #t
+      (lambda ()
+        (let ((result (thunk)))
+          (let ((elapsed (- (current-time) start-time)))
+            (log-success "~a completed in ~as" message elapsed))
+          result))
+      (lambda (key . args)
+        (log-error "~a failed: ~a ~a" message key args)
+        (throw key args)))))

packages/lab-tool/utils/logging/core.scm

@@ -0,0 +1,38 @@
+;; utils/logging/core.scm - Core logging functions
+
+(define-module (utils logging core)
+  #:use-module (utils logging state)
+  #:use-module (utils logging output)
+  #:export (log-with-color
+            log-debug
+            log-info
+            log-warn
+            log-error
+            log-success))
+
+;; Impure function: Core logging with color and level checking
+(define (log-with-color level color prefix message . args)
+  "Log message with color if level is appropriate"
+  (when (should-log? level)
+    (log-to-port (current-error-port) level color prefix message args)))
+
+;; Specific logging functions - each does one thing well
+(define (log-debug message . args)
+  "Log debug message"
+  (apply log-with-color 'debug 'cyan "DEBUG" message args))
+
+(define (log-info message . args)
+  "Log info message"
+  (apply log-with-color 'info 'blue "INFO " message args))
+
+(define (log-warn message . args)
+  "Log warning message"
+  (apply log-with-color 'warn 'yellow "WARN " message args))
+
+(define (log-error message . args)
+  "Log error message"
+  (apply log-with-color 'error 'red "ERROR" message args))
+
+(define (log-success message . args)
+  "Log success message"
+  (apply log-with-color 'info 'green "SUCCESS" message args))

packages/lab-tool/utils/logging/format.scm

@@ -0,0 +1,42 @@
+;; utils/logging/format.scm - Pure logging formatting functions
+
+(define-module (utils logging format)
+  #:use-module (ice-9 format)
+  #:use-module (srfi srfi-19)
+  #:export (format-timestamp
+            format-log-message
+            get-color
+            color-codes))
+
+;; Pure data: ANSI color codes
+(define color-codes
+  '((reset . "\x1b[0m")
+    (bold . "\x1b[1m")
+    (red . "\x1b[31m")
+    (green . "\x1b[32m")
+    (yellow . "\x1b[33m")
+    (blue . "\x1b[34m")
+    (magenta . "\x1b[35m")
+    (cyan . "\x1b[36m")))
+
+;; Pure function: Get color code by name
+(define (get-color name)
+  "Pure function to get ANSI color code"
+  (assoc-ref color-codes name))
+
+;; Pure function: Format timestamp
+(define (format-timestamp)
+  "Pure function to format current timestamp"
+  (date->string (current-date) "~H:~M:~S"))
+
+;; Pure function: Format complete log message
+;; Input: level symbol, color symbol, prefix string, message string, args list
+;; Output: formatted log message string
+(define (format-log-message level color prefix message args)
+  "Pure function to format a complete log message"
+  (let ((timestamp (format-timestamp))
+        (formatted-msg (apply format #f message args))
+        (color-start (get-color color))
+        (color-end (get-color 'reset)))
+    (format #f "~a~a[lab]~a ~a ~a~%"
+            color-start prefix color-end timestamp formatted-msg)))

packages/lab-tool/utils/logging/level.scm

@@ -0,0 +1,30 @@
+;; utils/logging/level.scm - Pure log level management
+
+(define-module (utils logging level)
+  #:export (log-levels
+            should-log-pure
+            validate-log-level))
+
+;; Pure data: Log levels with numeric values for comparison
+(define log-levels
+  '((debug . 0)
+    (info . 1)
+    (warn . 2)
+    (error . 3)))
+
+;; Pure function: Check if message should be logged at given levels
+;; Input: current-level symbol, message-level symbol
+;; Output: #t if should log, #f otherwise
+(define (should-log-pure current-level message-level)
+  "Pure function to determine if message should be logged"
+  (let ((current-value (assoc-ref log-levels current-level))
+        (message-value (assoc-ref log-levels message-level)))
+    (and current-value message-value
+         (<= current-value message-value))))
+
+;; Pure function: Validate log level
+;; Input: level symbol
+;; Output: #t if valid, #f otherwise
+(define (validate-log-level level)
+  "Pure function to validate log level"
+  (assoc-ref log-levels level))

packages/lab-tool/utils/logging/output.scm

@@ -0,0 +1,23 @@
+;; utils/logging/output.scm - Pure logging output functions
+
+(define-module (utils logging output)
+  #:use-module (utils logging format)
+  #:use-module (utils logging level)
+  #:export (log-message-pure
+            log-to-port))
+
+;; Pure function: Create log message without side effects
+;; Input: level, color, prefix, message, args
+;; Output: formatted log message string
+(define (log-message-pure level color prefix message args)
+  "Pure function to create formatted log message"
+  (format-log-message level color prefix message args))
+
+;; Impure function: Write log message to port
+;; Input: port, level, color, prefix, message, args
+;; Output: unspecified (side effect: writes to port)
+(define (log-to-port port level color prefix message args)
+  "Write formatted log message to specified port"
+  (let ((formatted-message (log-message-pure level color prefix message args)))
+    (display formatted-message port)
+    (force-output port)))

packages/lab-tool/utils/logging/spinner.scm

@@ -0,0 +1,27 @@
+;; utils/logging/spinner.scm - Spinner utility for long operations
+
+(define-module (utils logging spinner)
+  #:use-module (utils logging core)
+  #:export (with-spinner))
+
+;; Pure function: Calculate elapsed time
+;; Input: start-time, end-time
+;; Output: elapsed seconds
+(define (calculate-elapsed start-time end-time)
+  "Pure function to calculate elapsed time"
+  (- end-time start-time))
+
+;; Impure function: Execute operation with spinner logging
+(define (with-spinner message thunk)
+  "Execute operation with progress logging"
+  (log-info "~a..." message)
+  (let ((start-time (current-time)))
+    (catch #t
+      (lambda ()
+        (let ((result (thunk)))
+          (let ((elapsed (calculate-elapsed start-time (current-time))))
+            (log-success "~a completed in ~as" message elapsed))
+          result))
+      (lambda (key . args)
+        (log-error "~a failed: ~a ~a" message key args)
+        (throw key args)))))

packages/lab-tool/utils/logging/state.scm

@@ -0,0 +1,27 @@
+;; utils/logging/state.scm - Logging state management
+
+(define-module (utils logging state)
+  #:use-module (utils logging level)
+  #:export (get-current-log-level
+            set-log-level!
+            should-log?))
+
+;; Mutable state: Current log level
+(define current-log-level 'info)
+
+;; Impure function: Get current log level
+(define (get-current-log-level)
+  "Get current log level"
+  current-log-level)
+
+;; Impure function: Set log level with validation
+(define (set-log-level! level)
+  "Set current log level (with validation)"
+  (if (validate-log-level level)
+      (set! current-log-level level)
+      (error "Invalid log level" level)))
+
+;; Impure function: Check if message should be logged
+(define (should-log? level)
+  "Check if message should be logged at current level"
+  (should-log-pure current-log-level level))

packages/lab-tool/utils/ssh-new.scm

@@ -0,0 +1,27 @@
+;; utils/ssh.scm - SSH operations facade (aggregates modular components)
+
+(define-module (utils ssh)
+  #:use-module (utils ssh connection-test)
+  #:use-module (utils ssh remote-command)
+  #:use-module (utils ssh file-copy)
+  #:use-module (utils ssh retry)
+  #:use-module (utils ssh context)
+  #:re-export (test-ssh-connection
+               run-remote-command
+               run-remote-command-pure
+               copy-file-to-remote
+               copy-file-pure
+               run-command-with-retry
+               with-retry
+               with-ssh-connection))
+
+;; This module acts as a facade, re-exporting functions from specialized modules
+;; Each sub-module follows the single responsibility principle:
+;; - connection-test: SSH connectivity testing
+;; - remote-command: Command execution on remote machines
+;; - file-copy: File transfer operations
+;; - retry: Retry logic and error recovery
+;; - context: Connection context management
+;;
+;; Pure functions are exported alongside their impure wrappers,
+;; allowing callers to choose the appropriate level of abstraction.

packages/lab-tool/utils/ssh.scm

@@ -0,0 +1,138 @@
+;; utils/ssh.scm - SSH operations for Home Lab Tool
+
+(define-module (utils ssh)
+  #:use-module (ssh session)
+  #:use-module (ssh channel)
+  #:use-module (ssh popen)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 textual-ports)
+
+  #:use-module (srfi srfi-1)
+  #:use-module (utils logging)
+  #:use-module (utils config)
+  #:export (test-ssh-connection
+            run-remote-command
+            copy-file-to-remote
+            run-command-with-retry
+            with-ssh-connection))
+
+;; Test SSH connectivity to a machine
+(define (test-ssh-connection machine-name)
+  (let ((ssh-config (get-ssh-config machine-name)))
+    (if (not ssh-config)
+        (begin
+          (log-error "No SSH configuration found for ~a" machine-name)
+          #f)
+        (if (assoc-ref ssh-config 'is-local)
+            (begin
+              (log-debug "Machine ~a is local, skipping SSH test" machine-name)
+              #t)
+            (let ((hostname (assoc-ref ssh-config 'hostname))
+                  (ssh-alias (assoc-ref ssh-config 'ssh-alias)))
+              (log-debug "Testing SSH connection to ~a (~a)" machine-name hostname)
+              (catch #t
+                (lambda ()
+                  ;; Use system ssh command for compatibility with existing configuration
+                  (let* ((test-cmd (if ssh-alias
+                                      (format #f "ssh -o ConnectTimeout=5 -o BatchMode=yes ~a echo OK" ssh-alias)
+                                      (format #f "ssh -o ConnectTimeout=5 -o BatchMode=yes ~a echo OK" hostname)))
+                         (port (open-pipe* OPEN_READ "/bin/sh" "-c" test-cmd))
+                         (output (get-string-all port))
+                         (status (close-pipe port)))
+                    (if (zero? status)
+                        (begin
+                          (log-debug "SSH connection to ~a successful" machine-name)
+                          #t)
+                        (begin
+                          (log-warn "SSH connection to ~a failed (exit: ~a)" machine-name status)
+                          #f))))
+                (lambda (key . args)
+                  (log-error "SSH test failed for ~a: ~a ~a" machine-name key args)
+                  #f)))))))
+
+;; Run a command on a remote machine
+(define (run-remote-command machine-name command . args)
+  (let ((ssh-config (get-ssh-config machine-name))
+        (full-command (if (null? args) 
+                          command 
+                          (format #f "~a ~a" command (string-join args " ")))))
+    (if (not ssh-config)
+        (values #f "No SSH configuration found")
+        (if (assoc-ref ssh-config 'is-local)
+            ;; Local execution
+            (begin
+              (log-debug "Executing locally: ~a" full-command)
+              (let* ((port (open-pipe* OPEN_READ "/bin/sh" "-c" full-command))
+                     (output (get-string-all port))
+                     (status (close-pipe port)))
+                (values (zero? status) output)))
+            ;; Remote execution
+            (let ((ssh-alias (assoc-ref ssh-config 'ssh-alias))
+                  (hostname (assoc-ref ssh-config 'hostname)))
+              (log-debug "Executing on ~a: ~a" machine-name full-command)
+              (let* ((ssh-cmd (format #f "ssh ~a '~a'" 
+                                     (or ssh-alias hostname) 
+                                     full-command))
+                     (port (open-pipe* OPEN_READ "/bin/sh" "-c" ssh-cmd))
+                     (output (get-string-all port))
+                     (status (close-pipe port)))
+                (values (zero? status) output)))))))
+
+;; Copy file to remote machine using scp
+(define (copy-file-to-remote machine-name local-path remote-path)
+  (let ((ssh-config (get-ssh-config machine-name)))
+    (if (not ssh-config)
+        (begin
+          (log-error "No SSH configuration found for ~a" machine-name)
+          #f)
+        (if (assoc-ref ssh-config 'is-local)
+            ;; Local copy
+            (begin
+              (log-debug "Copying locally: ~a -> ~a" local-path remote-path)
+              (let* ((copy-cmd (format #f "cp '~a' '~a'" local-path remote-path))
+                     (status (system copy-cmd)))
+                (zero? status)))
+            ;; Remote copy
+            (let ((ssh-alias (assoc-ref ssh-config 'ssh-alias))
+                  (hostname (assoc-ref ssh-config 'hostname)))
+              (log-debug "Copying to ~a: ~a -> ~a" machine-name local-path remote-path)
+              (let* ((scp-cmd (format #f "scp '~a' '~a:~a'" 
+                                     local-path 
+                                     (or ssh-alias hostname) 
+                                     remote-path))
+                     (status (system scp-cmd)))
+                (if (zero? status)
+                    (begin
+                      (log-debug "File copy successful")
+                      #t)
+                    (begin
+                      (log-error "File copy failed (exit: ~a)" status)
+                      #f))))))))
+
+;; Run command with retry logic
+(define (run-command-with-retry machine-name command max-retries . args)
+  (let loop ((retries 0))
+    (call-with-values 
+        (lambda () (apply run-remote-command machine-name command args))
+      (lambda (success output)
+        (if success
+            (values #t output)
+            (if (< retries max-retries)
+                (begin
+                  (log-warn "Command failed, retrying (~a/~a)..." (+ retries 1) max-retries)
+                  (sleep 2)
+                  (loop (+ retries 1)))
+                (values #f output)))))))
+
+;; Execute a thunk with SSH connection context
+(define (with-ssh-connection machine-name thunk)
+  (if (test-ssh-connection machine-name)
+      (catch #t
+        (lambda () (thunk))
+        (lambda (key . args)
+          (log-error "SSH operation failed: ~a ~a" key args)
+          #f))
+      (begin
+        (log-error "Cannot establish SSH connection to ~a" machine-name)
+        #f)))

packages/lab-tool/utils/ssh/connection-test.scm

@@ -0,0 +1,41 @@
+;; utils/ssh/connection-test.scm - Pure SSH connection testing
+
+(define-module (utils ssh connection-test)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (ice-9 format)
+  #:use-module (utils logging)
+  #:use-module (utils config)
+  #:export (test-ssh-connection-pure
+            test-ssh-connection))
+
+;; Pure function: Test SSH connectivity to a machine
+;; Input: ssh-config alist
+;; Output: #t if connection successful, #f otherwise
+(define (test-ssh-connection-pure ssh-config)
+  "Pure function to test SSH connection given ssh-config"
+  (let ((hostname (assoc-ref ssh-config 'hostname))
+        (ssh-alias (assoc-ref ssh-config 'ssh-alias))
+        (is-local (assoc-ref ssh-config 'is-local)))
+    (if is-local
+        #t  ; Local connections always succeed
+        (let* ((target (or ssh-alias hostname))
+               (test-cmd (format #f "ssh -o ConnectTimeout=5 -o BatchMode=yes ~a echo OK" target))
+               (port (open-pipe* OPEN_READ "/bin/sh" "-c" test-cmd))
+               (output (get-string-all port))
+               (status (close-pipe port)))
+          (zero? status)))))
+
+;; Impure wrapper: Test SSH connection with logging and config lookup
+(define (test-ssh-connection machine-name)
+  "Test SSH connectivity to a machine (with side effects: logging, config lookup)"
+  (let ((ssh-config (get-ssh-config machine-name)))
+    (if (not ssh-config)
+        (begin
+          (log-error "No SSH configuration found for ~a" machine-name)
+          #f)
+        (let ((result (test-ssh-connection-pure ssh-config)))
+          (if result
+              (log-debug "SSH connection to ~a successful" machine-name)
+              (log-warn "SSH connection to ~a failed" machine-name))
+          result))))

packages/lab-tool/utils/ssh/context.scm

@@ -0,0 +1,33 @@
+;; utils/ssh/context.scm - SSH context management
+
+(define-module (utils ssh context)
+  #:use-module (ice-9 format)
+  #:use-module (utils logging)
+  #:use-module (utils ssh connection-test)
+  #:export (with-connection-context
+            with-ssh-connection))
+
+;; Pure function: Execute operation with connection validation
+;; Input: connection-validator (thunk -> boolean), operation (thunk)
+;; Output: result of operation or #f if connection invalid
+(define (with-connection-context connection-validator operation)
+  "Pure function to execute operation with connection context"
+  (if (connection-validator)
+      (catch #t
+        operation
+        (lambda (key . args)
+          (values #f (format #f "Operation failed: ~a ~a" key args))))
+      (values #f "Connection validation failed")))
+
+;; Impure wrapper: Execute with SSH connection context and logging
+(define (with-ssh-connection machine-name thunk)
+  "Execute operation with SSH connection context (with side effects: logging)"
+  (let ((connection-validator (lambda () (test-ssh-connection machine-name))))
+    (call-with-values 
+        (lambda () (with-connection-context connection-validator thunk))
+      (lambda (success result)
+        (if success
+            result
+            (begin
+              (log-error "SSH operation failed for ~a: ~a" machine-name result)
+              #f))))))

packages/lab-tool/utils/ssh/file-copy.scm

@@ -0,0 +1,50 @@
+;; utils/ssh/file-copy.scm - Pure file copying operations
+
+(define-module (utils ssh file-copy)
+  #:use-module (ice-9 format)
+  #:use-module (utils logging)
+  #:use-module (utils config)
+  #:export (copy-file-pure
+            build-copy-context
+            copy-file-to-remote))
+
+;; Pure function: Copy file with given copy context
+;; Input: copy-context alist, local-path string, remote-path string
+;; Output: #t if successful, #f otherwise
+(define (copy-file-pure copy-context local-path remote-path)
+  "Pure function to copy file given copy context"
+  (let ((is-local (assoc-ref copy-context 'is-local))
+        (target (assoc-ref copy-context 'target)))
+    (let* ((copy-cmd (if is-local
+                         (format #f "cp '~a' '~a'" local-path remote-path)
+                         (format #f "scp '~a' '~a:~a'" local-path target remote-path)))
+           (status (system copy-cmd)))
+      (zero? status))))
+
+;; Pure function: Build copy context from ssh-config
+(define (build-copy-context ssh-config)
+  "Pure function to build copy context from ssh-config"
+  (let ((hostname (assoc-ref ssh-config 'hostname))
+        (ssh-alias (assoc-ref ssh-config 'ssh-alias))
+        (is-local (assoc-ref ssh-config 'is-local)))
+    `((is-local . ,is-local)
+      (target . ,(or ssh-alias hostname)))))
+
+;; Impure wrapper: Copy file to remote with logging and config lookup
+(define (copy-file-to-remote machine-name local-path remote-path)
+  "Copy file to remote machine (with side effects: logging, config lookup)"
+  (let ((ssh-config (get-ssh-config machine-name)))
+    (if (not ssh-config)
+        (begin
+          (log-error "No SSH configuration found for ~a" machine-name)
+          #f)
+        (let* ((copy-context (build-copy-context ssh-config))
+               (is-local (assoc-ref copy-context 'is-local)))
+          (log-debug "Copying ~a: ~a -> ~a" 
+                     (if is-local "locally" (format #f "to ~a" machine-name))
+                     local-path remote-path)
+          (let ((result (copy-file-pure copy-context local-path remote-path)))
+            (if result
+                (log-debug "File copy successful")
+                (log-error "File copy failed"))
+            result)))))

packages/lab-tool/utils/ssh/remote-command.scm

@@ -0,0 +1,58 @@
+;; utils/ssh/remote-command.scm - Pure remote command execution
+
+(define-module (utils ssh remote-command)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (ice-9 format)
+  #:use-module (srfi srfi-1)
+  #:use-module (utils logging)
+  #:use-module (utils config)
+  #:export (run-remote-command-pure
+            execute-command-pure
+            build-execution-context
+            run-remote-command))
+
+;; Pure function: Execute command with given execution context
+;; Input: execution-context alist, command string, args list
+;; Output: (values success? output-string)
+(define (execute-command-pure execution-context command args)
+  "Pure function to execute command in given context"
+  (let ((is-local (assoc-ref execution-context 'is-local))
+        (target (assoc-ref execution-context 'target))
+        (full-command (if (null? args) 
+                          command 
+                          (format #f "~a ~a" command (string-join args " ")))))
+    (let* ((exec-cmd (if is-local
+                         full-command
+                         (format #f "ssh ~a '~a'" target full-command)))
+           (port (open-pipe* OPEN_READ "/bin/sh" "-c" exec-cmd))
+           (output (get-string-all port))
+           (status (close-pipe port)))
+      (values (zero? status) output))))
+
+;; Pure function: Build execution context from ssh-config
+(define (build-execution-context ssh-config)
+  "Pure function to build execution context from ssh-config"
+  (let ((hostname (assoc-ref ssh-config 'hostname))
+        (ssh-alias (assoc-ref ssh-config 'ssh-alias))
+        (is-local (assoc-ref ssh-config 'is-local)))
+    `((is-local . ,is-local)
+      (target . ,(or ssh-alias hostname)))))
+
+;; Pure wrapper: Run remote command with pure functions
+(define (run-remote-command-pure ssh-config command args)
+  "Pure function to run remote command given ssh-config"
+  (let ((exec-context (build-execution-context ssh-config)))
+    (execute-command-pure exec-context command args)))
+
+;; Impure wrapper: Run remote command with logging and config lookup
+(define (run-remote-command machine-name command . args)
+  "Run command on remote machine (with side effects: logging, config lookup)"
+  (let ((ssh-config (get-ssh-config machine-name)))
+    (if (not ssh-config)
+        (begin
+          (log-error "No SSH configuration found for ~a" machine-name)
+          (values #f "No SSH configuration found"))
+        (begin
+          (log-debug "Executing on ~a: ~a ~a" machine-name command (string-join args " "))
+          (run-remote-command-pure ssh-config command args)))))

packages/lab-tool/utils/ssh/retry.scm

@@ -0,0 +1,45 @@
+;; utils/ssh/retry.scm - Pure retry logic
+
+(define-module (utils ssh retry)
+  #:use-module (utils logging)
+  #:use-module (utils ssh remote-command)
+  #:export (with-retry
+            run-command-with-retry))
+
+;; Pure function: Retry operation with exponential backoff
+;; Input: operation (thunk), max-retries number, delay-fn (retry-count -> seconds)
+;; Output: result of operation or #f if all retries failed
+(define (with-retry operation max-retries . delay-fn)
+  "Pure retry logic - operation should return (values success? result)"
+  (let ((delay-func (if (null? delay-fn) 
+                        (lambda (retry) (* retry 2))  ; Default: exponential backoff
+                        (car delay-fn))))
+    (let loop ((retries 0))
+      (call-with-values operation
+        (lambda (success result)
+          (if success
+              (values #t result)
+              (if (< retries max-retries)
+                  (begin
+                    (sleep (delay-func retries))
+                    (loop (+ retries 1)))
+                  (values #f result))))))))
+
+;; Impure wrapper: Run command with retry and logging
+(define (run-command-with-retry machine-name command max-retries . args)
+  "Run command with retry logic (with side effects: logging)"
+  (let ((operation (lambda ()
+                     (apply run-remote-command machine-name command args))))
+    (let loop ((retries 0))
+      (call-with-values operation
+        (lambda (success output)
+          (if success
+              (values #t output)
+              (if (< retries max-retries)
+                  (begin
+                    (log-warn "Command failed, retrying (~a/~a)..." (+ retries 1) max-retries)
+                    (sleep 2)
+                    (loop (+ retries 1)))
+                  (begin
+                    (log-error "Command failed after ~a retries" max-retries)
+                    (values #f output))))))))))