Refactor emacs configuration and clean up lab-tool project
- Reorganized emacs configuration with profiles in modules/development/emacs.nix - Updated machine configurations to use new emacs module structure - Cleaned up lab-tool project by removing archive, research, testing, and utils directories - Streamlined lab-tool to focus on core deployment functionality with deploy-rs - Added DEVELOPMENT.md documentation for lab-tool 🤖 Generated with [Claude Code](https://claude.ai/code) Co-Authored-By: Claude <noreply@anthropic.com>
This commit is contained in:
parent
bff56e4ffc
commit
47c2961033
70 changed files with 195 additions and 5688 deletions
|
|
@ -1,75 +0,0 @@
|
|||
;; lab/core/health.scm - Health check functionality
|
||||
|
||||
(define-module (lab core health)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (lab core logging)
|
||||
#:use-module (lab core ssh)
|
||||
#:export (check-system-health
|
||||
check-disk-space
|
||||
check-system-load
|
||||
check-critical-services
|
||||
check-network-connectivity))
|
||||
|
||||
(define (check-system-health machine-name)
|
||||
"Perform comprehensive health check on a machine"
|
||||
(log-info "Performing health check on ~a..." machine-name)
|
||||
|
||||
(let ((health-checks
|
||||
'(("connectivity" . test-ssh-connection)
|
||||
("disk-space" . check-disk-space)
|
||||
("system-load" . check-system-load)
|
||||
("critical-services" . check-critical-services)
|
||||
("network" . check-network-connectivity))))
|
||||
|
||||
(map (lambda (check-pair)
|
||||
(let ((check-name (car check-pair))
|
||||
(check-proc (cdr check-pair)))
|
||||
(log-debug "Running ~a check..." check-name)
|
||||
(catch #t
|
||||
(lambda ()
|
||||
(let ((result (check-proc machine-name)))
|
||||
`(,check-name . ((status . ,(if result 'pass 'fail))
|
||||
(result . ,result)))))
|
||||
(lambda (key . args)
|
||||
(log-warn "Health check ~a failed: ~a" check-name key)
|
||||
`(,check-name . ((status . error)
|
||||
(error . ,key)))))))
|
||||
health-checks)))
|
||||
|
||||
(define (check-disk-space machine-name)
|
||||
"Check if disk space is below critical threshold"
|
||||
(call-with-values
|
||||
(lambda () (run-remote-command machine-name "df / | tail -1 | awk '{print $5}' | sed 's/%//'"))
|
||||
(lambda (success output)
|
||||
(if success
|
||||
(let ((usage (string->number (string-trim-right output))))
|
||||
(< usage 90)) ; Pass if usage < 90%
|
||||
#f))))
|
||||
|
||||
(define (check-system-load machine-name)
|
||||
"Check if system load is reasonable"
|
||||
(call-with-values
|
||||
(lambda () (run-remote-command machine-name "cat /proc/loadavg | cut -d' ' -f1"))
|
||||
(lambda (success output)
|
||||
(if success
|
||||
(let ((load (string->number (string-trim-right output))))
|
||||
(< load 5.0)) ; Pass if load < 5.0
|
||||
#f))))
|
||||
|
||||
(define (check-critical-services machine-name)
|
||||
"Check that critical services are running"
|
||||
(let ((critical-services '("sshd")))
|
||||
(every (lambda (service)
|
||||
(call-with-values
|
||||
(lambda () (run-remote-command machine-name "systemctl is-active" service))
|
||||
(lambda (success output)
|
||||
(and success (string=? (string-trim-right output) "active")))))
|
||||
critical-services)))
|
||||
|
||||
(define (check-network-connectivity machine-name)
|
||||
"Check basic network connectivity"
|
||||
(call-with-values
|
||||
(lambda () (run-remote-command machine-name "ping -c 1 -W 5 8.8.8.8 > /dev/null 2>&1; echo $?"))
|
||||
(lambda (success output)
|
||||
(and success (string=? (string-trim-right output) "0")))))
|
||||
|
|
@ -1,29 +0,0 @@
|
|||
;; lab/core/logging.scm - Logging functionality
|
||||
|
||||
(define-module (lab core logging)
|
||||
#:use-module (ice-9 format)
|
||||
#:export (log-info
|
||||
log-debug
|
||||
log-success
|
||||
log-error
|
||||
log-warn))
|
||||
|
||||
(define (log-info format-str . args)
|
||||
"Log info message"
|
||||
(apply format #t (string-append "[INFO] " format-str "~%") args))
|
||||
|
||||
(define (log-debug format-str . args)
|
||||
"Log debug message"
|
||||
(apply format #t (string-append "[DEBUG] " format-str "~%") args))
|
||||
|
||||
(define (log-success format-str . args)
|
||||
"Log success message"
|
||||
(apply format #t (string-append "[SUCCESS] " format-str "~%") args))
|
||||
|
||||
(define (log-error format-str . args)
|
||||
"Log error message"
|
||||
(apply format #t (string-append "[ERROR] " format-str "~%") args))
|
||||
|
||||
(define (log-warn format-str . args)
|
||||
"Log warning message"
|
||||
(apply format #t (string-append "[WARN] " format-str "~%") args))
|
||||
|
|
@ -1,24 +0,0 @@
|
|||
;; lab/core/ssh.scm - SSH operations
|
||||
|
||||
(define-module (lab core ssh)
|
||||
#:use-module (ice-9 format)
|
||||
#:use-module (ice-9 popen)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (ice-9 textual-ports)
|
||||
#:export (test-ssh-connection
|
||||
run-remote-command))
|
||||
|
||||
(define (test-ssh-connection machine-name)
|
||||
"Test SSH connection to machine"
|
||||
(zero? (system (format #f "ssh -o ConnectTimeout=5 -o BatchMode=yes ~a exit 2>/dev/null" machine-name))))
|
||||
|
||||
(define (run-remote-command machine-name command . args)
|
||||
"Run command on remote machine via SSH"
|
||||
(let* ((full-command (if (null? args)
|
||||
command
|
||||
(string-join (cons command args) " ")))
|
||||
(ssh-command (format #f "ssh ~a '~a'" machine-name full-command))
|
||||
(port (open-input-pipe ssh-command))
|
||||
(output (read-string port))
|
||||
(status (close-pipe port)))
|
||||
(values (zero? status) output)))
|
||||
|
|
@ -1,84 +0,0 @@
|
|||
;; lab/core/status.scm - Infrastructure status functionality
|
||||
|
||||
(define-module (lab core status)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-19)
|
||||
#:use-module (lab core logging)
|
||||
#:use-module (lab core config)
|
||||
#:use-module (lab core ssh)
|
||||
#:export (get-infrastructure-status
|
||||
get-machine-services-status
|
||||
get-machine-system-info))
|
||||
|
||||
(define (get-infrastructure-status . args)
|
||||
"Get status of all machines or specific machine if provided"
|
||||
(let ((target-machine (if (null? args) #f (car args)))
|
||||
(machines (if (null? args)
|
||||
(get-all-machines)
|
||||
(list (car args)))))
|
||||
|
||||
(log-info "Checking infrastructure status...")
|
||||
|
||||
(map (lambda (machine-name)
|
||||
(let ((start-time (current-time)))
|
||||
(log-debug "Checking ~a..." machine-name)
|
||||
|
||||
(let* ((ssh-config (get-ssh-config machine-name))
|
||||
(is-local (and ssh-config (assoc-ref ssh-config 'is-local)))
|
||||
(connection-status (test-ssh-connection machine-name))
|
||||
(services-status (if connection-status
|
||||
(get-machine-services-status machine-name)
|
||||
'()))
|
||||
(system-info (if connection-status
|
||||
(get-machine-system-info machine-name)
|
||||
#f))
|
||||
(elapsed (- (current-time) start-time)))
|
||||
|
||||
`((machine . ,machine-name)
|
||||
(type . ,(if is-local 'local 'remote))
|
||||
(connection . ,(if connection-status 'online 'offline))
|
||||
(services . ,services-status)
|
||||
(system . ,system-info)
|
||||
(check-time . ,elapsed)))))
|
||||
machines)))
|
||||
|
||||
(define (get-machine-services-status machine-name)
|
||||
"Check status of services on a machine"
|
||||
(let ((machine-config (get-machine-config machine-name)))
|
||||
(if machine-config
|
||||
(let ((services (assoc-ref machine-config 'services)))
|
||||
(if services
|
||||
(map (lambda (service)
|
||||
(call-with-values
|
||||
(lambda () (run-remote-command machine-name
|
||||
"systemctl is-active"
|
||||
(symbol->string service)))
|
||||
(lambda (success output)
|
||||
`(,service . ,(if success
|
||||
(string-trim-right output)
|
||||
"unknown")))))
|
||||
services)
|
||||
'()))
|
||||
'())))
|
||||
|
||||
(define (get-machine-system-info machine-name)
|
||||
"Get basic system information from a machine"
|
||||
(let ((info-commands
|
||||
'(("uptime" "uptime -p")
|
||||
("load" "cat /proc/loadavg | cut -d' ' -f1-3")
|
||||
("memory" "free -h | grep Mem | awk '{print $3\"/\"$2}'")
|
||||
("disk" "df -h / | tail -1 | awk '{print $5}'")
|
||||
("kernel" "uname -r"))))
|
||||
|
||||
(fold (lambda (cmd-pair acc)
|
||||
(let ((key (car cmd-pair))
|
||||
(command (cadr cmd-pair)))
|
||||
(call-with-values
|
||||
(lambda () (run-remote-command machine-name command))
|
||||
(lambda (success output)
|
||||
(if success
|
||||
(assoc-set! acc (string->symbol key) (string-trim-right output))
|
||||
acc)))))
|
||||
'()
|
||||
info-commands)))
|
||||
|
|
@ -1,12 +0,0 @@
|
|||
;; lab/core/utils.scm - Utility functions
|
||||
|
||||
(define-module (lab core utils)
|
||||
#:use-module (ice-9 format)
|
||||
#:export (with-spinner))
|
||||
|
||||
(define (with-spinner message proc)
|
||||
"Execute procedure with spinner (stub implementation)"
|
||||
(display (format #f "~a..." message))
|
||||
(let ((result (proc)))
|
||||
(display " done.\n")
|
||||
result))
|
||||
|
|
@ -1,109 +0,0 @@
|
|||
;; lab/core/deployment.scm - Deployment functionality
|
||||
|
||||
(define-module (lab core deployment)
|
||||
#:use-module (ice-9 format)
|
||||
#:use-module (ice-9 popen)
|
||||
#:use-module (ice-9 textual-ports)
|
||||
#:use-module (lab core logging)
|
||||
#:use-module (lab core config)
|
||||
#:use-module (lab core utils)
|
||||
#:export (update-flake
|
||||
validate-environment
|
||||
execute-nixos-rebuild))
|
||||
|
||||
(define (update-flake options)
|
||||
"Update flake inputs in the home lab repository"
|
||||
(let ((homelab-root (get-homelab-root))
|
||||
(dry-run (option-ref options 'dry-run #f)))
|
||||
|
||||
(log-info "Updating flake inputs...")
|
||||
|
||||
(if dry-run
|
||||
(begin
|
||||
(log-info "DRY RUN: Would execute: nix flake update")
|
||||
#t)
|
||||
(let* ((update-cmd (format #f "cd ~a && nix flake update" homelab-root))
|
||||
(port (open-pipe* OPEN_READ "/bin/sh" "-c" update-cmd))
|
||||
(output (get-string-all port))
|
||||
(status (close-pipe port)))
|
||||
|
||||
(if (zero? status)
|
||||
(begin
|
||||
(log-success "Flake inputs updated successfully")
|
||||
(log-debug "Update output: ~a" output)
|
||||
#t)
|
||||
(begin
|
||||
(log-error "Flake update failed (exit: ~a)" status)
|
||||
(log-error "Error output: ~a" output)
|
||||
#f))))))
|
||||
|
||||
(define (validate-environment)
|
||||
"Validate that the home lab environment is properly configured"
|
||||
(log-info "Validating home lab environment...")
|
||||
|
||||
(let ((checks
|
||||
`(("homelab-root" . ,(lambda () (file-exists? (get-homelab-root))))
|
||||
("flake-file" . ,(lambda () (file-exists? (string-append (get-homelab-root) "/flake.nix"))))
|
||||
("ssh-config" . ,(lambda () (file-exists? (string-append (getenv "HOME") "/.ssh/config"))))
|
||||
("nix-command" . ,(lambda () (zero? (system "which nix > /dev/null 2>&1"))))
|
||||
("machines-config" . ,(lambda () (not (null? (get-all-machines))))))))
|
||||
|
||||
(let ((results (map (lambda (check-pair)
|
||||
(let ((check-name (car check-pair))
|
||||
(check-proc (cdr check-pair)))
|
||||
(let ((result (check-proc)))
|
||||
(if result
|
||||
(log-success "✓ ~a" check-name)
|
||||
(log-error "✗ ~a" check-name))
|
||||
`(,check-name . ,result))))
|
||||
checks)))
|
||||
|
||||
(let ((failures (filter (lambda (result) (not (cdr result))) results)))
|
||||
(if (null? failures)
|
||||
(begin
|
||||
(log-success "Environment validation passed")
|
||||
#t)
|
||||
(begin
|
||||
(log-error "Environment validation failed: ~a" (map car failures))
|
||||
#f))))))
|
||||
|
||||
(define (execute-nixos-rebuild machine-name mode options)
|
||||
"Execute nixos-rebuild on a machine with comprehensive error handling"
|
||||
(let ((homelab-root (get-homelab-root))
|
||||
(dry-run (option-ref options 'dry-run #f))
|
||||
(ssh-config (get-ssh-config machine-name)))
|
||||
|
||||
(if (not ssh-config)
|
||||
(begin
|
||||
(log-error "No SSH configuration for machine: ~a" machine-name)
|
||||
#f)
|
||||
(let* ((is-local (assoc-ref ssh-config 'is-local))
|
||||
(flake-ref (format #f "~a#~a" homelab-root machine-name))
|
||||
(rebuild-cmd (if is-local
|
||||
(format #f "sudo nixos-rebuild ~a --flake ~a" mode flake-ref)
|
||||
(format #f "nixos-rebuild ~a --flake ~a --target-host ~a --use-remote-sudo"
|
||||
mode flake-ref (assoc-ref ssh-config 'hostname)))))
|
||||
|
||||
(log-info "Executing nixos-rebuild for ~a (mode: ~a)" machine-name mode)
|
||||
(log-debug "Command: ~a" rebuild-cmd)
|
||||
|
||||
(if dry-run
|
||||
(begin
|
||||
(log-info "DRY RUN: Would execute: ~a" rebuild-cmd)
|
||||
#t)
|
||||
(with-spinner
|
||||
(format #f "Rebuilding ~a" machine-name)
|
||||
(lambda ()
|
||||
(let* ((port (open-pipe* OPEN_READ "/bin/sh" "-c" rebuild-cmd))
|
||||
(output (get-string-all port))
|
||||
(status (close-pipe port)))
|
||||
|
||||
(if (zero? status)
|
||||
(begin
|
||||
(log-success "nixos-rebuild completed successfully for ~a" machine-name)
|
||||
(log-debug "Build output: ~a" output)
|
||||
#t)
|
||||
(begin
|
||||
(log-error "nixos-rebuild failed for ~a (exit: ~a)" machine-name status)
|
||||
(log-error "Error output: ~a" output)
|
||||
#f))))))))
|
||||
Loading…
Add table
Add a link
Reference in a new issue