]> code.delx.au - gnu-emacs/blobdiff - src/process.c
Merge from origin/emacs-25
[gnu-emacs] / src / process.c
index a006ca61ac51fe0bb3016be79a472e18a70674d4..9ca3e594355b12e0f2e577db9dc0cb2161b95c37 100644 (file)
@@ -150,6 +150,21 @@ bool inhibit_sentinels;
 #ifndef SOCK_CLOEXEC
 # define SOCK_CLOEXEC 0
 #endif
+#ifndef SOCK_NONBLOCK
+# define SOCK_NONBLOCK 0
+#endif
+
+/* True if ERRNUM represents an error where the system call would
+   block if a blocking variant were used.  */
+static bool
+would_block (int errnum)
+{
+#ifdef EWOULDBLOCK
+  if (EWOULDBLOCK != EAGAIN && errnum == EWOULDBLOCK)
+    return true;
+#endif
+  return errnum == EAGAIN;
+}
 
 #ifndef HAVE_ACCEPT4
 
@@ -267,6 +282,12 @@ static int max_process_desc;
 /* The largest descriptor currently in use for input; -1 if none.  */
 static int max_input_desc;
 
+/* Set the external socket descriptor for Emacs to use when
+   `make-network-process' is called with a non-nil
+   `:use-external-socket' option.  The value should be either -1, or
+   the file descriptor of a socket that is already bound.  */
+static int external_sock_fd;
+
 /* Indexed by descriptor, gives the process (if any) for that descriptor.  */
 static Lisp_Object chan_process[FD_SETSIZE];
 static void wait_for_socket_fds (Lisp_Object, char const *);
@@ -298,7 +319,6 @@ static struct sockaddr_and_len {
    XPROCESS (proc)->infd >= 0 &&                                        \
    datagram_address[XPROCESS (proc)->infd].sa != 0)
 #else
-#define DATAGRAM_CHAN_P(chan)  (0)
 #define DATAGRAM_CONN_P(proc)  (0)
 #endif
 
