トップ «前の日記(2006-01-11 (Wed)) 最新 次の日記(2006-01-16 (Mon))» 編集

猫熊は燃えつきた?!日記

最近なんにもやっていませんが、なにかやったらこちらに置くようにしています。
2002|12|
2003|01|02|03|04|05|06|07|08|09|10|11|12|
2004|01|02|03|04|05|06|07|08|09|10|11|12|
2005|01|02|03|04|05|06|07|08|09|10|11|12|
2006|01|02|03|04|05|06|07|08|09|10|11|12|
2007|01|02|03|04|05|06|07|08|09|10|11|12|
2008|01|02|03|04|05|06|07|08|09|10|11|12|
2009|01|02|03|04|05|06|07|08|09|10|11|12|
2010|01|02|03|04|05|06|07|08|
2011|09|
2012|02|


2006-01-12 (Thu) [長年日記]

dird から gpg.el

今日の小ネタということで、dired から gpg.el を使って、暗号化/平文化するものを作ってみた。
 (defvar gpg-file-cache-time 1 "*Minute of alive time of passphase.")
 
 (add-hook 'dired-mode-hook
 	  (lambda ()
 	    (define-key dired-mode-map "\C-cg" 'dired-do-gpg)))
 
 (defun dired-do-gpg ()
   (interactive)
   (let (files)
     (dired-map-over-marks-check
      (lambda ()
        (setq files (cons (dired-get-filename) files))
        nil)
      nil 'GPG nil)
     (if (not files)
 	(message "No files")
       (while files
 	(gpg-file (car files))
 	(setq files (cdr files)))
       (revert-buffer))))
 
 (defvar gpg-file-buffer-kill-timer nil)
 
 (defun gpg-file (&optional file)
   (interactive)
   (require 'gpg)
   (when gpg-file-buffer-kill-timer
     (cancel-timer gpg-file-buffer-kill-timer)
     (setq gpg-file-buffer-kill-timer nil))
   (setq file (expand-file-name (or file (read-file-name "File: " ))))
   (let ((buf (get-buffer-create " *gpg-tmp*"))
 	dec gfile pro)
     (when (string-match gpg-regex-suffix file)
       (setq file (substring file 0 (match-beginning 0)))
       (setq dec t))
     (setq gfile (concat file ".gpg"))
     (cond
      ((and (not dec)
 	   (not (and (file-exists-p file)
 		     (file-readable-p file)
 		     (file-writable-p gfile))))
       (message "%s can not gpg" file))
      ((and dec
 	   (not (and (file-exists-p gfile)
 		     (file-readable-p gfile)
 		     (file-writable-p file))))
       (message "%s can not gpg" file))
      ((or (file-directory-p file) (file-directory-p gfile))
       (message "%s is directory" file))
      (t
       (when (interactive-p)
 	(message "%s %s..." (if dec "decryption" "encryption") file))
       (if dec
 	  (if (file-exists-p file) (delete-file file))
 	(if (file-exists-p gfile) (delete-file gfile)))
       (save-excursion
 	(set-buffer buf)
 	(setq pro
 	      (if dec
 		  (setq pro (gpg-start-process gpg-process-decryption buf gpg-program
 					       "-d" "--yes" "--output" file gfile))
 		(gpg-start-process gpg-process-encryption buf gpg-program
 				   "-c" "--cipher-algo" gpg-cipher
 				   "--yes" "--output" gfile file)))
 	(set-process-filter   pro 'gpg-filter)
 	(set-process-sentinel pro 'gpg-sentinel)
 	(setq gpg-rendezvous t)
 	(while gpg-rendezvous
 	  (sit-for 0.1)
 	  (discard-input))
 	(when (and (file-exists-p file) (file-exists-p gfile))
 	  (if dec
 	      (delete-file gfile)
 	    (delete-file file)))
 	(setq gpg-file-buffer-kill-timer
 	      (run-at-time (* gpg-file-cache-time 60) nil 'gpg-file-buffer-kill))
 	(when (interactive-p)
 	  (message "%s %s...done" (if dec "decryption" "encryption") file)))))))
       
 (defun gpg-file-buffer-kill ()
   (when gpg-file-buffer-kill-timer
     (cancel-timer gpg-file-buffer-kill-timer)
     (setq gpg-file-buffer-kill-timer nil))
   (let ((buf " *gpg-tmp*"))
     (if (and buf (get-buffer buf)) (kill-buffer buf))))

使い方

M-x gpg-file しても良いし、dired で "C-cg" しても良い。指定したファイル名に ".gpg" という suffix がついていたら平文化するし、なければ暗号化する。

デフォルトだと一分間 passphrase を覚えているが、覚えている間は全部同じ passphrase を使って暗号化/平文化を行なうのがちょっと弱い。

egg-pobox Zaurus 向けパッケージ

丸山さんちで、egg-pobox 関連が全部揃うようになっている。素早い。
これから egg-pobox.el を変えるときは、ちゃんと考えてからやらないと ^^;;;
本日のツッコミ(全1件) [ツッコミを入れる]
なおと (2006-01-13 (Fri) 15:45)

作者には大昔に云ったんですけど、gpg.elはange-ftp(てかtramp)できないのでかなりいやんなかんじです。自分で作りかけたのがあるんだけど放置中…


書いている人: 白井秀行 (mailto:shirai@meadowy。org)
訪問して下さった人: 今日: 人, 昨日: , 過去: 人 (2007年5月10日から)
RDF Feed