bug#23808: Emacs 25 open-network-stream, make-network-process

bug#23808: Emacs 25 open-network-stream, make-network-process

[Paul Eggert]

[I'm passing this along from a correspondent who wishes to remain 
anonymous.]

Hello, the recent changes to make-network-process (between jan and the
end of april) may have introduced some problems, (I think they may
still be current, apologies otherwise)

I. misreporting the status of a failed network connection: when
open-network-stream is interrupted after `SYN_SENT': For example:

1. $ iptables -A OUTPUT -p tcp --dport 6697 -j DROP -d 127.0.0.1
2. $ nc -v localhost 6697 #;hangs
3. (open-network-stream "test-proc" "test-buffer" "127.0.0.1" 6697) ; ^G
4. (list-processes)
5. (process-status "test-proc") ; open
6. (process-send-string "test-proc" "foo") ; error fd closed
7. (delete-process "test-proc")

For testing on linux, step 1 makes connections to localhost:6697 hang,
step 2 verifies this using `netcat'. interrupt step 3 with a ^G, step
4 lists a spurious "test-proc" which should not exist, and step 5
reports its state as 'open, while step 6 confirms the fd is closed.

II. spurious "server-client-test" processes with
1. emacs --daemon -Q
2. emacsclient -t
3. list-processes

AFAICT from server.el these processes should not exist. Sometimes I've
seen half a dozen of these "server-client-test" processes when the
daemon was slow to start up with multiple clients connecting.

bug#23808: Emacs 25 open-network-stream, make-network-process

[Lars Ingebrigtsen]

Paul Eggert <eggert@cs.ucla.edu> writes:

> [I'm passing this along from a correspondent who wishes to remain
> anonymous.]
>
> Hello, the recent changes to make-network-process (between jan and the
> end of april) may have introduced some problems, (I think they may
> still be current, apologies otherwise)
>
> I. misreporting the status of a failed network connection: when
> open-network-stream is interrupted after `SYN_SENT': For example:

Is this with Emacs 25 or master?  Master got a reworked
make-network-process in that time period...

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#23808: Emacs 25 open-network-stream, make-network-process

[Paul Eggert]

On 06/20/2016 02:41 PM, Lars Ingebrigtsen wrote:
> Paul Eggert <eggert@cs.ucla.edu> writes:
>
>> [I'm passing this along from a correspondent who wishes to remain
>> anonymous.]
>>
>> Hello, the recent changes to make-network-process (between jan and the
>> end of april) may have introduced some problems, (I think they may
>> still be current, apologies otherwise)
>>
>> I. misreporting the status of a failed network connection: when
>> open-network-stream is interrupted after `SYN_SENT': For example:
> Is this with Emacs 25 or master?  Master got a reworked
> make-network-process in that time period...
>

Sorry, I don't know offhand. I expect it was master.

bug#23808: Emacs 25 open-network-stream, make-network-process

[Paul Eggert]

[-- Attachment #1: Type: text/plain, Size: 596 bytes --]

[CC'ing this to Lars, since this bug seems to have been introduced by the async 
DNS changes in February.]

Attached is a proposed patch for Bug#23808. The patch attempts to fix the bug 
reported by my anonymous correspondent, who writes "It appears that before the 
refactoring, make-network-process would not create a process object if the 
socket connection failed, or if it had been interrupted by ^G. However after the 
new refactoring, the process object is created upfront with status 'run', before 
the connection is attempted. The refactoring failed to preserve the semantics."

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-process-leak-with-make-network-process.patch --]
[-- Type: text/x-diff; name="0001-Fix-process-leak-with-make-network-process.patch", Size: 7822 bytes --]

From a21dfe515552c7d7f486950e9231b8ca2668f6cc Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Thu, 11 Aug 2016 01:56:16 -0700
Subject: [PATCH] Fix process leak with make-network-process

