aboutsummaryrefslogtreecommitdiffstats
path: root/bin
diff options
context:
space:
mode:
Diffstat (limited to 'bin')
-rwxr-xr-xbin/tagmail230
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)