blob: bd58d40cd32c0a0e780f1fcf5277b8a724607b0b (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
|
#!/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 and not subject:\"mentioned you\")")
("+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 "(~{from:~a~^ OR ~}) AND NOT (~:*~{to:~a~^ OR ~})" my-emails)))
(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 (cons 'mail-repo (string-append
(passwd:dir (getpwuid (geteuid)))
"/.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))))
|
