home-lab/packages/guile-mcp-server.scm
Geir Okkenhaug Jerstad cc735b3497 feat: Complete migration to GNU Guile Scheme with MCP integration
Major project milestone: Successfully migrated home lab management tool from Bash to GNU Guile Scheme

## Completed Components 
- **Project Foundation**: Complete directory structure (lab/, mcp/, utils/)
- **Working CLI Tool**: Functional home-lab-tool.scm with command parsing
- **Development Environment**: NixOS flake.nix with Guile, JSON, SSH, WebSocket libraries
- **Core Utilities**: Logging, configuration, SSH utilities with error handling
- **Module Architecture**: Comprehensive lab modules and MCP server foundation
- **TaskMaster Integration**: 25-task roadmap with project management
- **Testing & Validation**: Successfully tested in nix develop environment

## Implementation Highlights
- Functional programming patterns with immutable data structures
- Proper error handling and recovery mechanisms
- Clean module separation with well-defined interfaces
- Working CLI commands: help, status, deploy (with parsing)
- Modular Guile architecture ready for expansion

## Project Structure
- home-lab-tool.scm: Main CLI entry point (working)
- utils/: logging.scm, config.scm, ssh.scm (ssh needs syntax fixes)
- lab/: core.scm, machines.scm, deployment.scm, monitoring.scm
- mcp/: server.scm foundation for VS Code integration
- flake.nix: Working development environment

## Next Steps
1. Fix SSH utilities syntax errors for real connectivity
2. Implement actual infrastructure status checking
3. Complete MCP server JSON-RPC protocol
4. Develop VS Code extension with MCP client

This represents a complete rewrite maintaining compatibility while adding:
- Better error handling and maintainability
- MCP server for AI/VS Code integration
- Modular architecture for extensibility
- Comprehensive project management with TaskMaster

The Bash-to-Guile migration provides a solid foundation for advanced
home lab management with modern tooling and AI integration.
2025-06-15 22:17:47 +02:00

348 lines
12 KiB
Scheme