This problem was introduced by the recent async changes (Bug#23808).
* src/process.c (Fmake_process): Move USE_SAFE_ALLOCA later,
so that it follows the start_process_unwind unwind-protect.
Set pid to -1 while the process is being created.
(start_process_unwind): Omit unnecessary emacs_abort test.
(connect_network_socket): Simplify use of counts.  Unwind
bind_polling_period a bit earlier, so that a remove_process
unwind-protect can be added when needed; this is the heart of
the fix.  Undo the unwind-protect just before returning.
---
 src/process.c | 49 ++++++++++++++++++-------------------------------
 src/process.h |  9 +++++----
 2 files changed, 23 insertions(+), 35 deletions(-)

diff --git a/src/process.c b/src/process.c
index fb32698..69d1b2a 100644
--- a/src/process.c
+++ b/src/process.c
@@ -238,6 +238,7 @@ static int process_output_delay_count;
 
 static bool process_output_skip;
 
+static void start_process_unwind (Lisp_Object);
 static void create_process (Lisp_Object, char **, Lisp_Object);
 #ifdef USABLE_SIGIO
 static bool keyboard_bit_set (fd_set *);
@@ -245,11 +246,8 @@ static bool keyboard_bit_set (fd_set *);
 static void deactivate_process (Lisp_Object);
 static int status_notify (struct Lisp_Process *, struct Lisp_Process *);
 static int read_process_output (Lisp_Object, int);
-static void handle_child_signal (int);
 static void create_pty (Lisp_Object);
-
-static Lisp_Object get_process (register Lisp_Object name);
-static void exec_sentinel (Lisp_Object proc, Lisp_Object reason);
+static void exec_sentinel (Lisp_Object, Lisp_Object);
 
 /* Mask of bits indicating the descriptors that we wait for input on.  */
 
@@ -1407,8 +1405,6 @@ DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
 \f
 /* Starting asynchronous inferior processes.  */
 
-static void start_process_unwind (Lisp_Object proc);
-
 DEFUN ("make-process", Fmake_process, Smake_process, 0, MANY, 0,
        doc: /* Start a program in a subprocess.  Return the process object for it.
 
@@ -1459,7 +1455,6 @@ usage: (make-process &rest ARGS)  */)
   Lisp_Object buffer, name, command, program, proc, contact, current_dir, tem;
   Lisp_Object xstderr, stderrproc;
   ptrdiff_t count = SPECPDL_INDEX ();
-  USE_SAFE_ALLOCA;
 
   if (nargs == 0)
     return Qnil;
@@ -1508,10 +1503,6 @@ usage: (make-process &rest ARGS)  */)
     }
 
   proc = make_process (name);
-  /* If an error occurs and we can't start the process, we want to
-     remove it from the process list.  This means that each error
-     check in create_process doesn't need to call remove_process
-     itself; it's all taken care of here.  */
   record_unwind_protect (start_process_unwind, proc);
 
   pset_childp (XPROCESS (proc), Qt);
@@ -1561,6 +1552,8 @@ usage: (make-process &rest ARGS)  */)
 		     BUF_ZV (XBUFFER (buffer)),
 		     BUF_ZV_BYTE (XBUFFER (buffer)));
 
+  USE_SAFE_ALLOCA;
+
   {
     /* Decide coding systems for communicating with the process.  Here
        we don't setup the structure coding_system nor pay attention to
@@ -1719,18 +1712,11 @@ usage: (make-process &rest ARGS)  */)
   return unbind_to (count, proc);
 }
 
-/* This function is the unwind_protect form for Fstart_process.  If
-   PROC doesn't have its pid set, then we know someone has signaled
-   an error and the process wasn't started successfully, so we should
-   remove it from the process list.  */
+/* If PROC doesn't have its pid set, then an error was signaled and
+   the process wasn't started successfully, so remove it.  */
 static void
 start_process_unwind (Lisp_Object proc)
 {
-  if (!PROCESSP (proc))
-    emacs_abort ();
-
-  /* Was PROC started successfully?
-     -2 is used for a pty with no process, eg for gdb.  */
   if (XPROCESS (proc)->pid <= 0 && XPROCESS (proc)->pid != -2)
     remove_process (proc);
 }
@@ -3124,7 +3110,6 @@ 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;
   int family;
@@ -3145,7 +3130,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
     }
 
   /* Do this in case we never enter the while-loop below.  */
-  count1 = SPECPDL_INDEX ();
   s = -1;
 
   while (!NILP (addrinfos))
@@ -3313,7 +3297,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
       immediate_quit = 0;
 
       /* Discard the unwind protect closing S.  */
-      specpdl_ptr = specpdl + count1;
+      specpdl_ptr = specpdl + count;
       emacs_close (s);
       s = -1;
       if (0 <= socket_to_use)
@@ -3398,10 +3382,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
   p->outfd = outch;
 
   /* Discard the unwind protect for closing S, if any.  */
