- (setq sieve-manage-state 'initial
- sieve-manage-process
- (condition-case ()
- (funcall (nth 2 (assq sieve-manage-stream
- sieve-manage-stream-alist))
- "sieve" buffer sieve-manage-server sieve-manage-port)
- ((error quit) nil)))
- (when sieve-manage-process
- (while (and (eq sieve-manage-state 'initial)
- (memq (process-status sieve-manage-process) '(open run)))
- (message "Waiting for response from %s..." sieve-manage-server)
- (accept-process-output sieve-manage-process 1))
- (message "Waiting for response from %s...done" sieve-manage-server)
- (and (memq (process-status sieve-manage-process) '(open run))
- sieve-manage-process))))
-
-;; Streams
-
-(defun sieve-manage-network-p (buffer)
- t)
-
-(defun sieve-manage-network-open (name buffer server port)
- (let* ((port (or port sieve-manage-default-port))
- (coding-system-for-read sieve-manage-coding-system-for-read)
- (coding-system-for-write sieve-manage-coding-system-for-write)
- (process (open-network-stream name buffer server port)))
- (when process
- (while (and (memq (process-status process) '(open run))
- (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
- (goto-char (point-min))
- (not (sieve-manage-parse-greeting-1)))
- (accept-process-output process 1)
- (sit-for 1))
- (sieve-manage-erase nil buffer)
- (when (memq (process-status process) '(open run))
- process))))
-
-(defun imap-starttls-p (buffer)
- ;; (and (imap-capability 'STARTTLS buffer)
- (condition-case ()
- (progn
- (require 'starttls)
- (call-process "starttls"))
- (error nil)))
-
-(defun imap-starttls-open (name buffer server port)
- (let* ((port (or port sieve-manage-default-port))
- (coding-system-for-read sieve-manage-coding-system-for-read)
- (coding-system-for-write sieve-manage-coding-system-for-write)
- (process (starttls-open-stream name buffer server port))
- done)
- (when process
- (while (and (memq (process-status process) '(open run))
- (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
- (goto-char (point-min))
- (not (sieve-manage-parse-greeting-1)))
- (accept-process-output process 1)
- (sit-for 1))
- (sieve-manage-erase nil buffer)
- (sieve-manage-send "STARTTLS")
- (starttls-negotiate process))
- (when (memq (process-status process) '(open run))
- process)))
+ (setq sieve-manage-state 'initial)
+ (destructuring-bind (proc . props)
+ (open-protocol-stream
+ "SIEVE" buffer server port
+ :type stream
+ :capability-command "CAPABILITY\r\n"
+ :end-of-command "^\\(OK\\|NO\\).*\n"
+ :success "^OK.*\n"
+ :return-list t
+ :starttls-function
+ (lambda (capabilities)
+ (when (string-match "\\bSTARTTLS\\b" capabilities)
+ "STARTTLS\r\n")))
+ (setq sieve-manage-process proc)
+ (setq sieve-manage-capability
+ (sieve-manage-parse-capability (plist-get props :capabilities)))
+ ;; Ignore new capabilities issues after successful STARTTLS
+ (when (and (memq stream '(nil network starttls))
+ (eq (plist-get props :type) 'tls))
+ (sieve-manage-drop-next-answer))
+ (current-buffer))))