1;;; ps-ccrypt.el --- reading/writing/loading encrypted files
2
3;; Copyright (C) 1993, 1994, 1995, 1997  Free Software Foundation, Inc.
4;; Copyright (C) 2001-2018 Peter Selinger
5
6;; Author: jka@ece.cmu.edu (Jay K. Adams) (jka-compr.el)
7;; Changes: selinger@users.sourceforge.net (Peter Selinger) (ps-ccrypt.el)
8;; Maintainer: Peter Selinger
9;; Keywords: data
10
11;; This is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
13;; the Free Software Foundation; either version 2, or (at your option)
14;; any later version.
15
16;; This software is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with this software; see the file COPYING.  If not, write to the
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
25
26;;; Commentary:
27
28;; This package implements low-level support for reading, writing, and
29;; loading encrypted files.  It hooks into the low-level file I/O
30;; functions (including write-region and insert-file-contents) so that
31;; they automatically encrypt or decrypt a file if the file appears to
32;; need it (based on the extension of the file name).  Packages like
33;; Rmail, VM, GNUS, and Info should be able to work with encrypted
34;; files without modification.
35
36;;; Commentary on ccrypt support:
37
38;; support for encryption/decryption with ccrypt was added by Peter
39;; Selinger.  We have to deal with prompting users for passwords,
40;; remembering passwords for each buffer, etc.
41
42;; limitations:
43
44;; On some systems, passing the password to ccrypt in an environment
45;; variable may not be safe; this happens if users are able to display the
46;; environment of processes they don't own with the 'ps' program. I don't
47;; know of any system where this is still the case, but I heard that they
48;; may exist. In any case, ccrypt deletes the value from its environment as
49;; soon as it has been read; so this should not be a problem in most
50;; situations.
51
52;; Sometimes emacs will choke if it wants to auto-save a buffer in the
53;; absense of a password or a minibuffer for prompting for it. I have not
54;; yet figured out how to handle this situation; however, it does not arise
55;; during "normal" operation because when a buffer's name has the ".cpt"
56;; extension, a password is normally always defined for that buffer.
57
58;; Under certain circumstances, decrypted data will be written to disk
59;; temporarily. For instance, during each encryption operation, the
60;; decrypted data is written to a temporary file. This is because the
61;; call-process built-in function is designed to read from a file and write
62;; to a buffer, not the other way around. I don't know a way around this
63;; problem at the moment. Another potential way in which decrypted data
64;; might appear on disk is if buffer contents are swapped out from main
65;; memory.
66
67;; auto-save files should not be a problem, since such files are also
68;; encrypted if the buffer's filename indicates that they should be so.
69
70;;; todo:
71
72;; fix bug where "sh" does not return proper return value.
73;; add support for .gz.cpt and .gzc
74;; prompt for password twice when opening a new file.
75
76;; CHANGES:
77;;
78
79;; 2018/07/25: PS1 - Emacs 26 compatibility: fixed a bug caused by an
80;; incompatible change in write-region.
81;;
82;; 2017/03/05: PS1 - handle variable rename
83;; (inhibit-first-line-modes-suffixes -> inhibit-local-variables-suffixes)
84;; in a backward compatible way.
85;;
86;; 2017/02/22: PS1 - fixed warnings: inhibit-first-line-modes-suffixes
87;; -> inhibit-local-variables-suffixes, fix buffer-file-type warning.
88;;
89;; 2016/11/13: PS1 - delete KEY earlier (even on password mismatch).
90;;
91;; 2016/11/13: PS1 - move (setenv "KEY") into the unwind-protect.
92;; Note: this still leaks the password if the user mistyped it.
93;;
94;; 2016/11/13: PS1 - delete password from environment after each use.
95;;
96;; 2010/12/28: PS1 - only display "Password does not match" message if
97;; password was just entered by the user; if the non-matching password
98;; is stored, just prompt for it without error.
99;;
100;; 2010/12/28: PS1 - moved "encrypting xx" and "decrypting xx"
101;; messages inside ps-ccrypt-call-process; this ensures the message
102;; will appear even after a mismatched password prompt.
103;;
104;; 2010/12/28: PS1 - when inserting a file in a buffer, use filename,
105;; not buffer name, in password prompt.
106;;
107;; 2010/12/28: PS1 - use existing buffer password when re-reading a
108;; file.
109;;
110;; 2010/11/10: PS1 - fix mapcar compiler warnings.
111;;
112;; 2008/02/04: PS1 - better error message if ccrypt command not found.
113;;
114;; 2006/08/11: PS1 - removed compression functionality, renamed
115;; package as ps-ccrypt. This can now coexist peacefully with
116;; jka-compr.
117;;
118;; 2003/08/25: PS1 - bugfix
119;;
120;; 2003/08/13: JR1 - provide jka-compr existence functions in
121;; jka-compr-ccrypt.el, to keep info.el happy.
122;;
123;; 2001/10/27: PS1 - pass keyword to ccrypt in environment variable,
124;; not on command line. Renamed package as jka-compr-ccrypt.
125
126;; INSTRUCTIONS:
127;;
128;; To use ps-ccrypt, simply load this package, and edit as usual.
129;; One way to do this automatically is to include the lines
130;;  (setq load-path (cons "<path>" load-path))
131;;  (require 'ps-ccrypt "ps-ccrypt.el")
132;; in your .emacs file, where <path> is the pathname where this file
133;; is found.
134;;
135;; The operation of this package should be transparent to the user
136;; (except for messages appearing when a file is being encrypted or
137;; decrypted).
138;;
139;; The variable, ps-ccrypt-encryption-info-list can be used to
140;; customize ps-ccrypt to work with other encryption programs.
141;; The default value of this variable allows ps-ccrypt to work with
142;; ccrypt.
143;;
144;; If you don't want messages about encryption to show up in the echo
145;; area, you can set the encrypt-name and deencrypt-name fields of
146;; the ps-ccrypt-encryption-info-list to nil.
147;;
148;; The password for a buffer can be changed with the interactive command
149;; M-x ccrypt-set-buffer-password. Note that the change does not affect
150;; anything until the next time the buffer is saved.
151
152;; ACKNOWLEDGMENTS
153;;
154;; ps-ccrypt is an adaptation of jka-compr, which is part of GNU Emacs.
155;;
156;; jka-compr is a V19 adaptation of jka-compr for V18 of Emacs.  Many people
157;; have made helpful suggestions, reported bugs, and even fixed bugs in
158;; jka-compr.  I recall the following people as being particularly helpful.
159;;
160;;   Jean-loup Gailly
161;;   David Hughes
162;;   Richard Pieri
163;;   Daniel Quinlan
164;;   Chris P. Ross
165;;   Rick Sladkey
166;;
167;; Andy Norman's ange-ftp was the inspiration for the original jka-compr for
168;; Version 18 of Emacs.
169;;
170;; After I had made progress on the original jka-compr for V18, I learned of a
171;; package written by Kazushi Jam Marukawa, called jam-zcat, that did exactly
172;; what I was trying to do.  I looked over the jam-zcat source code and
173;; probably got some ideas from it.
174;;
175
176
177;;; Code:
178
179;; disable compiler warning about use of a "free variable"
180(defvar buffer-file-type)
181
182;; inhibit-first-line-modes-suffixes was renamed to
183;; inhibit-local-variables-suffixes in Emacs 24.1. Ensure backward
184;; compatibility with older versions.
185(if (not (boundp 'inhibit-local-variables-suffixes))
186    (defvaralias 'inhibit-local-variables-suffixes 'inhibit-first-line-modes-suffixes))
187
188(defgroup encryption nil
189  "Data encryption utilities"
190  :group 'data)
191
192(defgroup ps-ccrypt nil
193  "ps-ccrypt customization"
194  :group 'encryption)
195
196
197(defcustom ps-ccrypt-shell "sh"
198  "*Shell to be used for calling encryption programs. This is only used to
199discard part of the output when a file is partially decrypted.  Note:
200the hard-coded syntax in ps-ccrypt more or less assumes that this is
201either sh or bash. See also the function ps-ccrypt-shell-escape."
202  :type 'string
203  :group 'ps-ccrypt)
204
205(defun ps-ccrypt-shell-escape (x)
206  "Takes a string and returns its escaped form to be used on the
207command line of the shell whose name is set in ps-ccrypt-shell."
208  (concat "\""
209	  (apply 'concat
210		 (mapcar (function
211			  (lambda (c)
212			    (if (memq c '(?\" ?\\ ?\$))
213				(list ?\\ c)
214			      (char-to-string c))))
215			 x))
216	  "\""))
217
218
219;;; I have this defined so that .cpt files are assumed to be in ccrypt
220;;; format.
221(defcustom ps-ccrypt-encryption-info-list
222  ;;[regexp
223  ;; encr-message encr-prog encr-args
224  ;; decr-message decr-prog decr-args
225  ;; can-append auto-mode-flag retval-list password-flag]
226  '(["\\.cpt\\(\\#\\|~\\|\\.~[0-9]+~\\)?\\'"
227     "encrypting"     ("ccrypt" "-q" "-E" "KEY")
228     "decrypting"     ("ccrypt" "-q" "-d" "-E" "KEY")
229     nil t (0) t])
230
231  "List of vectors that describe available encryption and encryption
232techniques.  Each element, which describes an encryption or encryption
233technique, is a vector of the form [REGEXP ENCRYPT-MSG ENCRYPT-COMMAND
234DECRYPT-MSG DECRYPT-COMMAND APPEND-FLAG AUTO-MODE-FLAG RETVAL-LIST
235PASSWORD-FLAG], where:
236
237   regexp                is a regexp that matches filenames that are
238                         encrypted with this format
239
240   encrypt-msg          is the message to issue to the user when doing this
241                         type of encryption (nil means no message)
242
243   encrypt-command      is a command that performs this encryption, that
244                         is, a list consisting of a program name and arguments
245
246   decrypt-msg        is the message to issue to the user when doing this
247                         type of decryption (nil means no message)
248
249   decrypt-command    is a command that performs this encryption, that
250                         is, a list consisting of a program name and arguments
251
252   append-flag           is non-nil if this encryption technique can be
253                         appended
254
255   auto-mode-flag        non-nil means strip the regexp from file names
256                         before attempting to set the mode
257
258   retval-list           list of acceptable return values for encrypt
259                         and decrypt program
260
261   password-flag         non-nil if we are dealing with encryption rather
262                         than encryption. In this case, the password is
263                         passed to the ccrypt command in the environment
264                         variable KEY."
265
266  :type '(repeat (vector regexp
267			 (choice :tag "Encrypt Message"
268				 (string :format "%v")
269				 (const :tag "No Message" nil))
270			 (repeat :tag "Encrypt Command" string)
271			 (choice :tag "Decrypt Message"
272				 (string :format "%v")
273				 (const :tag "No Message" nil))
274			 (repeat :tag "Decrypt Command" string)
275			 (boolean :tag "Append")
276			 (boolean :tag "Auto Mode")
277                         (repeat :tag "Acceptable Return Values" integer)
278                         (boolean :tag "Password Mode")))
279  :group 'ps-ccrypt)
280
281(defvar ps-ccrypt-mode-alist-additions
282  (list (cons "\\.tgz\\'" 'tar-mode))
283  "A list of pairs to add to `auto-mode-alist' when ps-ccrypt is installed.")
284
285;; List of all the elements we actually added to file-coding-system-alist.
286(defvar ps-ccrypt-added-to-file-coding-system-alist nil)
287
288(defvar ps-ccrypt-file-name-handler-entry
289  nil
290  "The entry in `file-name-handler-alist' used by the ps-ccrypt I/O functions.")
291
292;;; Functions for accessing the return value of ps-ccrypt-get-encryption-info
293(defun ps-ccrypt-info-regexp               (info)  (aref info 0))
294(defun ps-ccrypt-info-encrypt-message     (info)  (aref info 1))
295(defun ps-ccrypt-info-encrypt-command     (info)  (aref info 2))
296(defun ps-ccrypt-info-decrypt-message   (info)  (aref info 3))
297(defun ps-ccrypt-info-decrypt-command   (info)  (aref info 4))
298(defun ps-ccrypt-info-can-append           (info)  (aref info 5))
299(defun ps-ccrypt-info-strip-extension      (info)  (aref info 6))
300(defun ps-ccrypt-info-retval-list          (info)  (aref info 7))
301(defun ps-ccrypt-info-password-flag        (info)  (aref info 8))
302
303(defun ps-ccrypt-get-encryption-info (filename)
304  "Return information about the encryption scheme of FILENAME.
305The determination as to which encryption scheme, if any, to use is
306based on the filename itself and `ps-ccrypt-encryption-info-list'."
307  (catch 'encryption-info
308    (let ((case-fold-search nil))
309      (mapc
310       (function (lambda (x)
311		   (and (string-match (ps-ccrypt-info-regexp x) filename)
312			(throw 'encryption-info x))))
313       ps-ccrypt-encryption-info-list)
314      nil)))
315
316(defun ps-ccrypt-substitute (list key value)
317  "Replace key by value in list"
318  (mapcar (function (lambda (x)
319		      (if (eq x key)
320			  value
321			x)))
322	  list))
323
324(defvar ps-ccrypt-buffer-password nil
325  "The encryption password. This variable is buffer-local.")
326
327(make-variable-buffer-local 'ps-ccrypt-buffer-password)
328(put 'ps-ccrypt-buffer-password 'permanent-local t)
329
330(defun ps-ccrypt-read-passwd (&optional confirm filename)
331  (read-passwd (format "Password for %s: " (or filename (buffer-name))) confirm nil))
332
333(defun ps-ccrypt-get-buffer-password (&optional buffer)
334  "Get encryption password for BUFFER (default: current buffer).
335Return nil if not set."
336  (with-current-buffer (or buffer (current-buffer))
337    ps-ccrypt-buffer-password))
338
339(defun ps-ccrypt-set-buffer-password (password &optional buffer)
340  "Set the encryption password for BUFFER (default: current buffer)."
341  (with-current-buffer (or buffer (current-buffer))
342    (setq ps-ccrypt-buffer-password password)))
343
344(defun ccrypt-set-buffer-password ()
345  "Set the encryption password for current buffer."
346  (interactive "")
347  (setq ps-ccrypt-buffer-password
348	(ps-ccrypt-read-passwd t)))
349
350(put 'encryption-error 'error-conditions '(encryption-error file-error error))
351
352;(defvar ps-ccrypt-acceptable-retval-list '(0 2 141))
353
354(defun ps-ccrypt-error (command infile message &optional errfile)
355
356  (let ((errbuf (get-buffer-create " *ps-ccrypt-error*"))
357	(curbuf (current-buffer)))
358    (with-current-buffer errbuf
359      (widen) (erase-buffer)
360      (insert (format "Error while executing \"%s < %s\"\n\n"
361		      (mapconcat 'identity command " ")
362		      infile))
363
364      (and errfile
365	   (insert-file-contents errfile)))
366     (display-buffer errbuf))
367
368  (signal 'encryption-error
369	  (list "Opening input file" (format "error %s" message) infile)))
370
371(defvar ps-ccrypt-dd-program
372  "/bin/dd")
373
374(defvar ps-ccrypt-dd-blocksize 256)
375
376(defun ps-ccrypt-partial-decrypt (command message infile beg
377					     len retvals &optional password)
378  "Call program PROG with ARGS args taking input from INFILE.
379Fourth and fifth args, BEG and LEN, specify which part of the output
380to keep: LEN chars starting BEG chars from the beginning.
381Sixth arg, RETVALS, specifies acceptable return values.
382Seventh arg, &optional PASSWORD, specifies encryption password, if any."
383  (let* ((skip (/ beg ps-ccrypt-dd-blocksize))
384	 (prefix (- beg (* skip ps-ccrypt-dd-blocksize)))
385	 (count (and len (1+ (/ (+ len prefix) ps-ccrypt-dd-blocksize))))
386	 (start (point))
387	 (dd (format "%s bs=%d skip=%d %s 2> /dev/null"
388		     ps-ccrypt-dd-program
389		     ps-ccrypt-dd-blocksize
390		     skip
391		     ;; dd seems to be unreliable about
392		     ;; providing the last block.  So, always
393		     ;; read one more than you think you need.
394		     (if count (concat "count=" (1+ count)) "")))
395	 (pipe-command (append command (list "|" dd))))
396
397    (setq password (ps-ccrypt-call-process pipe-command
398						  ps-ccrypt-shell
399						  message infile t retvals
400						  password))
401
402    ;; Delete the stuff after what we want, if there is any.
403    (and
404     len
405     (< (+ start prefix len) (point))
406     (delete-region (+ start prefix len) (point)))
407
408    ;; Delete the stuff before what we want.
409    (delete-region start (+ start prefix)))
410  password)
411
412(defun ps-ccrypt-call-process2 (command infile buffer display &optional shell)
413  "Similar to call-process. If SHELL is given and non-nil, then execute
414the given command in the given shell. COMMAND in this case is a list
415of strings, which are concatenated (with spaces) before execution.
416Redirections, pipelines, etc, are permissible. If SHELL is absent or
417nil, then execute the command directly, without a shell. In this case,
418command must be a list of a program name, followed by individual
419command line arguments."
420
421  (if shell
422      (call-process shell infile buffer display
423		    "-c" (mapconcat 'identity command " "))
424    (apply 'call-process (car command) infile buffer display (cdr command)))
425  )
426
427;; pw-fresh is non-nil if the password was recently supplied by the user.
428(defun ps-ccrypt-call-process (command shell message infile output retvals &optional password pw-fresh)
429
430  (let ((filename (expand-file-name infile))
431        (err-file (ps-ccrypt-make-temp-name))
432	(coding-system-for-read (or coding-system-for-read 'undecided))
433	(coding-system-for-write 'no-conversion)
434	(buffer output)
435	done)
436
437    (unwind-protect
438
439        (while (not done)
440	  (message (format "%s..." message))
441	  (if password
442	      (setenv "KEY" password))
443	  (let*
444	      ((status
445		(if shell
446		    (call-process shell infile (list buffer err-file) nil
447				  "-c" (mapconcat 'identity command " "))
448		  (condition-case err
449		      (apply 'call-process (car command) infile
450			     (list buffer err-file) nil (cdr command))
451		    (file-error
452		     (if (equal (nth 1 err) "Searching for program")
453			 ;; if command not found, output special error
454			 (error "Failed to run %s: %s" (nth 3 err) (nth 2 err)) (sit-for 1)
455		       ;; pass on other errors (e.g. input file not found)
456		       (signal (car err) (cdr err))))))))
457
458            ;; do not leave the password in the enviroment.
459            (setenv "KEY")
460	    (cond ((and password (eq status 4))
461		   (cond (pw-fresh
462			  (message "Password does not match; please try again")
463			  (sit-for 1)))
464		   (setq password (ps-ccrypt-read-passwd nil filename))
465		   (setq pw-fresh t))
466		  ((not (memq status retvals))
467		   (ps-ccrypt-error command
468				    infile message err-file))
469		  (t
470		   (setq done t)
471		   (message (format "%s...done" message))))))
472
473      (ps-ccrypt-delete-temp-file err-file)
474      (setenv "KEY"))
475
476    password))
477
478
479;;; Support for temp files.  Much of this was inspired if not lifted
480;;; from ange-ftp.
481
482(defcustom ps-ccrypt-temp-name-template
483  (expand-file-name "jka-com" temporary-file-directory)
484  "Prefix added to all temp files created by ps-ccrypt.
485There should be no more than seven characters after the final `/'."
486  :type 'string
487  :group 'ps-ccrypt)
488
489(defvar ps-ccrypt-temp-name-table (make-vector 31 nil))
490
491(defun ps-ccrypt-make-temp-name (&optional local-copy)
492  "This routine will return the name of a new file."
493  (let* ((lastchar ?a)
494	 (prevchar ?a)
495	 (template (concat ps-ccrypt-temp-name-template "aa"))
496	 (lastpos (1- (length template)))
497	 (not-done t)
498	 file
499	 entry)
500
501    (while not-done
502      (aset template lastpos lastchar)
503      (setq file (concat (make-temp-name template) "#"))
504      (setq entry (intern file ps-ccrypt-temp-name-table))
505      (if (or (get entry 'active)
506	      (file-exists-p file))
507
508	  (progn
509	    (setq lastchar (1+ lastchar))
510	    (if (> lastchar ?z)
511		(progn
512		  (setq prevchar (1+ prevchar))
513		  (setq lastchar ?a)
514		  (if (> prevchar ?z)
515		      (error "Can't allocate temp file.")
516		    (aset template (1- lastpos) prevchar)))))
517
518	(put entry 'active (not local-copy))
519	(setq not-done nil)))
520
521    file))
522
523
524(defun ps-ccrypt-delete-temp-file (temp)
525
526  (put (intern temp ps-ccrypt-temp-name-table)
527       'active nil)
528
529  (condition-case ()
530      (delete-file temp)
531    (error nil)))
532
533
534(defun ps-ccrypt-write-region (start end file &optional append visit lockname mustbenew)
535  (let* ((filename (expand-file-name file))
536	 (visit-file (if (stringp visit) (expand-file-name visit) filename))
537	 (lock-file (if (stringp lockname) (expand-file-name lockname) nil))
538	 (info (ps-ccrypt-get-encryption-info visit-file)))
539
540      (if info
541
542	  (let ((can-append (ps-ccrypt-info-can-append info))
543		(encrypt-message (ps-ccrypt-info-encrypt-message info))
544		(encrypt-command (ps-ccrypt-info-encrypt-command info))
545		(password (if (ps-ccrypt-info-password-flag info)
546			      (or (ps-ccrypt-get-buffer-password)
547				  (ps-ccrypt-read-passwd t filename))
548			    nil))
549		(retvals (ps-ccrypt-info-retval-list info))
550		(base-name (file-name-nondirectory visit-file))
551		temp-file temp-buffer
552		;; we need to leave `last-coding-system-used' set to its
553		;; value after calling write-region the first time, so
554		;; that `basic-save-buffer' sees the right value.
555		(coding-system-used last-coding-system-used))
556
557	    (setq temp-buffer (get-buffer-create " *ps-ccrypt-wr-temp*"))
558	    (with-current-buffer temp-buffer
559	      (widen) (erase-buffer))
560
561	    (if (and append
562		     (not can-append)
563		     (file-exists-p filename))
564
565		(let* ((local-copy (file-local-copy filename))
566		       (local-file (or local-copy filename)))
567
568		  (setq temp-file local-file))
569
570	      (setq temp-file (ps-ccrypt-make-temp-name)))
571
572	    (ps-ccrypt-run-real-handler 'write-region
573					(list start end temp-file t 'dont))
574	    ;; save value used by the real write-region
575	    (setq coding-system-used last-coding-system-used)
576
577	    ;; Here we must read the output of encrypt program as is
578	    ;; without any code conversion.
579	    (let ((coding-system-for-read 'no-conversion))
580	      (setq password
581		    (ps-ccrypt-call-process encrypt-command
582					    nil
583					    (concat encrypt-message
584						    " " base-name)
585					    temp-file
586					    temp-buffer
587					    retvals
588					    password)))
589
590	    (with-current-buffer temp-buffer
591              (let ((coding-system-for-write 'no-conversion))
592                (if (memq system-type '(ms-dos windows-nt))
593                    (setq buffer-file-type t) )
594                (ps-ccrypt-run-real-handler 'write-region
595                                            (list (point-min) (point-max)
596                                                  filename
597                                                  (and append can-append) 'dont lock-file mustbenew))
598                (erase-buffer)) )
599
600	    (ps-ccrypt-delete-temp-file temp-file)
601
602	    (cond
603	     ((eq visit t)
604	      (setq buffer-file-name filename)
605	      (ps-ccrypt-set-buffer-password password)
606	      (set-visited-file-modtime))
607	     ((stringp visit)
608	      (setq buffer-file-name visit)
609	      (ps-ccrypt-set-buffer-password password)
610	      (let ((buffer-file-name filename))
611		(set-visited-file-modtime))))
612
613	    (and (or (eq visit t)
614		     (eq visit nil)
615		     (stringp visit))
616		 (message "Wrote %s" visit-file))
617
618	    ;; ensure `last-coding-system-used' has an appropriate value
619	    (setq last-coding-system-used coding-system-used)
620
621	    nil)
622
623	(ps-ccrypt-run-real-handler 'write-region
624				    (list start end filename append visit lock-file mustbenew)))))
625
626
627(defun ps-ccrypt-insert-file-contents (file &optional visit beg end replace)
628  (barf-if-buffer-read-only)
629
630  (and (or beg end)
631       visit
632       (error "Attempt to visit less than an entire file"))
633
634  (let* ((filename (expand-file-name file))
635	 (info (ps-ccrypt-get-encryption-info filename)))
636
637    (if info
638
639	(let* ((pw-fresh nil)
640	       (decrypt-message (ps-ccrypt-info-decrypt-message info))
641	       (decrypt-command (ps-ccrypt-info-decrypt-command info))
642	       (password (if (ps-ccrypt-info-password-flag info)
643			     (or (ps-ccrypt-get-buffer-password)
644				 (progn (setq pw-fresh t)
645					(ps-ccrypt-read-passwd nil filename)))
646			   nil))
647	       (retvals (ps-ccrypt-info-retval-list info))
648	       (base-name (file-name-nondirectory filename))
649	       (notfound nil)
650	       (local-copy
651		(ps-ccrypt-run-real-handler 'file-local-copy (list filename)))
652	       local-file
653	       size start
654	       (coding-system-for-read
655		(or coding-system-for-read
656		    ;; If multibyte characters are disabled,
657		    ;; don't do that conversion.
658		    (and (null enable-multibyte-characters)
659			 (or (auto-coding-alist-lookup
660			      (ps-ccrypt-byte-compiler-base-file-name file))
661			     'raw-text))
662		    (let ((coding (find-operation-coding-system
663				   'insert-file-contents
664				   (ps-ccrypt-byte-compiler-base-file-name file))))
665		      (and (consp coding) (car coding)))
666		    'undecided)) )
667
668	  (setq local-file (or local-copy filename))
669
670	  (if visit
671	      (setq buffer-file-name filename))
672
673	  (unwind-protect		; to make sure local-copy gets deleted
674
675	      (progn
676
677		(condition-case error-code
678
679		    (progn
680		      (if replace
681			  (goto-char (point-min)))
682		      (setq start (point))
683		      (if (or beg end)
684			  (ps-ccrypt-partial-decrypt
685			   decrypt-command
686			   (concat decrypt-message
687				   " " base-name)
688			   local-file
689			   (or beg 0)
690			   (if (and beg end)
691			       (- end beg)
692			     end)
693			   retvals
694			   password)
695			;; If visiting, bind off buffer-file-name so that
696			;; file-locking will not ask whether we should
697			;; really edit the buffer.
698			(let ((buffer-file-name
699			       (if visit nil buffer-file-name)))
700			  (setq password
701				(ps-ccrypt-call-process
702				 decrypt-command
703				 nil
704				 (concat decrypt-message
705					 " " base-name)
706				 local-file
707				 t
708				 retvals
709				 password
710				 pw-fresh))))
711		      (setq size (- (point) start))
712		      (if replace
713			  (let* ((del-beg (point))
714				 (del-end (+ del-beg size)))
715			    (delete-region del-beg
716					   (min del-end (point-max)))))
717		      (goto-char start))
718		  (error
719		   (if (and (eq (car error-code) 'file-error)
720			    (eq (nth 3 error-code) local-file))
721		       (if visit
722			   (setq notfound error-code)
723			 (signal 'file-error
724				 (cons "Opening input file"
725				       (nthcdr 2 error-code))))
726		     (signal (car error-code) (cdr error-code))))))
727
728	    (and
729	     local-copy
730	     (file-exists-p local-copy)
731	     (delete-file local-copy)))
732
733	  (and
734	   visit
735	   (progn
736	     (unlock-buffer)
737	     (setq buffer-file-name filename)
738	     (set-visited-file-modtime)))
739
740	  (and visit
741	     (ps-ccrypt-set-buffer-password password))
742
743	  (and
744	   visit
745	   notfound
746	   (signal 'file-error
747		   (cons "Opening input file" (nth 2 notfound))))
748
749	  ;; This is done in insert-file-contents after we return.
750	  ;; That is a little weird, but better to go along with it now
751	  ;; than to change it now.
752
753;;;	  ;; Run the functions that insert-file-contents would.
754;;; 	  (let ((p after-insert-file-functions)
755;;; 		(insval size))
756;;; 	    (while p
757;;; 	      (setq insval (funcall (car p) size))
758;;; 	      (if insval
759;;; 		  (progn
760;;; 		    (or (integerp insval)
761;;; 			(signal 'wrong-type-argument
762;;; 				(list 'integerp insval)))
763;;; 		    (setq size insval)))
764;;; 	      (setq p (cdr p))))
765
766	  (list filename size))
767
768      (ps-ccrypt-run-real-handler 'insert-file-contents
769				  (list file visit beg end replace)))))
770
771
772(defun ps-ccrypt-file-local-copy (file)
773  (let* ((filename (expand-file-name file))
774	 (info (ps-ccrypt-get-encryption-info filename)))
775
776    (if info
777
778	(let* ((pw-fresh nil)
779	       (decrypt-message (ps-ccrypt-info-decrypt-message info))
780	       (decrypt-command (ps-ccrypt-info-decrypt-command info))
781	       (password (if (ps-ccrypt-info-password-flag info)
782			     (or (ps-ccrypt-get-buffer-password)
783				 (progn (setq pw-fresh t)
784					(ps-ccrypt-read-passwd nil filename)))
785			   nil))
786	       (retvals (ps-ccrypt-info-retval-list info))
787	       (base-name (file-name-nondirectory filename))
788	       (local-copy
789		(ps-ccrypt-run-real-handler 'file-local-copy (list filename)))
790	       (temp-file (ps-ccrypt-make-temp-name t))
791	       (temp-buffer (get-buffer-create " *ps-ccrypt-flc-temp*"))
792	       (notfound nil)
793	       local-file)
794
795	  (setq local-file (or local-copy filename))
796
797	  (unwind-protect
798
799	      (with-current-buffer temp-buffer
800
801		;; Here we must read the output of decrypt program
802		;; and write it to TEMP-FILE without any code
803		;; conversion.  An appropriate code conversion (if
804		;; necessary) is done by the later I/O operation
805		;; (e.g. load).
806		(let ((coding-system-for-read 'no-conversion)
807		      (coding-system-for-write 'no-conversion))
808
809		  (ps-ccrypt-call-process
810		   decrypt-command
811		   nil
812		   (concat decrypt-message
813			   " " base-name)
814		   local-file
815		   t
816		   retvals
817		   password
818		   pw-fresh)
819
820		  (write-region
821		   (point-min) (point-max) temp-file nil 'dont)))
822
823	    (and
824	     local-copy
825	     (file-exists-p local-copy)
826	     (delete-file local-copy))
827
828	    (kill-buffer temp-buffer))
829
830	  temp-file)
831
832      (ps-ccrypt-run-real-handler 'file-local-copy (list filename)))))
833
834
835;;; Support for loading encrypted files.
836(defun ps-ccrypt-load (file &optional noerror nomessage nosuffix)
837  "Documented as original."
838
839  (let* ((local-copy (ps-ccrypt-file-local-copy file))
840	 (load-file (or local-copy file)))
841
842    (unwind-protect
843
844	(let (inhibit-file-name-operation
845	      inhibit-file-name-handlers)
846	  (or nomessage
847	      (message "Loading %s..." file))
848
849	  (let ((load-force-doc-strings t))
850	    (load load-file noerror t t))
851
852	  (or nomessage
853	      (message "Loading %s...done." file)))
854
855      (ps-ccrypt-delete-temp-file local-copy))
856
857    t))
858
859(defun ps-ccrypt-byte-compiler-base-file-name (file)
860  (let ((info (ps-ccrypt-get-encryption-info file)))
861    (if (and info (ps-ccrypt-info-strip-extension info))
862	(save-match-data
863	  (substring file 0 (string-match (ps-ccrypt-info-regexp info) file)))
864      file)))
865
866(put 'write-region 'ps-ccrypt 'ps-ccrypt-write-region)
867(put 'insert-file-contents 'ps-ccrypt 'ps-ccrypt-insert-file-contents)
868(put 'file-local-copy 'ps-ccrypt 'ps-ccrypt-file-local-copy)
869(put 'load 'ps-ccrypt 'ps-ccrypt-load)
870(put 'byte-compiler-base-file-name 'ps-ccrypt
871     'ps-ccrypt-byte-compiler-base-file-name)
872
873(defvar ps-ccrypt-inhibit nil
874  "Non-nil means inhibit automatic decryption temporarily.
875Lisp programs can bind this to t to do that.
876It is not recommended to set this variable permanently to anything but nil.")
877
878(defun ps-ccrypt-handler (operation &rest args)
879  (save-match-data
880    (let ((jka-op (get operation 'ps-ccrypt)))
881      (if (and jka-op (not ps-ccrypt-inhibit))
882	  (apply jka-op args)
883	(ps-ccrypt-run-real-handler operation args)))))
884
885;; If we are given an operation that we don't handle,
886;; call the Emacs primitive for that operation,
887;; and manipulate the inhibit variables
888;; to prevent the primitive from calling our handler again.
889(defun ps-ccrypt-run-real-handler (operation args)
890  (let ((inhibit-file-name-handlers
891	 (cons 'ps-ccrypt-handler
892	       (and (eq inhibit-file-name-operation operation)
893		    inhibit-file-name-handlers)))
894	(inhibit-file-name-operation operation))
895    (apply operation args)))
896
897;;;###autoload(defun auto-encryption-mode (&optional arg)
898;;;###autoload  "\
899;;;###autoloadToggle automatic file encryption and decryption.
900;;;###autoloadWith prefix argument ARG, turn auto encryption on if positive, else off.
901;;;###autoloadReturns the new status of auto encryption (non-nil means on)."
902;;;###autoload  (interactive "P")
903;;;###autoload  (if (not (fboundp 'ps-ccrypt-installed-p))
904;;;###autoload      (progn
905;;;###autoload        (require 'ps-ccrypt)
906;;;###autoload        ;; That turned the mode on, so make it initially off.
907;;;###autoload        (toggle-auto-encryption)))
908;;;###autoload  (toggle-auto-encryption arg t))
909
910(defun toggle-auto-encryption (&optional arg message)
911  "Toggle automatic file encryption and decryption.
912With prefix argument ARG, turn auto encryption on if positive, else off.
913Returns the new status of auto encryption (non-nil means on).
914If the argument MESSAGE is non-nil, it means to print a message
915saying whether the mode is now on or off."
916  (interactive "P\np")
917  (let* ((installed (ps-ccrypt-installed-p))
918	 (flag (if (null arg)
919		   (not installed)
920		 (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0))))))
921
922    (cond
923     ((and flag installed) t)		; already installed
924
925     ((and (not flag) (not installed)) nil) ; already not installed
926
927     (flag
928      (ps-ccrypt-install))
929
930     (t
931      (ps-ccrypt-uninstall)))
932
933
934    (and message
935	 (if flag
936	     (message "Automatic file (de)encryption is now ON.")
937	   (message "Automatic file (de)encryption is now OFF.")))
938
939    flag))
940
941(defun ps-ccrypt-build-file-regexp ()
942  (concat
943   "\\("
944   (mapconcat
945    'ps-ccrypt-info-regexp
946    ps-ccrypt-encryption-info-list
947    "\\)\\|\\(")
948   "\\)"))
949
950
951(defun ps-ccrypt-install ()
952  "Install ps-ccrypt.
953This adds entries to `file-name-handler-alist' and `auto-mode-alist'
954and `inhibit-local-variables-suffixes'."
955
956  (setq ps-ccrypt-file-name-handler-entry
957	(cons (ps-ccrypt-build-file-regexp) 'ps-ccrypt-handler))
958
959  (setq file-name-handler-alist (cons ps-ccrypt-file-name-handler-entry
960				      file-name-handler-alist))
961
962  (setq ps-ccrypt-added-to-file-coding-system-alist nil)
963
964  (mapc
965   (function (lambda (x)
966	       ;; Don't do multibyte encoding on the encrypted files.
967	       (let ((elt (cons (ps-ccrypt-info-regexp x)
968				 '(no-conversion . no-conversion))))
969		 (setq file-coding-system-alist
970		       (cons elt file-coding-system-alist))
971		 (setq ps-ccrypt-added-to-file-coding-system-alist
972		       (cons elt ps-ccrypt-added-to-file-coding-system-alist)))
973
974	       (and (ps-ccrypt-info-strip-extension x)
975		    ;; Make entries in auto-mode-alist so that modes
976		    ;; are chosen right according to the file names
977		    ;; sans `.gz'.
978		    (setq auto-mode-alist
979			  (cons (list (ps-ccrypt-info-regexp x)
980				      nil 'ps-ccrypt)
981				auto-mode-alist))
982		    ;; Also add these regexps to
983		    ;; inhibit-local-variables-suffixes, so that a
984		    ;; -*- line in the first file of a encrypted tar
985		    ;; file doesn't override tar-mode.
986		    (setq inhibit-local-variables-suffixes
987			  (cons (ps-ccrypt-info-regexp x)
988				inhibit-local-variables-suffixes)))))
989   ps-ccrypt-encryption-info-list)
990  (setq auto-mode-alist
991	(append auto-mode-alist ps-ccrypt-mode-alist-additions)))
992
993
994(defun ps-ccrypt-uninstall ()
995  "Uninstall ps-ccrypt.
996This removes the entries in `file-name-handler-alist' and `auto-mode-alist'
997and `inhibit-local-variables-suffixes' that were added
998by `ps-ccrypt-installed'."
999  ;; Delete from inhibit-local-variables-suffixes
1000  ;; what ps-ccrypt-install added.
1001  (mapc
1002     (function (lambda (x)
1003		 (and (ps-ccrypt-info-strip-extension x)
1004		      (setq inhibit-local-variables-suffixes
1005			    (delete (ps-ccrypt-info-regexp x)
1006				    inhibit-local-variables-suffixes)))))
1007     ps-ccrypt-encryption-info-list)
1008
1009  (let* ((fnha (cons nil file-name-handler-alist))
1010	 (last fnha))
1011
1012    (while (cdr last)
1013      (if (eq (cdr (car (cdr last))) 'ps-ccrypt-handler)
1014	  (setcdr last (cdr (cdr last)))
1015	(setq last (cdr last))))
1016
1017    (setq file-name-handler-alist (cdr fnha)))
1018
1019  (let* ((ama (cons nil auto-mode-alist))
1020	 (last ama)
1021	 entry)
1022
1023    (while (cdr last)
1024      (setq entry (car (cdr last)))
1025      (if (or (member entry ps-ccrypt-mode-alist-additions)
1026	      (and (consp (cdr entry))
1027		   (eq (nth 2 entry) 'ps-ccrypt)))
1028	  (setcdr last (cdr (cdr last)))
1029	(setq last (cdr last))))
1030
1031    (setq auto-mode-alist (cdr ama)))
1032
1033  (let* ((ama (cons nil file-coding-system-alist))
1034	 (last ama)
1035	 entry)
1036
1037    (while (cdr last)
1038      (setq entry (car (cdr last)))
1039      (if (member entry ps-ccrypt-added-to-file-coding-system-alist)
1040	  (setcdr last (cdr (cdr last)))
1041	(setq last (cdr last))))
1042
1043    (setq file-coding-system-alist (cdr ama))))
1044
1045
1046(defun ps-ccrypt-installed-p ()
1047  "Return non-nil if ps-ccrypt is installed.
1048The return value is the entry in `file-name-handler-alist' for ps-ccrypt."
1049
1050  (let ((fnha file-name-handler-alist)
1051	(installed nil))
1052
1053    (while (and fnha (not installed))
1054     (and (eq (cdr (car fnha)) 'ps-ccrypt-handler)
1055	   (setq installed (car fnha)))
1056      (setq fnha (cdr fnha)))
1057
1058    installed))
1059
1060;;; Add the file I/O hook if it does not already exist.
1061;;; Make sure that ps-ccrypt-file-name-handler-entry is eq to the
1062;;; entry for ps-ccrypt in file-name-handler-alist.
1063(and (ps-ccrypt-installed-p)
1064     (ps-ccrypt-uninstall))
1065
1066(ps-ccrypt-install)
1067
1068
1069(provide 'ps-ccrypt)
1070
1071;; ps-ccrypt.el ends here.
1072