727 lines
25 KiB
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; gnus --- Daniel's Gnus Configuration -*- lexical-binding: t -*-
;;; Commentary:
;; Sources:
;; - http://page.math.tu-berlin.de/~freundt/.gnus
;; - Formatting from http://www.emacswiki.org/emacs/GnusFormatting, Version 3
;; - http://www.emacswiki.org/emacs/GnusDemon
;; - http://people.irisa.fr/Nicolas.Berthier/file:.gnus.el
;;; Code:
;;; General
;; Customization
;; XXX: This needs some functionality for local accounts
(defcustom db/mail-accounts nil
"Configuration for email accounts.
This is a list of lists, where each such list specifies necessary
parameters for one particular email address."
:group 'personal-settings
:type '(repeat
(string :tag "EMail Address")
(string :tag "Group Name")
(string :tag "IMAP Server Address")
(string :tag "SMTP Server Address")
(choice :tag "SMTP Stream Type"
(const nil) (const starttls) (const plain) (const ssl))
(integer :tag "SMTP Service Port")
(string :tag "SMTP Login Name"))))
(defcustom db/personal-gnus-filter-rules nil
"Default filter rules as used by Gnus for `user-mail-address."
:group 'personal-settings
:type 'sexp)
;; Requires
(require 'dash)
(require 'gnus)
(require 'message)
(require 'gnus-util)
(require 'gnus-start)
(require 'gnus-group)
(require 'gnus-sum)
(require 'gnus-art)
(require 'gnus-score)
(require 'nntp)
(require 'gnus-agent)
(require 'nnml)
(require 'gnus-async)
;; Debugging
(setq gnus-verbose 10)
;; Accounts
(setq-default message-dont-reply-to-names
(regexp-opt (cons user-mail-address db/additional-mail-addresses)
(setq gnus-select-method '(nnnil "")
;; XXX: this should be set by the customize interface of
;; `db/mail-accounts
;; immutable account definitions
`((nntp "etsep"
(nntp-open-connection-function nntp-open-tls-stream)
(nntp-port-number 563)
(nntp-address "news.eternal-september.org"))
(nntp "gmane"
(nntp-open-connection-function nntp-open-plain-stream)
;; (nntp-open-connection-function nntp-open-tls-stream)
;; (nntp-port-number 563)
(nntp-address "news.gmane.org"))
(nnimap "algebra20"
(nnimap-stream shell)
(nnimap-shell-program "/usr/lib/dovecot/imap -o mail_location=maildir:$HOME/Mail/algebra20")
(nnimap-split-methods nnimap-split-fancy)
(nnimap-inbox "INBOX")
(nnimap-split-fancy ,db/personal-gnus-filter-rules))
(nnml "local"
(nnmail-split-methods nnmail-split-fancy)
(| ("subject" ".*Tiger Auditing Report for.*" "mail.tiger")
(nnmaildir "archive"
(directory "~/Mail/archive/")
(directory-files nnheader-directory-files-safe)
(nnir-search-engine notmuch)
(nnir-notmuch-remove-prefix ,(expand-file-name "~/Mail/archive/"))))
;; automatically add accounts when address is not nil and not the empty string
;; XXX: this should be abstracted away in some kind of function
(remove-if #'null
(mapcar (lambda (account)
(let ((account-name (nth 1 account))
(account-address (nth 2 account)))
(when (and account-address
(stringp account-address)
(< 0 (length account-address)))
`(nnimap ,account-name
(nnimap-address ,account-address)
(nnimap-inbox "INBOX")))))
;; General Configuration
(setq gnus-ignored-from-addresses message-dont-reply-to-names
message-directory (expand-file-name "mail/" gnus-directory)
nnmail-message-id-cache-file (expand-file-name ".nnmail-cache" gnus-directory)
nnml-directory message-directory
mail-sources '((file))
mail-source-delete-incoming t
nntp-nov-is-evil t
gnus-asynchronous t
gnus-save-killed-list nil
gnus-save-newsrc-file nil
gnus-read-newsrc-file nil
gnus-check-new-newsgroups nil
gnus-use-cache 'passive
gnus-read-active-file 'some
gnus-build-sparse-threads 'some
gnus-subscribe-newsgroup-method 'gnus-subscribe-killed
gnus-group-list-inactive-groups nil
gnus-suppress-duplicates nil
gnus-large-newsgroup 200
nnmail-expiry-wait 7
nnmail-cache-accepted-message-ids t
gnus-summary-next-group-on-exit nil
gnus-use-full-window nil
gnus-always-force-window-configuration t
gnus-fetch-old-headers nil)
(setq gnus-visible-headers (regexp-opt '("From:"
(defadvice gnus-group-mail (before inhibit-no-argument activate)
(unless (ad-get-arg 0)
(ad-set-arg 0 1)))
(remove-hook 'gnus-mark-article-hook
(add-hook 'gnus-mark-article-hook 'gnus-summary-mark-unread-as-read)
(add-hook 'kill-emacs-hook
#'(lambda ()
(when (get-buffer "*Group*")
(bind-key "q" #'gnus-summary-expand-window gnus-article-mode-map)
;;; Appearence
(setq gnus-group-line-format "%S%p%P%5y(%2i):%B%(%s:%G%)\n"
gnus-auto-select-first nil
gnus-auto-select-next nil)
(setq gnus-summary-line-format "%U%O%R%6k %(%&user-date; %-13,13f %B%s%)\n"
gnus-thread-sort-functions '(gnus-thread-sort-by-most-recent-date)
gnus-subthread-sort-functions '(gnus-thread-sort-by-date)
gnus-thread-hide-subtree t
gnus-user-date-format-alist '((t . "%Y-%m-%d %H:%M"))
gnus-sum-thread-tree-indent " "
gnus-sum-thread-tree-root ""
gnus-sum-thread-tree-false-root ""
gnus-sum-thread-tree-single-indent ""
gnus-sum-thread-tree-single-leaf "╰► "
gnus-sum-thread-tree-leaf-with-other "├► "
gnus-sum-thread-tree-vertical ""
gnus-summary-thread-gathering-function 'gnus-gather-threads-by-references
;; Yay (seen here: `https://github.com/cofi/dotfiles/blob/master/gnus.el')
gnus-ancient-mark ?✓
;; gnus-cached-mark ?☍
gnus-canceled-mark ?↗
gnus-del-mark ?✗
;; gnus-dormant-mark ?⚐
gnus-expirable-mark ?♻
gnus-forwarded-mark ?↪
;; gnus-killed-mark ?☠
;; gnus-process-mark ?⚙
gnus-read-mark ?✓
gnus-recent-mark ?✩
gnus-replied-mark ?↺
gnus-unread-mark ?✉
;; gnus-unseen-mark ?★
;; gnus-ticked-mark ?⚑
;; we need to do some magic as otherwise the agent does not delete articles from
;; its .overview when we move them around
(defadvice gnus-summary-move-article (around
(&optional n to-newsgroup
select-method action)
(let ((articles (gnus-summary-work-articles n))
(return ad-do-it))
(when (or (null action)
(eq action 'move))
(dolist (article articles)
(gnus-summary-mark-article article gnus-expirable-mark)))
(add-hook 'gnus-group-mode-hook 'gnus-topic-mode)
(setq gnus-treat-hide-boring-headers 'head
gnus-treat-strip-multiple-blank-lines nil
gnus-treat-display-smileys t
gnus-treat-emphasize 'head
gnus-treat-unsplit-urls t)
;;; Adaptive Scoring
(setq gnus-use-scoring nil
gnus-use-adaptive-scoring nil
gnus-adaptive-word-length-limit 5
gnus-adaptive-word-no-group-words t
(gnus-ticked-mark (from 4))
(gnus-dormant-mark (from 5))
(gnus-del-mark (from -4) (subject -1))
(gnus-read-mark (from 4) (subject 2))
(gnus-expirable-mark (from -1) (subject -1))
(gnus-killed-mark (from -1) (subject -3))
(gnus-catchup-mark (from -1) (subject -1))))
(setq-default gnus-summary-mark-below nil)
(setq gnus-parameters
(gnus-use-scoring nil))
(gnus-use-scoring t)
(gnus-use-adaptive-scoring '(word line)))
(gnus-use-scoring nil)
(gnus-summary-mark-below -1000)
(gnus-use-adaptive-scoring '(word line)))))
(add-hook 'gnus-summary-exit-hook
;;; Gnus Registry
(require 'gnus-registry)
(setq gnus-registry-split-strategy 'majority
gnus-registry-ignored-groups '(("^nntp" t)
("^nnfolder" t)
("^nnir" t)
("^nnmaildir" t)
("INBOX$" t))
gnus-registry-max-entries 40000
gnus-registry-track-extra '(sender subject recipient)
gnus-registry-cache-file (expand-file-name "gnus.registry.eioioi"
gnus-refer-article-method 'current)
;;; MIME
(use-package dash
:demand t
:ensure t)
(add-to-list 'gnus-boring-article-headers 'long-to)
(setq gnus-ignored-mime-types '("text/x-vcard")
mm-discouraged-alternatives '("text/richtext" "text/html")
mm-automatic-display (-difference mm-automatic-display
message-forward-as-mime t
gnus-inhibit-mime-unbuttonizing nil
gnus-buttonized-mime-types '("multipart/signed" "multipart/encrypted")
gnus-inhibit-images t
gnus-blocked-images ".")
(setq message-citation-line-function
(lambda ()
(when message-reply-headers
(insert "ghItlhpu' " (mail-header-from message-reply-headers) ":")
(use-package mm-decode
:config (progn
;; Tells Gnus to inline the part
(add-to-list 'mm-inlined-types "application/pgp$")
;; Tells Gnus how to display the part when it is requested
(add-to-list 'mm-inline-media-tests
'("application/pgp$" mm-inline-text identity))
;; Tell Gnus not to wait for a request, just display the thing
;; straight away.
(add-to-list 'mm-automatic-display "application/pgp$")
(setq mm-text-html-renderer 'shr)))
;;; Signing and Encryption
(setq mm-encrypt-option nil
mm-sign-option nil
mm-decrypt-option 'known
mm-verify-option 'known
mml-smime-use 'epg
;;mml2015-encrypt-to-self t
mml2015-display-key-image nil
gnus-message-replysign t
gnus-message-replyencrypt t
gnus-message-replysignencrypted t
mml-secure-cache-passphrase nil)
;; Automatic encryption if all necessary keys are present
(require 'mail-extr)
(defun db/public-key (address &optional method)
"Return valid public keys for ADDRESS and given METHOD.
METHOD can be \"smime\" or \"pgpmime\"; defaults to \"pgpmime\".
ADDRESS is a string containing exactly one email address."
(check-type address string)
(unless method (setq method "pgpmime"))
(epg-list-keys (epg-make-context
((string= method "smime")
((string= method "pgpmime")
(t (error "Unknown method %s" method))))
(defun db/encryption-possible-p (recipients method)
"Check whether sending encrypted emails to all RECIPIENTS is possible.
METHOD specifies the encrypt method used. Can be either
\"smime\" or \"pgpmime\"."
(cl-every (lambda (recipient)
(not (null (db/public-key recipient method))))
(defun db/message-recipients ()
"Return all recipients of the email in the current buffer."
(cl-mapcan (lambda (field)
(let ((field-value (message-field-value field)))
(when field-value
(mapcar #'cadr
(mail-extract-address-components field-value t)))))
(list "to" "cc" "bcc")))
(defun db/signencrypt-message-when-possible ()
"Add mml markers for signing and encryption of an email if possible."
(when (eq major-mode 'message-mode)
(let ((from (message-field-value "from")))
(when from
(let ((methods (if (string-match "@tu-dresden\.de>" from)
(list "smime" "pgpmime")
(list "pgpmime")))
(recipients (db/message-recipients)))
;; if there is no recipient, encrypt with default method
(if (null recipients)
(mml-secure-message (first methods) 'signencrypt)
;; go through available keys
(let ((available-method
(cl-find-if (lambda (method)
(db/encryption-possible-p recipients method))
(if available-method
(mml-secure-message available-method 'signencrypt)
;; if nothing works, sign with default method
(mml-secure-message (first methods) 'sign)))))))))
(add-hook 'gnus-message-setup-hook
;; inspired by https://www.emacswiki.org/emacs/ExtendSMIME
(use-package ldap
:commands (ldap-search)
:config (progn
(setq ldap-default-host "")
(setq ldap-default-base "O=DFN-Verein,C=DE"
ldap-ldapsearch-args '("-x" "-tt" "-H ldaps://ldap.pca.dfn.de"))))
(defun db/lookup-smime-key (mail)
"Look up `MAIL' on ldap-server of the DFN.
If found, imports the certificate via gpgsm."
(interactive "sMail: ")
(when (get-buffer " *ldap-value*")
(kill-buffer " *ldap-value*"))
(ldap-search (format "(mail=%s)" mail))
(let ((bufval (get-buffer " *ldap-value*")))
(when bufval
(with-current-buffer bufval
(widen) ; just to be sure
(let ((result (call-process-region (point-min) (point-max)
nil nil nil
(if (zerop result)
(message "Successfully imported certificate for <%s>" mail)
(error "Could not import certificate for <%s>" mail))))))))
;; Fix
(defun mm-view-pkcs7-verify (handle)
(let ((verified nil))
(if (eq mml-smime-use 'epg)
;; Use gpgsm
(insert-buffer-substring (mm-handle-buffer handle))
(setq verified (epg-verify-string (epg-make-context 'CMS)
(base64-decode-string (buffer-string)))))
;; FIXME: insert valid signature
;; use openssl
(insert "MIME-Version: 1.0\n")
(mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
(insert-buffer-substring (mm-handle-buffer handle))
(setq verified (smime-verify-region (point-min) (point-max))))))
(goto-char (point-min))
(mm-insert-part handle)
(if (search-forward "Content-Type: " nil t)
(delete-region (point-min) (match-beginning 0)))
(goto-char (point-max))
(if (re-search-backward "--\r?\n?" nil t)
(delete-region (match-end 0) (point-max)))
(unless verified
(insert-buffer-substring smime-details-buffer)))
(goto-char (point-min))
(while (search-forward "\r\n" nil t)
(replace-match "\n"))
;;; Custom commands
(bind-key "v u"
'(lambda ()
(when (gnus-topic-select-group)
(bind-key "v j"
'(lambda ()
(gnus-agent-toggle-plugged nil)
(gnus-agent-toggle-plugged t)
(gnus-group-get-new-news 3))
(add-hook 'gnus-get-new-news-hook
(lambda ()
(when gnus-plugged
(gnus-agent-toggle-plugged nil)
(gnus-agent-toggle-plugged t))))
;; (bind-key "v g" #'db/get-mail gnus-group-mode-map)
(bind-key "v c"
(lambda ()
(gnus-topic-jump-to-topic "News")
(defun db/gnus-summary-open-Link ()
"Open link named \"Link\" in current article."
(let ((url nil))
(unless (eq major-mode 'gnus-article-mode)
(goto-char (point-min))
(while (and (not url)
(search-forward "Link"))
(setq url (get-text-property (point) 'shr-url)))
(when url
(browse-url url)))))))
(bind-key "C-<return>" #'db/gnus-summary-open-Link gnus-summary-mode-map)
(bind-key "C-<return>" #'db/gnus-summary-open-Link gnus-article-mode-map)
(defun db/gnus-html-mime-part-to-org ()
"Convert current gnus article to org mode."
(let ((return-code (gnus-mime-pipe-part "pandoc -f html -t org")))
(unless (zerop return-code)
(error "Error in extracting text"))
(with-current-buffer "*Shell Command Output*"
(kill-ring-save (point-min) (point-max)))))
;;; Timeout for fetching news
(setq nntp-connection-timeout nil)
;;; Daemons
(defun db/gnus-demon-scan-news-on-level-2 ()
"Scan for news in Gnus on level 2."
;; from https://www.emacswiki.org/emacs/GnusDemon
(let ((win (current-window-configuration))
(gnus-read-active-file 'some)
(gnus-check-new-newsgroups nil)
(gnus-verbose 2)
(gnus-verbose-backends 5)
(level 2))
(when (gnus-alive-p)
(with-current-buffer gnus-group-buffer
(gnus-group-get-new-news level))))
(set-window-configuration win)))))
(gnus-demon-add-handler 'gnus-demon-close-connections nil 10)
(gnus-demon-add-handler 'db/gnus-demon-scan-news-on-level-2 5 5)
;;; Agents
(setq gnus-agent-mark-unread-after-downloaded nil
gnus-agent-synchronize-flags t
gnus-agent-go-online t)
;;; Do some pretty printing before saving the newsrc file
(defun db/gnus-save-newsrc-with-whitespace-1 ()
"Save ~/.newsrc.eld with extra whitespace."
;; http://ding.gnus.narkive.com/pq3Z8ZjQ/pretty-printing-newsrc-eld#post3
(gnus-message 5 "Adding whitespace to .newsrc.eld")
(goto-char (point-min))
(while (re-search-forward "(\\\"\\| ((\\| (nn" nil t)
(replace-match "\n \\&" t))
(add-hook 'gnus-save-quick-newsrc-hook #'db/gnus-save-newsrc-with-whitespace-1)
;;; Mail Formatting
;; XXX: This should actually be set by the customize setter of
;; `db/mail-accounts
(setq gnus-posting-styles
(name ,user-full-name)
(address ,user-mail-address)
(signature-file "~/.signature")
("X-Jabber-ID" ,db/jabber-id)))
;; XXX: this should be abstracted away in some kind of function
(mapcar (lambda (account)
(let ((account-name (nth 1 account))
(account-address (nth 0 account)))
`(,(concat account-name ":")
(name ,user-full-name)
(address ,account-address)
(signature-file "~/.signature")
("X-Jabber-ID" ,db/jabber-id))))
;; http://mbork.pl/2015-11-28_Fixing_mml-attach-file_using_advice
(defun db/mml-attach-file--go-to-eob (orig-fun &rest args)
"Go to the end of buffer before attaching files."
(goto-char (point-max))
(apply orig-fun args))))
(advice-add 'mml-attach-file :around #'db/mml-attach-file--go-to-eob)
;;; Archiving
;; We store messages in the current group, so there is no need to use Gnus
;; archiving method
(setq gnus-message-archive-method nil
gnus-update-message-archive-method t
gnus-message-archive-group nil
gnus-gcc-mark-as-read t)
;;; SMTP configuration
(require 'smtpmail)
(require 'starttls)
(defadvice smtpmail-send-it (around display-trace-buffer disable)
"If an error is signalled, display the process buffer."
(condition-case signals-data
(error (shrink-window-if-larger-than-buffer
(display-buffer (get-buffer (format "*trace of SMTP session to %s*"
(signal (car signals-data) (cdr signals-data)))))
(setq send-mail-function 'smtpmail-send-it
smtpmail-stream-type 'starttls
smtpmail-smtp-service 587
starttls-use-gnutls t
starttls-extra-arguments '("--strict-tofu")
smtpmail-smtp-server (nth 3 (car db/mail-accounts))
smtpmail-smtp-user (nth 6 (car db/mail-accounts)))
(defun db/set-smtp-server-from-header (orig-fun &rest args)
"Choose smtp-settings dynamically, based on the From: header
entry of the current mail."
(require 'mail-extr)
(let* ((from (or (save-restriction
(mail-fetch-field "From"))
(address (cadr (mail-extract-address-components from)))
(account (assoc address db/mail-accounts)))
(message "Using address: %s" address)
(if account
(message "Sending with account for %s" address)
;; XXX: these calls to `nth should be abstracted away
(let ((smtpmail-smtp-server (nth 3 account))
(smtpmail-stream-type (nth 4 account))
(smtpmail-smtp-service (nth 5 account))
(smtpmail-smtp-user (nth 6 account)))
(apply orig-fun args)))
(message "Sending with default account settings")
(apply orig-fun args)))))
(advice-add 'smtpmail-via-smtp
:around #'db/set-smtp-server-from-header)
(setq smtpmail-debug-info t)
;;; Notmuch
(require 'nnir)
(setq nnir-method-default-engines '((nnimap . imap)
(nnmaildir . notmuch)
(nntp . gmane)))
(use-package notmuch
:config (progn
;; (bind-key "GG" 'notmuch-search gnus-group-mode-map)
(defun db/notmuch-search-update-index (orig-fun &rest args)
"Update notmuch index before searching"
(message "Indexing new Mail...")
(shell-command "notmuch new --quiet 2>&1 | grep -v \"Note: Ignoring\"")
(message "Indexing new Mail... done.")
(apply orig-fun args))
(advice-add 'notmuch-search
:around #'db/notmuch-search-update-index)
(advice-add 'nnir-run-notmuch
:around #'db/notmuch-search-update-index)
(setq notmuch-fcc-dirs nil)))