aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorLars Ingebrigtsen2016-02-01 02:57:04 +0100
committerLars Ingebrigtsen2016-02-01 02:57:04 +0100
commit0645c0f81b795ca2e8a44b7ad490d2aba502a489 (patch)
tree76e8552bcde99d48e4b9b979f0b6e49d315c787c
parent56cd5301f1ec70958fa0c2e51ce58c674e800a50 (diff)
downloademacs-0645c0f81b795ca2e8a44b7ad490d2aba502a489.tar.gz
emacs-0645c0f81b795ca2e8a44b7ad490d2aba502a489.zip
Make network connections work again on non-glibc systems
* lisp/net/gnutls.el (open-gnutls-stream): Pass the TLS keywords in directly so that they can be used when doing synchronous DNS on non-synchronous connections. * lisp/net/network-stream.el (open-network-stream): Allow passing in the TLS parameters directly. * src/process.c (conv_numerical_to_lisp): New function to convert numerical addresses to Lisp. (Fmake_network_process): Rework the non-HAVE_ADDRINFO code paths so that they work again. (syms_of_process): Build fix for non-glibc systems.
-rw-r--r--lisp/net/gnutls.el18
-rw-r--r--lisp/net/network-stream.el11
-rw-r--r--src/process.c53
3 files changed, 57 insertions, 25 deletions
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 9cfa8251133..8db665400eb 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -124,16 +124,16 @@ This is a very simple wrapper around `gnutls-negotiate'. See its
124documentation for the specific parameters you can use to open a 124documentation for the specific parameters you can use to open a
125GnuTLS connection, including specifying the credential type, 125GnuTLS connection, including specifying the credential type,
126trust and key files, and priority string." 126trust and key files, and priority string."
127 (let ((process (open-network-stream name buffer host service 127 (let ((process (open-network-stream
128 :nowait nowait))) 128 name buffer host service
129 :nowait nowait
130 :tls-parameters
131 (and nowait
132 (gnutls-negotiate :type 'gnutls-x509pki
133 :return-keywords t
134 :hostname host)))))
129 (if nowait 135 (if nowait
130 (progn 136 process
131 (gnutls-asynchronous-parameters
132 process
133 (gnutls-negotiate :type 'gnutls-x509pki
134 :return-keywords t
135 :hostname host))
136 process)
137 (gnutls-negotiate :process (open-network-stream name buffer host service) 137 (gnutls-negotiate :process (open-network-stream name buffer host service)
138 :type 'gnutls-x509pki 138 :type 'gnutls-x509pki
139 :hostname host)))) 139 :hostname host))))
diff --git a/lisp/net/network-stream.el b/lisp/net/network-stream.el
index 02af8845bf0..acbdb7a71b2 100644
--- a/lisp/net/network-stream.el
+++ b/lisp/net/network-stream.el
@@ -137,7 +137,12 @@ non-nil, is used warn the user if the connection isn't encrypted.
137a greeting from the server. 137a greeting from the server.
138 138
139:nowait is a boolean that says the connection should be made 139:nowait is a boolean that says the connection should be made
140asynchronously, if possible." 140asynchronously, if possible.
141
142:tls-parameters is a list that should be supplied if you're
143opening a TLS connection. The first element is the TLS type, and
144the remaining elements should be a keyword list accepted by
145gnutls-boot."
141 (unless (featurep 'make-network-process) 146 (unless (featurep 'make-network-process)
142 (error "Emacs was compiled without networking support")) 147 (error "Emacs was compiled without networking support"))
143 (let ((type (plist-get parameters :type)) 148 (let ((type (plist-get parameters :type))
@@ -150,7 +155,9 @@ asynchronously, if possible."
150 ;; The simplest case: wrapper around `make-network-process'. 155 ;; The simplest case: wrapper around `make-network-process'.
151 (make-network-process :name name :buffer buffer 156 (make-network-process :name name :buffer buffer
152 :host (puny-encode-domain host) :service service 157 :host (puny-encode-domain host) :service service
153 :nowait (plist-get parameters :nowait)) 158 :nowait (plist-get parameters :nowait)
159 :tls-parameters
160 (plist-get parameters :tls-parameters))
154 (let ((work-buffer (or buffer 161 (let ((work-buffer (or buffer
155 (generate-new-buffer " *stream buffer*"))) 162 (generate-new-buffer " *stream buffer*")))
156 (fun (cond ((and (eq type 'plain) 163 (fun (cond ((and (eq type 'plain)
diff --git a/src/process.c b/src/process.c
index 6b76559f309..5fee8b0cc32 100644
--- a/src/process.c
+++ b/src/process.c
@@ -3303,12 +3303,13 @@ void connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses)
3303 set_network_socket_coding_system (proc); 3303 set_network_socket_coding_system (proc);
3304 3304
3305#ifdef HAVE_GNUTLS 3305#ifdef HAVE_GNUTLS
3306 /* Continue the asynchronous connection. */
3306 if (!NILP (p->gnutls_async_parameters) && p->is_non_blocking_client) { 3307 if (!NILP (p->gnutls_async_parameters) && p->is_non_blocking_client) {
3307 Lisp_Object params = p->gnutls_async_parameters, boot = Qnil; 3308 Lisp_Object boot, params = p->gnutls_async_parameters;
3308 3309
3309 p->gnutls_async_parameters = Qnil; 3310 p->gnutls_async_parameters = Qnil;
3310 boot = Fgnutls_boot (proc, XCAR (params), XCDR (params)); 3311 boot = Fgnutls_boot (proc, XCAR (params), XCDR (params));
3311 if (STRINGP (boot)) { 3312 if (NILP (boot) || STRINGP (boot)) {
3312 pset_status (p, Qfailed); 3313 pset_status (p, Qfailed);
3313 deactivate_process (proc); 3314 deactivate_process (proc);
3314 } 3315 }
@@ -3317,6 +3318,19 @@ void connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses)
3317 3318
3318} 3319}
3319 3320
3321static Lisp_Object
3322conv_numerical_to_lisp (unsigned char *number, unsigned int length, int port)
3323{
3324 Lisp_Object address = Fmake_vector (make_number (length + 1), Qnil);
3325 register struct Lisp_Vector *p = XVECTOR (address);
3326 int i;
3327
3328 p->contents[length] = make_number (port);
3329 for (i = 0; i < length; i++)
3330 p->contents[i] = make_number (*(number + i));
3331
3332 return address;
3333}
3320 3334
3321/* Create a network stream/datagram client/server process. Treated 3335/* Create a network stream/datagram client/server process. Treated
3322 exactly like a normal process when reading and writing. Primary 3336 exactly like a normal process when reading and writing. Primary
@@ -3490,7 +3504,6 @@ usage: (make-network-process &rest ARGS) */)
3490 struct sockaddr_un address_un; 3504 struct sockaddr_un address_un;
3491#endif 3505#endif
3492 int port = 0; 3506 int port = 0;
3493 int ret = 0;
3494 Lisp_Object tem; 3507 Lisp_Object tem;
3495 Lisp_Object name, buffer, host, service, address; 3508 Lisp_Object name, buffer, host, service, address;
3496 Lisp_Object filter, sentinel; 3509 Lisp_Object filter, sentinel;
@@ -3661,6 +3674,8 @@ usage: (make-network-process &rest ARGS) */)
3661 if (!NILP (Fplist_get (contact, QCnowait)) && 3674 if (!NILP (Fplist_get (contact, QCnowait)) &&
3662 !NILP (host)) 3675 !NILP (host))
3663 { 3676 {
3677 int ret;
3678
3664 printf("Async DNS for '%s'\n", SSDATA (host)); 3679 printf("Async DNS for '%s'\n", SSDATA (host));
3665 dns_requests = xmalloc (sizeof (struct gaicb*)); 3680 dns_requests = xmalloc (sizeof (struct gaicb*));
3666 dns_requests[0] = xmalloc (sizeof (struct gaicb)); 3681 dns_requests[0] = xmalloc (sizeof (struct gaicb));
@@ -3724,7 +3739,7 @@ usage: (make-network-process &rest ARGS) */)
3724 if (EQ (service, Qt)) 3739 if (EQ (service, Qt))
3725 port = 0; 3740 port = 0;
3726 else if (INTEGERP (service)) 3741 else if (INTEGERP (service))
3727 port = htons ((unsigned short) XINT (service)); 3742 port = (unsigned short) XINT (service);
3728 else 3743 else
3729 { 3744 {
3730 struct servent *svc_info; 3745 struct servent *svc_info;
@@ -3733,7 +3748,7 @@ usage: (make-network-process &rest ARGS) */)
3733 (socktype == SOCK_DGRAM ? "udp" : "tcp")); 3748 (socktype == SOCK_DGRAM ? "udp" : "tcp"));
3734 if (svc_info == 0) 3749 if (svc_info == 0)
3735 error ("Unknown service: %s", SDATA (service)); 3750 error ("Unknown service: %s", SDATA (service));
3736 port = svc_info->s_port; 3751 port = ntohs (svc_info->s_port);
3737 } 3752 }
3738 3753
3739#ifndef HAVE_GETADDRINFO 3754#ifndef HAVE_GETADDRINFO
@@ -3750,24 +3765,29 @@ usage: (make-network-process &rest ARGS) */)
3750 res_init (); 3765 res_init ();
3751#endif 3766#endif
3752 3767
3753 host_info_ptr = gethostbyname (SDATA (host)); 3768 host_info_ptr = gethostbyname ((const char *) SDATA (host));
3754 immediate_quit = 0; 3769 immediate_quit = 0;
3755 3770
3756 if (host_info_ptr) 3771 if (host_info_ptr)
3757 { 3772 {
3758 ip_addresses = Ncons (make_number (host_info_ptr->h_addr, 3773 ip_addresses = Fcons (conv_numerical_to_lisp
3759 host_info_ptr->h_length), 3774 ((unsigned char *) host_info_ptr->h_addr,
3775 host_info_ptr->h_length,
3776 port),
3760 Qnil); 3777 Qnil);
3761 } 3778 }
3762 else 3779 else
3763 /* Attempt to interpret host as numeric inet address. */ 3780 /* Attempt to interpret host as numeric inet address. This
3781 only works for IPv4 addresses. */
3764 { 3782 {
3765 unsigned long numeric_addr; 3783 unsigned long numeric_addr = inet_addr (SSDATA (host));
3766 numeric_addr = inet_addr (SSDATA (host)); 3784
3767 if (numeric_addr == -1) 3785 if (numeric_addr == -1)
3768 error ("Unknown host \"%s\"", SDATA (host)); 3786 error ("Unknown host \"%s\"", SDATA (host));
3769 3787
3770 ip_addresses = Ncons (make_number (numeric_addr), Qnil); 3788 ip_addresses = Fcons (conv_numerical_to_lisp
3789 ((unsigned char *) &numeric_addr, 4, port),
3790 Qnil);
3771 } 3791 }
3772 3792
3773 } 3793 }
@@ -3802,7 +3822,9 @@ usage: (make-network-process &rest ARGS) */)
3802 p->dns_requests = NULL; 3822 p->dns_requests = NULL;
3803#endif 3823#endif
3804#ifdef HAVE_GNUTLS 3824#ifdef HAVE_GNUTLS
3805 p->gnutls_async_parameters = Qnil; 3825 tem = Fplist_get (contact, QCtls_parameters);
3826 CHECK_LIST (tem);
3827 p->gnutls_async_parameters = tem;
3806#endif 3828#endif
3807 3829
3808 unbind_to (count, Qnil); 3830 unbind_to (count, Qnil);
@@ -7705,6 +7727,7 @@ syms_of_process (void)
7705 DEFSYM (QCserver, ":server"); 7727 DEFSYM (QCserver, ":server");
7706 DEFSYM (QCnowait, ":nowait"); 7728 DEFSYM (QCnowait, ":nowait");
7707 DEFSYM (QCsentinel, ":sentinel"); 7729 DEFSYM (QCsentinel, ":sentinel");
7730 DEFSYM (QCtls_parameters, ":tls-parameters");
7708 DEFSYM (QClog, ":log"); 7731 DEFSYM (QClog, ":log");
7709 DEFSYM (QCnoquery, ":noquery"); 7732 DEFSYM (QCnoquery, ":noquery");
7710 DEFSYM (QCstop, ":stop"); 7733 DEFSYM (QCstop, ":stop");
@@ -7719,7 +7742,9 @@ syms_of_process (void)
7719 7742
7720 staticpro (&Vprocess_alist); 7743 staticpro (&Vprocess_alist);
7721 staticpro (&deleted_pid_list); 7744 staticpro (&deleted_pid_list);
7745#ifdef HAVE_GETADDRINFO_A
7722 staticpro (&dns_processes); 7746 staticpro (&dns_processes);
7747#endif
7723 7748
7724#endif /* subprocesses */ 7749#endif /* subprocesses */
7725 7750