;;; pkg-social.el --- Social media and security tools -*- lexical-binding: t -*- ;; Copyright (C) 2026 Cytrogen ;; This file contains: ;; - Mastodon client configuration ;; - GPG/EPA security setup ;; - Social media integrations ;;; Commentary: ;; Configuration for social media tools and security features. ;; Includes comprehensive GPG setup with Windows compatibility. ;;; Code: ;; Dependencies (require 'cl-lib) ; 确保cl-some函数可用 ;; GPG Configuration ;; Cross-platform GPG setup with error handling (defun my/setup-gpg () "配置GPG，优先查找Windows常见安装路径。" (interactive) (require 'epa-file) ;; 1. 定义查找列表：优先找用户实际安装位置 (let* ((candidates '("D:/GnuPG/bin/gpg.exe" ; 用户实际安装位置 (最高优先级) "C:/Program Files (x86)/GnuPG/bin/gpg.exe" ; Gpg4win 默认路径 (64位系统) "C:/Program Files/GnuPG/bin/gpg.exe" ; Gpg4win 备选路径 "gpg")) ; 系统 PATH ;; 找到第一个存在的路径 (found-gpg (cl-some (lambda (path) (if (string-match-p "/" path) (and (file-exists-p path) path) (executable-find path))) candidates))) (if found-gpg (progn ;; Add GPG path to exec-path for proper discovery (let ((gpg-dir (file-name-directory found-gpg))) (when (and gpg-dir (not (member gpg-dir exec-path))) (add-to-list 'exec-path gpg-dir))) ;; Use custom-set-variables for EPA configuration (StackOverflow solution) (custom-set-variables `(epg-gpg-program ,found-gpg) '(epa-pinentry-mode 'loopback) '(epg-debug t) `(epg-gpg-home-directory ,(or (getenv "GNUPGHOME") (expand-file-name "~/.gnupg"))) '(epa-file-cache-passphrase-for-symmetric-encryption t) '(epa-file-select-keys 'silent) '(epa-file-encrypt-to nil) '(epa-armor t) '(epg-user-id nil)) ;; Enable encrypted file support (require 'epa-file) (epa-file-enable) (message "GPG configured successfully. Path: %s" found-gpg)) ;; GPG not found handling (message "Warning: GPG executable not found. Mastodon will not be able to save credentials securely.") (message "Please check if Gpg4win is installed and confirm the installation path.")))) ;; GPG Management Tools (defun my/check-or-create-gpg-keys () "检测GPG密钥，如果没有则提示创建。" (interactive) (when epg-gpg-program (condition-case err (let* ((context (epg-make-context)) (keys (epg-list-keys context))) (if keys (progn (message "Found %d GPG keys" (length keys)) (dolist (key keys) (let ((user-ids (epg-key-user-id-list key))) (when user-ids (message "Key: %s" (epg-user-id-string (car user-ids))))))) ;; 没有密钥，提供创建选项 (when (yes-or-no-p "未找到GPG密钥，是否创建新密钥对? ") (my/create-gpg-keypair)))) (error (message "Error checking GPG keys: %s" (error-message-string err)))))) (defun my/create-gpg-keypair () "创建新的GPG密钥对。" (interactive) (let* ((name (read-string "输入姓名: ")) (email (read-string "输入邮箱: ")) (passphrase (read-passwd "输入密码(可选，直接回车跳过): ")) (batch-config (format "%%echo Generating GPG key Key-Type: RSA Key-Length: 2048 Subkey-Type: RSA Subkey-Length: 2048 Name-Real: %s Name-Email: %s %s Expire-Date: 0 %%commit %%echo Done" name email (if (string-empty-p passphrase) "%no-protection" (format "Passphrase: %s" passphrase)))) (temp-file (make-temp-file "gpg-batch" nil ".txt"))) (with-temp-file temp-file (insert batch-config)) (message "Creating GPG keypair, please wait...") (let ((result (shell-command (format "\"%s\" --batch --generate-key \"%s\"" epg-gpg-program temp-file)))) (delete-file temp-file) (if (= result 0) (progn (message "GPG keypair created successfully!") (my/check-or-create-gpg-keys)) (message "Failed to create GPG keypair. Please check configuration"))))) (defun my/check-gpg-config () "检查和修复GPG配置文件。" (interactive) (let* ((gpg-home (or (getenv "GNUPGHOME") (expand-file-name "~/.gnupg"))) (gpg-conf (expand-file-name "gpg.conf" gpg-home)) (gpg-agent-conf (expand-file-name "gpg-agent.conf" gpg-home))) ;; 确保.gnupg目录存在 (unless (file-directory-p gpg-home) (make-directory gpg-home t) (message "Created GPG home directory: %s" gpg-home)) ;; 检查和创建gpg.conf (unless (file-exists-p gpg-conf) (with-temp-file gpg-conf (insert "# GPG配置文件\n") (insert "use-agent\n") (insert "armor\n") (insert "keyid-format long\n")) (message "Created gpg.conf configuration file")) ;; 检查和创建gpg-agent.conf (Windows需要) (unless (file-exists-p gpg-agent-conf) (with-temp-file gpg-agent-conf (insert "# GPG Agent配置文件\n") (insert "default-cache-ttl 28800\n") (insert "max-cache-ttl 86400\n") (when (eq system-type 'windows-nt) (insert "pinentry-program C:/Program Files (x86)/Gpg4win/bin/pinentry-basic.exe\n"))) (message "Created gpg-agent.conf configuration file")) (message "GPG configuration check completed"))) (defun my/fix-epa-issues () "一键诊断和修复EPA配置问题。" (interactive) (message "Starting EPA diagnostics and repair...") ;; 重新配置GPG (my/setup-gpg) ;; 检查配置文件 (my/check-gpg-config) ;; 检查密钥 (my/check-or-create-gpg-keys) ;; 重新初始化EPA (when (fboundp 'epa-file-disable) (epa-file-disable)) (epa-file-enable) ;; 测试EPA功能 (run-with-timer 3 nil (lambda () (condition-case err (progn (epg-make-context) (message "EPA repair completed! Please test Mastodon functionality")) (error (message "EPA still has issues: %s" (error-message-string err)) (message "Suggestion: manually check GPG installation and key configuration")))))) ;; Initialize GPG configuration (my/setup-gpg) ;; Mastodon Configuration ;; Social media client with modern UI (unless (package-installed-p 'mastodon) (package-install 'mastodon)) (with-eval-after-load 'mastodon (setq mastodon-instance-url "https://m.otter.homes" mastodon-active-user "cytrogen") ;; 界面设置 (setq mastodon-client-width-mode nil) ;; --- UI Modernization (Avatars & Images) --- ;; 1. Enable Avatars (setq mastodon-tl--show-avatars t) ;; 2. Optimize Image Preview (setq mastodon-media-format-type 'preview) ;; 智能EPA绕过和错误隔离 (defvar my/mastodon-encryption-attempted nil "记录是否已尝试启用加密。") (defun my/test-mastodon-encryption () "测试Mastodon是否能安全使用GPG加密。" (condition-case err (progn (epg-make-context) (epg-list-keys (epg-make-context)) t) ; 成功返回t (error nil))) ; 失败返回nil ;; 根据EPA功能自动选择加密方式 (if (and (not my/mastodon-encryption-attempted) (my/test-mastodon-encryption)) (progn (setq mastodon-client-file-encryption t) (setq my/mastodon-encryption-attempted t) (message "Mastodon enabled GPG encrypted storage")) (progn (setq mastodon-client-file-encryption nil) (setq my/mastodon-encryption-attempted t) (message "Mastodon using plaintext storage (EPA unavailable or problematic)"))) ;; 运行时错误隔离 (condition-case gpg-err (when mastodon-client-file-encryption (when (and epg-gpg-program (file-exists-p epg-gpg-program)) (message "Mastodon GPG configuration validation completed"))) (error (setq mastodon-client-file-encryption nil) ; 自动fallback到明文 (message "Detected EPA issues, automatically switching to plaintext storage: %s" (error-message-string gpg-err))))) ;; Nerd Icons Integration (unless (package-installed-p 'nerd-icons) (package-install 'nerd-icons)) (defun my/verify-nerd-font () "Check if Symbols Nerd Font is available." (interactive) (let* ((font-name "Symbols Nerd Font Mono") (font (find-font (font-spec :name font-name)))) (if font (message "成功! Emacs 已找到字体: %s" font) (message "失败! Emacs 找不到 '%s'。请确认已选择'为所有用户安装'并重启了 Emacs。" font-name)))) (with-eval-after-load 'nerd-icons ;; (setq nerd-icons-font-family "Your Nerd Font Name") ) (with-eval-after-load 'mastodon (require 'nerd-icons) ;; 1. Replace text symbols with Nerd Icons (setq mastodon-tl--symbols `((reply . (,(nerd-icons-faicon "nf-fa-reply") . "R")) (boost . (,(nerd-icons-faicon "nf-fa-retweet") . "B")) (reblog . (,(nerd-icons-faicon "nf-fa-retweet") . "B")) (favourite . (,(nerd-icons-faicon "nf-fa-star") . "F")) (bookmark . (,(nerd-icons-faicon "nf-fa-bookmark") . "K")) (media . (,(nerd-icons-faicon "nf-fa-file_image_o") . "[media]")) (verified . (,(nerd-icons-octicon "nf-oct-verified") . "V")) (locked . (,(nerd-icons-faicon "nf-fa-lock") . "[locked]")) (private . (,(nerd-icons-faicon "nf-fa-lock") . "[followers]")) (mention . (,(nerd-icons-faicon "nf-fa-at") . "[mention]")) (direct . (,(nerd-icons-faicon "nf-fa-envelope") . "[direct]")) (edited . (,(nerd-icons-faicon "nf-fa-pencil") . "[edited]")) (update . (,(nerd-icons-faicon "nf-fa-pencil") . "[edited]")) (status . (,(nerd-icons-faicon "nf-fa-bell") . "[posted]")) (poll . (,(nerd-icons-faicon "nf-fa-bar_chart") . "[poll]")) (follow . (,(nerd-icons-faicon "nf-fa-user_plus") . "+")) (follow_request . (,(nerd-icons-faicon "nf-fa-user_plus") . "+")) (severed_relationships . (,(nerd-icons-faicon "nf-fa-chain_broken") . "//")) (moderation_warning . (,(nerd-icons-faicon "nf-fa-exclamation_triangle") . "!!")) (reply-bar . ("┃" . "|")))) ;; 2. Modernize Faces ;; Use variable width font for main text (if desired) (add-hook 'mastodon-mode-hook #'variable-pitch-mode) ;; Make headers stand out (set-face-attribute 'mastodon-display-name-face nil :height 1.2 :weight 'bold) (set-face-attribute 'mastodon-handle-face nil :height 0.9 :slant 'italic :foreground "gray60") ;; Improve metadata visibility (set-face-attribute 'mastodon-toot-docs-face nil :height 0.85 :foreground "gray50") ;; Fix alignment for icons if needed (when (display-graphic-p) (setq mastodon-tl--enable-proportional-fonts t))) ;; Security Tools ;; Additional security and privacy features (defun my/check-gpg-status () "检查并显示当前GPG配置状态。" (interactive) (with-output-to-temp-buffer "*GPG状态检查*" (princ "=== GPG状态检查 ===\n\n") ;; 使用与my/setup-gpg相同的查找逻辑 (princ "1. GPG程序检查（按优先级顺序）:\n") (let* ((candidates '("D:/GnuPG/bin/gpg.exe" ; 用户实际安装位置 "C:/Program Files (x86)/GnuPG/bin/gpg.exe" "C:/Program Files/GnuPG/bin/gpg.exe" "gpg")) (found-paths '())) ;; 检查每个候选路径 (dolist (path candidates) (let ((exists (if (string-match-p "/" path) (file-exists-p path) (executable-find path)))) (if exists (progn (princ (format " Found: %s\n" path)) (push path found-paths)) (princ (format " ✗ %s\n" path))))) ;; 显示当前使用的路径 (princ "\n2. 当前Emacs配置:\n") (if epg-gpg-program (progn (princ (format " Using path: %s\n" epg-gpg-program)) (condition-case err (let ((version (shell-command-to-string (format "\"%s\" --version" epg-gpg-program)))) (princ (format " Version: %s" (car (split-string version "\n"))))) (error (princ (format " Warning: version check failed: %s\n" (error-message-string err)))))) (princ " ✗ epg-gpg-program 未设置\n")) (princ (format " epa-pinentry-mode: %s\n" epa-pinentry-mode)) ;; Mastodon相关设置 (princ "\n3. Mastodon配置:\n") (if (boundp 'mastodon-client-file-encryption) (princ (format " Encryption setting: %s\n" (if mastodon-client-file-encryption "GPG加密" "明文存储（当前设置）"))) (princ " ✓ 加密设置: 默认（依赖GPG）\n")) ;; 给出建议 (princ "\n=== 状态总结 ===\n") (cond ((not (boundp 'mastodon-client-file-encryption)) (princ "⚠️ Mastodon包未加载，无法确定加密设置\n")) ((not mastodon-client-file-encryption) (princ "OK: Mastodon configured for plaintext storage, should work normally\n") (princ " For GPG encryption, run M-x my/test-gpg-basic to diagnose issues\n")) ((and epg-gpg-program (file-exists-p epg-gpg-program)) (princ "OK: GPG configured, mastodon should work with encryption\n")) (found-paths (princ "Warning: Found GPG but not properly configured, please restart Emacs\n")) (t (princ "Error: GPG not found, suggest enabling plaintext storage\n")))) (princ "\nRun M-x my/setup-gpg to reconfigure GPG\n"))) (defun my/test-gpg-basic () "Test basic GPG functionality to help troubleshoot issues." (interactive) (with-output-to-temp-buffer "*GPG Basic Test*" (princ "=== GPG Basic Functionality Test ===\n\n") ;; 测试GPG版本 (princ "1. GPG Version Test:\n") (condition-case err (let ((version-output (shell-command-to-string (format "\"%s\" --version" epg-gpg-program)))) (princ (format " Version info:\n%s\n" version-output))) (error (princ (format " Error: Version check failed: %s\n" (error-message-string err))))) ;; 测试密钥列表 (princ "2. Key Check:\n") (condition-case err (let ((keys-output (shell-command-to-string (format "\"%s\" --list-keys" epg-gpg-program)))) (if (string-match "gpg: error" keys-output) (princ " Warning: Key list has warnings, but this is usually normal\n") (princ " Key list access normal\n"))) (error (princ (format " Error: Key check failed: %s\n" (error-message-string err))))) ;; 测试Emacs EPA (princ "3. Emacs EPA Test:\n") (condition-case err (progn (require 'epg) (let ((context (epg-make-context))) (princ " EPA context created successfully\n"))) (error (princ (format " Error: EPA test failed: %s\n" (error-message-string err))))) ;; 给出建议 (princ "\n=== Suggestions ===\n") (princ "If GPG basic functionality works but mastodon still has issues:\n") (princ "1. Plaintext storage is currently enabled, mastodon should work normally\n") (princ "2. For full GPG support, you may need to generate GPG keypair\n") (princ "3. Run: gpg --full-generate-key (in command line)\n") (princ "4. Or continue using plaintext storage (usually secure enough for personal use)\n"))) (provide 'pkg-social) ;;; pkg-social.el ends here