Function: starttls-negotiate-gnutls

starttls-negotiate-gnutls is a byte-compiled function defined in starttls.el.gz.

Signature

(starttls-negotiate-gnutls PROCESS)

Documentation

Negotiate TLS on PROCESS opened by open-starttls-stream.

This should typically only be done once. It typically returns a multi-line informational message with information about the handshake, or nil on failure.

Source Code

;; Defined in /usr/src/emacs/lisp/obsolete/starttls.el.gz
(defun starttls-negotiate-gnutls (process)
  "Negotiate TLS on PROCESS opened by `open-starttls-stream'.
This should typically only be done once.  It typically returns a
multi-line informational message with information about the
handshake, or nil on failure."
  (let (buffer info old-max done-ok done-bad)
    (if (null (setq buffer (process-buffer process)))
	;; XXX How to remove/extract the TLS negotiation junk?
	(signal-process (process-id process) 'SIGALRM)
      (with-current-buffer buffer
	(save-excursion
	  (setq old-max (goto-char (point-max)))
	  (signal-process (process-id process) 'SIGALRM)
	  (while (and (processp process)
		      (eq (process-status process) 'run)
		      (save-excursion
			(goto-char old-max)
			(not (or (setq done-ok (re-search-forward
						starttls-success nil t))
				 (setq done-bad (re-search-forward
						 starttls-failure nil t))))))
	    (accept-process-output process 1.1)
	    (sit-for 0.1))
	  (setq info (buffer-substring-no-properties old-max (point-max)))
	  (delete-region old-max (point-max))
	  (if (or (and done-ok (not done-bad))
		  ;; Prevent mitm that fake success msg after failure msg.
		  (and done-ok done-bad (< done-ok done-bad)))
	      info
	    (message "STARTTLS negotiation failed: %s" info)
	    nil))))))