blob: 409aff1aa8921fb99fe7bebca9a83017d59f2914 (
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
218
219
220
221
222
223
224
225
|
#!/usr/bin/env sh
LD_LIBRARY_PATH=$HOME/.guix-profile/lib exec guile -e main -s "$0" "$@"
!#
;; 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/dotfiles/lib/guile/" ))
(use-modules
(ffi notmuch)
(ice-9 and-let-star)
(ice-9 ftw)
(ice-9 format)
(ice-9 getopt-long)
(ice-9 popen)
(ice-9 ports)
(ice-9 rdelim)
(ice-9 regex)
(ice-9 receive)
(mail-tools)
(utils)
(srfi srfi-1)
(system ffi-help-rt)
(system foreign)
(term ansi-color))
(define (on-all-messages-filenames query proc)
(nm-iter messages (nm-result-messages query)
(lambda (message*)
(simple-format #t " ~a~%" (nm-header message* "subject"))
(map proc (nm-iter filenames (notmuch_message_get_filenames message*)
pointer->string)))))
(define (delete-email-files! options)
(define (logged-delete file-path)
(let ((do? (not (option-ref options 'dry-run #f))))
(simple-format #t " [~a] ~a~%"
(colorize-string "rm" 'BOLD (if do? 'RED 'NONE))
file-path)
(if do? (delete-file file-path))))
(with-nm-database
(ffi-db (assq-ref options 'mail-repo) 0)
(with-nm-query
(ffi-db to-delete "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 logged-delete))))
(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))
(do? (not (option-ref options 'dry-run #f))))
(simple-format #t " [~a] ~a -> ~a~%"
(colorize-string "mv" 'BOLD (if do? 'RED 'NONE))
(substring file sub-len)
(substring target-file sub-len))
(when do? (rename-file file target-file)))))
(let* ((mail-repo (assq-ref options 'mail-repo))
(target-folder (format #f "~a~a/~a" mail-repo account end-dir))
(uidvalidity (get-folder-uidvalidity target-folder)))
(with-nm-database
(ffi-db mail-repo 0)
(with-nm-query
(ffi-db to-move (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))))))
(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 (log-msg-tag count rule new)
(let* ((query-str (query-with-new rule new))
(tags (tags-with-new rule new))
(info (if (null? (cddr rule)) query-str (caddr rule))))
(when (< 0 count)
(simple-format #t " ~a messages: ~a~a~%"
count
(if (string=? info query-str) ""
(string-append info " | "))
tags))))
(define (notmuch-tag options ffi-db new)
(lambda (rule)
(let ((query-str (query-with-new rule new))
(tags (tags-with-new rule new)))
(with-nm-query
(ffi-db query query-str)
(log-msg-tag (nm-count-messages query) rule new)
(nm-iter messages (nm-result-messages query) (apply-tags-to-message options tags))))))
(define (list-tag options ffi-db new)
(display (colorize-string "[LISTS filters]\n" 'BOLD 'YELLOW))
(let ((query-str (query-with-new '("+lists" "not tag:lists") new))
(tags-str (tags-with-new '("+lists" "not tag:lists") new))
(reg (make-regexp "<([a-z0-9=_-]+)\\." regexp/icase)))
(with-nm-query
(ffi-db query query-str)
(->> (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*)))
(nm-iter messages (nm-result-messages query))
(filter identity)
length
(simple-format #t " ~a messages belonging to lists~%")))))
(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)))))
(receive vals (proc (cdr p2c) port)
(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)))
(with-nm-query
(ffi-db query query-str)
(->> (lambda (message)
(when (spam? (pointer->string (notmuch_message_get_filename message)))
((apply-tags-to-message options "+spam -inbox") message)))
(nm-iter messages (nm-result-messages query))
(filter boolean?)
length
(format #t " ~a messages added to spam~%")))))))
(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")
("+slack" "from:slack.com")
("+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")
("+Isar-Speak" "to:isarspeak@gmail.com")
("+toastmasters" "toastmaster NOT from:info@meetup.com")
("+iohk" "from:iohk.io" "IOHK Plutus")
("+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"))
(sent (format #f "(~{from:~a~^ OR ~}) AND NOT (~:*~{to:~a~^ OR ~})" my-emails)))
(map (notmuch-tag options ffi-db #t)
`(("+sent" ,sent "Emails I have sent")
("+inbox" "*" "Inbox for the rest")))))
(define (main args)
(let* ((mail-repo (string-append
(passwd:dir (getpwuid (geteuid)))
"/.mail/" ))
(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 mail-repo)
(getopt-long args option-spec)))
(account (assq-ref options '()) ))
(delete-email-files! options)
(when (or (and (null? '())
(access? (string-append mail-repo "hi_pers") W_OK))
(and (string? account)
(string=? account "hi_pers")))
(move-mail! options "hi_pers" "tag:spam" "Inbox" "Junk"))
(unless (option-ref options 'dry-run #f)
(display (colorize-string "[SYNC]\n" 'BOLD 'YELLOW))
(system (string-append "mbsync " (if (null? account) " -a" (car account))))
(display (colorize-string "[notmuch new]\n" 'BOLD 'YELLOW))
(system "notmuch new"))
(with-nm-database
(ffi-db (assq-ref options 'mail-repo) 1)
(let ((new (not (option-ref options 'all #f))))
(display (colorize-string "[TAG rules]\n" 'BOLD 'YELLOW))
(map (notmuch-tag options ffi-db new) tag-rules)
(list-tag options ffi-db new)
(clear-inbox options ffi-db)
(tag-spam options ffi-db "tag:inbox")))))
;; Local Variables:
;; mode: scheme
;; End:
|
