Commit 53cb3d3e authored by Lars Ingebrigtsen's avatar Lars Ingebrigtsen

Merge remote-tracking branch 'origin/netsec'

parents b4d3a882 29d485fb
......@@ -3005,6 +3005,21 @@ If the vector does not include the port number, @var{p}, or if
@code{:@var{p}} suffix.
@end defun
@defun network-lookup-address-info name &optional family
This function is used to perform hostname lookups on @var{name}, which
is expected to be an ASCII-only string, otherwise an error is
signaled. Call @code{puny-encode-domain} on @var{name}
first if you wish to lookup internationalized hostnames.
If successful it returns a list of Lisp representations of network
addresses (without port numbers), otherwise it returns @code{nil}.
By default both IPv4 and IPv6 lookups are attempted. The optional
argument @var{family} controls this behavior, specifying the symbol
@code{ipv4} or @code{ipv6} restricts lookups to IPv4 and IPv6
respectively.
@end defun
@node Serial Ports
@section Communicating with Serial Ports
@cindex @file{/dev/tty}
......
......@@ -205,6 +205,9 @@ To get the old, less-secure behavior, you can set the
*** When run by root, emacsclient no longer connects to non-root sockets.
(Instead you can use Tramp methods to run root commands in a non-root Emacs.)
** New function 'network-lookup-address-info'.
This does IPv4 and/or IPv6 address lookups on hostnames.
---
** Control of the threshold for using the 'distant-foreground' color.
The threshold for color distance below which the 'distant-foreground'
......
......@@ -113,16 +113,14 @@ Security'."
"/etc/ssl/cert.pem" ; macOS
)
"List of CA bundle location filenames or a function returning said list.
If a file path contains glob wildcards, they will be expanded.
The files may be in PEM or DER format, as per the GnuTLS documentation.
The files may not exist, in which case they will be ignored."
:group 'gnutls
:type '(choice (function :tag "Function to produce list of bundle filenames")
(repeat (file :tag "Bundle filename"))))
;;;###autoload
(defcustom gnutls-min-prime-bits 256
;; Several mail servers send fewer bits than the GnuTLS default.
;; Currently, 256 appears to be a reasonable choice (Bug#11267).
(defcustom gnutls-min-prime-bits nil
"Minimum number of prime bits accepted by GnuTLS for key exchange.
During a Diffie-Hellman handshake, if the server sends a prime
number with fewer than this number of bits, the handshake is
......@@ -138,9 +136,22 @@ network security is handled at a higher level via
`open-network-stream' and the Network Security Manager. See Info
node `(emacs) Network Security'."
:type '(choice (const :tag "Use default value" nil)
(integer :tag "Number of bits" 512))
(integer :tag "Number of bits" 2048))
:group 'gnutls)
(defcustom gnutls-crlfiles
'(
"/etc/grid-security/certificates/*.crl.pem"
)
"List of CRL file paths or a function returning said list.
If a file path contains glob wildcards, they will be expanded.
The files may be in PEM or DER format, as per the GnuTLS documentation.
The files may not exist, in which case they will be ignored."
:group 'gnutls
:type '(choice (function :tag "Function to produce list of CRL filenames")
(repeat (file :tag "CRL filename")))
:version "27.1")
(defun open-gnutls-stream (name buffer host service &optional parameters)
"Open a SSL/TLS connection for a service to a host.
Returns a subprocess-object to represent the connection.
......@@ -304,6 +315,7 @@ here's a recent version of the list.
It must be omitted, a number, or nil; if omitted or nil it
defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
(let* ((trustfiles (or trustfiles (gnutls-trustfiles)))
(crlfiles (or crlfiles (gnutls-crlfiles)))
(maybe-dumbfw (if (memq 'ClientHello\ Padding (gnutls-available-p))
":%DUMBFW"
""))
......@@ -345,13 +357,18 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
:verify-error ,verify-error
:callbacks nil)))
(defun gnutls--get-files (files)
(cl-loop for f in files
if f do (setq f (if (functionp f) (funcall f) f))
append (cl-delete-if-not #'file-exists-p (file-expand-wildcards f t))))
(defun gnutls-trustfiles ()
"Return a list of usable trustfiles."
(delq nil
(mapcar (lambda (f) (and f (file-exists-p f) f))
(if (functionp gnutls-trustfiles)
(funcall gnutls-trustfiles)
gnutls-trustfiles))))
(gnutls--get-files gnutls-trustfiles))
(defun gnutls-crlfiles ()
"Return a list of usable CRL files."
(gnutls--get-files gnutls-crlfiles))
(declare-function gnutls-error-string "gnutls.c" (error))
......
......@@ -43,6 +43,10 @@
;; still use them for queries). Actually the trend these
;; days is for /sbin to be a symlink to /usr/sbin, but we still need to
;; search both for older systems.
(require 'subr-x)
(require 'cl-lib)
(defun net-utils--executable-find-sbin (command)
"Return absolute name of COMMAND if found in an sbin directory."
(let ((exec-path '("/sbin" "/usr/sbin" "/usr/local/sbin")))
......@@ -514,7 +518,11 @@ Optional argument NAME-SERVER says which server to use for
DNS resolution.
Interactively, prompt for NAME-SERVER if invoked with prefix argument.
This command uses `nslookup-program' for looking up the DNS information."
This command uses `nslookup-program' for looking up the DNS information.
See also: `nslookup-host-ipv4', `nslookup-host-ipv6' for
non-interactive versions of this function more suitable for use
in Lisp code."
(interactive
(list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))
(if current-prefix-arg (read-from-minibuffer "Name server: "))))
......@@ -530,6 +538,71 @@ This command uses `nslookup-program' for looking up the DNS information."
nslookup-program
options)))
;;;###autoload
(defun nslookup-host-ipv4 (host &optional name-server format)
"Return the IPv4 address for HOST (name or IP address).
Optional argument NAME-SERVER says which server to use for DNS
resolution.
If FORMAT is `string', returns the IP address as a
string (default). If FORMAT is `vector', returns a 4-integer
vector of octets.
This command uses `nslookup-program' to look up DNS records."
(let* ((args `(,nslookup-program "-type=A" ,host ,name-server))
(output (shell-command-to-string
(string-join (cl-remove nil args) " ")))
(ip (or (and (string-match
"Name:.*\nAddress: *\\(\\([0-9]\\{1,3\\}\\.?\\)\\{4\\}\\)"
output)
(match-string 1 output))
host)))
(cond ((memq format '(string nil))
ip)
((eq format 'vector)
(apply #'vector (mapcar #'string-to-number (split-string ip "\\."))))
(t (error "Invalid format: %s" format)))))
(defun ipv6-expand (ipv6-vector)
(let ((len (length ipv6-vector)))
(if (< len 8)
(let* ((pivot (cl-position 0 ipv6-vector))
(head (cl-subseq ipv6-vector 0 pivot))
(tail (cl-subseq ipv6-vector (1+ pivot) len)))
(vconcat head (make-vector (- 8 (1- len)) 0) tail))
ipv6-vector)))
;;;###autoload
(defun nslookup-host-ipv6 (host &optional name-server format)
"Return the IPv6 address for HOST (name or IP address).
Optional argument NAME-SERVER says which server to use for DNS
resolution.
If FORMAT is `string', returns the IP address as a
string (default). If FORMAT is `vector', returns a 8-integer
vector of hextets.
This command uses `nslookup-program' to look up DNS records."
(let* ((args `(,nslookup-program "-type=AAAA" ,host ,name-server))
(output (shell-command-to-string
(string-join (cl-remove nil args) " ")))
(hextet "[0-9a-fA-F]\\{1,4\\}")
(ip-regex (concat "\\(\\(" hextet "[:]\\)\\{1,6\\}\\([:]?\\(" hextet "\\)\\{1,6\\}\\)\\)"))
(ip (or (and (string-match
(if (eq system-type 'windows-nt)
(concat "Name:.*\nAddress: *" ip-regex)
(concat "has AAAA address " ip-regex))
output)
(match-string 1 output))
host)))
(cond ((memq format '(string nil))
ip)
((eq format 'vector)
(ipv6-expand (apply #'vector
(cl-loop for hextet in (split-string ip "[:]")
collect (string-to-number hextet 16)))))
(t (error "Invalid format: %s" format)))))
;;;###autoload
(defun nslookup ()
"Run `nslookup-program'."
......
This diff is collapsed.
This diff is collapsed.
......@@ -276,6 +276,10 @@ static int read_process_output (Lisp_Object, int);
static void create_pty (Lisp_Object);
static void exec_sentinel (Lisp_Object, Lisp_Object);
static Lisp_Object
network_lookup_address_info_1 (Lisp_Object host, const char *service,
struct addrinfo *hints, struct addrinfo **res);
/* Number of bits set in connect_wait_mask. */
static int num_pending_connects;
......@@ -4106,7 +4110,7 @@ usage: (make-network-process &rest ARGS) */)
if (!NILP (host))
{
struct addrinfo *res, *lres;
int ret;
Lisp_Object msg;
maybe_quit ();
......@@ -4115,20 +4119,11 @@ usage: (make-network-process &rest ARGS) */)
hints.ai_family = family;
hints.ai_socktype = socktype;
ret = getaddrinfo (SSDATA (host), portstring, &hints, &res);
if (ret)
#ifdef HAVE_GAI_STRERROR
{
synchronize_system_messages_locale ();
char const *str = gai_strerror (ret);
if (! NILP (Vlocale_coding_system))
str = SSDATA (code_convert_string_norecord
(build_string (str), Vlocale_coding_system, 0));
error ("%s/%s %s", SSDATA (host), portstring, str);
}
#else
error ("%s/%s getaddrinfo error %d", SSDATA (host), portstring, ret);
#endif
msg = network_lookup_address_info_1 (host, portstring, &hints, &res);
if (!EQ(msg, Qt))
{
error ("%s", SSDATA (msg));
}
for (lres = res; lres; lres = lres->ai_next)
addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
......@@ -4576,6 +4571,88 @@ Data that is unavailable is returned as nil. */)
#endif
}
static Lisp_Object
network_lookup_address_info_1 (Lisp_Object host, const char *service,
struct addrinfo *hints, struct addrinfo **res)
{
Lisp_Object msg = Qt;
int ret;
if (STRING_MULTIBYTE (host) && SBYTES (host) != SCHARS (host))
error ("Non-ASCII hostname %s detected, please use puny-encode-domain",
SSDATA (host));
ret = getaddrinfo (SSDATA (host), service, hints, res);
if (ret)
{
if (service == NULL)
service = "0";
#ifdef HAVE_GAI_STRERROR
synchronize_system_messages_locale ();
char const *str = gai_strerror (ret);
if (! NILP (Vlocale_coding_system))
str = SSDATA (code_convert_string_norecord
(build_string (str), Vlocale_coding_system, 0));
AUTO_STRING (format, "%s/%s %s");
msg = CALLN (Fformat, format, host, build_string (service), build_string (str));
#else
AUTO_STRING (format, "%s/%s getaddrinfo error %d");
msg = CALLN (Fformat, format, host, build_string (service), make_number (ret));
#endif
}
return msg;
}
DEFUN ("network-lookup-address-info", Fnetwork_lookup_address_info,
Snetwork_lookup_address_info, 1, 2, 0,
doc: /* Look up ip address info of NAME.
Optional parameter FAMILY controls whether to look up IPv4 or IPv6
addresses. The default of nil means both, symbol `ipv4' means IPv4
only, symbol `ipv6' means IPv6 only. Returns a list of addresses, or
nil if none were found. Each address is a vector of integers. */)
(Lisp_Object name, Lisp_Object family)
{
Lisp_Object addresses = Qnil;
Lisp_Object msg = Qnil;
struct addrinfo *res, *lres;
struct addrinfo hints;
memset (&hints, 0, sizeof hints);
if (EQ (family, Qnil))
hints.ai_family = AF_UNSPEC;
else if (EQ (family, Qipv4))
hints.ai_family = AF_INET;
else if (EQ (family, Qipv6))
#ifdef AF_INET6
hints.ai_family = AF_INET6;
#else
/* If we don't support IPv6, querying will never work anyway */
return addresses;
#endif
else
error ("Unsupported lookup type");
hints.ai_socktype = SOCK_DGRAM;
msg = network_lookup_address_info_1 (name, NULL, &hints, &res);
if (!EQ(msg, Qt))
{
message ("%s", SSDATA(msg));
}
else
{
for (lres = res; lres; lres = lres->ai_next)
{
addresses = Fcons (conv_sockaddr_to_lisp
(lres->ai_addr, lres->ai_addrlen),
addresses);
}
addresses = Fnreverse (addresses);
freeaddrinfo (res);
}
return addresses;
}
/* Turn off input and output for process PROC. */
static void
......@@ -8345,6 +8422,7 @@ returns non-`nil'. */);
defsubr (&Sset_network_process_option);
defsubr (&Smake_network_process);
defsubr (&Sformat_network_address);
defsubr (&Snetwork_lookup_address_info);
defsubr (&Snetwork_interface_list);
defsubr (&Snetwork_interface_info);
#ifdef DATAGRAM_SOCKETS
......
;;; network-stream-tests.el --- tests for network security manager -*- lexical-binding: t; -*-
;; Copyright (C) 2019 Free Software Foundation, Inc.
;; Author: Robert Pluim <rpluim@gmail.com>
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
(require 'nsm)
(eval-when-compile (require 'cl-lib))
(ert-deftest nsm-check-local-subnet-ipv4 ()
"Check that nsm can be avoided for local subnets."
(let ((local-ip '[172 26 128 160 0])
(mask '[255 255 255 0 0])
(wrong-length-mask '[255 255 255])
(wrong-mask '[255 255 255 255 0])
(remote-ip-yes '[172 26 128 161 0])
(remote-ip-no '[172 26 129 161 0]))
(should (eq t (nsm-network-same-subnet local-ip mask remote-ip-yes)))
(should (eq nil (nsm-network-same-subnet local-ip mask remote-ip-no)))
(should-error (nsm-network-same-subnet local-ip wrong-length-mask remote-ip-yes))
(should (eq nil (nsm-network-same-subnet local-ip wrong-mask remote-ip-yes)))
(should (eq t (nsm-should-check "google.com")))
(should (eq t (nsm-should-check "127.1")))
(should (eq t (nsm-should-check "localhost")))
(let ((nsm-trust-local-network t))
(should (eq t (nsm-should-check "google.com")))
(should (eq nil (nsm-should-check "127.1")))
(should (eq nil (nsm-should-check "localhost"))))))
;; FIXME This will never return true, since
;; network-interface-list only gives the primary address of each
;; interface, which will be the IPv4 one
(defun nsm-ipv6-is-available ()
(and (featurep 'make-network-process '(:family ipv6))
(cl-rassoc-if
(lambda (elt)
(eq 9 (length elt)))
(network-interface-list))))
(ert-deftest nsm-check-local-subnet-ipv6 ()
(skip-unless (nsm-ipv6-is-available))
(should (eq t (nsm-should-check "::1")))
(let ((nsm-trust-local-network t))
(should (eq nil (nsm-should-check "::1")))))
;;; nsm-tests.el ends here
......@@ -22,6 +22,7 @@
;;; Code:
(require 'ert)
(require 'puny)
;; Timeout in seconds; the test fails if the timeout is reached.
(defvar process-test-sentinel-wait-timeout 2.0)
......@@ -322,5 +323,33 @@ See Bug#30460."
invocation-directory))
:stop t)))
(ert-deftest lookup-family-specification ()
"network-lookup-address-info should only accept valid family symbols."
(should-error (network-lookup-address-info "google.com" 'both))
(should (network-lookup-address-info "google.com" 'ipv4))
(should (network-lookup-address-info "google.com" 'ipv6)))
(ert-deftest lookup-unicode-domains ()
"Unicode domains should fail"
(should-error (network-lookup-address-info "faß.de"))
(should (length (network-lookup-address-info (puny-encode-domain "faß.de")))))
(ert-deftest unibyte-domain-name ()
"Unibyte domain names should work"
(should (length (network-lookup-address-info (string-to-unibyte "google.com")))))
(ert-deftest lookup-google ()
"Check that we can look up google IP addresses"
(let ((addresses-both (network-lookup-address-info "google.com"))
(addresses-v4 (network-lookup-address-info "google.com" 'ipv4))
(addresses-v6 (network-lookup-address-info "google.com" 'ipv6)))
(should (length addresses-both))
(should (length addresses-v4))
(should (length addresses-v6))))
(ert-deftest non-existent-lookup-failure ()
"Check that looking up non-existent domain returns nil"
(should (eq nil (network-lookup-address-info "emacs.invalid"))))
(provide 'process-tests)
;; process-tests.el ends here.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment