Download and tag mail script

1 files changed, 230 insertions, 0 deletions

diff --git a/bin/tagmail b/bin/tagmail
new file mode 100755
index 0000000..e6b4c50
--- /dev/null
+++ b/bin/tagmail
@@ -0,0 +1,230 @@
+#!/usr/bin/guile \
+-e main -s
+!#
+;; TODO
+;; - Check for bogofilter installation
+;; - Check for compilation a notmuch dev package or package all or learn just to compile without the guild call
+;; - Spam moving check on other folders like work
+;; - individual tag-rules testing take the ones with [] subject
+
+(add-to-load-path
+ (string-append
+  (passwd:dir (getpwuid (geteuid)))
+  "/dev/helpful_scripts/guile/" ))
+
+(use-modules
+ (ffi notmuch)
+ (ice-9 and-let-star)
+ (ice-9 ftw)
+ (ice-9 getopt-long)
+ (ice-9 match)
+ (ice-9 popen)
+ (ice-9 ports)
+ (ice-9 rdelim)
+ (ice-9 regex)
+ (mail-tools)
+ (srfi srfi-1)
+ (system ffi-help-rt)
+ (system foreign)
+ (term ansi-color))
+
+(define (pcmd dry-run str)
+  (apply colorize-string
+         (if dry-run
+             `(,str BOLD)
+             `(,str RED BOLD))))
+
+(define (on-all-messages-filenames query proc proc-name dry-run)
+  (nm-iter messages (nm-result-messages query)
+           (lambda (message*)
+             (let ((subject (nm-header message* "subject"))
+                   (files (nm-iter filenames (notmuch_message_get_filenames message*)
+                                   pointer->string)))
+               (display (string-append
+                         (pcmd dry-run (format #f " [~a] " proc-name))
+                         subject
+                         "\n"))
+               (unless dry-run
+                 (map proc files))
+               (list subject files)))))
+
+(define (delete-email-files! options)
+  (let* ((ffi-db (nm-open-database (assq-ref options 'mail-repo) 0))
+         (to-delete (nm-query-db ffi-db "tag:deleted")))
+    (display (string-append
+              (colorize-string "[DELETE] " 'BOLD 'YELLOW)
+              (number->string (nm-count-messages to-delete))
+              " files marked\n"))
+    (on-all-messages-filenames to-delete delete-file "rm" (option-ref options 'dry-run #f))
+    (notmuch_query_destroy to-delete)
+    (notmuch_database_destroy ffi-db)))
+
+(define (move-mail! options account query start-dir end-dir)
+  (define (move-file uidvalidity target-folder)
+    (lambda (file)
+      (let* ((target-file (new-path (rename-higher file uidvalidity) target-folder))
+             (sub-len (string-prefix-length file target-file)))
+        (simple-format #t "    ~a -> ~a~%"
+                       (substring file sub-len)
+                       (substring target-file sub-len))
+        (unless (option-ref options 'dry-run #f)
+          (rename-file file target-file)))))
+
+  (let* ((mail-repo (assq-ref options 'mail-repo))
+         (ffi-db (nm-open-database mail-repo 0))
+         (target-folder (format #f "~a~a/~a" mail-repo account end-dir))
+         (uidvalidity (get-folder-uidvalidity target-folder))
+         (to-move (nm-query-db ffi-db
+                            (format #f "~a and folder:~a/~a" query account start-dir))))
+    (display (string-append
+              (colorize-string "[MOVE] " 'BOLD 'YELLOW)
+              (number->string (nm-count-messages to-move))
+              " messages marked in "
+              (colorize-string account 'GREEN 'BOLD)
+              "\n"))
+    (on-all-messages-filenames to-move (move-file uidvalidity target-folder) "mv"
+                               (option-ref options 'dry-run #f))
+    (notmuch_query_destroy to-move)
+    (notmuch_database_destroy ffi-db)))
+
+(define (apply-tags-to-message options tags)
+  (lambda (message)
+    (simple-format #t "  ~a~%" (nm-header message "subject"))
+    (unless (option-ref options 'dry-run #f)
+      (nm-apply-tags message tags)) #t))
+
+(define (notmuch-tag options ffi-db rules new)
+  (map (lambda (rule)
+         (match-let* (((tags query-str) (with-new rule new))
+                      (info (if (null? (cddr rule)) query-str (caddr rule)))
+                      (query (nm-query-db ffi-db query-str)))
+           (simple-format #t " ~a messages: ~a~a~%"
+                          (nm-count-messages query)
+                          (if (string=? info query-str) ""
+                              (string-append info " | "))
+                          tags)
+           (nm-iter messages (nm-result-messages query) (apply-tags-to-message options tags))
+           (notmuch_query_destroy query)))
+       rules))
+
+(define (list-tag options ffi-db new)
+  (display (colorize-string "[LISTS filters]\n" 'BOLD 'YELLOW))
+  (match-let* (((tags-str query-str) (with-new '("+lists" "not tag:lists") new))
+               (reg (make-regexp "<([a-z0-9=_-]+)\\." regexp/icase))
+               (query (nm-query-db ffi-db query-str))
+               (result (nm-iter
+                        messages (nm-result-messages query)
+                        (lambda (msg*)
+                          (and-let* ((list-id (regexp-exec reg (nm-header msg* "list-id")))
+                                     (tags (format #f "~a +lists/~a" tags-str
+                                                   (string-downcase (match:substring list-id 1)))))
+                            ((apply-tags-to-message options tags) msg*))))))
+    (simple-format #t " ~a messages belonging to lists~%"
+                   (length (filter identity result)))
+    (notmuch_query_destroy query)))
+
+(define (spam-channel push result)
+  (setvbuf push 'line)
+  (lambda (path)
+    (display path push)
+    (unless (string-suffix? "\n" path)
+      (newline push))
+    (string=? "S" (cadr (string-split (read-line result) #\space)))))
+
+(define (call-with-pipe cmd proc)
+  (let* ((p2c (pipe))
+         (port (with-input-from-port (car p2c)
+                 (lambda ()
+                   (open-input-pipe cmd)))))
+    (call-with-values
+        (lambda ()
+          (proc (cdr p2c) port))
+      (lambda vals
+        (close-port (cdr p2c))
+        (close-pipe port)
+        (apply values vals)))))
+
+(define (tag-spam options ffi-db query-str)
+  (call-with-pipe
+   "bogofilter -bTv"
+   (lambda (push result)
+     (display (colorize-string "[SPAM Flag]\n" 'BOLD 'YELLOW))
+     (let* ((spam? (spam-channel push result))
+            (query (nm-query-db ffi-db query-str))
+            (result (nm-iter messages (nm-result-messages query)
+                             (lambda (message)
+                               (when (spam? (pointer->string (notmuch_message_get_filename message)))
+                                 ((apply-tags-to-message options "+spam -inbox") message))))))
+       (format #t " ~a messages added to spam~%"
+               (length (filter boolean? result)))
+       (notmuch_query_destroy query)))))
+
+(define tag-rules
+  '(("+ci" "from:travis-ci.com or from:travis-ci.org or from:appveyor.com or from:circleci.com or from:mg.gitlab.com and subject:Pipeline")
+    ("+CMK-JIRA -inbox" "from:infra@mathias-kettner.de or from:jira@tribe29.com")
+    ("+slack" "from:slack.com")
+    ("+alle-mk" "to:alle@mathias-kettner.de to:technik@tribe29.com")
+    ("+cmk-commits" "to:cmk-internal-commits@mathias-kettner.de")
+    ("+cma-commits" "to:cma-commits@mathias-kettner.de")
+    ("+immonews" "from:immobilienscout24.de")
+    ("+immonews/communications" "from:nachrichten.immobilienscout24.de or subject:Kontaktaufnahme and tag:immonews")
+    ("+socialnews" "from:facebookmail.com or from:mail.instagram.com")
+    ("+promotions" "from:newsletter")
+    ("+linkedin +socialnews" "from:linkedin.com" "Linkedin")
+    ("+meetups" "from:info@meetup.com" "Meetups info mails")
+    ("+ingrid" "from:postmaster@oscarnajera.com or from:root@oscarnajera.com" "Reports from ingrid")
+    ("+fail2ban" "subject:Fail2Ban from:oscarnajera.com" "Fail2ban report")
+    ("+toastmasters" "toastmaster NOT from:info@meetup.com")
+    ("+sms" "folder:hi_pers/SMS")
+    ("+calls" "folder:hi_pers/Calls")))
+
+(define (clear-inbox options ffi-db)
+  (display (colorize-string "[Inbox]\n" 'BOLD 'YELLOW))
+  (let* ((my-emails (list "hi@oscarnajera.com" "hello@oscarnajera.com" "najera.oscar@gmail.com"
+                          "on@mathias-kettner.de" "oscar.najera@tribe29.com"))
+         (sent (format #f "~?" "(~A) AND NOT (~A)"
+                       (map (lambda (header)
+                              (string-join
+                               (map (lambda (address)
+                                      (format #f "~a:~a" header address))
+                                    my-emails)
+                               " OR "))
+                            (list "from" "to")))))
+    (notmuch-tag options ffi-db `(("+sent" ,sent "Emails I have sent")
+                                  ("+inbox" "*" "Inbox for the rest")) #t)))
+
+(define (main args)
+  (let* ((option-spec '((version (single-char #\V) (value #f))
+                        (help    (single-char #\h) (value #f))
+                        (all (value #f))
+                        (dry-run (single-char #\n) (value #f))))
+         (options (cons '(mail-repo . "/home/titan/.mail/")
+                        (getopt-long args option-spec)))
+         (account  (if (null? (assq-ref options '())) "hi_pers" (car (assq-ref options '())))))
+    (delete-email-files! options)
+    (if (string=? account "hi_pers")
+        (move-mail! options account "tag:spam" "Inbox" "Junk"))
+
+
+    (unless (option-ref options 'dry-run #f)
+      (display (colorize-string "[SYNC]\n" 'BOLD 'YELLOW))
+      (system (string-append "mbsync " (if (null? (assq-ref options '())) " -a" account)))
+      (display (colorize-string "[notmuch new]\n" 'BOLD 'YELLOW))
+      (system "notmuch new"))
+
+    (let ((ffi-db (nm-open-database (assq-ref options 'mail-repo) 1))
+          (new (not (option-ref options 'all #f))))
+      (list-tag options ffi-db new)
+      (display (colorize-string "[TAG rules]\n" 'BOLD 'YELLOW))
+      (notmuch-tag options ffi-db tag-rules new)
+      (clear-inbox options ffi-db)
+      (tag-spam options ffi-db "tag:inbox")
+      (notmuch_database_destroy ffi-db))))
+
+(let* ((ffi-db (nm-open-database "/home/titan/.mail/" 0))
+      (query (nm-query-db ffi-db "subject:^.FYI"))
+      (subjects (nm-iter messages (nm-result-messages query)
+                         (lambda (msg) (nm-header msg "subject")))))
+
+  (notmuch_database_destroy ffi-db)
+  subjects)