Ted Zlatanov <[email protected]> writes:

> I need to do more cleanup, but at least this version is usable.  The
> next release will be for wide release and will go into Tramp itself, so
> PLEASE test this version and let me know if you find problems.

I've played a little bit around:

- Several functions in `tramp-imap-file-name-handler-alist' are not
  implemented yet.

- I doubt there will be implementation for `shell-command',
  `executable-find', and `process-file'. I've disabled them in
  `tramp-imap-file-name-handler-alist'.

- You have used `tramp-debug-message'. I recommend to use
  `tramp-message' instead, the verbose levels allow a better analysis of
  the debug buffer.

- `tramp-imap-handle-file-directory-p' must not return nil in all
  cases. When I apply (save-buffer), the imap folder is checked for
  being a directory. As workaround, I've changed
  `tramp-imap-handle-file-directory-p' to return `t', but it must be
  more precise.

- When I have opened "/imap:albi...@localhost:/INBOX.test/1", and try to
  save it under the name "/imap:albi...@localhost:/INBOX.test/2", I get

  Debugger entered--Lisp error: (none "bad name 1 or mailbox INBOX.test/2")
  signal(none ("bad name 1 or mailbox INBOX.test/2"))
  tramp-error(["imap" "albinus" "localhost" "/INBOX.test/2/1"] none "bad name 
%s or mailbox %s" "1" "INBOX.test/2")
  (if (and name (imap-mailbox-select mbox)) (let (sname) (tramp-debug-message 
vec "looking for '%s'" search-name) (dolist ... ... ...)) (tramp-error vec 
(quote none) "bad name %s or mailbox %s" name mbox))
  (let* ((mbox ...) (name ...) (truename ...) (search-name ...) res) 
(tramp-debug-message vec "selecting mbox %s" mbox) (if (and name ...) (let ... 
... ...) (tramp-error vec ... "bad name %s or mailbox %s" name mbox)) res)
  (save-current-buffer (set-buffer (tramp-imap-buffer vec)) (let* (... ... ... 
... res) (tramp-debug-message vec "selecting mbox %s" mbox) (if ... ... ...) 
res))
  (with-current-buffer (tramp-imap-buffer vec) (let* (... ... ... ... res) 
(tramp-debug-message vec "selecting mbox %s" mbox) (if ... ... ...) res))
  tramp-imap-get-file-entries(["imap" "albinus" "localhost" "/INBOX.test/2/1"] 
"/INBOX.test/2/1")

  [...]

- I've fixed a small error in `tramp-imap-handle-delete-file' and
  `tramp-imap-delete-files'.

- `tramp-retrieve-data', used in `tramp-imap-handle-file-local-copy',
  does not exist.

- In `tramp-imap-passphrase-callback-function', you use the non-existing
  variable `v'.

- The email address of stored messages looks like "a real one", one
  could try to send messages there. Better might be to use an invalid
  address as defined in RFC 2606, like "Tramp-IMAP
  <[email protected]>".

My current patch is appended. Now I must go; my kids want to see HP6.

> Ted

Best regards, Michael.

*** /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 <[email protected]>")
  	 (From . "Tramp-IMAP <[email protected]>")
! 	 (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 <[email protected]>")
  	 (From . "Tramp-IMAP <[email protected]>")
! 	 (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))
_______________________________________________
Tramp-devel mailing list
[email protected]
http://lists.gnu.org/mailman/listinfo/tramp-devel

Reply via email to