Function: nsm-check-tls-connection

nsm-check-tls-connection is a byte-compiled function defined in nsm.el.gz.

Signature

(nsm-check-tls-connection PROCESS HOST PORT STATUS SETTINGS)

Documentation

Check TLS connection against potential security problems.

This function runs each test defined in network-security-protocol-checks in the order specified against the TLS connection's peer status STATUS for the host HOST and port PORT.

If one or more problems are found, this function will collect all the error messages returned by the check functions, and confirm with the user in interactive mode whether to continue with the TLS session.

If the user declines to continue, or problem(s) are found under non-interactive mode, the process PROCESS will be deleted, thus terminating the connection.

This function returns the process PROCESS if no problems are found, and nil otherwise.

See also: network-security-protocol-checks and nsm-noninteractive

Source Code

;; Defined in /usr/src/emacs/lisp/net/nsm.el.gz
(defun nsm-check-tls-connection (process host port status settings)
  "Check TLS connection against potential security problems.

This function runs each test defined in
`network-security-protocol-checks' in the order specified against
the TLS connection's peer status STATUS for the host HOST and
port PORT.

If one or more problems are found, this function will collect all
the error messages returned by the check functions, and confirm
with the user in interactive mode whether to continue with the
TLS session.

If the user declines to continue, or problem(s) are found under
non-interactive mode, the process PROCESS will be deleted, thus
terminating the connection.

This function returns the process PROCESS if no problems are
found, and nil otherwise.

See also: `network-security-protocol-checks' and `nsm-noninteractive'"
  (when (nsm-should-check host)
    (let* ((results
            (cl-loop
             for check in network-security-protocol-checks
             for type = (intern (format ":%s" (car check)))
             ;; Skip the check if the user has already said that this
             ;; host is OK for this type of "error".
             for result = (and (not (memq type
                                          (plist-get settings :conditions)))
                               (>= (nsm-level network-security-level)
                                   (nsm-level (cadr check)))
                               (funcall
                                (intern (format "nsm-protocol-check--%s"
                                                (car check)))
                                host port status settings))
             when result
             collect (cons type result)))
           (problems (nconc (plist-get status :warnings) (map-keys results))))

      ;; We haven't seen this before, and we're paranoid.
      (when (and (eq network-security-level 'paranoid)
                 (not (nsm-fingerprint-ok-p status settings)))
        (push '(:not-seen . "Certificate not seen before") results))

      (when (and results
                 (not (seq-set-equal-p (plist-get settings :conditions)
                                       problems))
                 (not (nsm-query host port status
                                 'conditions
                                 problems
                                 (format-message
                                  "The TLS connection to %s:%s is insecure\nfor the following reason%s:\n\n%s"
                                  host port
                                  (if (> (length problems) 1)
                                      "s" "")
                                  (concat "* " (string-join
                                                (split-string
                                                 (string-join
                                                  (map-values results)
                                                  "\n")
                                                 "\n")
						"\n* "))))))
	(delete-process process)
	(setq process nil))
      (run-hook-with-args 'nsm-tls-post-check-functions
                          host port status settings results)))
  process)