[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] netsec 534a3d5 3/6: Revamp Network Security manager checks
|
From: |
Jimmy Yuen Ho Wong |
|
Subject: |
[Emacs-diffs] netsec 534a3d5 3/6: Revamp Network Security manager checks for TLS |
|
Date: |
Sat, 14 Jul 2018 13:08:09 -0400 (EDT) |
branch: netsec
commit 534a3d5d3a99a6b86a47b3d91840ce8771ee0ae6
Author: Jimmy Yuen Ho Wong <address@hidden>
Commit: Jimmy Yuen Ho Wong <address@hidden>
Revamp Network Security manager checks for TLS
* lisp/net/nsm.el (network-security-level, nsm-level,
nsm-new-fingerprint-ok-p): Remove `paranoid' level and related code.
* lisp/net/nsm.el (nsm-tls-checks, nsm-tls-check-version,
nsm-tls-check-compression, nsm-tls-check-renegotiation-info-ext,
nsm-tls-check-verify-cert, nsm-tls-check-same-cert,
nsm-tls-check-null-suite, nsm-tls-check-export-kx,
nsm-tls-check-anon-kx, nsm-tls-check-md5-sig,
nsm-tls-check-rc4-cipher, nsm-tls-check-dhe-prime-kx,
nsm-tls-check-sha1-sig, nsm-tls-check-ecdsa-cbc-cipher
nsm-tls-check-dhe-kx, nsm-tls-check-rsa-kx,
nsm-tls-check-3des-cipher, nsm-tls-check-cbc-cipher,
nsm-save-fingerprint-maybe, nsm-tls-post-check-functions): New
options and functions for checking TLS handshake problems.
* lisp/net/nsm.el (nsm-check-certificate,
network-security-protocol-checks,
nsm-protocol-check--diffie-hellman-prime-bits,
nsm-protocol-check--3des, nsm-protocol-check--rc4,
nsm-protocol-check--signature-sha1,
nsm-protocol-check--intermediate-sha1, nsm-protocol-check--ssl,
nsm-check-protocol): Remove in favor of `nsm-tls-checks' and
`nsm-tls-check-*' functions.
* lisp/net/nsm.el (nsm-verify-connection): Ensure connection is
checked even when `network-security-level' is `low'.
* lisp/net/nsm.el (nsm-check-tls-connection): Batch all problems found
before querying the user.
* lisp/net/nsm.el (nsm--encryption): Renamed to `nsm-cipher-suite'.
* lisp/net/nsm.el (nsm-fingerprint-ok-p): No longer prompt when
certificate fingerprints mismatch. Returns a boolean instead when
the fingerprint of the certificate received matches the saved
fingerprints.
* lisp/net/nsm.el (nsm-query): Change signature. Accepts a list of
problems and a preformatted message instead of just a message format
and the arguments for the message.
* lisp/net/nsm.el (nsm-query-user): Change signature. Accepts a
preformatted message and the peer status of the handshake instead of
a message format, its arguments and the certificate for the host.
* lisp/net/nsm.el (nsm-save-host): Change signature. Accepts a list of
problems after the WHAT parameter. Saves multiple fingerprints for
the same host in case the host load balances a TLS server with more
than one certificates signed with different keys. Makes sure
conditions are not removed when updating a fingerprint.
* lisp/net/nsm.el (nsm-format-certificate): Display the TLS handshake's
renegotiation info extension, compression level, encrypt-then-MAC
extension, and key exchange prime bit length.
* src/gnutls.c (gnutls-peer-status-warning-describe,
gnutls-peer-status): Check for certificate verification problems
introduced since GnuTLS 3.1.
* src/gnutls.c (gnutls-peer-status): `:compression', `:encrypt-then-mac'
and `:safe-renegotiation' are now contained in the peer status
result return value.
---
lisp/net/nsm.el | 944 +++++++++++++++++++++++++++++++++++++++-----------------
src/gnutls.c | 96 ++++++
2 files changed, 763 insertions(+), 277 deletions(-)
diff --git a/lisp/net/nsm.el b/lisp/net/nsm.el
index dab9003..50895bc 100644
--- a/lisp/net/nsm.el
+++ b/lisp/net/nsm.el
@@ -27,6 +27,7 @@
(require 'cl-lib)
(require 'rmc) ; read-multiple-choice
(require 'subr-x)
+(require 'seq)
(defvar nsm-permanent-host-settings nil)
(defvar nsm-temporary-host-settings nil)
@@ -44,20 +45,22 @@ connection should be handled.
The following values are possible:
-`low': Absolutely no checks are performed.
-`medium': This is the default level, should be reasonable for most usage.
-`high': This warns about additional things that many people would
-not find useful.
-`paranoid': On this level, the user is queried for most new connections.
+`low': Check for problems known before Edward Snowden.
+`medium': Default. Suitable for most circumstances.
+`high': Warns about additional issues not enabled in `medium' due to
+compatibility concerns.
See the Emacs manual for a description of all things that are
checked and warned against."
:version "25.1"
:group 'nsm
:type '(choice (const :tag "Low" low)
- (const :tag "Medium" medium)
- (const :tag "High" high)
- (const :tag "Paranoid" paranoid)))
+ (const :tag "Medium" medium)
+ (const :tag "High" high)))
+
+;; Backward compatibility
+(when (eq network-security-level 'paranoid)
+ (setq network-security-level 'high))
(defcustom nsm-settings-file (expand-file-name "network-security.data"
user-emacs-directory)
@@ -98,246 +101,611 @@ to keep track of the TLS status of STARTTLS servers.
If WARN-UNENCRYPTED, query the user if the connection is
unencrypted."
- (if (eq network-security-level 'low)
- process
- (let* ((status (gnutls-peer-status process))
- (id (nsm-id host port))
- (settings (nsm-host-settings id)))
- (cond
- ((not (process-live-p process))
- nil)
- ((not status)
- ;; This is a non-TLS connection.
- (nsm-check-plain-connection process host port settings
- warn-unencrypted))
- (t
- (let ((process
- (nsm-check-tls-connection process host port status settings)))
- (when (and process save-fingerprint
- (null (nsm-host-settings id)))
- (nsm-save-host host port status 'fingerprint 'always))
- process))))))
+ (let* ((status (gnutls-peer-status process))
+ (id (nsm-id host port))
+ (settings (nsm-host-settings id)))
+ (cond
+ ((not (process-live-p process))
+ nil)
+ ((not status)
+ ;; This is a non-TLS connection.
+ (nsm-check-plain-connection process host port settings
+ warn-unencrypted))
+ (t
+ (let ((process
+ (nsm-check-tls-connection process host port status settings)))
+ (when (and process save-fingerprint
+ (null (nsm-host-settings id)))
+ (nsm-save-host host port status 'fingerprint nil 'always))
+ process)))))
+
+(defcustom nsm-tls-checks
+ '(;; Pre-Snowden Known Weaknesses
+ (nsm-tls-check-version . low)
+ (nsm-tls-check-compression . low)
+ (nsm-tls-check-renegotiation-info-ext . low)
+ (nsm-tls-check-verify-cert . low)
+ (nsm-tls-check-same-cert . low)
+ (nsm-tls-check-null-suite . low)
+ (nsm-tls-check-export-kx . low)
+ (nsm-tls-check-anon-kx . low)
+ (nsm-tls-check-md5-sig . low)
+ (nsm-tls-check-rc4-cipher . low)
+ ;; Post-Snowden Apocalypse
+ (nsm-tls-check-dhe-prime-kx . medium)
+ (nsm-tls-check-sha1-sig . medium)
+ (nsm-tls-check-ecdsa-cbc-cipher . medium)
+ ;; Towards TLS 1.3
+ (nsm-tls-check-dhe-kx . high)
+ (nsm-tls-check-rsa-kx . high)
+ (nsm-tls-check-3des-cipher . high)
+ (nsm-tls-check-cbc-cipher . high))
+ "This variable specifies what TLS connection checks to perform.
+It's an alist where the key is the name of the check, and the
+value is the minimum security level the check should begin.
+
+Each check function is called with the parameters HOST PORT
+STATUS SETTINGS. HOST is the host domain, PORT is a TCP port
+number, STATUS is the peer status returned by
+`gnutls-peer-status', and SETTINGS is the persistent and session
+settings for the host HOST. Please refer to the contents of
+`nsm-setting-file' for details. If a problem is found, the check
+function is required to return an error message, and nil
+otherwise.
+
+See also: `nsm-check-tls-connection', `nsm-save-host-names',
+`nsm-settings-file'"
+ :version "27.1"
+ :group 'nsm
+ :type '(repeat (cons (function :tag "Check function")
+ (choice :tag "Level"
+ :value medium
+ (const :tag "Low" low)
+ (const :tag "Medium" medium)
+ (const :tag "High" high)))))
+
+(defun nsm-save-fingerprint-maybe (host port status &rest _)
+ "Saves the certificate's fingerprint.
+
+In order to detect man-in-the-middle attacks, when
+`network-security-level' is `high', this function will save the
+fingerprint of the certificate for check functions to check."
+ (when (>= (nsm-level network-security-level) (nsm-level 'high))
+ ;; Save the host fingerprint so that we can check it the
+ ;; next time we connect.
+ (nsm-save-host host port status 'fingerprint nil 'always)))
+
+(defvar nsm-tls-post-check-functions '(nsm-save-fingerprint-maybe)
+ "Functions to run after checking a TLS session.
+
+Each function will be run with the parameters HOST PORT STATUS
+SETTINGS and RESULTS. The parameters HOST PORT STATUS and
+SETTINGS are the same as those supplied to each check function.
+RESULTS is an alist where the keys are the checks run and the
+values the results of the checks.")
(defun nsm-check-tls-connection (process host port status settings)
- (when-let ((process
- (nsm-check-certificate process host port status settings)))
- ;; Do further protocol-level checks.
- (nsm-check-protocol process host port status settings)))
+ "Check TLS connection against potential security problems.
+
+This function runs each test defined in `nsm-tls-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: `nsm-tls-checks' and `nsm-noninteractive'"
+ (let* ((results
+ (cl-loop for check in nsm-tls-checks
+ for type = (intern (format ":%s"
+ (string-remove-prefix
+ "nsm-tls-check-"
+ (symbol-name (car check))))
+ obarray)
+ ;; 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 (cdr check)))
+ (funcall (car check) host port status
settings))
+ when result
+ collect (cons type result)))
+ (problems (nconc (plist-get status :warnings) (map-keys 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 for
the following reason%s:\n\n%s"
+ host port
+ (if (> (length results) 1)
+ "s" "")
+ (string-join (map-values results) "\n"))))
+ (delete-process process)
+ (setq process nil)))
+ (run-hook-with-args 'nsm-tls-post-check-functions
+ host port status settings results))
+ process)
-(declare-function gnutls-peer-status-warning-describe "gnutls.c"
- (status-symbol))
+
-(defun nsm-check-certificate (process host port status settings)
- (let ((warnings (plist-get status :warnings)))
- (cond
+;; Certificate checks
- ;; The certificate validated, but perhaps we want to do
- ;; certificate pinning.
- ((null warnings)
- (cond
- ((< (nsm-level network-security-level) (nsm-level 'high))
- process)
- ;; The certificate is fine, but if we're paranoid, we might
- ;; want to check whether it's changed anyway.
- ((and (>= (nsm-level network-security-level) (nsm-level 'high))
- (not (nsm-fingerprint-ok-p host port status settings)))
- (delete-process process)
- nil)
- ;; We haven't seen this before, and we're paranoid.
- ((and (eq network-security-level 'paranoid)
- (null settings)
- (not (nsm-new-fingerprint-ok-p host port status)))
- (delete-process process)
- nil)
- ((>= (nsm-level network-security-level) (nsm-level 'high))
- ;; Save the host fingerprint so that we can check it the
- ;; next time we connect.
- (nsm-save-host host port status 'fingerprint 'always)
- process)
- (t
- process)))
-
- ;; The certificate did not validate.
- ((not (equal network-security-level 'low))
- ;; We always want to pin the certificate of invalid connections
- ;; to track man-in-the-middle or the like.
- (if (not (nsm-fingerprint-ok-p host port status settings))
- (progn
- (delete-process process)
- nil)
- ;; We have a warning, so query the user.
- (if (and (not (nsm-warnings-ok-p status settings))
- (not (nsm-query
- host port status 'conditions
- "The TLS connection to %s:%s is insecure for the
following reason%s:\n\n%s"
- host port
- (if (> (length warnings) 1)
- "s" "")
- (mapconcat #'gnutls-peer-status-warning-describe
- warnings
- "\n"))))
- (progn
- (delete-process process)
- nil)
- process))))))
-
-(defvar network-security-protocol-checks
- '((diffie-hellman-prime-bits medium 1024)
- (rc4 medium)
- (signature-sha1 medium)
- (intermediate-sha1 medium)
- (3des high)
- (ssl medium))
- "This variable specifies what TLS connection checks to perform.
-It's an alist where the first element is the name of the check,
-the second is the security level where the check kicks in, and the
-optional third element is a parameter supplied to the check.
-
-An element like `(rc4 medium)' will result in the function
-`nsm-protocol-check--rc4' being called with the parameters
-HOST PORT STATUS OPTIONAL-PARAMETER.")
-
-(defun nsm-check-protocol (process host port status settings)
- (cl-loop for check in network-security-protocol-checks
- for type = (intern (format ":%s" (car check)) obarray)
- while process
- ;; Skip the check if the user has already said that this
- ;; host is OK for this type of "error".
- when (and (not (memq type (plist-get settings :conditions)))
- (>= (nsm-level network-security-level)
- (nsm-level (cadr check))))
- do (let ((result
- (funcall (intern (format "nsm-protocol-check--%s"
- (car check))
- obarray)
- host port status (nth 2 check))))
- (unless result
- (delete-process process)
- (setq process nil))))
- ;; If a test failed we return nil, otherwise the process object.
- process)
+(declare-function gnutls-peer-status-warning-describe "gnutls.c"
+ (status-symbol))
-(defun nsm--encryption (status)
- (format "%s-%s-%s"
- (plist-get status :key-exchange)
- (plist-get status :cipher)
- (plist-get status :mac)))
+(defun nsm-tls-check-verify-cert (host port status settings)
+ "Check for warnings from the certificate verification status.
-(defun nsm-protocol-check--diffie-hellman-prime-bits (host port status bits)
+This is the most basic security check for a TLS connection. If
+ certificate verification fails, it means the server's identity
+ cannot be verified by the credentials received.
+
+Think very carefully before removing this check from
+`nsm-tls-checks'."
+ (let ((warnings (plist-get status :warnings)))
+ (and warnings
+ (not (nsm-warnings-ok-p status settings))
+ (mapconcat #'gnutls-peer-status-warning-describe warnings "\n"))))
+
+(defun nsm-tls-check-same-cert (host port status settings)
+ "Check for certificate fingerprint mismatch.
+
+If the fingerprints saved do not match the fingerprint of the
+certificate presented, the TLS session may be under a
+man-in-the-middle attack."
+ (and (not (nsm-fingerprint-ok-p status settings))
+ (format-message
+ "fingerprint has changed")))
+
+;; Key exchange checks
+
+(defun nsm-tls-check-rsa-kx (host port status &optional settings)
+ "Check for static RSA key exchange.
+
+Static RSA key exchange methods do not offer perfect forward
+secrecy, therefore, the security of a TLS session is only as
+secure as the server's private key. Due to TLS' use of RSA key
+exchange to create a session key (the key negotiated between the
+client and the server to encrypt traffic), if the server's
+private key had been compromised, the attacker will be able to
+decrypt any past TLS session recorded, as opposed to just one TLS
+session if the key exchange was conducted via a key exchange
+method that offers perfect forward secrecy, such as ephemeral
+Diffie-Hellman key exchange.
+
+By default, this check is only enabled when
+`network-security-level' is set to `high' for compatibility
+reasons.
+
+Reference:
+
+Sheffer, Holz, Saint-Andre (May 2015). \"Recommendations for Secure
+Use of Transport Layer Security (TLS) and Datagram Transport Layer
+Security (DTLS)\", \"(4.1. General Guidelines)\"
+`https://tools.ietf.org/html/rfc7525\#section-4.1'"
+ (let ((kx (plist-get status :key-exchange)))
+ (and (string-match "^\\bRSA\\b" kx)
+ (format-message
+ "RSA key exchange method (%s) does not offer perfect forward secrecy"
+ kx))))
+
+(defun nsm-tls-check-dhe-prime-kx (host port status &optional settings)
+ "Check for the key strength of DH key exchange based on integer
factorization.
+
+This check is a response to Logjam[1]. Logjam is an attack that
+allows an attacker with sufficient resource, and positioned
+between the user and the server, to downgrade vulnerable TLS
+connections to insecure 512-bit export grade crypotography.
+
+The Logjam paper suggests using 1024-bit prime on the client to
+mitigate some effects of this attack, and upgrade to 2048-bit as
+soon as server configurations allow. According to SSLLabs' SSL
+Pulse tracker, only about 75% of server support 2048-bit key
+exchange in June 2018[2]. To provide a balance between
+compatibility and security, this function only checks for a
+minimum key strength of 1024-bit.
+
+See also: `nsm-tls-check-dhe-kx'
+
+Reference:
+
+[1]: Adrian et al (2014). \"Imperfect Forward Secrecy: How
+Diffie-Hellman Fails in Practice\", `https://weakdh.org/'
+[2]: SSL Pulse (June 03, 2018). \"Key Exchange Strength\",
+`https://www.ssllabs.com/ssl-pulse/'"
(let ((prime-bits (plist-get status :diffie-hellman-prime-bits)))
- (or (not prime-bits)
- (>= prime-bits bits)
- (nsm-query
- host port status :diffie-hellman-prime-bits
- "The Diffie-Hellman prime bits (%s) used for this connection to %s:%s
is less than what is considered safe (%s)."
- prime-bits host port bits))))
-
-(defun nsm-protocol-check--3des (host port status _)
- (or (not (string-match "\\b3DES\\b" (plist-get status :cipher)))
- (nsm-query
- host port status :rc4
- "The connection to %s:%s uses the 3DES cipher (%s), which is believed
to be unsafe."
- host port (plist-get status :cipher))))
-
-(defun nsm-protocol-check--rc4 (host port status _)
- (or (not (string-match "\\bRC4\\b" (nsm--encryption status)))
- (nsm-query
- host port status :rc4
- "The connection to %s:%s uses the RC4 algorithm (%s), which is believed
to be unsafe."
- host port (nsm--encryption status))))
-
-(defun nsm-protocol-check--signature-sha1 (host port status _)
- (let ((signature-algorithm
- (plist-get (plist-get status :certificate) :signature-algorithm)))
- (or (not (string-match "\\bSHA1\\b" signature-algorithm))
- (nsm-query
- host port status :signature-sha1
- "The certificate used to verify the connection to %s:%s uses the SHA1
algorithm (%s), which is believed to be unsafe."
- host port signature-algorithm))))
-
-(defun nsm-protocol-check--intermediate-sha1 (host port status _)
- ;; Skip the first certificate, because that's the host certificate.
- (cl-loop for certificate in (cdr (plist-get status :certificates))
+ (if (and (string-match "^\\bDHE\\b" (plist-get status :key-exchange))
+ (< prime-bits 1024))
+ (format-message
+ "Diffie-Hellman key strength (%s bits) too weak (%s bits)"
+ prime-bits 1024))))
+
+(defun nsm-tls-check-dhe-kx (host port status &optional settings)
+ "Check for existence of DH key exchange based on integer factorization.
+
+In the years since the discovery of Logjam, it was discovered
+that there were rampant use of small subgroup prime or composite
+number for DHE by many servers, and thus allowed themselves to be
+vulnerable to backdoors[1]. Given the difficulty in validating
+Diffie-Hellman parameters, major browser vendors had started to
+remove DHE since 2016[2]. Emacs stops short of banning DHE and
+terminating connection, but prompts the user instead.
+
+References:
+
+[1]: Dorey, Fong, and Essex (2016). \"Indiscreet Logs: Persistent
+Diffie-Hellman Backdoors in TLS.\",
+`https://eprint.iacr.org/2016/999.pdf'
+[2]: Chrome Platform Status (2017). \"Remove DHE-based ciphers\",
+`https://www.chromestatus.com/feature/5128908798164992'"
+ (let ((kx (plist-get status :key-exchange)))
+ (when (string-match "^\\bDHE\\b" kx)
+ (format-message
+ "unable to verify Diffie-Hellman key exchange method (%s) parameters"
+ kx))))
+
+(defun nsm-tls-check-export-kx (host port status &optional settings)
+ "Check for RSA-EXPORT key exchange.
+
+EXPORT cipher suites are a family of 40-bit and 56-bit effective
+security algorithms legally exportable by the United States in
+the early 90s[1]. They can be broken in seconds on 2018 hardware.
+
+Prior to 3.2.0, GnuTLS had only supported RSA-EXPORT key
+exchange. Since 3.2.0, RSA-EXPORT had been removed, therefore,
+this check has no effect on GnuTLS >= 3.2.0.
+
+Reference:
+
+[1]: Schneier, Bruce (1996). Applied Cryptography (Second ed.). John
+Wiley & Sons. ISBN 0-471-11709-9.
+[2]: N. Mavrogiannopoulos, FSF (Apr 2015). \"GnuTLS NEWS -- History
+of user-visible changes.\" Version 3.4.0,
+`https://gitlab.com/gnutls/gnutls/blob/master/NEWS'"
+ (when (< libgnutls-version 30200)
+ (let ((kx (plist-get status :key-exchange)))
+ (and (string-match "\\bEXPORT\\b" kx)
+ (format-message
+ "EXPORT level key exchange (%s) is insecure"
+ kx)))))
+
+(defun nsm-tls-check-anon-kx (host port status &optional settings)
+ "Check for anonymous key exchange.
+
+Anonymous key exchange exposes the connection to
+man-in-the-middle attacks.
+
+Reference:
+
+GnuTLS authors (2018). \"GnuTLS Manual 4.3.3 Anonymous
+authentication\",
+`https://www.gnutls.org/manual/gnutls.html\#Anonymous-authentication'"
+ (let ((kx (plist-get status :key-exchange)))
+ (and (string-match "\\bANON\\b" kx)
+ (format-message
+ "anonymous key exchange method (%s) can be unsafe"
+ kx))))
+
+;; Cipher checks
+
+(defun nsm-tls-check-cbc-cipher (host port status &optional settings)
+ "Check for CBC mode ciphers.
+
+CBC mode cipher in TLS versions earlier than 1.3 are problematic
+because of MAC-then-encrypt. This construction is vulnerable to
+padding oracle attacks[1].
+
+Since GnuTLS 3.4.0, the TLS encrypt-then-MAC extension[2] has
+been enabled by default[3]. If encrypt-then-MAC is negotiated,
+this check has no effect.
+
+Reference:
+
+[1]: Sullivan (Feb 2016). \"Padding oracles and the decline of
+CBC-mode cipher suites\",
+`https://blog.cloudflare.com/padding-oracles-and-the-decline-of-cbc-mode-ciphersuites/'
+[2]: P. Gutmann (Sept 2014). \"Encrypt-then-MAC for Transport Layer
+Security (TLS) and Datagram Transport Layer Security (DTLS)\",
+`https://tools.ietf.org/html/rfc7366'
+[3]: N. Mavrogiannopoulos (Nov 2015). \"An overview of GnuTLS
+3.4.x\",
+`https://nikmav.blogspot.com/2015/11/an-overview-of-gnutls-34x.html'"
+ (when (not (plist-get status :encrypt-then-mac))
+ (let ((cipher (plist-get status :cipher)))
+ (and (string-match "\\bCBC\\b" cipher)
+ (format-message
+ "CBC mode cipher (%s) can be insecure"
+ cipher)))))
+
+(defun nsm-tls-check-ecdsa-cbc-cipher (host port status &optional settings)
+ "Check for CBC mode cipher usage under ECDSA key exchange.
+
+CBC mode cipher in TLS versions earlier than 1.3 are problematic
+because of MAC-then-encrypt. This construction is vulnerable to
+padding oracle attacks[1].
+
+Due to current widespread use of CBC mode ciphers by servers,
+this function only checks for CBC mode cipher usage in
+combination with ECDSA key exchange, which is virtually
+non-existent[2].
+
+Since GnuTLS 3.4.0, the TLS encrypt-then-MAC extension[3] has
+been enabled by default[4]. If encrypt-then-MAC is negotiated,
+this check has no effect.
+
+References:
+
+[1]: Sullivan (Feb 2016). \"Padding oracles and the decline of
+CBC-mode cipher suites\",
+`https://blog.cloudflare.com/padding-oracles-and-the-decline-of-cbc-mode-ciphersuites/'
+[2]: Chrome Platform Status (2017). \"Remove CBC-mode ECDSA ciphers in
+TLS\", `https://www.chromestatus.com/feature/5740978103123968'
+[3]: P. Gutmann (Sept 2014). \"Encrypt-then-MAC for Transport Layer
+Security (TLS) and Datagram Transport Layer Security (DTLS)\",
+`https://tools.ietf.org/html/rfc7366'
+[4]: N. Mavrogiannopoulos (Nov 2015). \"An overview of GnuTLS
+3.4.x\",
+`https://nikmav.blogspot.com/2015/11/an-overview-of-gnutls-34x.html'"
+ (when (not (plist-get status :encrypt-then-mac))
+ (let ((kx (plist-get status :key-exchange))
+ (cipher (plist-get status :cipher)))
+ (and (string-match "\\bECDSA\\b" kx)
+ (string-match "\\bCBC\\b" cipher)
+ (format-message
+ "CBC mode cipher (%s) can be insecure"
+ cipher)))))
+
+(defun nsm-tls-check-3des-cipher (host port status &optional settings)
+ "Check for 3DES ciphers.
+
+Due to its use of 64-bit block size, it is known that a
+ciphertext collision is highly likely when 2^32 blocks are
+encrypted with the same key bundle under 3-key 3DES. Practical
+birthday attacks of this kind have been demostrated by Sweet32[1].
+As such, NIST is in the process of disallowing its use in TLS[2].
+
+[1]: Bhargavan, Leurent (2016). \"On the Practical (In-)Security of
+64-bit Block Ciphers — Collision Attacks on HTTP over TLS and
+OpenVPN\", `https://sweet32.info/'
+[2]: NIST Information Technology Laboratory (Jul 2017). \"Update to
+Current Use and Deprecation of TDEA\",
+`https://csrc.nist.gov/News/2017/Update-to-Current-Use-and-Deprecation-of-TDEA'"
+ (let ((cipher (plist-get status :cipher)))
+ (and (string-match "\\b3DES\\b" cipher)
+ (format-message
+ "3DES cipher (%s) is weak"
+ cipher))))
+
+(defun nsm-tls-check-rc4-cipher (host port status &optional settings)
+ "Check for RC4 ciphers.
+
+RC4 cipher has been prohibited by RFC 7465[1].
+
+Since GnuTLS 3.4.0, RC4 is not enabled by default[2], but can be
+enabled if requested. This check is mainly provided to secure
+Emacs built with older version of GnuTLS.
+
+Reference:
+
+[1]: Popov A (Feb 2015). \"Prohibiting RC4 Cipher Suites\",
+`https://tools.ietf.org/html/rfc7465'
+[2]: N. Mavrogiannopoulos (Nov 2015). \"An overview of GnuTLS
+3.4.x\",
+`https://nikmav.blogspot.com/2015/11/an-overview-of-gnutls-34x.html'"
+ (let ((cipher (plist-get status :cipher)))
+ (and (string-match "\\bARCFOUR\\b" cipher)
+ (format-message
+ "RC4 cipher (%s) is insecure"
+ cipher))))
+
+;; Signature checks
+
+(defun nsm-tls-check-sha1-sig (host port status &optional settings)
+ "Check for SHA1 signatures on certificates.
+
+The first SHA1 collision was found in 2017[1], as a precaution
+against the events following the discovery of cheap collisions in
+MD5, major browsers[2][3][4][5] have removed the use of SHA1
+signatures in certificates.
+
+References:
+
+[1]: Stevens M, Karpman P et al (2017). \"The first collision for
+full SHA-1\", `https://shattered.io/static/shattered.pdf'
+[2]: Chromium Security Education TLS/SSL. \"Deprecated and Removed
+Features (SHA-1 Certificate Signatures)\",
+`https://www.chromium.org/Home/chromium-security/education/tls\#TOC-SHA-1-Certificate-Signatures'
+[3]: Jones J.C (2017). \"The end of SHA-1 on the Public Web\",
+`https://blog.mozilla.org/security/2017/02/23/the-end-of-sha-1-on-the-public-web/'
+[4]: Apple Support (2017). \"Move to SHA-256 signed certificates to
+avoid connection failures\",
+`https://support.apple.com/en-gb/HT207459'
+[5]: Microsoft Security Advisory 4010323 (2017). \"Deprecation of
+SHA-1 for SSL/TLS Certificates in Microsoft Edge and Internet Explorer
+11\",
+`https://docs.microsoft.com/en-us/security-updates/securityadvisories/2017/4010323'"
+ (cl-loop for certificate in (plist-get status :certificates)
+ for algo = (plist-get certificate :signature-algorithm)
+ ;; Don't check root certificates -- root is always trusted.
+ if (and (not (equal (plist-get certificate :issuer)
+ (plist-get certificate :subject)))
+ (string-match "\\bSHA1\\b" algo))
+ return (format-message
+ "SHA1 signature (%s) is prone to collisions"
+ algo)
+ end))
+
+(defun nsm-tls-check-md5-sig (host port status &optional settings)
+ "Check for MD5 signatures on certificates.
+
+In 2008, a group of researchers were able to forge an
+intermediate CA certificate that appeared to be legitimate when
+checked by MD5[1]. RFC 6151[2] has recommended against the usage
+of MD5 for digital signatures, which includes TLS certificate
+signatures.
+
+Since GnuTLS 3.3.0, MD5 has been disabled by default, but can be
+enabled if requested.
+
+References:
+
+[1]: Sotirov A, Stevens M et al (2008). \"MD5 considered harmful today
+- Creating a rogue CA certificate\",
+`http://www.win.tue.nl/hashclash/rogue-ca/'
+[2]: Turner S, Chen L (2011). \"Updated Security Considerations for
+the MD5 Message-Digest and the HMAC-MD5 Algorithms\",
+`https://tools.ietf.org/html/rfc6151'"
+ (cl-loop for certificate in (plist-get status :certificates)
for algo = (plist-get certificate :signature-algorithm)
- ;; Don't check root certificates -- SHA1 isn't dangerous
- ;; there.
- when (and (not (equal (plist-get certificate :issuer)
- (plist-get certificate :subject)))
- (string-match "\\bSHA1\\b" algo)
- (not (nsm-query
- host port status :intermediate-sha1
- "An intermediate certificate used to verify the
connection to %s:%s uses the SHA1 algorithm (%s), which is believed to be
unsafe."
- host port algo)))
- do (cl-return nil)
- finally (cl-return t)))
-
-(defun nsm-protocol-check--ssl (host port status _)
+ ;; Don't check root certificates -- root is always trusted.
+ if (and (not (equal (plist-get certificate :issuer)
+ (plist-get certificate :subject)))
+ (string-match "\\bMD5\\b" algo))
+ return (format-message
+ "MD5 signature (%s) is very prone to collisions"
+ algo)
+ end))
+
+;; Extension checks
+
+(defun nsm-tls-check-renegotiation-info-ext (host port status &optional
settings)
+ "Check for renegotiation_info TLS extension status.
+
+If this TLS extension is not used, the connection established is
+vulnerable to an attack in which an impersonator can extract
+sensitive information such as HTTP session ID cookies or login
+passwords.
+
+Reference:
+
+E. Rescorla, M. Ray, S. Dispensa, N. Oskov (Feb 2010). \"Transport
+Layer Security (TLS) Renegotiation Indication Extension\",
+`https://tools.ietf.org/html/rfc5746'"
+ (let ((unsafe-renegotiation (not (plist-get status :safe-renegotiation))))
+ (and unsafe-renegotiation
+ (format-message
+ "safe renegotiation is not supported, connection not protected from
impersonators"))))
+
+;; Compression checks
+
+(defun nsm-tls-check-compression (host port status &optional settings)
+ "Check for TLS compression.
+
+TLS compression attacks such as CRIME would allow an attacker to
+decrypt ciphertext. As a result, RFC 7525 has recommended its
+disablement.
+
+Reference:
+
+Sheffer, Holz, Saint-Andre (May 2015). \"Recommendations for Secure
+Use of Transport Layer Security (TLS) and Datagram Transport Layer
+Security (DTLS)\", `https://tools.ietf.org/html/rfc7525'"
+ (let ((compression (plist-get status :compression)))
+ (and (string-match "^\\bDEFLATE\\b" compression)
+ (format-message
+ "compression method (%s) may lead to leakage of sensitive
information"
+ compression))))
+
+;; Protocol version checks
+
+(defun nsm-tls-check-version (host port status &optional settings)
+ "Check for SSL/TLS protocol version.
+
+This function guards against the usage of SSL3.0, which has been
+deprecated by RFC7568[1], and TLS 1.0, which has been deprecated
+by PCI DSS[2].
+
+References:
+
+[1]: Barnes, Thomson, Pironti, Langley (2015). \"Deprecating Secure
+Sockets Layer Version 3.0\", `https://tools.ietf.org/html/rfc7568'
+[2]: PCI Security Standards Council (2016). \"Migrating from SSL and
+Early TLS\"
+`https://www.pcisecuritystandards.org/documents/Migrating-from-SSL-Early-TLS-Info-Supp-v1_1.pdf'"
(let ((protocol (plist-get status :protocol)))
- (or (not protocol)
- (not (string-match "SSL" protocol))
- (nsm-query
- host port status :ssl
- "The connection to %s:%s uses the %s protocol, which is believed to be
unsafe."
- host port protocol))))
+ (and protocol
+ (or (string-match "SSL" protocol)
+ (and (string-match "TLS1.\\([0-9]+\\)" protocol)
+ (< (string-to-number (match-string 1 protocol)) 1)))
+ (format-message
+ "%s protocol is deprecated by standard bodies"
+ protocol))))
+
+;; Full suite checks
+
+(defun nsm-tls-check-null-suite (host port status &optional settings)
+ "Check for NULL cipher suites.
+
+This function checks for NULL key exchange, cipher and message
+authentication code key derivation function. As the name
+suggests, a NULL assigned for any of the above disables an
+integral part of the security properties that makes up the TLS
+protocol."
+ (let ((suite (nsm-cipher-suite status)))
+ (and (string-match "\\bNULL\\b" suite)
+ (format-message
+ "NULL cipher suite (%s) violates authenticity, integrity, or
confidentiality guarantees"
+ suite))))
+
+
(defun nsm-fingerprint (status)
(plist-get (plist-get status :certificate) :public-key-id))
-(defun nsm-fingerprint-ok-p (host port status settings)
- (let ((did-query nil))
- (if (and settings
- (not (eq (plist-get settings :fingerprint) :none))
- (not (equal (nsm-fingerprint status)
- (plist-get settings :fingerprint)))
- (not
- (setq did-query
- (nsm-query
- host port status 'fingerprint
- "The fingerprint for the connection to %s:%s has changed
from %s to %s"
- host port
- (plist-get settings :fingerprint)
- (nsm-fingerprint status)))))
- ;; Not OK.
- nil
- (when did-query
- ;; Remove any exceptions that have been set on the previous
- ;; certificate.
- (plist-put settings :conditions nil))
- t)))
-
-(defun nsm-new-fingerprint-ok-p (host port status)
- (nsm-query
- host port status 'fingerprint
- "The fingerprint for the connection to %s:%s is new: %s"
- host port
- (nsm-fingerprint status)))
+(defun nsm-fingerprint-ok-p (status settings)
+ (let ((saved-fingerprints (plist-get settings :fingerprints)))
+ ;; Haven't seen this host before or not pinning cert
+ (or (null saved-fingerprints)
+ ;; Plain connection allowed
+ (memq :none saved-fingerprints)
+ ;; We are pinning certs, and we have seen this host
+ ;; before, but the credientials for this host differs
+ ;; from the last times we saw it
+ (member (nsm-fingerprint status) saved-fingerprints))))
+
+(set-advertised-calling-convention
+ 'nsm-fingerprint-ok-p '(status settings) "27.1")
(defun nsm-check-plain-connection (process host port settings warn-unencrypted)
- ;; If this connection used to be TLS, but is now plain, then it's
- ;; possible that we're being Man-In-The-Middled by a proxy that's
- ;; stripping out STARTTLS announcements.
- (cond
- ((and (plist-get settings :fingerprint)
- (not (eq (plist-get settings :fingerprint) :none))
- (not
- (nsm-query
- host port nil 'conditions
- "The connection to %s:%s used to be an encrypted connection, but is
now unencrypted. This might mean that there's a man-in-the-middle tapping this
connection."
- host port)))
- (delete-process process)
- nil)
- ((and warn-unencrypted
- (not (memq :unencrypted (plist-get settings :conditions)))
- (not (nsm-query
- host port nil 'conditions
- "The connection to %s:%s is unencrypted."
- host port)))
- (delete-process process)
- nil)
- (t
- process)))
-
-(defun nsm-query (host port status what message &rest args)
+ ;; If this connection used to be TLS, but is now plain, then it's
+ ;; possible that we're being Man-In-The-Middled by a proxy that's
+ ;; stripping out STARTTLS announcements.
+ (let ((fingerprints (plist-get settings :fingerprints)))
+ (cond
+ ((and fingerprints
+ (not (memq :none fingerprints))
+ (not
+ (nsm-query
+ host port nil 'conditions '(:unencrypted)
+ (format-message
+ "The connection to %s:%s used to be an encrypted connection,
but is now unencrypted. This might mean that there's a man-in-the-middle
tapping this connection."
+ host port))))
+ (delete-process process)
+ nil)
+ ((and warn-unencrypted
+ (not (memq :unencrypted (plist-get settings :conditions)))
+ (not (nsm-query
+ host port nil 'conditions '(:unencrypted)
+ (format-message
+ "The connection to %s:%s is unencrypted."
+ host port))))
+ (delete-process process)
+ nil)
+ (t
+ process))))
+
+(defun nsm-query (host port status what problems message)
;; If there is no user to answer queries, then say `no' to everything.
(if (or noninteractive
nsm-noninteractive)
@@ -345,9 +713,7 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
(let ((response
(condition-case nil
(intern
- (car (split-string
- (nsm-query-user message args
- (nsm-format-certificate status))))
+ (car (split-string (nsm-query-user message status)))
obarray)
;; Make sure we manage to close the process if the user hits
;; `C-g'.
@@ -361,41 +727,47 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
"Accepting certificate for %s:%s this session only"
"Permanently accepting certificate for %s:%s")
host port)
- (nsm-save-host host port status what response)
- t))))
+ (nsm-save-host host port status what problems response)
+ t))))
+
+(set-advertised-calling-convention
+ 'nsm-query '(host port status what problems message) "27.1")
-(defun nsm-query-user (message args cert)
- (let ((buffer (get-buffer-create "*Network Security Manager*")))
+(defun nsm-query-user (message status)
+ (let ((buffer (get-buffer-create "*Network Security Manager*"))
+ (cert-buffer (get-buffer-create "*Certificate Details*"))
+ (certs (plist-get status :certificates)))
(save-window-excursion
;; First format the certificate and warnings.
- (with-help-window buffer
- (with-current-buffer buffer
- (erase-buffer)
- (when (> (length cert) 0)
- (insert cert "\n"))
- (let ((start (point)))
- (insert (apply #'format-message message args))
- (goto-char start)
- ;; Fill the first line of the message, which usually
- ;; contains lots of explanatory text.
- (fill-region (point) (line-end-position)))))
+ (with-current-buffer-window
+ buffer nil nil
+ (insert (nsm-format-certificate status))
+ (insert message)
+ (goto-char (point-min))
+ ;; Fill the first line of the message, which usually
+ ;; contains lots of explanatory text.
+ (fill-region (point) (line-end-position)))
;; Then ask the user what to do about it.
(unwind-protect
- (cadr
- (read-multiple-choice
- "Continue connecting?"
- '((?a "always" "Accept this certificate this session and for all
future sessions.")
- (?s "session only" "Accept this certificate this session only.")
- (?n "no" "Refuse to use this certificate, and close the
connection."))))
+ (let* ((accept-choices '((?a "always" "Accept this certificate this
session and for all future sessions.")
+ (?s "session only" "Accept this certificate
this session only.")
+ (?n "no" "Refuse to use this certificate,
and close the connection.")))
+ (answer (read-multiple-choice "Continue connecting?"
accept-choices)))
+ (cadr answer))
(kill-buffer buffer)))))
-(defun nsm-save-host (host port status what permanency)
+(set-advertised-calling-convention 'nsm-query-user '(message status) "27.1")
+
+(defun nsm-save-host (host port status what problems permanency)
(let* ((id (nsm-id host port))
- (saved
- (list :id id
- :fingerprint (or (nsm-fingerprint status)
- ;; Plain connection.
- :none))))
+ (saved-fingerprints (plist-get (nsm-host-settings id) :fingerprints))
+ (fingerprints (cl-delete-duplicates
+ (append saved-fingerprints
+ (list (or (nsm-fingerprint status)
+ ;; Plain connection.
+ :none)))
+ :test #'string=))
+ (saved (list :id id :fingerprints fingerprints)))
(when (or (eq what 'conditions)
nsm-save-host-names)
(nconc saved (list :host (format "%s:%s" host port))))
@@ -403,20 +775,19 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
;; of the certificate/unencrypted connection.
(cond
((eq what 'conditions)
- (cond
- ((not status)
- (nconc saved '(:conditions (:unencrypted))))
- ((plist-get status :warnings)
- (nconc saved
- (list :conditions (plist-get status :warnings))))))
- ((not (eq what 'fingerprint))
+ (plist-put saved :conditions problems))
+ ;; Make sure the conditions are not erased when we save a
+ ;; fingerprint
+ ((eq what 'fingerprint)
;; Store additional protocol settings.
(let ((settings (nsm-host-settings id)))
- (when settings
- (setq saved settings))
- (if (plist-get saved :conditions)
- (nconc (plist-get saved :conditions) (list what))
- (nconc saved (list :conditions (list what)))))))
+ (when settings
+ (setq saved settings))
+ (if (plist-get saved :conditions)
+ (plist-put saved :conditions
+ (cl-delete-duplicates
+ (nconc (plist-get saved :conditions) problems)))
+ (plist-put saved :conditions problems)))))
(if (eq permanency 'always)
(progn
(nsm-remove-temporary-setting id)
@@ -426,6 +797,11 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
(nsm-remove-temporary-setting id)
(push saved nsm-temporary-host-settings))))
+(set-advertised-calling-convention
+ 'nsm-save-host
+ '(host port status what problems permanency)
+ "27.1")
+
(defun nsm-write-settings ()
(with-temp-file nsm-settings-file
(insert "(\n")
@@ -501,10 +877,17 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
(when (and (plist-get status :key-exchange)
(plist-get status :cipher)
(plist-get status :mac)
- (plist-get status :protocol))
+ (plist-get status :protocol)
+ (plist-get status :compression))
(insert
"Protocol:" (plist-get status :protocol)
+ ", safe renegotiation: " (if (plist-get status :safe-renegotiation)
"YES" "NO")
+ ", compression: " (plist-get status :compression)
+ ", encrypt-then-MAC: " (if (plist-get status :encrypt-then-mac)
"YES" "NO")
", key: " (plist-get status :key-exchange)
+ (if (string-match "^\\bDHE\\b" (plist-get status :key-exchange))
+ (concat ", prime bits: " (format "%s" (plist-get status
:diffie-hellman-prime-bits)))
+ "")
", cipher: " (plist-get status :cipher)
", mac: " (plist-get status :mac) "\n"))
(when (plist-get cert :certificate-security-level)
@@ -557,8 +940,15 @@ HOST PORT STATUS OPTIONAL-PARAMETER.")
(cond
((eq symbol 'low) 0)
((eq symbol 'medium) 1)
- ((eq symbol 'high) 2)
- (t 3)))
+ (t 2)))
+
+(defun nsm-cipher-suite (status)
+ (format "%s-%s-%s"
+ (plist-get status :key-exchange)
+ (plist-get status :cipher)
+ (plist-get status :mac)))
+
+(define-obsolete-function-alias 'nsm--encryption #'nsm-cipher-suite "27.1")
(provide 'nsm)
diff --git a/src/gnutls.c b/src/gnutls.c
index d7a4ee4..448f673 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -40,6 +40,10 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
# define HAVE_GNUTLS_AEAD
#endif
+#if GNUTLS_VERSION_NUMBER >= 0x030400
+# define HAVE_GNUTLS_ETM_STATUS
+#endif
+
/* gnutls_mac_get_nonce_size was added in GnuTLS 3.2.0, but was
exported only since 3.3.0. */
#if GNUTLS_VERSION_NUMBER >= 0x030300
@@ -197,6 +201,11 @@ DEF_DLL_FN (const char *, gnutls_cipher_get_name,
(gnutls_cipher_algorithm_t));
DEF_DLL_FN (gnutls_mac_algorithm_t, gnutls_mac_get, (gnutls_session_t));
DEF_DLL_FN (const char *, gnutls_mac_get_name, (gnutls_mac_algorithm_t));
+DEF_DLL_FN (gnutls_compression_method_t, gnutls_compression_get,
+ (gnutls_session_t));
+DEF_DLL_FN (const char *, gnutls_compression_get_name,
+ (gnutls_compression_method_t));
+DEF_DLL_FN (unsigned, gnutls_safe_renegotiation_status, (gnutls_session_t));
# ifdef HAVE_GNUTLS3
DEF_DLL_FN (int, gnutls_rnd, (gnutls_rnd_level_t, void *, size_t));
@@ -233,6 +242,9 @@ DEF_DLL_FN (int, gnutls_aead_cipher_decrypt,
(gnutls_aead_cipher_hd_t, const void *, size_t, const void *,
size_t, size_t, const void *, size_t, void *, size_t *));
# endif
+# ifdef HAVE_GNUTLS_ETM_STATUS
+DEF_DLL_FN (unsigned, gnutls_session_etm_status, (gnutls_session_t));
+# endif
DEF_DLL_FN (int, gnutls_hmac_init,
(gnutls_hmac_hd_t *, gnutls_mac_algorithm_t, const void *, size_t));
DEF_DLL_FN (int, gnutls_hmac_get_len, (gnutls_mac_algorithm_t));
@@ -332,6 +344,9 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_cipher_get_name);
LOAD_DLL_FN (library, gnutls_mac_get);
LOAD_DLL_FN (library, gnutls_mac_get_name);
+ LOAD_DLL_FN (library, gnutls_compression_get);
+ LOAD_DLL_FN (library, gnutls_compression_get_name);
+ LOAD_DLL_FN (library, gnutls_safe_renegotiation_status);
# ifdef HAVE_GNUTLS3
LOAD_DLL_FN (library, gnutls_rnd);
LOAD_DLL_FN (library, gnutls_mac_list);
@@ -357,6 +372,9 @@ init_gnutls_functions (void)
LOAD_DLL_FN (library, gnutls_aead_cipher_encrypt);
LOAD_DLL_FN (library, gnutls_aead_cipher_decrypt);
# endif
+# ifdef HAVE_GNUTLS_ETM_STATUS
+ LOAD_DLL_FN (library, gnutls_session_etm_status);
+# endif
LOAD_DLL_FN (library, gnutls_hmac_init);
LOAD_DLL_FN (library, gnutls_hmac_get_len);
LOAD_DLL_FN (library, gnutls_hmac);
@@ -415,6 +433,9 @@ init_gnutls_functions (void)
# define gnutls_kx_get_name fn_gnutls_kx_get_name
# define gnutls_mac_get fn_gnutls_mac_get
# define gnutls_mac_get_name fn_gnutls_mac_get_name
+# define gnutls_compression_get fn_gnutls_compression_get
+# define gnutls_compression_get_name fn_gnutls_compression_get_name
+# define gnutls_safe_renegotiation_status fn_gnutls_safe_renegotiation_status;
# define gnutls_pk_algorithm_get_name fn_gnutls_pk_algorithm_get_name
# define gnutls_pk_bits_to_sec_param fn_gnutls_pk_bits_to_sec_param
# define gnutls_priority_set_direct fn_gnutls_priority_set_direct
@@ -473,6 +494,9 @@ init_gnutls_functions (void)
# define gnutls_aead_cipher_init fn_gnutls_aead_cipher_init
# define gnutls_aead_cipher_deinit fn_gnutls_aead_cipher_deinit
# endif
+# ifdef HAVE_GNUTLS_ETM_STATUS
+# define gnutls_session_etm_status fn_gnutls_session_etm_status
+# endif
# define gnutls_hmac_init fn_gnutls_hmac_init
# define gnutls_hmac_get_len fn_gnutls_hmac_get_len
# define gnutls_hmac fn_gnutls_hmac
@@ -1205,6 +1229,29 @@ DEFUN ("gnutls-peer-status-warning-describe",
Fgnutls_peer_status_warning_descri
if (EQ (status_symbol, intern (":no-host-match")))
return build_string ("certificate host does not match hostname");
+ if (EQ (status_symbol, intern (":signature-failure")))
+ return build_string ("certificate signature could not be verified");
+
+ if (EQ (status_symbol, intern (":revocation-data-superseded")))
+ return build_string ("certificate revocation data are old and have been "
+ "superseded");
+
+ if (EQ (status_symbol, intern (":revocation-data-issued-in-future")))
+ return build_string ("certificate revocation data have a future issue
date");
+
+ if (EQ (status_symbol, intern (":signer-constraints-failure")))
+ return build_string ("certificate ");
+
+ if (EQ (status_symbol, intern (":purpose-mismatch")))
+ return build_string ("certificate does not match the intended purpose");
+
+ if (EQ (status_symbol, intern (":missing-ocsp-status")))
+ return build_string ("certificate requires the server to send a OCSP "
+ "certificate status, but no status was received");
+
+ if (EQ (status_symbol, intern (":invalid-ocsp-status")))
+ return build_string ("the received OCSP certificate status is invalid");
+
return Qnil;
}
@@ -1256,6 +1303,35 @@ returned as the :certificate entry. */)
if (verification & GNUTLS_CERT_EXPIRED)
warnings = Fcons (intern (":expired"), warnings);
+#if GNUTLS_VERSION_NUMBER >= 0x030100
+ if (verification & GNUTLS_CERT_SIGNATURE_FAILURE)
+ warnings = Fcons (intern (":signature-failure"), warnings);
+
+# if GNUTLS_VERSION_NUMBER >= 0x030114
+ if (verification & GNUTLS_CERT_REVOCATION_DATA_SUPERSEDED)
+ warnings = Fcons (intern (":revocation-data-superseded"), warnings);
+
+ if (verification & GNUTLS_CERT_REVOCATION_DATA_ISSUED_IN_FUTURE)
+ warnings = Fcons (intern (":revocation-data-issued-in-future"), warnings);
+
+ if (verification & GNUTLS_CERT_SIGNER_CONSTRAINTS_FAILURE)
+ warnings = Fcons (intern (":signer-constraints-failure"), warnings);
+
+# if GNUTLS_VERSION_NUMBER >= 0x030400
+ if (verification & GNUTLS_CERT_PURPOSE_MISMATCH)
+ warnings = Fcons (intern (":purpose-mismatch"), warnings);
+
+# if GNUTLS_VERSION_NUMBER >= 0x030501
+ if (verification & GNUTLS_CERT_MISSING_OCSP_STATUS)
+ warnings = Fcons (intern (":missing-ocsp-status"), warnings);
+
+ if (verification & GNUTLS_CERT_INVALID_OCSP_STATUS)
+ warnings = Fcons (intern (":invalid-ocsp-status"), warnings);
+# endif
+# endif
+# endif
+#endif
+
if (XPROCESS (proc)->gnutls_extra_peer_verification &
CERTIFICATE_NOT_MATCHING)
warnings = Fcons (intern (":no-host-match"), warnings);
@@ -1323,6 +1399,26 @@ returned as the :certificate entry. */)
build_string (gnutls_mac_get_name
(gnutls_mac_get (state)))));
+ /* Compression name. */
+ result = nconc2
+ (result, list2 (intern (":compression"),
+ build_string (gnutls_compression_get_name
+ (gnutls_compression_get (state)))));
+
+ /* Encrypt-then-MAC. */
+ result = nconc2
+ (result, list2 (intern (":encrypt-then-mac"),
+#ifdef HAVE_GNUTLS_ETM_STATUS
+ gnutls_session_etm_status (state) ? Qt : Qnil
+#else
+ Qnil
+#endif
+ ));
+
+ /* Renegotiation Indication */
+ result = nconc2
+ (result, list2 (intern (":safe-renegotiation"),
+ gnutls_safe_renegotiation_status (state) ? Qt : Qnil));
return result;
}
- [Emacs-diffs] branch netsec created (now fab6139), Jimmy Yuen Ho Wong, 2018/07/14
- [Emacs-diffs] netsec 023f4c6 2/6: Set standard value of `gnutls-min-primes-bits' to nil, Jimmy Yuen Ho Wong, 2018/07/14
- [Emacs-diffs] netsec fab6139 6/6: Show full issuer and subject distinguished names, Jimmy Yuen Ho Wong, 2018/07/14
- [Emacs-diffs] netsec 534a3d5 3/6: Revamp Network Security manager checks for TLS,
Jimmy Yuen Ho Wong <=
- [Emacs-diffs] netsec 682578f 4/6: Add option to bypass NSM TLS checks on local networks, Jimmy Yuen Ho Wong, 2018/07/14
- [Emacs-diffs] netsec 87484dc 5/6: Full certificate chain details for NSM, Jimmy Yuen Ho Wong, 2018/07/14
- [Emacs-diffs] netsec a9f09f7 1/6: Check TLS certs against CRL, Jimmy Yuen Ho Wong, 2018/07/14