-  specpdl_ptr = specpdl + count1;
-
-  /* Unwind bind_polling_period and request_sigio.  */
-  unbind_to (count, Qnil);
+  specpdl_ptr = specpdl + count;
 
   if (p->is_server && p->socktype != SOCK_DGRAM)
     pset_status (p, Qlisten);
@@ -3925,7 +3906,12 @@ usage: (make-network-process &rest ARGS)  */)
 
   if (!NILP (buffer))
     buffer = Fget_buffer_create (buffer);
+
+  /* Unwind bind_polling_period.  */
+  unbind_to (count, Qnil);
+
   proc = make_process (name);
+  record_unwind_protect (remove_process, proc);
   p = XPROCESS (proc);
   pset_childp (p, contact);
   pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
@@ -3956,8 +3942,6 @@ usage: (make-network-process &rest ARGS)  */)
 
   set_network_socket_coding_system (proc, host, service, name);
 
-  unbind_to (count, Qnil);
-
   /* :server BOOL */
   tem = Fplist_get (contact, QCserver);
   if (!NILP (tem))
@@ -3974,6 +3958,7 @@ usage: (make-network-process &rest ARGS)  */)
       && !NILP (Fplist_get (contact, QCnowait)))
     p->is_non_blocking_client = true;
 
+  bool postpone_connection = false;
 #ifdef HAVE_GETADDRINFO_A
   /* With async address resolution, the list of addresses is empty, so
      postpone connecting to the server. */
@@ -3981,11 +3966,13 @@ usage: (make-network-process &rest ARGS)  */)
     {
       p->dns_request = dns_request;
       p->status = list1 (Qconnect);
-      return proc;
+      postpone_connection = true;
     }
 #endif
+  if (! postpone_connection)
+    connect_network_socket (proc, addrinfos, use_external_socket_p);
 
-  connect_network_socket (proc, addrinfos, use_external_socket_p);
+  specpdl_ptr = specpdl + count;
   return proc;
 }
 
diff --git a/src/process.h b/src/process.h
index 6c227bc..9926050 100644
--- a/src/process.h
+++ b/src/process.h
@@ -118,10 +118,11 @@ struct Lisp_Process
     /* After this point, there are no Lisp_Objects any more.  */
     /* alloc.c assumes that `pid' is the first such non-Lisp slot.  */
 
-    /* Number of this process.
-       allocate_process assumes this is the first non-Lisp_Object field.
-       A value 0 is used for pseudo-processes such as network or serial
-       connections.  */
+    /* Process ID.  A positive value is a child process ID.
+       Zero is for pseudo-processes such as network or serial connections,
+       or for processes that have not been fully created yet.
+       -1 is for a process that was not created successfully.
+       -2 is for a pty with no process, e.g., for GDB.  */
     pid_t pid;
     /* Descriptor by which we read from this process.  */
     int infd;
-- 
2.5.5

bug#23808: Emacs 25 open-network-stream, make-network-process

[Lars Ingebrigtsen]

Paul Eggert <eggert@cs.ucla.edu> writes:

