Finish initial implementation

1 files changed, 54 insertions, 8 deletions

diff --git a/traclicker.el b/traclicker.el
index f06580f..c4b53a4 100644
--- a/traclicker.el
+++ b/traclicker.el
@@ -24,24 +24,40 @@
 
 ;; traclicker is a tool that protects user privacy against email click
 ;; trackers by sending a HEAD request to all urls in these emails and
-;; recording the real urls.
+;; recording the real urls. The real urls are collected into a
+;; database, which is consulted when the user reads emails in gnus. To
+;; substitute all click trackers in an email with the real ones, run
+;; `tracli-wash-gnus-article', bound to "v t" in gnus-summary-mode /
+;; gnus-article-mode.
 
 ;;; Code:
+(require 'gnus)
+(require 'gnus-art)
 (require 'gnus-util)
 (require 'ol)
 (require 'mm-decode)
+(require 'shr)
 
-(defvar tracli-senders
+(defcustom tracli-senders
   nil
-  "List of email addresses.")
+  "List of sender email addresses to scan for links."
+  :type '(repeat string)
+  :group 'traclicker)
 
-(defvar tracli-db-file (locate-user-emacs-file "traclicker.eld")
-  "Database file to read.")
+(defcustom tracli-db-file (locate-user-emacs-file "traclicker.eld")
+  "Database file to read and write."
+  :type 'file
+  :group 'traclicker)
 
-(defvar tracli-maildirs '("~/mail")
+(defcustom tracli-maildirs '("~/mail")
   "List of maildirs to scan and process urls.
 
-Will scan from both cur and new subdirs.")
+Will scan from both cur and new subdirs."
+  :type '(repeat directory)
+  :group 'traclicker)
+
+(defvar tracli-data nil
+  "Data read from and written to `tracli-db-file'.")
 
 (defun tracli-read-data ()
   "Read data from `tracli-db-file'."
@@ -51,6 +67,10 @@ Will scan from both cur and new subdirs.")
       (goto-char (point-min))
       (read (current-buffer)))))
 
+(defun tracli-refresh-data ()
+  "Read into `tracli-data'."
+  (setq tracli-data (tracli-read-data)))
+
 (defun tracli-scan (&optional after)
   "Scan emails and get redirect urls.
 
@@ -58,7 +78,8 @@ Only scan emails that are sent by `tracli-senders', delivered
 after AFTER (in epoch), in `tracli-maildirs'.
 
 If AFTER is nil, use the timestamp in `tracli-db-file', or an
-empty string (i.e. scan all mails)."
+empty string (i.e. scan mails from any time)."
+  (interactive)
   (let* ((sender-re (format "<%s>" (regexp-opt tracli-senders)))
          (counter 0)
          (data (tracli-read-data))
@@ -92,6 +113,7 @@ empty string (i.e. scan all mails)."
     (with-temp-buffer
       (insert (prin1-to-string data))
       (write-region nil nil tracli-db-file))
+    (setq tracli-data data)
     (message "Processed %d mails" counter)))
 
 (defun tracli-get-redirect-url (url)
@@ -190,5 +212,29 @@ text/html;\\s-*charset=\\([^\t\n\r \"'>]+\\)[^>]*>" nil t)
         (replace-match "" t t))
       (buffer-substring-no-properties (point-min) (point-max)))))
 
+(defun tracli-wash-gnus-article ()
+  "Wash gnus article by replacing links with those in the `tracli-data'."
+  (interactive)
+  (with-current-buffer gnus-article-buffer
+    (save-excursion
+      (when-let ((inhibit-read-only t)
+                 (urls (alist-get 'urls tracli-data)))
+        (article-goto-body)
+        (while (re-search-forward org-link-plain-re nil t)
+          (let ((matched (match-string-no-properties 0)))
+            (when-let ((new-url (gethash matched urls)))
+              (replace-match new-url))))
+        (article-goto-body)
+        (let ((match))
+          (while (setq match (text-property-search-forward 'shr-url))
+            (when-let ((start (prop-match-beginning match))
+                       (end (prop-match-end match))
+                       (new-url (gethash (prop-match-value match) urls)))
+              (put-text-property start end 'shr-url new-url)
+              (put-text-property start end 'help-echo new-url))))))
+    (gnus-article-add-buttons)))
+
+(define-key gnus-summary-mode-map (kbd "v t") #'tracli-wash-gnus-article)
+
 (provide 'traclicker)
 ;;; traclicker.el ends here