;;; ai-mcp.el --- MCP server integration for GPTel -*- lexical-binding: t; coding: utf-8; -*- ;; Author: Craig Jennings ;; Maintainer: Craig Jennings ;; 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