diff options
Diffstat (limited to 'modules/ai-mcp.el')
| -rw-r--r-- | modules/ai-mcp.el | 416 |
1 files changed, 0 insertions, 416 deletions
diff --git a/modules/ai-mcp.el b/modules/ai-mcp.el deleted file mode 100644 index 3b552d8dc..000000000 --- a/modules/ai-mcp.el +++ /dev/null @@ -1,416 +0,0 @@ -;;; ai-mcp.el --- MCP server integration for GPTel -*- lexical-binding: t; coding: utf-8; -*- -;; Author: Craig Jennings <c@cjennings.net> -;; Maintainer: Craig Jennings <c@cjennings.net> -;; Version 0.1 -;; Package-Requires: ((emacs "30.1") (mcp "0.1.0") (gptel "0.9.8")) -;; Keywords: convenience, tools, ai -;; -;;; Commentary: -;; Wires mcp.el's MCP server inventory into GPTel. GPTel agents gain -;; access to the MCP servers Claude Code already uses (linear, notion, -;; figma, slack-deepsat, drawio, google-calendar, google-docs-personal, -;; google-docs-work, google-keep), with write-confirmation gating and a -;; doctor for diagnosing prerequisites. -;; -;; Design doc: docs/design/mcp-el-gptel-integration.org -;; -;; File organization (seven sections, populated by phases): -;; 1. Constants and defcustoms <- this phase -;; 2. Public commands <- later phase -;; 3. Pure helpers <- this phase -;; 4. mcp.el compatibility layer <- later phase -;; 5. Registration pipeline <- later phase -;; 6. Async state machine <- later phase -;; 7. UI <- later phase - -;;; Code: - -(require 'cl-lib) -(require 'json) - -;;;; --- 1. Constants and defcustoms ----------------------------------- - -(defgroup cj/ai-mcp nil - "MCP server integration for GPTel." - :group 'gptel - :prefix "cj/") - -(defcustom cj/mcp-claude-config - (expand-file-name "~/.claude.json") - "Path to the Claude Code config that holds MCP server env vars. -The config is read at server-spawn time and cached by mtime." - :type 'file - :group 'cj/ai-mcp) - -(defconst cj/mcp-server-specs - '((:name "linear" - :transport http - :url "https://mcp.linear.app/mcp" - :auth in-protocol - :risk write-capable) - (:name "notion" - :transport http - :url "https://mcp.notion.com/mcp" - :auth in-protocol - :risk write-capable) - (:name "figma" - :transport stdio - :command "npx" - :args ("-y" "figma-developer-mcp" "--stdio") - :secret-args ("--figma-api-key" :figma-api-key) - :auth args-token - :risk arg-leak) - (:name "slack-deepsat" - :transport sse - :url "http://127.0.0.1:13080/sse" - :auth local - :risk write-capable) - (:name "drawio" - :transport stdio - :command "npx" - :args ("-y" "@drawio/mcp") - :auth none - :risk none) - (:name "google-calendar" - :transport stdio - :command "npx" - :args ("-y" "@cocal/google-calendar-mcp") - :env (:GOOGLE_OAUTH_CREDENTIALS t) - :auth oauth - :risk write-capable) - (:name "google-docs-personal" - :transport stdio - :command "npx" - :args ("-y" "@a-bonus/google-docs-mcp") - :env (:GOOGLE_CLIENT_ID t :GOOGLE_CLIENT_SECRET t :GOOGLE_MCP_PROFILE t) - :auth oauth - :risk write-capable) - (:name "google-docs-work" - :transport stdio - :command "npx" - :args ("-y" "@a-bonus/google-docs-mcp") - :env (:GOOGLE_CLIENT_ID t :GOOGLE_CLIENT_SECRET t :GOOGLE_MCP_PROFILE t) - :auth oauth - :risk write-capable) - (:name "google-keep" - :transport stdio - :command "uvx" - :args ("--from" "keep-mcp" "python" "-m" "server.cli") - :env (:GOOGLE_EMAIL t :GOOGLE_MASTER_TOKEN t) - :auth token - :risk write-capable)) - "Static, secret-free description of the MCP servers we wire to GPTel. -Each entry is a plist describing one server. `:env' values are -placeholders (t) replaced at spawn time from `cj/mcp-claude-config'. -`:secret-args' (e.g. for figma) names the flag whose value is pulled -from the Claude config's args at spawn time.") - -(defcustom cj/mcp-enabled-servers - (mapcar (lambda (s) (plist-get s :name)) cj/mcp-server-specs) - "List of MCP server names to start. -Defaults to every server in `cj/mcp-server-specs'. Set to a -shorter list to disable specific servers without editing the -spec. Changes take effect on next `cj/mcp-restart-failed' or -Emacs restart." - :type '(repeat string) - :group 'cj/ai-mcp) - -(defcustom cj/mcp-start-on-entry-points - '(toggle-gptel) - "GPTel entry points that trigger MCP startup. -Symbols correspond to commands: `toggle-gptel', `gptel-send', -`gptel-quick-ask', `gptel-rewrite-with-directive', -`gptel-magit-generate-message'. Default: only full chat -\(`toggle-gptel')." - :type '(repeat symbol) - :group 'cj/ai-mcp) - -(defcustom cj/mcp-startup-timeout 30 - "Seconds before a still-starting MCP server is marked failed." - :type 'integer - :group 'cj/ai-mcp) - -(defcustom cj/mcp-tool-timeout 60 - "Seconds before an in-flight MCP tool call times out." - :type 'integer - :group 'cj/ai-mcp) - -(defcustom cj/mcp-tool-confirm-overrides nil - "Per-tool confirmation overrides. -Alist mapping fully qualified MCP tool name (e.g., -\"mcp__linear__create_issue\") to t or nil. Wins over the -pattern-based classifier in `cj/mcp--confirm-p'." - :type '(alist :key-type string :value-type boolean) - :group 'cj/ai-mcp) - -(defcustom cj/mcp-tool-audit-log-enabled t - "When non-nil, append metadata for every MCP tool call to the audit log." - :type 'boolean - :group 'cj/ai-mcp) - -;; Classifier patterns: name prefixes that indicate read vs write. - -(defconst cj/mcp--write-name-patterns - '("\\`create\\b" "\\`update\\b" "\\`delete\\b" "\\`remove\\b" - "\\`send\\b" "\\`post\\b" "\\`add\\b" "\\`move\\b" - "\\`invite\\b" "\\`share\\b" "\\`upload\\b" "\\`set\\b" - "\\`patch\\b" "\\`import\\b" "\\`sync\\b" "\\`merge\\b" - "\\`close\\b" "\\`reopen\\b" "\\`archive\\b" "\\`unarchive\\b" - "\\`approve\\b" "\\`reject\\b" "\\`label\\b" "\\`assign\\b" - "\\`reply\\b" "\\`comment\\b" "\\`trash\\b" "\\`restore\\b" - "\\`pin\\b" "\\`unpin\\b" "\\`copy\\b" "\\`rename\\b") - "Tool-name prefixes that indicate a write/mutate operation. -Matched after the `mcp__SERVER__' prefix is stripped.") - -(defconst cj/mcp--read-name-patterns - '("\\`get\\b" "\\`list\\b" "\\`read\\b" "\\`search\\b" - "\\`find\\b" "\\`fetch\\b" "\\`view\\b" "\\`query\\b" - "\\`describe\\b" "\\`show\\b" "\\`check\\b") - "Tool-name prefixes that indicate a read-only operation.") - -;; Secret-pattern list for redaction. Each entry is (REGEX -;; . GROUP-NUMBER); the substring matched by GROUP-NUMBER is replaced -;; with "***". - -(defconst cj/mcp--secret-redaction-patterns - '(("\\(--token\\)\\(=\\|\\s-+\\)\\(\\S-+\\)" . 3) - ("\\(--secret\\)\\(=\\|\\s-+\\)\\(\\S-+\\)" . 3) - ("\\(--password\\)\\(=\\|\\s-+\\)\\(\\S-+\\)" . 3) - ("\\(--figma-api-key\\)\\(=\\|\\s-+\\)\\(\\S-+\\)" . 3) - ("\\(Authorization:\\s-*\\)\\(\\S-[^\"\n]*\\)" . 2) - ("\\([?&]token=\\)\\([^&[:space:]\"]+\\)" . 2)) - "List of (REGEX . GROUP-NUMBER) for masking secrets in user-facing strings. -Applied in order by `cj/mcp--redact'.") - -;;;; --- 3. Pure helpers ----------------------------------------------- - -;; ---- secrets redaction ---- - -(defun cj/mcp--redact (str) - "Return STR with known secret patterns replaced by `***'. -Returns nil when STR is not a string. See -`cj/mcp--secret-redaction-patterns' for the matched patterns." - (when (stringp str) - (let ((result str)) - (dolist (entry cj/mcp--secret-redaction-patterns result) - (let ((re (car entry)) - (group (cdr entry)) - (start 0)) - (while (and (< start (length result)) - (string-match re result start)) - (setq result - (concat (substring result 0 (match-beginning group)) - "***" - (substring result (match-end group)))) - (setq start (+ (match-beginning group) 3)))))))) - -;; ---- confirm-policy classifier ---- - -(defun cj/mcp--strip-name-prefix (name) - "Strip the `mcp__SERVER__' prefix from NAME, if present." - (replace-regexp-in-string "\\`mcp__[^_]+__" "" name)) - -(defun cj/mcp--name-matches-p (name patterns) - "Non-nil if NAME matches any regexp in PATTERNS." - (cl-some (lambda (p) (string-match-p p name)) patterns)) - -(defun cj/mcp--confirm-p (gptel-name &optional remote-name) - "Return non-nil if a tool should register with `:confirm t'. -GPTEL-NAME is the fully qualified `mcp__SERVER__TOOL' string. -REMOTE-NAME, if provided, overrides the prefix-strip of GPTEL-NAME. - -Decision order: -1. `cj/mcp-tool-confirm-overrides' alist entry wins. -2. Bare name matches a write pattern → t. -3. Bare name matches a read pattern → nil. -4. Neither → t (fail closed)." - (let ((override (assoc gptel-name cj/mcp-tool-confirm-overrides))) - (cond - (override (cdr override)) - (t - (let ((bare (or remote-name (cj/mcp--strip-name-prefix gptel-name)))) - (cond - ((cj/mcp--name-matches-p bare cj/mcp--write-name-patterns) t) - ((cj/mcp--name-matches-p bare cj/mcp--read-name-patterns) nil) - (t t))))))) - -;; ---- description normalizer ---- - -(defun cj/mcp--normalize-description (server-name raw-tool) - "Return a normalized description string for RAW-TOOL from SERVER-NAME. -Prefix `[SERVER]' for reads, `[SERVER WRITE]' for writes, -`[SERVER ?]' for unknown classification, then the upstream -description unchanged." - (let* ((remote-name (plist-get raw-tool :name)) - (upstream (or (plist-get raw-tool :description) - "(no description provided by server)")) - (suffix (cond - ((cj/mcp--name-matches-p remote-name - cj/mcp--write-name-patterns) - " WRITE") - ((cj/mcp--name-matches-p remote-name - cj/mcp--read-name-patterns) - "") - (t " ?")))) - (format "[%s%s] %s" server-name suffix upstream))) - -;; ---- Claude config reader (mtime-cached, structured returns) ---- - -(defvar cj/mcp--config-cache nil - "Cache for the parsed Claude config. -Plist of (:path P :mtime M :data PARSED) or nil when empty.") - -(defun cj/mcp--invalidate-config-cache () - "Force the next `cj/mcp--read-claude-config' call to reparse." - (setq cj/mcp--config-cache nil)) - -(defun cj/mcp--read-claude-config (&optional path) - "Return a structured plist describing the Claude config state. -PATH defaults to `cj/mcp-claude-config'. - -Result shape: - (:ok t :data PLIST) - (:ok nil :reason missing-file) - (:ok nil :reason unreadable) - (:ok nil :reason malformed-json :message STR) - -The parsed result is cached by (PATH, MTIME); subsequent calls -reparse only if the file has changed." - (let ((path (or path cj/mcp-claude-config))) - (cond - ((not (file-exists-p path)) - (list :ok nil :reason 'missing-file)) - ((not (file-readable-p path)) - (list :ok nil :reason 'unreadable)) - (t - (let ((mtime (file-attribute-modification-time - (file-attributes path)))) - (if (and cj/mcp--config-cache - (equal (plist-get cj/mcp--config-cache :path) path) - (equal (plist-get cj/mcp--config-cache :mtime) mtime)) - (list :ok t :data (plist-get cj/mcp--config-cache :data)) - (condition-case err - (let* ((json-object-type 'plist) - (json-array-type 'list) - (data (with-temp-buffer - (insert-file-contents path) - (goto-char (point-min)) - (json-read)))) - (setq cj/mcp--config-cache - (list :path path :mtime mtime :data data)) - (list :ok t :data data)) - (error - (setq cj/mcp--config-cache nil) - (list :ok nil :reason 'malformed-json - :message (error-message-string err)))))))))) - -;; ---- env / secret-args resolution ---- - -(defun cj/mcp--get-server-entry (server-name &optional config-result) - "Return the parsed Claude-config entry plist for SERVER-NAME. -CONFIG-RESULT, if provided, is a return value from -`cj/mcp--read-claude-config' (avoids re-reading). Returns nil -when the config is unavailable or SERVER-NAME is unknown." - (let ((result (or config-result (cj/mcp--read-claude-config)))) - (when (plist-get result :ok) - (let* ((data (plist-get result :data)) - (servers (plist-get data :mcpServers)) - (server-key (intern (concat ":" server-name)))) - (plist-get servers server-key))))) - -(defun cj/mcp--get-env (server-name &optional config-result) - "Return the env plist for SERVER-NAME from the parsed Claude config. -CONFIG-RESULT, if provided, is reused to avoid re-reading the -config. Returns nil when the config is unavailable, the server -is unknown, or the server has no env section." - (plist-get (cj/mcp--get-server-entry server-name config-result) :env)) - -(defun cj/mcp--get-secret-arg (server-name flag &optional config-result) - "Return the secret value for SERVER-NAME's FLAG from the Claude config. -FLAG is the option name (e.g. \"--figma-api-key\"). Returns the -value following `FLAG=' in the server entry's args, or nil if -not found." - (let* ((entry (cj/mcp--get-server-entry server-name config-result)) - (args (plist-get entry :args)) - (prefix (concat flag "="))) - (cl-some - (lambda (a) - (when (and (stringp a) (string-prefix-p prefix a)) - (substring a (length prefix)))) - args))) - -;; ---- server-alist builder (pure transform from specs + config) ---- - -(defun cj/mcp--resolve-env (env-spec server-name config-result) - "Return a flat (KEY1 VAL1 KEY2 VAL2 ...) list for ENV-SPEC. -ENV-SPEC is a plist of `(:VAR1 t :VAR2 t)`. Values come from -SERVER-NAME's env subtree in the parsed Claude config. Vars -without a value are omitted." - (let ((source-env (cj/mcp--get-env server-name config-result)) - (result nil)) - (cl-loop for (key _placeholder) on env-spec by #'cddr - do (let ((value (plist-get source-env key))) - (when value - (push key result) - (push value result)))) - (nreverse result))) - -(defun cj/mcp--resolve-args (args secret-args-spec server-name config-result) - "Return ARGS with `:secret-args' placeholders filled in. -SECRET-ARGS-SPEC is (FLAG-STRING SLOT-KEYWORD). When the value is -available in the Claude config, append `FLAG=VALUE' to ARGS; -otherwise return ARGS unchanged." - (if (not secret-args-spec) - args - (let* ((flag (car secret-args-spec)) - (value (cj/mcp--get-secret-arg server-name flag config-result))) - (if value - (append args (list (format "%s=%s" flag value))) - args)))) - -(defun cj/mcp--spec-to-alist-entry (spec config-result) - "Translate one SPEC plist into a `(NAME . PLIST)' alist entry. -Pulls env values from CONFIG-RESULT; splices `:secret-args' into -`:args' for stdio specs that declare one." - (let* ((name (plist-get spec :name)) - (transport (plist-get spec :transport)) - (entry (list :type (symbol-name transport))) - (env-spec (plist-get spec :env)) - (secret-args-spec (plist-get spec :secret-args))) - (pcase transport - ('stdio - (setq entry (append entry - (list :command (plist-get spec :command) - :args (cj/mcp--resolve-args - (plist-get spec :args) - secret-args-spec - name - config-result))))) - ((or 'http 'sse) - (setq entry (append entry - (list :url (plist-get spec :url)))))) - (when env-spec - (let ((env-pairs (cj/mcp--resolve-env env-spec name config-result))) - (when env-pairs - (setq entry (append entry (list :env env-pairs)))))) - (cons name entry))) - -(defun cj/mcp--build-server-alist (&optional specs enabled-names config-result) - "Return an alist suitable for `mcp-hub-servers'. -SPECS defaults to `cj/mcp-server-specs'. ENABLED-NAMES defaults -to `cj/mcp-enabled-servers'. CONFIG-RESULT, if provided, is a -parsed Claude-config result (reused for env/secret resolution). -Does not mutate SPECS." - (let* ((specs (or specs cj/mcp-server-specs)) - (enabled-names (or enabled-names cj/mcp-enabled-servers)) - (config-result (or config-result (cj/mcp--read-claude-config)))) - (delq nil - (mapcar - (lambda (spec) - (let ((name (plist-get spec :name))) - (when (member name enabled-names) - (cj/mcp--spec-to-alist-entry spec config-result)))) - specs)))) - -(provide 'ai-mcp) -;;; ai-mcp.el ends here |