moved some files to archive

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)))