diff options
Diffstat (limited to 'traclicker.el')
| -rw-r--r-- | traclicker.el | 62 |
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 |