#!/usr/bin/env guile
!#
;; Guile MCP Server for Home Lab Integration
;; Implements Model Context Protocol for VS Code extension
(use-modules (json)
(ice-9 textual-ports)
(ice-9 popen)
(ice-9 rdelim)
(ice-9 match)
(ice-9 threads)
(srfi srfi-1)
(srfi srfi-19)
(srfi srfi-26))
;; MCP Protocol Implementation
(define mcp-protocol-version "2024-11-05")
(define request-id-counter 0)
;; Server capabilities and state
(define server-capabilities
`((tools . ())
(resources . ())
(prompts . ())))
(define server-info
`((name . "guile-homelab-mcp")
(version . "0.1.0")))
;; Request/Response utilities
(define (make-response id result)
`((jsonrpc . "2.0")
(id . ,id)
(result . ,result)))
(define (make-error id code message)
`((jsonrpc . "2.0")
(id . ,id)
(error . ((code . ,code)
(message . ,message)))))
(define (send-response response)
(let ((json-str (scm->json-string response)))
(display json-str)
(newline)
(force-output)))
;; Home Lab Tools Implementation
(define (list-machines)
"List all available machines in the home lab"
(let* ((proc (open-input-pipe "find /etc/nixos/hosts -name '*.nix' -type f"))
(output (read-string proc)))
(close-pipe proc)
(if (string-null? output)
'()
(map (lambda (path)
(basename path ".nix"))
(string-split (string-trim-right output #\newline) #\newline)))))
(define (get-machine-status machine)
"Get status of a specific machine"
(let* ((cmd (format #f "ping -c 1 -W 1 ~a > /dev/null 2>&1" machine))
(status (system cmd)))
(if (= status 0) "online" "offline")))
(define (deploy-machine machine method)
"Deploy configuration to a machine"
(match method
("deploy-rs"
(let ((cmd (format #f "deploy '.#~a'" machine)))
(deploy-with-command cmd machine)))
("hybrid-update"
(let ((cmd (format #f "nixos-rebuild switch --flake '.#~a' --target-host ~a --use-remote-sudo" machine machine)))
(deploy-with-command cmd machine)))
("legacy"
(let ((cmd (format #f "nixos-rebuild switch --flake '.#~a'" machine)))
(deploy-with-command cmd machine)))
(_ (throw 'deployment-error "Unknown deployment method" method))))
(define (deploy-with-command cmd machine)
"Execute deployment command and return result"
(let* ((proc (open-input-pipe cmd))
(output (read-string proc))
(status (close-pipe proc)))
`((success . ,(= status 0))
(output . ,output)
(machine . ,machine)
(timestamp . ,(date->string (current-date))))))
(define (generate-nix-config machine-name services)
"Generate NixOS configuration for a new machine"
(let ((config (format #f "# Generated NixOS configuration for ~a
# Generated on ~a
{ config, pkgs, ... }:
{
imports = [
./hardware-configuration.nix
];
# Machine name
networking.hostName = \"~a\";
# Basic system configuration
system.stateVersion = \"23.11\";
# Enable services
~a
# Network configuration
networking.firewall.enable = true;
# SSH access
services.openssh.enable = true;
users.users.root.openssh.authorizedKeys.keys = [
# Add your public key here
];
}
"
machine-name
(date->string (current-date))
machine-name
(string-join
(map (lambda (service)
(format #f " services.~a.enable = true;" service))
services)
"\n"))))
`((content . ,config)
(filename . ,(format #f "~a.nix" machine-name)))))
(define (get-infrastructure-status)
"Get comprehensive infrastructure status"
(let* ((machines (list-machines))
(machine-status (map (lambda (m)
`((name . ,m)
(status . ,(get-machine-status m))))
machines)))
`((machines . ,machine-status)
(timestamp . ,(date->string (current-date)))
(total-machines . ,(length machines))
(online-machines . ,(length (filter (lambda (m)
(equal? (assoc-ref m 'status) "online"))
machine-status))))))
;; MCP Tools Registry
(define mcp-tools
`(((name . "deploy-machine")
(description . "Deploy NixOS configuration to a home lab machine")
(inputSchema . ((type . "object")
(properties . ((machine . ((type . "string")
(description . "Machine hostname to deploy to")))
(method . ((type . "string")
(enum . ("deploy-rs" "hybrid-update" "legacy"))
(description . "Deployment method to use")))))
(required . ("machine" "method")))))
((name . "list-machines")
(description . "List all available machines in the home lab")
(inputSchema . ((type . "object")
(properties . ()))))
((name . "check-status")
(description . "Check status of home lab infrastructure")
(inputSchema . ((type . "object")
(properties . ((machine . ((type . "string")
(description . "Specific machine to check (optional)")))))))
((name . "generate-nix-config")
(description . "Generate NixOS configuration for a new machine")
(inputSchema . ((type . "object")
(properties . ((machine-name . ((type . "string")
(description . "Name for the new machine")))
(services . ((type . "array")
(items . ((type . "string")))
(description . "List of services to enable")))))
(required . ("machine-name")))))
((name . "list-services")
(description . "List available NixOS services")
(inputSchema . ((type . "object")
(properties . ()))))))
;; MCP Resources Registry
(define mcp-resources
`(((uri . "homelab://status/all")
(name . "Infrastructure Status")
(description . "Complete status of all home lab machines and services")
(mimeType . "application/json"))
((uri . "homelab://status/summary")
(name . "Status Summary")
(description . "Summary of infrastructure health")
(mimeType . "text/plain"))
((uri . "homelab://context/copilot")
(name . "Copilot Context")
(description . "Context information for GitHub Copilot integration")
(mimeType . "text/markdown"))))
;; Tool execution dispatcher
(define (execute-tool name arguments)
"Execute a registered MCP tool"
(match name
("deploy-machine"
(let ((machine (assoc-ref arguments 'machine))
(method (assoc-ref arguments 'method)))
(deploy-machine machine method)))
("list-machines"
`((machines . ,(list-machines))))
("check-status"
(let ((machine (assoc-ref arguments 'machine)))
(if machine
`((machine . ,machine)
(status . ,(get-machine-status machine)))
(get-infrastructure-status))))
("generate-nix-config"
(let ((machine-name (assoc-ref arguments 'machine-name))
(services (or (assoc-ref arguments 'services) '())))
(generate-nix-config machine-name services)))
("list-services"
`((services . ("nginx" "postgresql" "redis" "mysql" "docker" "kubernetes"
"grafana" "prometheus" "gitea" "nextcloud" "jellyfin"))))
(_ (throw 'unknown-tool "Tool not found" name))))
;; Resource content providers
(define (get-resource-content uri)
"Get content for a resource URI"
(match uri
("homelab://status/all"
`((content . ,(get-infrastructure-status))))
("homelab://status/summary"
(let ((status (get-infrastructure-status)))
`((content . ,(format #f "Home Lab Status: ~a/~a machines online"
(assoc-ref status 'online-machines)
(assoc-ref status 'total-machines))))))
("homelab://context/copilot"
(let ((status (get-infrastructure-status)))
`((content . ,(format #f "# Home Lab Infrastructure Context
## Current Status
- Total Machines: ~a
- Online Machines: ~a
- Last Updated: ~a
## Available Operations
Use the home lab extension commands or MCP tools for:
- Deploying configurations (deploy-machine)
- Checking infrastructure status (check-status)
- Generating new machine configs (generate-nix-config)
- Managing services across the fleet
## Machine List
~a
This context helps GitHub Copilot understand your home lab infrastructure state."
(assoc-ref status 'total-machines)
(assoc-ref status 'online-machines)
(assoc-ref status 'timestamp)
(string-join
(map (lambda (m)
(format #f "- ~a: ~a"
(assoc-ref m 'name)
(assoc-ref m 'status)))
(assoc-ref status 'machines))
"\n"))))))
(_ (throw 'unknown-resource "Resource not found" uri))))
;; MCP Protocol Handlers
(define (handle-initialize params)
"Handle MCP initialize request"
`((protocolVersion . ,mcp-protocol-version)
(capabilities . ((tools . ((listChanged . #f)))
(resources . ((subscribe . #f)
(listChanged . #f)))
(prompts . ((listChanged . #f)))))
(serverInfo . ,server-info)))
(define (handle-tools-list params)
"Handle tools/list request"
`((tools . ,mcp-tools)))
(define (handle-tools-call params)
"Handle tools/call request"
(let ((name (assoc-ref params 'name))
(arguments (assoc-ref params 'arguments)))
(execute-tool name arguments)))
(define (handle-resources-list params)
"Handle resources/list request"
`((resources . ,mcp-resources)))
(define (handle-resources-read params)
"Handle resources/read request"
(let ((uri (assoc-ref params 'uri)))
(get-resource-content uri)))
;; Main request dispatcher
(define (handle-request request)
"Main request handler"
(let ((method (assoc-ref request 'method))
(params (assoc-ref request 'params))
(id (assoc-ref request 'id)))
(catch #t
(lambda ()
(let ((result
(match method
("initialize" (handle-initialize params))
("tools/list" (handle-tools-list params))
("tools/call" (handle-tools-call params))
("resources/list" (handle-resources-list params))
("resources/read" (handle-resources-read params))
(_ (throw 'method-not-found "Method not supported" method)))))
(send-response (make-response id result))))
(lambda (key . args)
(send-response (make-error id -32603 (format #f "~a: ~a" key args)))))))
;; Main server loop
(define (run-mcp-server)
"Run the MCP server main loop"
(let loop ()
(let ((line (read-line)))
(unless (eof-object? line)
(catch #t
(lambda ()
(let ((request (json-string->scm line)))
(handle-request request)))
(lambda (key . args)
(send-response (make-error 0 -32700 "Parse error"))))
(loop)))))
;; Export main function for use as module
(define-public run-mcp-server run-mcp-server)
;; Run server if called directly
(when (equal? (car (command-line)) (current-filename))
(run-mcp-server))