Function: nntp-open-connection

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

Signature

(nntp-open-connection BUFFER)

Documentation

Open a connection to PORT on ADDRESS delivering output to BUFFER.

Source Code

;; Defined in /usr/src/emacs/lisp/gnus/nntp.el.gz
(defun nntp-open-connection (buffer)
  "Open a connection to PORT on ADDRESS delivering output to BUFFER."
  (run-hooks 'nntp-prepare-server-hook)
  (let* ((pbuffer (nntp-make-process-buffer buffer))
	 (timer
	  (and nntp-connection-timeout
	       (run-at-time
		nntp-connection-timeout nil
		(lambda ()
		  (nntp-kill-buffer pbuffer)))))
	 (process
	  (condition-case err
	      (let ((coding-system-for-read 'binary)
		    (coding-system-for-write 'binary)
		    (map '((nntp-open-network-stream network)
			   (network-only plain) ; compat
			   (nntp-open-plain-stream plain)
			   (nntp-open-ssl-stream tls)
			   (nntp-open-tls-stream tls))))
		(if (assoc nntp-open-connection-function map)
		    (open-network-stream
		     "nntpd" pbuffer nntp-address nntp-port-number
		     :type (cadr (assoc nntp-open-connection-function map))
		     :end-of-command "^\\([2345]\\|[.]\\).*\n"
		     :capability-command
		     (lambda (greeting)
		       (if (and greeting
				(string-match "Typhoon" greeting))
			   ;; Certain versions of the Typhoon server
			   ;; doesn't understand the CAPABILITIES
			   ;; command, but includes the capability
			   ;; data in the HELP command instead.
			   "HELP\r\n"
			 ;; Use the correct command for everything else.
			 "CAPABILITIES\r\n"))
		     :success "^3"
		     :starttls-function
		     (lambda (capabilities)
		       (if (not (string-match "STARTTLS" capabilities))
			   nil
			 "STARTTLS\r\n")))
		  (funcall nntp-open-connection-function pbuffer)))
	    (error
	     (nnheader-report 'nntp ">>> %s" err))
	    (quit
	     (message "Quit opening connection to %s" nntp-address)
	     (nntp-kill-buffer pbuffer)
	     (signal 'quit nil)
	     nil))))
    (when timer
      (cancel-timer timer))
    (when (and process
	       (not (memq (process-status process) '(open run))))
      (with-current-buffer pbuffer
	(goto-char (point-min))
	(nnheader-report 'nntp "Error when connecting: %s"
			 (buffer-substring (point) (line-end-position))))
      (setq process nil))
    (unless process
      (nntp-kill-buffer pbuffer))
    (when (and (buffer-live-p pbuffer)
	       process)
      (when (eq (process-type process) 'network)
        ;; Use TCP-keepalive so that connections that pass through a NAT router
        ;; don't hang when left idle.
        (set-network-process-option process :keepalive t))
      (set-process-query-on-exit-flag process nil)
      (if (and (nntp-wait-for process "^2.*\n" buffer nil t)
	       (memq (process-status process) '(open run)))
	  (prog1
	      (caar (push (list process buffer nil) nntp-connection-alist))
	    (push process nntp-connection-list)
	    (with-current-buffer pbuffer
	      (nntp-read-server-type)
	      (erase-buffer)
	      (set-buffer nntp-server-buffer)
	      (let ((nnheader-callback-function nil))
		(run-hooks 'nntp-server-opened-hook)
		(nntp-send-authinfo t))))
	(nntp-kill-buffer (process-buffer process))
	nil))))