@@ -1128,7 +1148,9 @@ See `set-process-sentinel' for more info on sentinels.  */)
 
 DEFUN ("set-process-window-size", Fset_process_window_size,
        Sset_process_window_size, 3, 3, 0,
-       doc: /* Tell PROCESS that it has logical window size HEIGHT and WIDTH.  */)
+       doc: /* Tell PROCESS that it has logical window size WIDTH by HEIGHT.
+Value is t if PROCESS was successfully told about the window size,
+nil otherwise.  */)
   (Lisp_Object process, Lisp_Object height, Lisp_Object width)
 {
   CHECK_PROCESS (process);
@@ -2321,6 +2343,16 @@ conv_sockaddr_to_lisp (struct sockaddr *sa, ptrdiff_t len)
   return address;
 }
 
+/* Convert an internal struct addrinfo to a Lisp object.  */
+
+static Lisp_Object
+conv_addrinfo_to_lisp (struct addrinfo *res)
+{
+  Lisp_Object protocol = make_number (res->ai_protocol);
+  eassert (XINT (protocol) == res->ai_protocol);
+  return Fcons (protocol, conv_sockaddr_to_lisp (res->ai_addr, res->ai_addrlen));
+}
+
 
 /* Get family and required size for sockaddr structure to hold ADDRESS.  */
 
@@ -3075,13 +3107,13 @@ finish_after_tls_connection (Lisp_Object proc)
 #endif
 
 static void
-connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses)
+connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
+                        Lisp_Object use_external_socket_p)
 {
   ptrdiff_t count = SPECPDL_INDEX ();
   ptrdiff_t count1;
   int s = -1, outch, inch;
   int xerrno = 0;
-  Lisp_Object ip_address;
   int family;
   struct sockaddr *sa = NULL;
   int ret;
@@ -3089,15 +3121,26 @@ connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses)
   struct Lisp_Process *p = XPROCESS (proc);
   Lisp_Object contact = p->childp;
   int optbits = 0;
+  int socket_to_use = -1;
+
+  if (!NILP (use_external_socket_p))
+    {
+      socket_to_use = external_sock_fd;
+
+      /* Ensure we don't consume the external socket twice.  */
+      external_sock_fd = -1;
+    }
 
   /* Do this in case we never enter the while-loop below.  */
   count1 = SPECPDL_INDEX ();
   s = -1;
 
-  while (!NILP (ip_addresses))
+  while (!NILP (addrinfos))
     {
-      ip_address = XCAR (ip_addresses);
-      ip_addresses = XCDR (ip_addresses);
+      Lisp_Object addrinfo = XCAR (addrinfos);
+      addrinfos = XCDR (addrinfos);
+      int protocol = XINT (XCAR (addrinfo));
+      Lisp_Object ip_address = XCDR (addrinfo);
 
 #ifdef WINDOWSNT
     retry_connect:
@@ -3109,19 +3152,21 @@ connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses)
       sa = xmalloc (addrlen);
       conv_lisp_to_sockaddr (family, ip_address, sa, addrlen);
 
-      s = socket (family, p->socktype | SOCK_CLOEXEC, p->ai_protocol);
+      s = socket_to_use;
       if (s < 0)
        {
-         xerrno = errno;
-         continue;
+         int socktype = p->socktype | SOCK_CLOEXEC;
+         if (p->is_non_blocking_client)
+           socktype |= SOCK_NONBLOCK;
+         s = socket (family, socktype, protocol);
+         if (s < 0)
+           {
+             xerrno = errno;
+             continue;
+           }
        }
 
-#ifdef DATAGRAM_SOCKETS
-      if (!p->is_server && p->socktype == SOCK_DGRAM)
-       break;
-#endif /* DATAGRAM_SOCKETS */
-
-      if (p->is_non_blocking_client)
+      if (p->is_non_blocking_client && ! (SOCK_NONBLOCK && socket_to_use < 0))
        {
          ret = fcntl (s, F_SETFL, O_NONBLOCK);
          if (ret < 0)
@@ -3133,6 +3178,11 @@ connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses)
            }
        }
 
+#ifdef DATAGRAM_SOCKETS
+      if (!p->is_server && p->socktype == SOCK_DGRAM)
+       break;
+#endif /* DATAGRAM_SOCKETS */
+
       /* Make us close S if quit.  */
       record_unwind_protect_int (close_file_unwind, s);
 
@@ -3168,7 +3218,8 @@ connect_network_socket (Lisp_Object proc, Lisp_Object ip_addresses)
                  report_file_error ("Cannot set reuse option on server socket", Qnil);
              }
 
-         if (bind (s, sa, addrlen))
+          /* If passed a socket descriptor, it should be already bound. */
+         if (socket_to_use < 0 && bind (s, sa, addrlen) != 0)
            report_file_error ("Cannot bind server socket", Qnil);
 
 #ifdef HAVE_GETSOCKNAME
@@ -3534,6 +3585,11 @@ The following network options can be specified for this connection:
                       (this is allowed by default for a server process).
 :bindtodevice NAME -- bind to interface NAME.  Using this may require
                       special privileges on some systems.
+:use-external-socket BOOL -- Use any pre-allocated sockets that have
+                             been passed to Emacs.  If Emacs wasn't
+                             passed a socket, this option is silently
+                             ignored.
+
 
 Consult the relevant system programmer's manual pages for more
 information on using these options.
@@ -3578,11 +3634,11 @@ usage: (make-network-process &rest ARGS)  */)
   EMACS_INT port = 0;
   Lisp_Object tem;
   Lisp_Object name, buffer, host, service, address;
-  Lisp_Object filter, sentinel;
-  Lisp_Object ip_addresses = Qnil;
+  Lisp_Object filter, sentinel, use_external_socket_p;
+  Lisp_Object addrinfos = Qnil;
   int socktype;
   int family = -1;
-  int ai_protocol = 0;
+  enum { any_protocol = 0 };
 #ifdef HAVE_GETADDRINFO_A
   struct gaicb *dns_request = NULL;
 #endif
@@ -3618,12 +3674,13 @@ usage: (make-network-process &rest ARGS)  */)
   buffer = Fplist_get (contact, QCbuffer);
   filter = Fplist_get (contact, QCfilter);
   sentinel = Fplist_get (contact, QCsentinel);
+  use_external_socket_p = Fplist_get (contact, QCuse_external_socket);
 
   CHECK_STRING (name);
 
   /* :local ADDRESS or :remote ADDRESS */
   tem = Fplist_get (contact, QCserver);
-  if (!NILP (tem))
+  if (NILP (tem))
     address = Fplist_get (contact, QCremote);
   else
     address = Fplist_get (contact, QClocal);
@@ -3634,7 +3691,7 @@ usage: (make-network-process &rest ARGS)  */)
       if (!get_lisp_to_sockaddr_size (address, &family))
        error ("Malformed :address");
 
-      ip_addresses = list1 (address);
+      addrinfos = list1 (Fcons (make_number (any_protocol), address));
       goto open_socket;
     }
 
@@ -3698,7 +3755,7 @@ usage: (make-network-process &rest ARGS)  */)
       CHECK_STRING (service);
       if (sizeof address_un.sun_path <= SBYTES (service))
        error ("Service name too long");
-      ip_addresses = list1 (service);
+      addrinfos = list1 (Fcons (make_number (any_protocol), service));
       goto open_socket;
     }
 #endif
@@ -3799,14 +3856,9 @@ usage: (make-network-process &rest ARGS)  */)
       immediate_quit = 0;
 
       for (lres = res; lres; lres = lres->ai_next)
-       {
-         ip_addresses = Fcons (conv_sockaddr_to_lisp
-                               (lres->ai_addr, lres->ai_addrlen),
-                               ip_addresses);
-         ai_protocol = lres->ai_protocol;
-       }
+       addrinfos = Fcons (conv_addrinfo_to_lisp (lres), addrinfos);
 
-      ip_addresses = Fnreverse (ip_addresses);
+      addrinfos = Fnreverse (addrinfos);
 
       freeaddrinfo (res);
 
@@ -3873,7 +3925,6 @@ usage: (make-network-process &rest ARGS)  */)
   p->is_server = false;
   p->port = port;
   p->socktype = socktype;
-  p->ai_protocol = ai_protocol;
 #ifdef HAVE_GETADDRINFO_A
   p->dns_request = NULL;
 #endif
@@ -3883,7 +3934,7 @@ usage: (make-network-process &rest ARGS)  */)
   p->gnutls_boot_parameters = tem;
 #endif
 
-  set_network_socket_coding_system (proc, service, host, name);
+  set_network_socket_coding_system (proc, host, service, name);
 
   unbind_to (count, Qnil);
 
@@ -3906,7 +3957,7 @@ usage: (make-network-process &rest ARGS)  */)
 #ifdef HAVE_GETADDRINFO_A
   /* With async address resolution, the list of addresses is empty, so
      postpone connecting to the server. */
-  if (!p->is_server && NILP (ip_addresses))
+  if (!p->is_server && NILP (addrinfos))
     {
       p->dns_request = dns_request;
       p->status = Qconnect;
@@ -3914,7 +3965,7 @@ usage: (make-network-process &rest ARGS)  */)
     }
 #endif
 
-  connect_network_socket (proc, ip_addresses);
+  connect_network_socket (proc, addrinfos, use_external_socket_p);
   return proc;
 }
 
@@ -4251,19 +4302,6 @@ Data that is unavailable is returned as nil.  */)
 #endif
 }
 
-/* If program file NAME starts with /: for quoting a magic
-   name, remove that, preserving the multibyteness of NAME.  */
-
-Lisp_Object
-remove_slash_colon (Lisp_Object name)
-{
-  return
-    ((SBYTES (name) > 2 && SREF (name, 0) == '/' && SREF (name, 1) == ':')
-     ? make_specified_string (SSDATA (name) + 2, SCHARS (name) - 2,
-                             SBYTES (name) - 2, STRING_MULTIBYTE (name))
-     : name);
-}
-
 /* Turn off input and output for process PROC.  */
 
 static void
@@ -4437,15 +4475,7 @@ server_accept_connection (Lisp_Object server, int channel)
   if (s < 0)
     {
       int code = errno;
-
-      if (code == EAGAIN)
-       return;
-#ifdef EWOULDBLOCK
-      if (code == EWOULDBLOCK)
-       return;
-#endif
-
-      if (!NILP (ps->log))
+      if (!would_block (code) && !NILP (ps->log))
        call3 (ps->log, server, Qnil,
               concat3 (build_string ("accept failed with code"),
                        Fnumber_to_string (make_number (code)),
@@ -4622,7 +4652,7 @@ static Lisp_Object
 check_for_dns (Lisp_Object proc)
 {
   struct Lisp_Process *p = XPROCESS (proc);
-  Lisp_Object ip_addresses = Qnil;
+  Lisp_Object addrinfos = Qnil;
 
   /* Sanity check. */
   if (! p->dns_request)
@@ -4638,13 +4668,9 @@ check_for_dns (Lisp_Object proc)
       struct addrinfo *res;
 
       for (res = p->dns_request->ar_result; res; res = res->ai_next)
-       {
-         ip_addresses = Fcons (conv_sockaddr_to_lisp
-                               (res->ai_addr, res->ai_addrlen),
-                               ip_addresses);
-       }
+       addrinfos = Fcons (conv_addrinfo_to_lisp (res), addrinfos);
 
-      ip_addresses = Fnreverse (ip_addresses);
+      addrinfos = Fnreverse (addrinfos);
     }
   /* The DNS lookup failed. */
   else if (EQ (p->status, Qconnect))
@@ -4663,7 +4689,7 @@ check_for_dns (Lisp_Object proc)
   if (!EQ (p->status, Qconnect))
     return Qnil;
 
-  return ip_addresses;
+  return addrinfos;
 }
 
 #endif /* HAVE_GETADDRINFO_A */
@@ -4846,9 +4872,9 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
                /* Check for pending DNS requests. */
                if (p->dns_request)
                  {
-                   Lisp_Object ip_addresses = check_for_dns (aproc);
-                   if (!NILP (ip_addresses) && !EQ (ip_addresses, Qt))
-                     connect_network_socket (aproc, ip_addresses);
+                   Lisp_Object addrinfos = check_for_dns (aproc);
+                   if (!NILP (addrinfos) && !EQ (addrinfos, Qt))
+                     connect_network_socket (aproc, addrinfos, Qnil);
                    else
                      retry_for_async = true;
                  }
@@ -5000,12 +5026,8 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
                  int nread = read_process_output (proc, wait_proc->infd);
                  if (nread < 0)
                    {
-                   if (errno == EIO || errno == EAGAIN)
-                     break;
-#ifdef EWOULDBLOCK
-                   if (errno == EWOULDBLOCK)
-                     break;
-#endif
+                     if (errno == EIO || would_block (errno))
+                       break;
                    }
                  else
                    {
@@ -5389,11 +5411,7 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
                  if (do_display)
                    redisplay_preserve_echo_area (12);
                }
-#ifdef EWOULDBLOCK
-             else if (nread == -1 && errno == EWOULDBLOCK)
-               ;
-#endif
-             else if (nread == -1 && errno == EAGAIN)
+             else if (nread == -1 && would_block (errno))
                ;
 #ifdef WINDOWSNT
              /* FIXME: Is this special case still needed?  */
@@ -6131,11 +6149,7 @@ send_process (Lisp_Object proc, const char *buf, ptrdiff_t len,
 
          if (rv < 0)
            {
-             if (errno == EAGAIN
-#ifdef EWOULDBLOCK
-                 || errno == EWOULDBLOCK
-#endif
-                 )
+             if (would_block (errno))
                /* Buffer is full.  Wait, accepting input;
                   that may allow the program
                   to finish doing output and read more.  */
@@ -7456,6 +7470,19 @@ add_timer_wait_descriptor (int fd)
 
 #endif /* HAVE_TIMERFD */
 
+/* If program file NAME starts with /: for quoting a magic
+   name, remove that, preserving the multibyteness of NAME.  */
+
+Lisp_Object
+remove_slash_colon (Lisp_Object name)
+{
+  return
+    ((SBYTES (name) > 2 && SREF (name, 0) == '/' && SREF (name, 1) == ':')
+     ? make_specified_string (SSDATA (name) + 2, SCHARS (name) - 2,
+                             SBYTES (name) - 2, STRING_MULTIBYTE (name))
+     : name);
+}
+
 /* Add DESC to the set of keyboard input descriptors.  */
 
 void
@@ -7713,10 +7740,10 @@ catch_child_signal (void)
 /* This is not called "init_process" because that is the name of a
    Mach system call, so it would cause problems on Darwin systems.  */
 void
-init_process_emacs (void)
+init_process_emacs (int sockfd)
 {
 #ifdef subprocesses
-  register int i;
+  int i;
 
   inhibit_sentinels = 0;
 
@@ -7739,6 +7766,7 @@ init_process_emacs (void)
   FD_ZERO (&non_process_wait_mask);
   FD_ZERO (&write_mask);
   max_process_desc = max_input_desc = -1;
+  external_sock_fd = sockfd;
   memset (fd_callback_info, 0, sizeof (fd_callback_info));
 
   FD_ZERO (&connect_wait_mask);
@@ -7837,6 +7865,7 @@ syms_of_process (void)
   DEFSYM (QCserver, ":server");
   DEFSYM (QCnowait, ":nowait");
   DEFSYM (QCsentinel, ":sentinel");
+  DEFSYM (QCuse_external_socket, ":use-external-socket");
   DEFSYM (QCtls_parameters, ":tls-parameters");
   DEFSYM (Qnsm_verify_connection, "nsm-verify-connection");
   DEFSYM (QClog, ":log");
@@ -7981,13 +8010,6 @@ The variable takes effect when `start-process' is called.  */);
   defsubr (&Sset_process_filter_multibyte);
   defsubr (&Sprocess_filter_multibyte_p);
 
-#endif /* subprocesses */
-
-  defsubr (&Sget_buffer_process);
-  defsubr (&Sprocess_inherit_coding_system_flag);
-  defsubr (&Slist_system_processes);
-  defsubr (&Sprocess_attributes);
-
  {
    Lisp_Object subfeatures = Qnil;
    const struct socket_options *sopt;
@@ -8020,4 +8042,10 @@ The variable takes effect when `start-process' is called.  */);
    Fprovide (intern_c_string ("make-network-process"), subfeatures);
  }
 
+#endif /* subprocesses */
+
+  defsubr (&Sget_buffer_process);
+  defsubr (&Sprocess_inherit_coding_system_flag);
+  defsubr (&Slist_system_processes);
+  defsubr (&Sprocess_attributes);
 }