moved some files to archive

packages/lab-tool/archive/lab-old/utils/config.scm

@@ -0,0 +1,69 @@
+;; utils/config.scm - Declarative configuration for Home Lab Tool
+
+(define-module (utils config)
+  #:export (default-config
+            get-config-value
+            host-configs
+            get-host-config
+            get-all-hosts
+            validate-host-name
+            get-ssh-config))
+
+;; Declarative configuration (source of truth)
+(define default-config
+  '((ssh-user . "sma")
+    (hosts . ((congenital-optimist (hostname . "congenital-optimist"))
+              (sleeper-service (hostname . "sleeper-service"))
+              (grey-area (hostname . "grey-area"))
+              (reverse-proxy (hostname . "reverse-proxy"))
+              (little-rascal (hostname . "little-rascal"))))
+    (deployment . ((default-mode . "boot")
+                   (timeout . 300)
+                   (retry-count . 3)))
+    (monitoring . ((interval . 30)
+                   (timeout . 10)))
+    (mcp . ((port . 3001)
+            (host . "localhost")
+            (log-level . "info")))))
+
+;; Accessors (pure, no mutation, no IO)
+(define (get-config-value path . default)
+  (let ((result (fold (lambda (key acc)
+                        (if (and acc (list? acc))
+                            (assoc-ref acc key)
+                            #f))
+                      default-config path)))
+    (if result 
+        result 
+        (if (null? default) #f (car default)))))
+
+(define (host-configs)
+  (get-config-value '(hosts)))
+
+(define (get-host-config host-name)
+  (let ((host-symbol (if (symbol? host-name)
+                         host-name
+                         (string->symbol host-name))))
+    (assoc-ref (host-configs) host-symbol)))
+
+(define (get-all-hosts)
+  (map (lambda (host-entry)
+         (symbol->string (car host-entry)))
+       (host-configs)))
+
+(define (validate-host-name host-name)
+  (let ((hosts (get-all-hosts)))
+    (if (member host-name hosts)
+        #t
+        #f)))
+
+(define (get-ssh-config host-name)
+  (let ((host-config (get-host-config host-name))
+        (ssh-user (get-config-value '(ssh-user) "sma")))
+    (if host-config
+        (let ((hostname (assoc-ref host-config 'hostname)))
+          `((hostname . ,hostname)
+            (user . ,ssh-user)
+            (ssh-user . ,ssh-user)
+            (identity-file . "~/.ssh/id_ed25519_admin")))
+        #f)))

packages/lab-tool/archive/lab-old/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/archive/lab-old/utils/logging.scm

@@ -0,0 +1,92 @@
+;; 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!
+            get-color
+            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/archive/lab-old/utils/ssh.scm

@@ -0,0 +1,188 @@
+;; utils/ssh.scm - SSH operations for Home Lab Tool
+;; Refactored using functional programming principles
+
+(define-module (utils ssh)
+  #:use-module (ice-9 format)
+  #:use-module (srfi srfi-1)
+  #:use-module (utils logging)
+  #:use-module (utils config)
+  #:use-module (io ssh)
+  #:use-module (io shell)
+  #: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)
+  "Test SSH connectivity using functional composition"
+  (let ((ssh-config (get-ssh-config machine-name)))
+    (cond
+      ((not ssh-config)
+       (log-error "No SSH configuration found for ~a" machine-name)
+       #f)
+      ((assoc-ref ssh-config 'is-local)
+       (log-debug "Machine ~a is local, skipping SSH test" machine-name)
+       #t)
+      (else
+       (test-remote-ssh-connection machine-name ssh-config)))))
+
+;; Helper: Test remote SSH connection
+(define (test-remote-ssh-connection machine-name ssh-config)
+  "Test remote SSH connection with error handling"
+  (let* ((hostname (assoc-ref ssh-config 'hostname))
+         (ssh-alias (assoc-ref ssh-config 'ssh-alias))
+         (user (assoc-ref ssh-config 'user))
+         (identity-file (assoc-ref ssh-config 'identity-file))
+         (target (make-ssh-target user (or ssh-alias hostname)))
+         (options (make-ssh-options identity-file 5))
+         (test-cmd (build-ssh-command target options "echo OK")))
+    
+    (log-debug "Testing SSH connection to ~a (~a) as ~a using key ~a" 
+               machine-name hostname user identity-file)
+    
+    (catch #t
+      (lambda ()
+        (let ((result (execute-with-output test-cmd)))
+          (if (car result)
+              (begin
+                (log-debug "SSH connection to ~a successful" machine-name)
+                #t)
+              (begin
+                (log-warn "SSH connection to ~a failed" machine-name)
+                #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)
+  "Run command remotely using functional composition"
+  (let ((ssh-config (get-ssh-config machine-name))
+        (full-command (build-full-command command args)))
+    (cond
+      ((not ssh-config)
+       (values #f "No SSH configuration found"))
+      ((assoc-ref ssh-config 'is-local)
+       (execute-local-command full-command))
+      (else
+       (execute-remote-command machine-name ssh-config full-command)))))
+
+;; Helper: Build full command string
+(define (build-full-command command args)
+  "Build complete command string from command and arguments"
+  (if (null? args)
+      command
+      (format #f "~a ~a" command (string-join args " "))))
+
+;; Helper: Execute command locally
+(define (execute-local-command command)
+  "Execute command locally and return (success . output)"
+  (log-debug "Executing locally: ~a" command)
+  (let ((result (execute-with-output command)))
+    (values (car result) (cdr result))))
+
+;; Helper: Execute command remotely
+(define (execute-remote-command machine-name ssh-config command)
+  "Execute command remotely using SSH"
+  (let* ((hostname (assoc-ref ssh-config 'hostname))
+         (ssh-alias (assoc-ref ssh-config 'ssh-alias))
+         (user (assoc-ref ssh-config 'user))
+         (identity-file (assoc-ref ssh-config 'identity-file))
+         (target (make-ssh-target user (or ssh-alias hostname)))
+         (options (make-ssh-options identity-file #f))
+         (ssh-cmd (build-ssh-command target options command)))
+    
+    (log-debug "Executing remotely on ~a: ~a" machine-name command)
+    
+    (catch #t
+      (lambda ()
+        (let ((result (execute-with-output ssh-cmd)))
+          (values (car result) (cdr result))))
+      (lambda (key . args)
+        (log-error "SSH command failed for ~a: ~a ~a" machine-name key args)
+        (values #f "")))))
+
+;; Copy file to remote machine using scp
+(define (copy-file-to-remote machine-name local-path remote-path)
+  "Copy file to remote machine using functional composition"
+  (let ((ssh-config (get-ssh-config machine-name)))
+    (cond
+      ((not ssh-config)
+       (log-error "No SSH configuration found for ~a" machine-name)
+       #f)
+      ((assoc-ref ssh-config 'is-local)
+       (copy-file-locally local-path remote-path))
+      (else
+       (copy-file-remotely machine-name ssh-config local-path remote-path)))))
+
+;; Helper: Copy file locally
+(define (copy-file-locally local-path remote-path)
+  "Copy file locally using cp command"
+  (log-debug "Copying locally: ~a -> ~a" local-path remote-path)
+  (let ((copy-cmd (format #f "cp '~a' '~a'" local-path remote-path)))
+    (execute-command copy-cmd)))
+
+;; Helper: Copy file remotely
+(define (copy-file-remotely machine-name ssh-config local-path remote-path)
+  "Copy file remotely using scp command"
+  (let* ((hostname (assoc-ref ssh-config 'hostname))
+         (ssh-alias (assoc-ref ssh-config 'ssh-alias))
+         (user (assoc-ref ssh-config 'user))
+         (identity-file (assoc-ref ssh-config 'identity-file))
+         (target (make-ssh-target user (or ssh-alias hostname)))
+         (options (make-ssh-options identity-file #f))
+         (scp-cmd (format #f "scp ~a '~a' '~a:~a'" options local-path target remote-path)))
+    
+    (log-debug "Copying to ~a: ~a -> ~a as ~a using key ~a" 
+               machine-name local-path remote-path user identity-file)
+    
+    (let ((success (execute-command scp-cmd)))
+      (if success
+          (begin
+            (log-debug "File copy successful")
+            #t)
+          (begin
+            (log-error "File copy failed")
+            #f)))))
+
+;; Run command with retry logic
+(define (run-command-with-retry machine-name command max-retries . args)
+  "Run command with retry logic using functional recursion"
+  (retry-command machine-name command max-retries 0 args))
+
+;; Helper: Retry command implementation
+(define (retry-command machine-name command max-retries current-retry args)
+  "Recursive retry implementation"
+  (call-with-values
+    (lambda () (apply run-remote-command machine-name command args))
+    (lambda (success output)
+      (cond
+        (success
+         (values #t output))
+        ((< current-retry max-retries)
+         (log-warn "Command failed, retrying (~a/~a)..." (+ current-retry 1) max-retries)
+         (sleep 2)
+         (retry-command machine-name command max-retries (+ current-retry 1) args))
+        (else
+         (values #f output))))))
+
+;; Execute a thunk with SSH connection context
+(define (with-ssh-connection machine-name thunk)
+  "Execute thunk with SSH connection context using functional composition"
+  (cond
+    ((test-ssh-connection machine-name)
+     (execute-with-ssh-context thunk machine-name))
+    (else
+     (log-error "Cannot establish SSH connection to ~a" machine-name)
+     #f)))
+
+;; Helper: Execute thunk with error handling
+(define (execute-with-ssh-context thunk machine-name)
+  "Execute thunk with proper error handling"
+  (catch #t
+    (lambda () (thunk))
+    (lambda (key . args)
+      (log-error "SSH operation failed: ~a ~a" key args)
+      #f)))