aboutsummaryrefslogtreecommitdiff
path: root/modules/ai-mcp.el
diff options
context:
space:
mode:
authorCraig Jennings <c@cjennings.net>2026-05-17 14:11:21 -0500
committerCraig Jennings <c@cjennings.net>2026-05-17 14:11:21 -0500
commit54d231be98bdde220355102abb8b37f3740db74d (patch)
treedbecd1198dc0965bc1cf7f207332c14d808ef436 /modules/ai-mcp.el
parent2b61aa82afa39a0ff1b165fa9ff09d55d21bfabf (diff)
downloaddotemacs-54d231be98bdde220355102abb8b37f3740db74d.tar.gz
dotemacs-54d231be98bdde220355102abb8b37f3740db74d.zip
feat(ai-mcp): add pure-helper foundation with tests
First of nine phases for wiring mcp.el into GPTel. I scoped this phase to sections 1 (constants and defcustoms) and 3 (pure helpers) of the seven-section outline in the design doc. The other five sections ship in later phases. The module loads only under the test harness for now. init.el wiring waits for Phase 4. What I added: - cj/mcp-server-specs defconst: secret-free description of the 9 servers (linear, notion, figma, slack-deepsat, drawio, google-calendar, google-docs-personal, google-docs-work, google-keep). - Seven defcustoms: claude-config path, enabled-servers list, start-on-entry-points scope, two timeouts, per-tool confirm overrides, audit-log toggle. - cj/mcp--read-claude-config with an mtime cache and structured (:ok t/nil :reason ...) returns. - cj/mcp--get-server-entry, get-env, and get-secret-arg for pulling server data from the parsed config (figma's API key lives in args, not env). - cj/mcp--build-server-alist: pure transformer from specs plus config to the alist mcp-hub-servers expects. - cj/mcp--confirm-p classifier with write-pattern, read-pattern, and unknown-fails-closed branches, plus a cj/mcp-tool-confirm-overrides alist override. - cj/mcp--normalize-description prefixing tool descriptions with [SERVER], [SERVER WRITE], or [SERVER ?]. - cj/mcp--redact masking --token, --secret, --password, and --figma-api-key flags, Authorization headers, and ?token= URL params. Tests in tests/test-ai-mcp-helpers.el (41 ERT tests, all green): fixtures via make-temp-file, no real ~/.claude.json reads, no subprocesses, no network. Sentinel REDACTED_TEST_SECRET never appears in any redactor output. Design doc: docs/design/mcp-el-gptel-integration.org
Diffstat (limited to 'modules/ai-mcp.el')
-rw-r--r--modules/ai-mcp.el416
1 files changed, 416 insertions, 0 deletions
diff --git a/modules/ai-mcp.el b/modules/ai-mcp.el
new file mode 100644
index 00000000..3b552d8d
--- /dev/null
+++ b/modules/ai-mcp.el
@@ -0,0 +1,416 @@
+;;; 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