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