home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / interfaces / pgp.el < prev    next >
Encoding:
Text File  |  1993-06-01  |  13.4 KB  |  425 lines
  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;
  3. ;; PGP 2.2 encryption/decryption routines for Mail/Rmail modes.
  4. ;;
  5. ;; Copyright 1992 by Gray Watson and the Antaire Corporation
  6. ;;
  7. ;; $Id: pgp.el,v 1.14 1993/05/25 01:19:36 gray Exp $
  8. ;;
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10. ;;
  11. ;; LCD Archive Entry:
  12. ;; pgp|Gray Watson|gray.watson@antaire.com|
  13. ;; Pretty Good Privacy Version 2.2+ Interface.|
  14. ;; 25-May-1993|1.14|~/interfaces/pgp.el|
  15. ;;
  16. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  17. ;;
  18. ;; This program is free software; you can redistribute it and/or modify
  19. ;; it under the terms of the GNU General Public License as published by
  20. ;; the Free Software Foundation; either version 1, or (at your option)
  21. ;; any later version.
  22. ;;
  23. ;; This program is distributed in the hope that it will be useful,
  24. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  25. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  26. ;; GNU General Public License for more details.
  27. ;;
  28. ;; You should have received a copy of the GNU General Public License
  29. ;; along with this program; if not, write to the Free Software
  30. ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  31. ;;
  32. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  33. ;;
  34. ;; Put the following in your .emacs to enable the pgp hooks:
  35. ;;
  36. ;;(autoload 'pgp-decrypt-message "pgp"
  37. ;;      "Decrypt and incoming mail message in rmail using pgp" t)
  38. ;;(autoload 'pgp-verify-message "pgp"
  39. ;;      "Verify an incoming cleartext-signed mail message in rmail using pgp"
  40. ;;      t)
  41. ;;(autoload 'pgp-encrypt-message "pgp"
  42. ;;      "Encrypt an outgoing mail message using pgp" t)
  43. ;;(autoload 'pgp-sign-message "pgp"
  44. ;;      "Sign your mail message using pgp" t)
  45. ;;(autoload 'pgp-append-public "pgp"
  46. ;;      "Add your public key to end of outgoing mail message using pgp" t)
  47. ;;
  48. ;; (setq pgp-tmp-dir (format "%s/tmp" (getenv "PGPPATH")))
  49. ;; (setq pgp-binary "/usr/local/bin/pgp")
  50. ;;
  51. ;; (require 'sendmail)
  52. ;; (define-key rmail-mode-map "\C-cd" 'pgp-decrypt-message)
  53. ;; (define-key rmail-mode-map "\C-cv" 'pgp-verify-message)
  54. ;; (define-key mail-mode-map "\C-ce" 'pgp-encrypt-message)
  55. ;; (define-key mail-mode-map "\C-cs" 'pgp-sign-message)
  56. ;; (define-key mail-mode-map "\C-ca" 'pgp-append-public)
  57. ;;
  58. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  59. ;;
  60. ;; SECURITY
  61. ;;
  62. ;; This module makes use of:
  63. ;;
  64. ;;   a) a password routine which does not echo chars
  65. ;;   b) PGP 2.2's way of taking the password from stdin
  66. ;;   c) a secure temporary file directory.
  67. ;;
  68. ;; However, there are many other ways to overcome Unix security so BEWARE.
  69. ;;
  70. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  71. ;;
  72. ;; LIMITATIONS
  73. ;;
  74. ;; If you mistype the password, PGP will prompt for it again even if it is in
  75. ;; filter mode.  This is just plain PGP idiocy but I don't know a way around
  76. ;; it without hacking PGP code.  PGP should just return an error code here
  77. ;; if anyone is listening.
  78. ;;
  79. ;; If you ^G after waiting for what you think an "abnormally long" time and you
  80. ;; have in your mail buffer the PGP prompt for a password then you need to
  81. ;; undo a couple of times to restore your mail message and then try again.
  82. ;;
  83. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  84.  
  85. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  86. ;;
  87. ;; VARIABLES
  88. ;;
  89.  
  90. ;;
  91. ;; Where to put the pgp.el temp files.  WARNING: should be secure directory
  92. ;; I usually create a tmp under my PGPPATH directory which is secure so maybe
  93. ;; (setq pgp-tmp-dir (format "%s/tmp" (getenv "PGPPATH"))) is more appropriate.
  94. ;;
  95. (defvar pgp-tmp-dir "/var/tmp"
  96.   "Directory to put pgp.el temp files.  WARNING: should be secure.")
  97.  
  98. ;;
  99. ;; Full-path to the pgp installed binary.  Maybe (expand-file-name "~/bin/pgp")
  100. ;;
  101. (defvar pgp-binary "/usr/local/bin/pgp" "Full path to the pgp binary.")
  102.  
  103. ;;
  104. ;; The PGP User-ID for your personal key to sign and encrypt outgoing messages
  105. ;;
  106. (defvar pgp-my-user-id (user-full-name)
  107.   "The PGP User ID to locate your personal key to sign and encrypt messages.")
  108.  
  109. ;;
  110. ;; Encrypt all outgoing messages with your private key also so you can read
  111. ;; your own outgoing messages.
  112. ;;
  113. (defvar pgp-encrypt-with-my-key nil
  114.   "Set to t to always encrypt outgoing messages with your private key.")
  115.  
  116. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  117. ;;
  118. ;; FUNCTIONS
  119. ;;
  120.  
  121. ;;
  122. ;; read in a password without showing user input and while handling ^u (kill)
  123. ;; as well as delete and ^h (erase).  does another emacs function do this?
  124. ;;
  125. (defun read-password (prompt)
  126.   (let ((key ?\177) (pass ""))
  127.     
  128.     ;; run until we get a cr or lf
  129.     (while (not (or (= key ?\n)
  130.             (= key ?\r)))
  131.       (progn
  132.     ;; watch for erase characters
  133.     (if (or (= key ?\177)
  134.         (= key ?\010))
  135.         (if (> (length pass) 0)
  136.         (setq pass (substring pass 0 -1)))
  137.       (if (= key ?\025)
  138.           (setq pass "")
  139.         (setq pass (concat pass (char-to-string key)))
  140.         )
  141.       )
  142.     
  143.     ;; display the prompt if appropriate
  144.     (if prompt
  145.         (message prompt))
  146.     
  147.     ;; magic to read-key while blocking quitting while in the non-echo area
  148.     (setq cursor-in-echo-area t)
  149.     (setq inhibit-quit t)
  150.     (setq key (read-char))
  151.     (setq cursor-in-echo-area nil)
  152.     (setq inhibit-quit nil)
  153.     )
  154.       )
  155.     pass
  156.     ))
  157.  
  158. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  159. ;;
  160. ;; encrypt a message while in Mail mode
  161. ;;
  162. (defun pgp-encrypt-message ()
  163.   "Encrypt an outgoing mail message using pgp in Mail mode"
  164.   (interactive)
  165.   (let ((pass) (tmp) (user) (receiver) (next) (start) (command)
  166.     (process-environment))
  167.     
  168.     ;; setup the environment for pgp with tmp directory
  169.     (setq tmp (getenv "PGPPATH"))
  170.     (if (not tmp)
  171.     (error
  172.      "Please set your PGPPATH env variable before using this function!"))
  173.     (setq process-environment
  174.       (list (format "PGPPATH=%s" tmp)
  175.         (format "TMP=%s" pgp-tmp-dir)
  176.         "PGPPASSFD=0"
  177.         ))
  178.     
  179.     ;; get the password and signature address
  180.     (setq pass (read-password "PGP Password: "))
  181.     (setq user (read-input
  182.         (format "Signature to use or 'none' [%s]: " pgp-my-user-id)
  183.         ))
  184.     (if (string= user "")
  185.     (setq user pgp-my-user-id))
  186.     
  187.     ;; get the receiver information
  188.     (goto-char (point-min))
  189.     (re-search-forward "^To:[ ]*")
  190.     (setq start (point))
  191.     (re-search-forward "@\\|\n")
  192.     (if (= (char-after (- (point) 1)) ?\n)
  193.     (forward-char -1))
  194.     (setq receiver (read-input
  195.             (format "Encrypt message for [%s]: "
  196.                 (buffer-substring start (point)))))
  197.     (if (string= receiver "")
  198.     (setq receiver (buffer-substring start (point))))
  199.     
  200.     ;; should we encrypt with user's key also?
  201.     (if (or pgp-encrypt-with-my-key
  202.         (y-or-n-p (format "Encrypt message for yourself [%s]? "
  203.                   pgp-my-user-id)))
  204.     (setq receiver (concat  receiver "' '" pgp-my-user-id))
  205.       )
  206.     
  207.     ;; maybe add some more addresses to encrypt for?
  208.     (while (not (string=
  209.          (setq next (read-input
  210.                  "Encrypt message for someone else [none]: ")) ""))
  211.       (setq receiver (concat receiver "' '" next))
  212.       )
  213.     
  214.     ;; copy the message into the message file
  215.     (goto-char (point-min))
  216.     (search-forward "\n--text follows this line--\n")
  217.     (setq start (point))
  218.     (insert pass "\n")
  219.     
  220.     ;; call pgp on the message
  221.     (message "Working.  Please wait...")
  222.     (if (string= user "none")
  223.     (setq command (format "%s -fe '%s'" pgp-binary receiver))
  224.       (setq command (format "%s -fe -su '%s' '%s'" pgp-binary user receiver))
  225.       )
  226.     
  227.     (shell-command-on-region start (point-max) command t)
  228.     
  229.     ;; remove the pgp stuff if the user wants
  230.     (goto-char start)
  231.     (message "Press a key to remove pgp information from the message.")
  232.     (read-char)
  233.     (search-forward "-----BEGIN PGP MESSAGE-----\n")
  234.     (search-backward "-----BEGIN PGP MESSAGE-----\n")
  235.     (delete-region start (point))
  236.     ))
  237.  
  238. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  239. ;;
  240. ;; decrypt a message in Rmail mode
  241. ;;
  242. (defun pgp-decrypt-message ()
  243.   "Decrypt and incoming mail message using pgp in Rmail mode"
  244.   (interactive)
  245.   (let ((pass) (tmp) (start) (process-environment))
  246.     
  247.     ;; setup the environment for pgp with tmp directory
  248.     (setq tmp (getenv "PGPPATH"))
  249.     (if (not tmp)
  250.     (error
  251.      "Please set your PGPPATH env variable before using this function!"))
  252.     (setq process-environment
  253.       (list (format "PGPPATH=%s" tmp)
  254.         (format "TMP=%s" pgp-tmp-dir)
  255.         "PGPPASSFD=0"
  256.         ))
  257.     
  258.     ;; get the password and destination address
  259.     (setq pass (read-password "PGP Password: "))
  260.     
  261.     ;; copy the message into the message file
  262.     (goto-char (point-min))
  263.     (search-forward "\n\n")
  264.     (setq start (point))
  265.     (rmail-edit-current-message)
  266.     (insert pass "\n")
  267.     
  268.     ;; call pgp on the message
  269.     (message "Working.  Please wait...")
  270.     (shell-command-on-region start (point-max) pgp-binary t)
  271.     
  272.     ;; remove the pgp information
  273.     (goto-char start)
  274.     (message "Press a key to remove pgp information from the message.")
  275.     (read-char)
  276.     (search-forward "\nSignature made")
  277.     (search-forward "\n")
  278.     (delete-region start (point))
  279.     (rmail-cease-edit)
  280.     ))
  281.  
  282. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  283. ;;
  284. ;; sign a message in Mail mode
  285. ;;
  286. (defun pgp-sign-message ()
  287.   "Sign your mail message using pgp in mail mode"
  288.   (interactive)
  289.   (let ((pass) (clear) (command) (tmp) (start) (process-environment))
  290.     
  291.     ;; setup the environment for pgp with tmp directory
  292.     (setq tmp (getenv "PGPPATH"))
  293.     (if (not tmp)
  294.     (error
  295.      "Please set your PGPPATH env variable before using this function!"))
  296.     (setq process-environment
  297.       (list (format "PGPPATH=%s" tmp)
  298.         (format "TMP=%s" pgp-tmp-dir)
  299.         "PGPPASSFD=0"
  300.         ))
  301.     
  302.     ;; get the password
  303.     (setq pass (read-password "PGP Password: "))
  304.     
  305.     ;; get signature.
  306.     (setq user (read-input
  307.         (format "Signature to use [%s]: " pgp-my-user-id)
  308.         ))
  309.     (if (string= user "")
  310.     (setq user pgp-my-user-id))
  311.     
  312.     (setq clear (y-or-n-p "Clear-text sign? "))
  313.     
  314.     ;; copy the message into the message file
  315.     (goto-char (point-min))
  316.     (search-forward "\n--text follows this line--\n")
  317.     (setq start (point))
  318.     (insert pass "\n")
  319.     
  320.     ;; call pgp on the message
  321.     (message "Working.  Please wait...")
  322.     (setq command (format "%s -fs -u '%s'" pgp-binary user))
  323.     (if clear
  324.     (setq command (concat command " +clear")))
  325.     (shell-command-on-region start (point-max) command t)
  326.     
  327.     ;; remove the pgp stuff if the user wants
  328.     (goto-char start)
  329.     (message "Press a key to remove pgp information from the message.")
  330.     (read-char)
  331.     (if clear
  332.     (progn
  333.       (search-forward "-----BEGIN PGP SIGNED MESSAGE-----\n")
  334.       (search-backward "-----BEGIN PGP SIGNED MESSAGE-----\n"))
  335.       (progn
  336.     (search-forward "-----BEGIN PGP MESSAGE-----\n")
  337.     (search-backward "-----BEGIN PGP MESSAGE-----\n")))
  338.     (delete-region start (point))
  339.     ))
  340.  
  341. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  342. ;;
  343. ;; verify the signature of an incoming message
  344. ;;
  345. (defun pgp-verify-message ()
  346.   "Verify an incoming cleartext-signed mail message using pgp in Rmail mode"
  347.   (interactive)
  348.   (let ((start) (tmp) (process-environment))
  349.     
  350.     ;; setup the environment for pgp with tmp directory
  351.     (setq tmp (getenv "PGPPATH"))
  352.     (if (not tmp)
  353.     (error
  354.      "Please set your PGPPATH env variable before using this function!"))
  355.     (setq process-environment
  356.       (list (format "PGPPATH=%s" tmp)
  357.         (format "TMP=%s" pgp-tmp-dir)
  358.         ))
  359.     
  360.     ;; copy the message into the message file
  361.     (goto-char (point-min))
  362.     (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----")
  363.     (beginning-of-line)
  364.     (setq start (point))
  365.     
  366.     ;; get a buffer
  367.     (save-excursion
  368.       ;; call pgp on the message
  369.       (message "Working.  Please wait...")
  370.       (shell-command-on-region start (point-max) pgp-binary nil)
  371.       
  372.       (goto-char (point-min))
  373.       (message "Press a key to return to message buffer")
  374.       (read-char)
  375.       (kill-buffer "*Shell Command Output*")
  376.       )
  377.     ))
  378.  
  379. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  380. ;;
  381. ;; append your public key on the end of a message in Mail mode
  382. ;;
  383. (defun pgp-append-public ()
  384.   "Add a public key to end of outgoing mail message using pgp in mail mode"
  385.   (interactive)
  386.   (let ((tmp) (start) (key) (process-environment) (public))
  387.     
  388.     ;; setup the environment for pgp with tmp directory
  389.     (setq tmp (getenv "PGPPATH"))
  390.     (if (not tmp)
  391.     (error
  392.      "Please set your PGPPATH env variable before using this function!"))
  393.     (setq process-environment
  394.       (list (format "PGPPATH=%s" tmp)
  395.         (format "TMP=%s" pgp-tmp-dir)
  396.         ))
  397.     (setq public (format "%s/tmp/public" tmp))
  398.     
  399.     ;; copy the public into the public file
  400.     (if (file-exists-p (concat public ".asc"))
  401.     (delete-file (concat public ".asc")))
  402.     
  403.     (setq key
  404.       (read-input (format "Public key to extract [%s]: " pgp-my-user-id)))
  405.     (if (string= key "")
  406.     (setq key pgp-my-user-id))
  407.     
  408.     ;; get the public key into the buffer
  409.     (save-excursion
  410.       (message "Working.  Please wait...")
  411.       (setq start (point-max))
  412.       (shell-command-on-region start start
  413.                    (format "%s -kx '%s' %s" pgp-binary key public)
  414.                    t)
  415.       (goto-char start)
  416.       (message "Press a key to remove pgp information from the message.")
  417.       (read-char)
  418.       (delete-region start (point-max))
  419.       
  420.       (insert-char ?\n 1)
  421.       (insert-file (concat public ".asc"))
  422.       (delete-file (concat public ".asc"))
  423.       )
  424.     ))
  425.