> [CC'ing this to Lars, since this bug seems to have been introduced by
> the async DNS changes in February.]
>
> Attached is a proposed patch for Bug#23808. The patch attempts to fix
> the bug reported by my anonymous correspondent, who writes "It appears
> that before the refactoring, make-network-process would not create a
> process object if the socket connection failed, or if it had been
> interrupted by ^G. However after the new refactoring, the process
> object is created upfront with status 'run', before the connection is
> attempted. The refactoring failed to preserve the semantics."
>
> From a21dfe515552c7d7f486950e9231b8ca2668f6cc Mon Sep 17 00:00:00 2001
> From: Paul Eggert <eggert@cs.ucla.edu>
> Date: Thu, 11 Aug 2016 01:56:16 -0700
> Subject: [PATCH] Fix process leak with make-network-process
>
> This problem was introduced by the recent async changes (Bug#23808).
> * src/process.c (Fmake_process): Move USE_SAFE_ALLOCA later,
> so that it follows the start_process_unwind unwind-protect.
> Set pid to -1 while the process is being created.
> (start_process_unwind): Omit unnecessary emacs_abort test.
> (connect_network_socket): Simplify use of counts.  Unwind
> bind_polling_period a bit earlier, so that a remove_process
> unwind-protect can be added when needed; this is the heart of
> the fix.  Undo the unwind-protect just before returning.
> ---
>  src/process.c | 49 ++++++++++++++++++-------------------------------
>  src/process.h |  9 +++++----
>  2 files changed, 23 insertions(+), 35 deletions(-)
>
> diff --git a/src/process.c b/src/process.c
> index fb32698..69d1b2a 100644
> --- a/src/process.c
> +++ b/src/process.c
> @@ -238,6 +238,7 @@ static int process_output_delay_count;
>  
>  static bool process_output_skip;
>  
> +static void start_process_unwind (Lisp_Object);
>  static void create_process (Lisp_Object, char **, Lisp_Object);
>  #ifdef USABLE_SIGIO
>  static bool keyboard_bit_set (fd_set *);
> @@ -245,11 +246,8 @@ static bool keyboard_bit_set (fd_set *);
>  static void deactivate_process (Lisp_Object);
>  static int status_notify (struct Lisp_Process *, struct Lisp_Process *);
>  static int read_process_output (Lisp_Object, int);
> -static void handle_child_signal (int);
>  static void create_pty (Lisp_Object);
> -
> -static Lisp_Object get_process (register Lisp_Object name);
> -static void exec_sentinel (Lisp_Object proc, Lisp_Object reason);
> +static void exec_sentinel (Lisp_Object, Lisp_Object);
>  
>  /* Mask of bits indicating the descriptors that we wait for input on.  */
>  
> @@ -1407,8 +1405,6 @@ DEFUN ("process-list", Fprocess_list, Sprocess_list, 0, 0, 0,
>  \f
>  /* Starting asynchronous inferior processes.  */
>  
> -static void start_process_unwind (Lisp_Object proc);
> -
>  DEFUN ("make-process", Fmake_process, Smake_process, 0, MANY, 0,
>         doc: /* Start a program in a subprocess.  Return the process object for it.
>  
> @@ -1459,7 +1455,6 @@ usage: (make-process &rest ARGS)  */)
>    Lisp_Object buffer, name, command, program, proc, contact, current_dir, tem;
>    Lisp_Object xstderr, stderrproc;
>    ptrdiff_t count = SPECPDL_INDEX ();
> -  USE_SAFE_ALLOCA;
>  
>    if (nargs == 0)
>      return Qnil;
> @@ -1508,10 +1503,6 @@ usage: (make-process &rest ARGS)  */)
>      }
>  
>    proc = make_process (name);
> -  /* If an error occurs and we can't start the process, we want to
> -     remove it from the process list.  This means that each error
> -     check in create_process doesn't need to call remove_process
> -     itself; it's all taken care of here.  */
>    record_unwind_protect (start_process_unwind, proc);
>  
>    pset_childp (XPROCESS (proc), Qt);
> @@ -1561,6 +1552,8 @@ usage: (make-process &rest ARGS)  */)
>  		     BUF_ZV (XBUFFER (buffer)),
>  		     BUF_ZV_BYTE (XBUFFER (buffer)));
>  
> +  USE_SAFE_ALLOCA;
> +
>    {
>      /* Decide coding systems for communicating with the process.  Here
>         we don't setup the structure coding_system nor pay attention to
> @@ -1719,18 +1712,11 @@ usage: (make-process &rest ARGS)  */)
>    return unbind_to (count, proc);
>  }
>  
> -/* This function is the unwind_protect form for Fstart_process.  If
> -   PROC doesn't have its pid set, then we know someone has signaled
> -   an error and the process wasn't started successfully, so we should
> -   remove it from the process list.  */
> +/* If PROC doesn't have its pid set, then an error was signaled and
> +   the process wasn't started successfully, so remove it.  */
>  static void
>  start_process_unwind (Lisp_Object proc)
>  {
> -  if (!PROCESSP (proc))
> -    emacs_abort ();
> -
> -  /* Was PROC started successfully?
> -     -2 is used for a pty with no process, eg for gdb.  */
>    if (XPROCESS (proc)->pid <= 0 && XPROCESS (proc)->pid != -2)
>      remove_process (proc);
>  }
> @@ -3124,7 +3110,6 @@ 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;
>    int family;
> @@ -3145,7 +3130,6 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
>      }
>  
>    /* Do this in case we never enter the while-loop below.  */
> -  count1 = SPECPDL_INDEX ();
>    s = -1;
>  
>    while (!NILP (addrinfos))
> @@ -3313,7 +3297,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
>        immediate_quit = 0;
>  
>        /* Discard the unwind protect closing S.  */
> -      specpdl_ptr = specpdl + count1;
> +      specpdl_ptr = specpdl + count;
>        emacs_close (s);
>        s = -1;
>        if (0 <= socket_to_use)
> @@ -3398,10 +3382,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
>    p->outfd = outch;
>  
>    /* Discard the unwind protect for closing S, if any.  */
> -  specpdl_ptr = specpdl + count1;
> -
> -  /* Unwind bind_polling_period and request_sigio.  */
> -  unbind_to (count, Qnil);
> +  specpdl_ptr = specpdl + count;
>  
>    if (p->is_server && p->socktype != SOCK_DGRAM)
>      pset_status (p, Qlisten);
> @@ -3925,7 +3906,12 @@ usage: (make-network-process &rest ARGS)  */)
>  
>    if (!NILP (buffer))
>      buffer = Fget_buffer_create (buffer);
> +
> +  /* Unwind bind_polling_period.  */
> +  unbind_to (count, Qnil);
> +
>    proc = make_process (name);
> +  record_unwind_protect (remove_process, proc);
>    p = XPROCESS (proc);
>    pset_childp (p, contact);
>    pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
> @@ -3956,8 +3942,6 @@ usage: (make-network-process &rest ARGS)  */)
>  
>    set_network_socket_coding_system (proc, host, service, name);
>  
> -  unbind_to (count, Qnil);
> -
>    /* :server BOOL */
>    tem = Fplist_get (contact, QCserver);
>    if (!NILP (tem))
> @@ -3974,6 +3958,7 @@ usage: (make-network-process &rest ARGS)  */)
>        && !NILP (Fplist_get (contact, QCnowait)))
>      p->is_non_blocking_client = true;
>  
> +  bool postpone_connection = false;
>  #ifdef HAVE_GETADDRINFO_A
>    /* With async address resolution, the list of addresses is empty, so
>       postpone connecting to the server. */
> @@ -3981,11 +3966,13 @@ usage: (make-network-process &rest ARGS)  */)
>      {
>        p->dns_request = dns_request;
>        p->status = list1 (Qconnect);
> -      return proc;
> +      postpone_connection = true;
>      }
>  #endif
> +  if (! postpone_connection)
> +    connect_network_socket (proc, addrinfos, use_external_socket_p);
>  
> -  connect_network_socket (proc, addrinfos, use_external_socket_p);
> +  specpdl_ptr = specpdl + count;
>    return proc;
>  }
>  
> diff --git a/src/process.h b/src/process.h
> index 6c227bc..9926050 100644
> --- a/src/process.h
> +++ b/src/process.h
> @@ -118,10 +118,11 @@ struct Lisp_Process
>      /* After this point, there are no Lisp_Objects any more.  */
>      /* alloc.c assumes that `pid' is the first such non-Lisp slot.  */
>  
> -    /* Number of this process.
> -       allocate_process assumes this is the first non-Lisp_Object field.
> -       A value 0 is used for pseudo-processes such as network or serial
> -       connections.  */
> +    /* Process ID.  A positive value is a child process ID.
> +       Zero is for pseudo-processes such as network or serial connections,
> +       or for processes that have not been fully created yet.
> +       -1 is for a process that was not created successfully.
> +       -2 is for a pty with no process, e.g., for GDB.  */
>      pid_t pid;
>      /* Descriptor by which we read from this process.  */
>      int infd;

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#23808: Emacs 25 open-network-stream, make-network-process

[Lars Ingebrigtsen]

Paul Eggert <eggert@cs.ucla.edu> writes:

> This problem was introduced by the recent async changes (Bug#23808).
> * src/process.c (Fmake_process): Move USE_SAFE_ALLOCA later,
> so that it follows the start_process_unwind unwind-protect.
> Set pid to -1 while the process is being created.
> (start_process_unwind): Omit unnecessary emacs_abort test.
> (connect_network_socket): Simplify use of counts.  Unwind
> bind_polling_period a bit earlier, so that a remove_process
> unwind-protect can be added when needed; this is the heart of
> the fix.  Undo the unwind-protect just before returning.

Seems like the right fix to me, I think?

-- 
(domestic pets only, the antidote for overdose, milk.)
   bloggy blog: http://lars.ingebrigtsen.no

bug#23808: Emacs 25 open-network-stream, make-network-process

[Paul Eggert]

Lars Ingebrigtsen wrote:

> Seems like the right fix to me, I think?

Thanks for looking at it. I installed it and am closing this bug report.