- (message "Opening Kerberized IMAP connection...")
- (let* ((port (or port imap-default-port))
- (coding-system-for-read imap-coding-system-for-read)
- (coding-system-for-write imap-coding-system-for-write)
- (process (start-process
- name buffer shell-file-name shell-command-switch
- (format-spec
- imap-imtest-program
- (format-spec-make ?s server ?p (number-to-string port))))))
- (when process
- (with-current-buffer buffer
- (setq imap-client-eol "\n")
- ;; Result of authentication is a string: __Full privacy protection__
- (while (and (memq (process-status process) '(open run))
- (goto-char (point-min))
- (not (and (imap-parse-greeting)
- (re-search-forward "__\\(.*\\)__\n" nil t))))
- (accept-process-output process 1)
- (sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
- (let ((response (match-string 1)))
- (erase-buffer)
- (message "Kerberized IMAP connection: %s" response)
- (if (and response (let ((case-fold-search nil))
- (not (string-match "failed" response))))
- process
- (if (memq (process-status process) '(open run))
- (imap-send-command-wait "LOGOUT"))
- (delete-process process)
- nil))))))
-
+ (let ((cmds imap-kerberos4-program)
+ cmd done)
+ (while (and (not done) (setq cmd (pop cmds)))
+ (message "Opening Kerberos 4 IMAP connection with `%s'..." cmd)
+ (erase-buffer)
+ (let* ((port (or port imap-default-port))
+ (process-connection-type imap-process-connection-type)
+ (process (as-binary-process
+ (start-process
+ name buffer shell-file-name shell-command-switch
+ (format-spec
+ cmd
+ (format-spec-make
+ ?s server
+ ?p (number-to-string port)
+ ?l imap-default-user)))))
+ response)
+ (when process
+ (with-current-buffer buffer
+ (setq imap-client-eol "\n"
+ imap-calculate-literal-size-first t)
+ (while (and (memq (process-status process) '(open run))
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+ (goto-char (point-min))
+ ;; Athena IMTEST can output SSL verify errors
+ (or (while (looking-at "^verify error:num=")
+ (forward-line))
+ t)
+ (or (while (looking-at "^TLS connection established")
+ (forward-line))
+ t)
+ ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
+ (or (while (looking-at "^C:")
+ (forward-line))
+ t)
+ ;; cyrus 1.6 imtest print "S: " before server greeting
+ (or (not (looking-at "S: "))
+ (forward-char 3)
+ t)
+ (not (and (imap-parse-greeting)
+ ;; success in imtest < 1.6:
+ (or (re-search-forward
+ "^__\\(.*\\)__\n" nil t)
+ ;; success in imtest 1.6:
+ (re-search-forward
+ "^\\(Authenticat.*\\)" nil t))
+ (setq response (match-string 1)))))
+ (accept-process-output process 1)
+ (sit-for 1))
+ (and imap-log
+ (with-current-buffer (get-buffer-create imap-log-buffer)
+ (imap-disable-multibyte)
+ (buffer-disable-undo)
+ (goto-char (point-max))
+ (insert-buffer-substring buffer)))
+ (erase-buffer)
+ (message "Opening Kerberos 4 IMAP connection with `%s'...%s" cmd
+ (if response (concat "done, " response) "failed"))
+ (if (and response (let ((case-fold-search nil))
+ (not (string-match "failed" response))))
+ (setq done process)
+ (if (memq (process-status process) '(open run))
+ (imap-send-command "LOGOUT"))
+ (delete-process process)
+ nil)))))
+ done))
+
+(defun imap-gssapi-stream-p (buffer)
+ (imap-capability 'AUTH=GSSAPI buffer))
+
+(defun imap-gssapi-open (name buffer server port)
+ (let ((cmds imap-gssapi-program)
+ cmd done)
+ (while (and (not done) (setq cmd (pop cmds)))
+ (message "Opening GSSAPI IMAP connection with `%s'..." cmd)
+ (erase-buffer)
+ (let* ((port (or port imap-default-port))
+ (process-connection-type imap-process-connection-type)
+ (process (as-binary-process
+ (start-process
+ name buffer shell-file-name shell-command-switch
+ (format-spec
+ cmd
+ (format-spec-make
+ ?s server
+ ?p (number-to-string port)
+ ?l imap-default-user)))))
+ response)
+ (when process
+ (with-current-buffer buffer
+ (setq imap-client-eol "\n"
+ imap-calculate-literal-size-first t)
+ (while (and (memq (process-status process) '(open run))
+ (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
+ (goto-char (point-min))
+ ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
+ (or (while (looking-at "^C:")
+ (forward-line))
+ t)
+ ;; cyrus 1.6 imtest print "S: " before server greeting
+ (or (not (looking-at "S: "))
+ (forward-char 3)
+ t)
+ (not (and (imap-parse-greeting)
+ ;; success in imtest 1.6:
+ (re-search-forward
+ (concat "^\\(\\(Authenticat.*\\)\\|\\("
+ "Client authentication "
+ "finished.*\\)\\)")
+ nil t)
+ (setq response (match-string 1)))))
+ (accept-process-output process 1)
+ (sit-for 1))
+ (and imap-log
+ (with-current-buffer (get-buffer-create imap-log-buffer)
+ (imap-disable-multibyte)
+ (buffer-disable-undo)
+ (goto-char (point-max))
+ (insert-buffer-substring buffer)))
+ (erase-buffer)
+ (message "GSSAPI IMAP connection: %s" (or response "failed"))
+ (if (and response (let ((case-fold-search nil))
+ (not (string-match "failed" response))))
+ (setq done process)
+ (if (memq (process-status process) '(open run))
+ (imap-send-command "LOGOUT"))
+ (delete-process process)
+ nil)))))
+ done))
+