blob: 02e5d6e161fe69598c4c89e0a762b6683dc54042 (
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
|
#!/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 match)
(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 (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)))
(simple-format #t "~a~a~%"
(pcmd dry-run (simple-format #f " [~a] " proc-name))
subject)
(unless dry-run
(map proc files))
(list subject files)))))
(define (delete-email-files! options)
(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 delete-file "rm" (option-ref options 'dry-run #f)))))
(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)))
(with-nm-database
(ffi-db mail-repo 0)
(let* ((target-folder (format #f "~a~a/~a" mail-repo account end-dir))
(uidvalidity (get-folder-uidvalidity target-folder)))
(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) "mv"
(option-ref options 'dry-run #f)))))))
(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))))
(with-nm-query
(ffi-db query 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)))))
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)))
(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)))
(notmuch-tag options ffi-db `(("+sent" ,sent "Emails I have sent")
("+inbox" "*" "Inbox for the rest")) #t)))
(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))
(notmuch-tag options ffi-db tag-rules new)
(list-tag options ffi-db new)
(clear-inbox options ffi-db)
(tag-spam options ffi-db "tag:inbox")))))
;; Local Variables:
;; mode: scheme
;; End:
|
