all messages for Emacs-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* epa-mail.el
@ 2013-07-19 19:10 Richard Stallman
  0 siblings, 0 replies; only message in thread
From: Richard Stallman @ 2013-07-19 19:10 UTC (permalink / raw
  To: emacs-devel

        [ To any NSA and FBI agents reading my email: please consider
        [ whether defending the US Constitution against all enemies,
        [ foreign or domestic, requires you to follow Snowden's example.

I would like to replace epa-mail-encrypt with this,
to make it usable from Lisp code.  Any objections?


(defun epa-mail-encrypt (&optional recipients signers)
  "Encrypt the outgoing mail message in the current buffer.
Optional argument RECIPIENTS is a list of recipient addresses
or t to perform symmetric encryption.  If it is nil,
take the recipients from the text in the header in the buffer.

SIGNERS is a list of keys to sign the message with."
  (interactive
   (let ((verbose current-prefix-arg))
     (list (if verbose
	       (or (epa-select-keys
		    context
		    "Select recipients for encryption.
If no one is selected, symmetric encryption will be performed.  "
		    recipients)
		   t))
	   (and verbose (y-or-n-p "Sign? ")
		(epa-select-keys context
				 "Select keys for signing.  ")))))
  (let (start real-recipients recipient-keys)
    (save-excursion
      (if recipients
	  (setq real-recipients
		(if (eq recipients t)
		    nil
		  recipients))

	(let ((config (epg-configuration))
	      (context (epg-make-context epa-protocol))
	      recipients-string recipient-key sign)
	  (goto-char (point-min))
	  (save-restriction
	    (narrow-to-region (point)
			      (if (search-forward mail-header-separator nil 0)
				  (match-beginning 0)
				(point)))
	    (setq recipients-string
		  (mapconcat #'identity
			     (nconc (mail-fetch-field "to" nil nil t)
				    (mail-fetch-field "cc" nil nil t)
				    (mail-fetch-field "bcc" nil nil t))
			     ","))
	    (setq recipients-string
		  (mail-strip-quoted-names
		   (with-temp-buffer
		     (insert "to: " recipients-string "\n")
		     (expand-mail-aliases (point-min) (point-max))
		     (car (mail-fetch-field "to" nil nil t))))))

	  (setq real-recipients
		(split-string recipients-string "," t "[ \t\n]*"))

	  ;; Process all the recipients thru the list of GnuPG groups.
	  ;; Expand GnuPG group names to what they stand for.
	  (setq real-recipients
		(apply #'nconc
		       (mapcar
			(lambda (recipient)
			  (or (epg-expand-group config recipient)
			      (list recipient)))
			real-recipients)))
	  ))

	(goto-char (point-min))
	(if (search-forward mail-header-separator nil t)
	    (forward-line))
	(setq start (point))

	(setq epa-last-coding-system-specified
	      (or coding-system-for-write
		  (epa--select-safe-coding-system (point) (point-max))))

	(when real-recipients
	  (setq recipient-keys
		(apply
		 'nconc
		 (mapcar
		  (lambda (recipient)
		    (setq recipient-key
			  (epa-mail--find-usable-key
			   (epg-list-keys
			    (epg-make-context epa-protocol)
			    (if (string-match "@" recipient)
				(concat "<" recipient ">")
			      recipient))
			   'encrypt))
		    (unless (or recipient-key
				(y-or-n-p
				 (format
				  "No public key for %s; skip it? "
				  recipient)))
		      (error "No public key for %s" recipient))
		    (if recipient-key (list recipient-key)))
		  real-recipients)))))

    ;; Don't let some read-only text stop us from encrypting.
    (let ((inhibit-read-only t))
      (epa-encrypt-region start (point-max) recipient-keys signers signers))))

-- 
Dr Richard Stallman
President, Free Software Foundation
51 Franklin St
Boston MA 02110
USA
www.fsf.org  www.gnu.org
Skype: No way! That's nonfree (freedom-denying) software.
  Use Ekiga or an ordinary phone call.




^ permalink raw reply	[flat|nested] only message in thread

only message in thread, other threads:[~2013-07-19 19:10 UTC | newest]

Thread overview: (only message) (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2013-07-19 19:10 epa-mail.el Richard Stallman

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/emacs.git
	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.