*** /home/albinus/lisp/tramp-imap.el.~1~ 2009-07-18 10:45:43.000000000 +0200 --- /home/albinus/lisp/tramp-imap.el 2009-07-18 12:58:21.000000000 +0200 *************** *** 60,65 **** --- 60,66 ---- (defcustom tramp-imap-method "imap" "*Method to connect via IMAP protocol." :group 'tramp + :version "23.2" :type 'string) (add-to-list 'tramp-methods (cons tramp-imap-method nil)) *************** *** 72,77 **** --- 73,79 ---- (defcustom tramp-imaps-method "imaps" "*Method to connect via secure IMAP protocol." :group 'tramp + :version "23.2" :type 'string) ;; ... and add it to the method list. *************** *** 84,89 **** --- 86,92 ---- ;; Add completion function for IMAP method. ;; (tramp-set-completion-function ;; tramp-imap-method tramp-completion-function-alist-ssh) ; TODO: test this + ;; tramp-imaps-method tramp-completion-function-alist-ssh) ; TODO: test this ;; New handlers should be added here. (defconst tramp-imap-file-name-handler-alist *************** *** 136,161 **** (set-file-modes . tramp-imap-handle-set-file-modes) (set-file-times . tramp-imap-handle-set-file-times) (set-visited-file-modtime . ignore) ! (shell-command . tramp-handle-shell-command) (substitute-in-file-name . tramp-handle-substitute-in-file-name) (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) (vc-registered . ignore) (verify-visited-file-modtime . ignore) (write-region . tramp-imap-handle-write-region) ! (executable-find . tramp-imap-handle-executable-find) (start-file-process . ignore) ! (process-file . tramp-imap-handle-process-file) ) "Alist of handler functions for Tramp IMAP method. Operations not mentioned here will be handled by the default Emacs primitives.") (defgroup tramp-imap nil "Tramp over IMAP configuration." :group 'applications) (defcustom tramp-imap-subject-marker "tramp-imap-subject-marker" "The subject marker that Tramp-IMAP will use." :type 'string :group 'tramp-imap) ;; TODO: these will be defcustoms later --- 139,166 ---- (set-file-modes . tramp-imap-handle-set-file-modes) (set-file-times . tramp-imap-handle-set-file-times) (set-visited-file-modtime . ignore) ! (shell-command . ignore) (substitute-in-file-name . tramp-handle-substitute-in-file-name) (unhandled-file-name-directory . tramp-handle-unhandled-file-name-directory) (vc-registered . ignore) (verify-visited-file-modtime . ignore) (write-region . tramp-imap-handle-write-region) ! (executable-find . ignore) (start-file-process . ignore) ! (process-file . ignore) ) "Alist of handler functions for Tramp IMAP method. Operations not mentioned here will be handled by the default Emacs primitives.") (defgroup tramp-imap nil "Tramp over IMAP configuration." + :version "23.2" :group 'applications) (defcustom tramp-imap-subject-marker "tramp-imap-subject-marker" "The subject marker that Tramp-IMAP will use." :type 'string + :version "23.2" :group 'tramp-imap) ;; TODO: these will be defcustoms later *************** *** 253,265 **** (tramp-debug-message vec "looking for '%s'" search-name) (dolist (msg (imap-search (format "SUBJECT \"%s %s\"" ! tramp-imap-subject-marker search-name))) ;; this is the name of the file (setq sname (tramp-imap-get-message-x-tramp-imap msg)) ! ! (when (and sname ; we need a valid X-Tramp-IMAP header (or (not exact) (equal sname truename))) ;; Return entry in file-attributes format --- 258,270 ---- (tramp-debug-message vec "looking for '%s'" search-name) (dolist (msg (imap-search (format "SUBJECT \"%s %s\"" ! tramp-imap-subject-marker search-name))) ;; this is the name of the file (setq sname (tramp-imap-get-message-x-tramp-imap msg)) ! ! (when (and sname ; we need a valid X-Tramp-IMAP header (or (not exact) (equal sname truename))) ;; Return entry in file-attributes format *************** *** 356,362 **** (defun tramp-imap-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files. False for IMAP." ! nil) (defun tramp-imap-handle-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files." --- 361,367 ---- (defun tramp-imap-handle-file-directory-p (filename) "Like `file-directory-p' for Tramp files. False for IMAP." ! t);nil) (defun tramp-imap-handle-file-attributes (filename &optional id-format) "Like `file-attributes' for Tramp files." *************** *** 380,388 **** "Like `delete-file' for Tramp files." (cond ((not (file-exists-p file)) nil) ! (t (tramp-imap-delete-files ! ;; inode is the message UID; we use any messages found ! (tramp-imap-get-file-entries v filename))))) ;; TODO: fix this in tramp-imap-get-file-entries (defun tramp-imap-handle-file-newer-than-file-p (file1 file2) --- 385,395 ---- "Like `delete-file' for Tramp files." (cond ((not (file-exists-p file)) nil) ! (t (with-parsed-tramp-file-name (expand-file-name file) nil ! (with-current-buffer (tramp-imap-buffer v) ! (tramp-imap-delete-files ! ;; inode is the message UID; we use any messages found ! (tramp-imap-get-file-entries v file))))))) ;; TODO: fix this in tramp-imap-get-file-entries (defun tramp-imap-handle-file-newer-than-file-p (file1 file2) *************** *** 402,407 **** --- 409,415 ---- "Cannot make local copy of non-existing file `%s'" filename)) (let ((tmpfile (tramp-compat-make-temp-file filename))) (tramp-message v 4 "Fetching %s to tmp file %s..." filename tmpfile) + ;; TODO: tramp-retrieve-data does not exist!!! (when (tramp-imap-retrieve-data v) ;; Save file (with-current-buffer (tramp-get-buffer v) *************** *** 437,460 **** (defun tramp-imap-file-name-truename (vec) (tramp-imap-file-name-mailbox-or-name vec nil)) ! (defun tramp-imap-buffer (v) ! (if (imap-opened (tramp-get-buffer v)) ! (tramp-get-buffer v) ! (let* ((server (tramp-file-name-real-host v)) ! (port (tramp-file-name-port v)) (auth-info (auth-source-user-or-password '("login" "password") server port)) (auth-user (nth 0 auth-info)) (auth-passwd (nth 1 auth-info)) ! (buffer (imap-open ! server ! port ;; this is the only place where IMAP vs IMAPS matters ! (if (string= (tramp-file-name-method v) tramp-imap-method) nil 'ssl) nil ! (tramp-get-buffer v)))) (imap-authenticate auth-user auth-passwd buffer) buffer))) --- 445,468 ---- (defun tramp-imap-file-name-truename (vec) (tramp-imap-file-name-mailbox-or-name vec nil)) ! (defun tramp-imap-buffer (vec) ! (if (imap-opened (tramp-get-buffer vec)) ! (tramp-get-buffer vec) ! (let* ((server (tramp-file-name-real-host vec)) ! (port (tramp-file-name-port vec)) (auth-info (auth-source-user-or-password '("login" "password") server port)) (auth-user (nth 0 auth-info)) (auth-passwd (nth 1 auth-info)) ! (buffer (imap-open ! server ! port ;; this is the only place where IMAP vs IMAPS matters ! (if (string= (tramp-file-name-method vec) tramp-imap-method) nil 'ssl) nil ! (tramp-get-buffer vec)))) (imap-authenticate auth-user auth-passwd buffer) buffer))) *************** *** 462,468 **** ;;; (with-current-buffer (tramp-imap-buffer (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new")) (tramp-imap-put-file "INBOX.test" "/etc/fstab" "new5")) (defun tramp-imap-put-file (mailbox filename-or-buffer &optional subject) ! (imap-message-append mailbox ;;TODO: use better buffer name (tramp-imap-message-buffer "*tramp-imap-encode*" filename-or-buffer subject))) --- 470,476 ---- ;;; (with-current-buffer (tramp-imap-buffer (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new")) (tramp-imap-put-file "INBOX.test" "/etc/fstab" "new5")) (defun tramp-imap-put-file (mailbox filename-or-buffer &optional subject) ! (imap-message-append mailbox ;;TODO: use better buffer name (tramp-imap-message-buffer "*tramp-imap-encode*" filename-or-buffer subject))) *************** *** 479,504 **** (tramp-imap-decode-buffer)))) (defun tramp-imap-delete-files (entries) ! (with-current-buffer (tramp-imap-buffer v) ! (dolist (entry entries) ! ;; TODO: this should be aware of IMAP large integers ! (when (integerp (nth 11 entry)) ! (imap-message-flags-add (format "%d" (nth 11 entry)) ! "\\Seen \\Deleted"))) ! (imap-mailbox-expunge))) ;; TODO: make it use tramp-imap-get-message-details, so it's compatible with non-IMAP4rev1 IMAP servers ;;; (with-current-buffer (tramp-imap-buffer (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new")) (tramp-imap-get-message-subject 24)) (defun tramp-imap-get-message-subject (msgs) "Get message subject over IMAP." ! (let ((allsubject ! (tramp-imap-ms-strip-cr ! (nth 2 (nth 0 (imap-fetch msgs ! "BODY[HEADER.FIELDS (SUBJECT)]" 'BODYDETAIL)))))) ! (when (string-match ! (format "Subject: %s \\(.+\\)" tramp-imap-subject-marker) allsubject) (match-string 1 allsubject)))) --- 487,511 ---- (tramp-imap-decode-buffer)))) (defun tramp-imap-delete-files (entries) ! (dolist (entry entries) ! ;; TODO: this should be aware of IMAP large integers ! (when (integerp (nth 11 entry)) ! (imap-message-flags-add (format "%d" (nth 11 entry)) ! "\\Seen \\Deleted"))) ! (imap-mailbox-expunge)) ;; TODO: make it use tramp-imap-get-message-details, so it's compatible with non-IMAP4rev1 IMAP servers ;;; (with-current-buffer (tramp-imap-buffer (tramp-dissect-file-name "/imap:yourhosthere.com:/INBOX.test/new")) (tramp-imap-get-message-subject 24)) (defun tramp-imap-get-message-subject (msgs) "Get message subject over IMAP." ! (let ((allsubject ! (tramp-imap-ms-strip-cr ! (nth 2 (nth 0 (imap-fetch msgs ! "BODY[HEADER.FIELDS (SUBJECT)]" 'BODYDETAIL)))))) ! (when (string-match ! (format "Subject: %s \\(.+\\)" tramp-imap-subject-marker) allsubject) (match-string 1 allsubject)))) *************** *** 514,520 **** (defun tramp-imap-get-message-headers (msgs) "Get message headers over IMAP." ;; nil means "all headers" ! (tramp-imap-ms-strip-cr (nth 2 (nth 0 (tramp-imap-get-message-details msgs nil))))) ;; from nnheader.el --- 521,527 ---- (defun tramp-imap-get-message-headers (msgs) "Get message headers over IMAP." ;; nil means "all headers" ! (tramp-imap-ms-strip-cr (nth 2 (nth 0 (tramp-imap-get-message-details msgs nil))))) ;; from nnheader.el *************** *** 536,542 **** (defun tramp-imap-get-message-body (msgs) "Get message body over IMAP." ! (tramp-imap-ms-strip-cr (nth 2 (nth 0 (tramp-imap-get-message-details msgs 'body))))) (defun tramp-imap-get-message-details (msgs body-or-header) --- 543,549 ---- (defun tramp-imap-get-message-body (msgs) "Get message body over IMAP." ! (tramp-imap-ms-strip-cr (nth 2 (nth 0 (tramp-imap-get-message-details msgs 'body))))) (defun tramp-imap-get-message-details (msgs body-or-header) *************** *** 549,563 **** (if body "BODY.PEEK[TEXT]" "BODY.PEEK[HEADER]") (if body "RFC822.TEXT.PEEK" "RFC822.HEADER")) ;; the RECEIVE parameter ! (if i4r1 'BODYDETAIL (if body 'RFC822.TEXT 'RFC822.HEADER))))) ! ;;; (tramp-imap-collapse-name "a b c / where ; strange ! characters $ abound") ;;; => "abcwherestrangecharactersabound" (defun tramp-imap-collapse-name (name) "Return NAME with only [A-Za-z0-9] characters" ! (when name (replace-regexp-in-string "[^A-Za-z0-9]" "" name))) ;;; (tramp-imap-message-buffer "testimap" "/etc/fstab" "fstab") --- 556,570 ---- (if body "BODY.PEEK[TEXT]" "BODY.PEEK[HEADER]") (if body "RFC822.TEXT.PEEK" "RFC822.HEADER")) ;; the RECEIVE parameter ! (if i4r1 'BODYDETAIL (if body 'RFC822.TEXT 'RFC822.HEADER))))) ! ;;; (tramp-imap-collapse-name "a b c / where ; strange ! characters $ abound") ;;; => "abcwherestrangecharactersabound" (defun tramp-imap-collapse-name (name) "Return NAME with only [A-Za-z0-9] characters" ! (when name (replace-regexp-in-string "[^A-Za-z0-9]" "" name))) ;;; (tramp-imap-message-buffer "testimap" "/etc/fstab" "fstab") *************** *** 579,586 **** (message-setup `((To . "Tramp-IMAP ") (From . "Tramp-IMAP ") ! (Subject . ,(format ! "%s %s" tramp-imap-subject-marker (or subject (tramp-imap-collapse-name sname)))) ;; TODO: make sure this can handle non-ASCII data --- 586,593 ---- (message-setup `((To . "Tramp-IMAP ") (From . "Tramp-IMAP ") ! (Subject . ,(format ! "%s %s" tramp-imap-subject-marker (or subject (tramp-imap-collapse-name sname)))) ;; TODO: make sure this can handle non-ASCII data *************** *** 601,606 **** --- 608,614 ---- CONTEXT is the encryption/decryption EPG context. HANDBACK is just carried through. KEY-ID can be 'SYM or 'PIN among others." + ;; TODO: Variable `v' is not declared!!! Existing due to side-effects only. (let* ((server (tramp-file-name-real-host v)) (port "tramp-imap") ; this is NOT the server password! (auth-passwd *************** *** 613,625 **** ;; do we reuse it? (if (y-or-n-p "Reuse the passphrase? ") (copy-sequence tramp-imap-passphrase) ! ;; don't reuse: revert caching behavior to nil, erase passphrase, ;; call ourselves again (setq tramp-imap-passphrase-cache nil) (setq tramp-imap-passphrase nil) (tramp-imap-passphrase-callback-function context key-id handback)) (let ((p (if (eq key-id 'SYM) ! (read-passwd "Tramp-IMAP passphrase for symmetric encryption: " (eq (epg-context-operation context) 'encrypt) tramp-imap-passphrase) --- 621,633 ---- ;; do we reuse it? (if (y-or-n-p "Reuse the passphrase? ") (copy-sequence tramp-imap-passphrase) ! ;; don't reuse: revert caching behavior to nil, erase passphrase, ;; call ourselves again (setq tramp-imap-passphrase-cache nil) (setq tramp-imap-passphrase nil) (tramp-imap-passphrase-callback-function context key-id handback)) (let ((p (if (eq key-id 'SYM) ! (read-passwd "Tramp-IMAP passphrase for symmetric encryption: " (eq (epg-context-operation context) 'encrypt) tramp-imap-passphrase) *************** *** 628,643 **** "Tramp-IMAP passphrase for PIN: " (let ((entry (assoc key-id epg-user-id-alist))) (if entry ! (format "Tramp-IMAP passphrase for %s %s: " key-id (cdr entry)) (format "Tramp-IMAP passphrase for %s: " key-id)))) nil tramp-imap-passphrase)))) ! ;; if we have an answer, the passphrase has changed, ! ;; the user hasn't declined keeping the passphrase, ;; and they answer yes to keep it now... ! (when (and p (not (equal tramp-imap-passphrase p)) (not (eq tramp-imap-passphrase-cache 'never)) --- 636,651 ---- "Tramp-IMAP passphrase for PIN: " (let ((entry (assoc key-id epg-user-id-alist))) (if entry ! (format "Tramp-IMAP passphrase for %s %s: " key-id (cdr entry)) (format "Tramp-IMAP passphrase for %s: " key-id)))) nil tramp-imap-passphrase)))) ! ;; if we have an answer, the passphrase has changed, ! ;; the user hasn't declined keeping the passphrase, ;; and they answer yes to keep it now... ! (when (and p (not (equal tramp-imap-passphrase p)) (not (eq tramp-imap-passphrase-cache 'never))