Function: nnimap-open-connection-1

nnimap-open-connection-1 is a byte-compiled function defined in nnimap.el.gz.

Signature

(nnimap-open-connection-1 BUFFER)

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/nnimap.el.gz
(defun nnimap-open-connection-1 (buffer)
  (unless (or nnimap-keepalive-timer
              (null nnimap-keepalive-intervals))
    (setq nnimap-keepalive-timer (run-at-time
                                  (car nnimap-keepalive-intervals)
                                  (car nnimap-keepalive-intervals)
				  #'nnimap-keepalive)))
  (with-current-buffer (nnimap-make-process-buffer buffer)
    (let* ((coding-system-for-read 'binary)
	   (coding-system-for-write 'binary)
	   (ports
	    (cond
	     ((memq nnimap-stream '(network plain starttls))
	      (nnheader-message 7 "Opening connection to %s..."
				nnimap-address)
	      '("imap" "143"))
	     ((eq nnimap-stream 'shell)
	      (nnheader-message 7 "Opening connection to %s via shell..."
				nnimap-address)
	      '("imap"))
	     ((memq nnimap-stream '(ssl tls))
	      (nnheader-message 7 "Opening connection to %s via tls..."
				nnimap-address)
	      '("imaps" "imap" "993" "143"))
	     (t
	      (error "Unknown stream type: %s" nnimap-stream))))
           login-result credentials)
      (when nnimap-server-port
	(push nnimap-server-port ports))
      (let* ((stream-list
	      (open-network-stream
	       "*nnimap*" (current-buffer) nnimap-address
	       (nnimap-map-port (car ports))
	       :type nnimap-stream
	       :warn-unless-encrypted t
	       :return-list t
	       :shell-command nnimap-shell-program
	       :capability-command "1 CAPABILITY\r\n"
               :always-query-capabilities t
	       :end-of-command "\r\n"
	       :success " OK "
	       :starttls-function
	       (lambda (capabilities)
		 (when (string-match-p "STARTTLS" capabilities)
		   "1 STARTTLS\r\n"))))
	     (stream (car stream-list))
	     (props (cdr stream-list))
	     (greeting (plist-get props :greeting))
	     (capabilities (plist-get props :capabilities))
	     (stream-type (plist-get props :type))
             (server (nnoo-current-server 'nnimap)))
	(when (and stream (not (memq (process-status stream) '(open run))))
	  (setq stream nil))

        (when (eq (process-type stream) 'network)
          ;; Use TCP-keepalive so that connections that pass through a NAT
          ;; router don't hang when left idle.
          (set-network-process-option stream :keepalive t))

	(setf (nnimap-process nnimap-object) stream)
	(setf (nnimap-stream-type nnimap-object) stream-type)
	(if (not stream)
	    (progn
	      (nnheader-report 'nnimap "Unable to contact %s:%s via %s"
			       nnimap-address (car ports) nnimap-stream)
	      'no-connect)
	  (set-process-query-on-exit-flag stream nil)
	  (if (not (string-match-p "[*.] \\(OK\\|PREAUTH\\)" greeting))
	      (nnheader-report 'nnimap "%s" greeting)
	    ;; Store the greeting (for debugging purposes).
	    (setf (nnimap-greeting nnimap-object) greeting)
	    (setf (nnimap-capabilities nnimap-object)
		  (mapcar #'upcase
			  (split-string capabilities)))
	    (unless (string-match-p "[*.] PREAUTH" greeting)
	      (if (not (setq credentials
			     (if (eq nnimap-authenticator 'anonymous)
				 (list "anonymous"
				       (message-make-address))
                               ;; Look for the credentials based on
                               ;; the virtual server name and the address
                               (nnimap-credentials
				(gnus-delete-duplicates
				 (list server nnimap-address))
                                ports
                                nnimap-user))))
		  (setq nnimap-object nil)
		(let ((nnimap-inhibit-logging t))
		  (setq login-result
			(nnimap-login (car credentials) (cadr credentials))))
		(if (car login-result)
		    (progn
		      ;; Save the credentials if a save function exists
		      ;; (such a function will only be passed if a new
		      ;; token was created).
		      (when (functionp (nth 2 credentials))
			(funcall (nth 2 credentials)))
		      ;; See if CAPABILITY is set as part of login
		      ;; response.
		      (dolist (response (cddr (nnimap-command "CAPABILITY")))
			(when (string= "CAPABILITY" (upcase (car response)))
			  (setf (nnimap-capabilities nnimap-object)
				(mapcar #'upcase (cdr response)))))
                      (when (and nnimap-use-namespaces
                                 (nnimap-capability "NAMESPACE"))
                        (erase-buffer)
                        (nnimap-wait-for-response (nnimap-send-command "NAMESPACE"))
                        (let ((response (nnimap-last-response-string)))
                          (when (string-match
                                 "^\\*\\W+NAMESPACE\\W+((\"\\([^\"\n]+\\)\"\\W+\"\\(.\\)\"))\\W+"
                                 response)
                            (setq nnimap-namespace (match-string 1 response))))))
                  ;; If the login failed, then forget the credentials
		  ;; that are now possibly cached.
		  (dolist (host (list (nnoo-current-server 'nnimap)
				      nnimap-address))
		    (dolist (port ports)
                      (auth-source-forget+ :host host :port port)))
		  (delete-process (nnimap-process nnimap-object))
		  (setq nnimap-object nil))))
	    (when nnimap-object
	      (when (nnimap-capability "QRESYNC")
		(nnimap-command "ENABLE QRESYNC"))
              (nnheader-message 7 "Opening connection to %s...done"
				nnimap-address)
	      (nnimap-process nnimap-object))))))))