bug#10815: counterintuitive results with process-send-string

bug#10815: counterintuitive results with process-send-string

[Tiphaine Turpin]

Hello,

I realized a strange behavior of process-send-string when writing to a 
socket, and I am wondering whether is is expected or not, and how to 
live with it.

Here is a very short extract from my code (exact code, no simplification):

   (message "sending command %s" c)
   (process-send-string connection
                        (concat request-start "\n" c "\n" end-of-message 
"\n"))
   (message "command sent:   %s" c)

and an extract of the resulting *Messages* (I have replaced the real 
"command" contents by timestamps):

sending command 1
sending command 2
command sent:   2
sending command 3
command sent:   3
command sent:   1

The other end of the socket connection receives the messages in the 
order 2, 3, 1, i.e., the same as indicated by "comment sent" debug messages.

It seems that process-send-string,although it is blocking (until sent 
data is acknowledged), may allow execution of other code (which in this 
case calls process-send-string again). This seems to be allowed by its 
specification: "Output from processes can arrive in between bunches.", 
except that in my setting, I am almost sure than no input can be 
available at this moment, at least from this connection. In fact, the 
calls to process-send-string are initiated by after-modify hooks, 
originating from a single user command (which performs several 
modifications).

But what is really annoying, is that the inner call to 
process-send-string takes priority on the pending one: the second 
message is actually sent before the first, while I would expect the 
messages to be queued in the right order.

So, I would very much appreciate an opinion on whether this semantics is 
appropriate. Furthermore, any hint about working around this behavior 
will be welcome, as I don't know what would be the equivalent of 
"mutexes" in the absence of threads :-\ .

Finally, it won't be easy to isolate a reproducible test-case (this is 
about implementing fontification with an external tool), but I can try 
if this observed behavior seems really impossible from the 
implementation of process-send-string.

Regards,

Tiphaine Turpin

bug#10815: counterintuitive results with process-send-string

[Andreas Schwab]

Tiphaine Turpin <tiphaine.turpin@inria.fr> writes:

> It seems that process-send-string,although it is blocking (until sent data
> is acknowledged), may allow execution of other code (which in this case
> calls process-send-string again). This seems to be allowed by its
> specification: "Output from processes can arrive in between bunches.",
> except that in my setting, I am almost sure than no input can be available
> at this moment, at least from this connection. In fact, the calls to
> process-send-string are initiated by after-modify hooks, originating from
> a single user command (which performs several modifications).

wait_reading_process_output can run timers.

Andreas.

-- 
Andreas Schwab, schwab@linux-m68k.org
GPG Key fingerprint = 58CA 54C7 6D53 942B 1756  01D3 44D5 214B 8276 4ED5
"And now for something completely different."

bug#10815: counterintuitive results with process-send-string

[Stefan Monnier]

severity 10815 important
thanks

> Here is a very short extract from my code (exact code, no simplification):

>   (message "sending command %s" c)
>   (process-send-string connection
>                        (concat request-start "\n" c "\n" end-of-message
> "\n"))
>   (message "command sent:   %s" c)

> and an extract of the resulting *Messages* (I have replaced the real
> "command" contents by timestamps):

> sending command 1
> sending command 2
> command sent:   2
> sending command 3
> command sent:   3
> command sent:   1

This output is not a problem in itself, it can be explained as follows:
- (message "sending command %s" 1)
- (process-send-string connection .... 1)
- after sending the command we check timers and process filters; turns
  out we received an answer from the process so we run the filter.
- (message "sending command %s" 2)
- (process-send-string connection .... 2)
- (message "command sent: %s" 2)
- before returning from process-send-string, we check timers and filters
  once more and find another answer, so we run the filter again.
- (message "sending command %s" 3)
- (process-send-string connection .... 3)
- (message "command sent: %s" 3)
- finally the timers and filters seem all processed, we can return.
- (message "command sent: %s" 1)

> The other end of the socket connection receives the messages in the order 2,
> 3, 1, i.e., the same as indicated by "comment sent" debug messages.

That is more problematic.  I haven't looked enough at the code to see
exactly why it happens, but I agree it's undesirable.

> It seems that process-send-string,although it is blocking (until sent data
> is acknowledged), may allow execution of other code (which in this case
> calls process-send-string again).  This seems to be allowed by its
> specification: "Output from processes can arrive in between bunches.",

Indeed, but it doesn't justify the kind of out-of-order-sending you're
seeing (although it may explain it).

> except that in my setting, I am almost sure than no input can be available
> at this moment, at least from this connection.

Are you sure: consider the case where the OS forces Emacs to yield right
after sending the bytes, such that the other process gets to reply
before Emacs finishes the process-send-string?

Of course, rather than process filters, the culprit might be a timer.

> In fact, the calls to process-send-string are initiated by
> after-modify hooks, originating from a single user command (which
> performs several modifications).

Can they also be triggered from timers?  I.e. is there some timer code
modifying the buffer?  Or does the process-filter itself modify the
buffer (seems unlikely since it would lead to inf-loops)?

> But what is really annoying, is that the inner call to process-send-string
> takes priority on the pending one: the second message is actually sent
> before the first, while I would expect the messages to be queued in the
> right order.

Yes, that seems to be a bug/misfeature.


        Stefan

bug#10815: #10815 counterintuitive results with process-send-string

[Troels Nielsen]

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

Hi all

I've been looking into this problem and have succeed in reproducing
the issue:

Just compile echo-server.c and execute it, and then eval-buffer
write-queue-issue.el.
Messages will be seen to be sent from emacs and arrive in
different order.

I have a proposed patch, which fixes the ordering.

It seems that the best way to ensure that everything is sent in the
right order, is to add a write queue keeping track of data that has
not been sent and sending the unsent data before any new data is
attempted. It will not ensure that send_process 1 will return before
send_process 2 is executed, but it will ensure that the data in
send_process 1 will be sent before the data in send_process 2.

And it will certainly ensure that not half of the data of send_process
1 is sent, then send_process's 2 data and then the rest of
send_process 1's data, which is kind of catastrophic.

In addition I spotted another possible bug which could be serious when
a buffer object is used as an argument:

The code currently:

object is a buffer, that won't need encoding
until (len == 0) {
attempt write and get error
if (errno == EAGAIN etc.)
 {
...
if (BUFFERP (object))
  offset = BUF_PTR_BYTE_POS (XBUFFER (object),
	           				   (unsigned char *) buf);
wait_reading_process_output
 if (BUFFERP (object))
		buf = (char *) BUF_BYTE_ADDRESS (XBUFFER (object),
						 offset);
}}

Now, as far as I can see, we have no guarantee that the buffer object
has not changed while wait_reading_process_output is called, which in
and of itself is kind of bad. But this/len has not been updated, and if
buffer has been shortened (or maybe killed (?)) we may very well be in
for a segmentation fault.

In the new code this possible problem have been fixed by copying the
buffer data to be sent into a string, whenever calling
wait_reading_process_output.

Regards,
Troels

PS. This is the patch without indent-changes. I attach the patch
including new indents:

=== modified file 'src/process.c'
*** src/process.c	2012-03-23 12:23:14 +0000
--- src/process.c	2012-03-26 14:03:27 +0000
*************** make_process (Lisp_Object name)
*** 631,636 ****
--- 631,637 ----
    p->status = Qrun;
    p->mark = Fmake_marker ();
    p->kill_without_query = 0;
+   p->write_queue = Qnil;

  #ifdef ADAPTIVE_READ_BUFFERING
    p->adaptive_read_buffering = 0;
*************** send_process_trap (int ignore)
*** 5366,5371 ****
--- 5367,5462 ----
    longjmp (send_process_frame, 1);
  }

+ /* In send_process, when a write fails temporarily,
+    wait_reading_process_output is called.
+
+    It may execute user code, for example timers, that sometimes
+    attempt to write new data to the same process. Data must be ensured
+    to be sent in the right order, and certainly not be interspersed
+    half-completed with other writes.
+    (See bug #10815)
+
+    To amend this problem the process write_queue has been added.
+    It is a list with each entry having the form:
+
+    (string . (offset . length))
+
+    where string is a lisp string, offset is the offset into the
+    string's bytesequence, from where we should begin to send and
+    length is the number of bytes left to send.
+  */
+
+ /* Create a new entry in write_queue,
+
+     input_obj should be a buffer, string or Qt/Qnil
+     buf is a pointer to the string sequence of the input_obj or a C
+     string in case of Qt/Qnil
+ */
+ static void
+ write_queue_push (struct Lisp_Process *p, Lisp_Object input_obj,
+                   const char *buf, int len, int front)
+ {
+   EMACS_INT offset;
+   Lisp_Object entry, obj;
+
+   if (STRINGP (input_obj))
+     {
+       offset = buf - SSDATA (input_obj);
+       obj = input_obj;
+     }
+   else
+     {
+       offset = 0;
+       obj = make_unibyte_string (buf, len);
+     }
+
+   entry = Fcons (obj, Fcons (make_number (offset), make_number (len)));
+
+   if (front)
+     p->write_queue = Fcons (entry, p->write_queue);
+   else
+     p->write_queue = nconc2 (p->write_queue, Fcons (entry, Qnil));
+ }
+
+ static void
+ write_queue_push_front (struct Lisp_Process *p, Lisp_Object obj,
+                         const char *buf, EMACS_INT len)
+ {
+   write_queue_push (p, obj, buf, len, 1);
+ }
+
+ static void
+ write_queue_push_back (struct Lisp_Process *p, Lisp_Object obj,
+                        const char *buf, EMACS_INT len)
+ {
+   write_queue_push (p, obj, buf, len, 0);
+ }
+
+ /* remove the first element in process' write_queue and
+    put its contents in obj, buf and len or return -1 if
+    write_queue is empty */
+ static int
+ write_queue_pop_front (struct Lisp_Process *p, Lisp_Object *obj, const
+                        char **buf, EMACS_INT *len) {
+   Lisp_Object entry, offset_length;
+   EMACS_INT offset;
+
+   if (NILP (p->write_queue))
+     return -1;
+
+   entry = XCAR (p->write_queue);
+   p->write_queue = XCDR (p->write_queue);
+
+   *obj = XCAR (entry);
+   offset_length = XCDR (entry);
+
+   *len = XINT (XCDR (offset_length));
+   offset = XINT (XCAR (offset_length));
+   *buf = SDATA (*obj) + offset;
+
+   return 0;
+ }
+
  /* Send some data to process PROC.
     BUF is the beginning of the data; LEN is the number of characters.
     OBJECT is the Lisp object that the data comes from.  If OBJECT is
*************** send_process_trap (int ignore)
*** 5375,5381 ****
     for encoding before it is sent.

     This function can evaluate Lisp code and can garbage collect.  */
-
  static void
  send_process (volatile Lisp_Object proc, const char *volatile buf,
  	      volatile EMACS_INT len, volatile Lisp_Object object)
--- 5466,5471 ----
*************** send_process (volatile Lisp_Object proc,
*** 5384,5394 ****
    struct Lisp_Process *p = XPROCESS (proc);
    ssize_t rv;
    struct coding_system *coding;
-   struct gcpro gcpro1;
    void (*volatile old_sigpipe) (int);

-   GCPRO1 (object);
-
    if (p->raw_status_new)
      update_status (p);
    if (! EQ (p->status, Qrun))
--- 5474,5481 ----
*************** send_process (volatile Lisp_Object proc,
*** 5500,5521 ****
    if (!setjmp (send_process_frame))
      {
        p = XPROCESS (proc);  /* Repair any setjmp clobbering.  */
-
        process_sent_to = proc;
!       while (len > 0)
  	{
! 	  EMACS_INT this = len;

! 	  /* Send this batch, using one or more write calls.  */
! 	  while (this > 0)
  	    {
  	      EMACS_INT written = 0;
  	      int outfd = p->outfd;
  	      old_sigpipe = (void (*) (int)) signal (SIGPIPE, send_process_trap);
  #ifdef DATAGRAM_SOCKETS
  	      if (DATAGRAM_CHAN_P (outfd))
  		{
! 		  rv = sendto (outfd, buf, this,
  			       0, datagram_address[outfd].sa,
  			       datagram_address[outfd].len);
  		  if (0 <= rv)
--- 5587,5626 ----
    if (!setjmp (send_process_frame))
      {
        p = XPROCESS (proc);  /* Repair any setjmp clobbering.  */
        process_sent_to = proc;
!
!       /* if there is already data in the write_queue, put the new data
!          in the back of queue, otherwise just ignore it */
!       if (!NILP (p->write_queue))
!         write_queue_push_back (p, object, buf, len);
!
!       /* until NILP (p->write_queue) */
!       do
          {
!           EMACS_INT cur_len;
!           const char *cur_buf;
!           Lisp_Object cur_object;

!           /* if write_queue is empty, just ignore it */
!           if (NILP (p->write_queue))
              {
+               cur_len = len;
+               cur_buf = buf;
+               cur_object = object;
+             }
+           else
+             write_queue_pop_front (p, &cur_object, &cur_buf, &cur_len);
+
+           while (cur_len > 0)
+             {
+               /* Send this batch, using one or more write calls.  */
                EMACS_INT written = 0;
                int outfd = p->outfd;
                old_sigpipe = (void (*) (int)) signal (SIGPIPE,
send_process_trap);
  #ifdef DATAGRAM_SOCKETS
                if (DATAGRAM_CHAN_P (outfd))
                  {
!                   rv = sendto (outfd, cur_buf, cur_len,
                                 0, datagram_address[outfd].sa,
                                 datagram_address[outfd].len);
                    if (0 <= rv)
*************** send_process (volatile Lisp_Object proc,
*** 5532,5541 ****
  		{
  #ifdef HAVE_GNUTLS
  		  if (p->gnutls_p)
! 		    written = emacs_gnutls_write (p, buf, this);
  		  else
  #endif
! 		    written = emacs_write (outfd, buf, this);
  		  rv = (written ? 0 : -1);
  #ifdef ADAPTIVE_READ_BUFFERING
  		  if (p->read_output_delay > 0
--- 5637,5647 ----
                  {
  #ifdef HAVE_GNUTLS
                    if (p->gnutls_p)
!                     written = emacs_gnutls_write (p, cur_buf, cur_len);
                    else
  #endif
!                     written = emacs_write (outfd, cur_buf, cur_len);
!
                    rv = (written ? 0 : -1);
  #ifdef ADAPTIVE_READ_BUFFERING
                    if (p->read_output_delay > 0
*************** send_process (volatile Lisp_Object proc,
*** 5590,5624 ****
  			}
  #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */

! 		      /* Running filters might relocate buffers or strings.
! 			 Arrange to relocate BUF.  */
! 		      if (BUFFERP (object))
! 			offset = BUF_PTR_BYTE_POS (XBUFFER (object),
! 						   (unsigned char *) buf);
! 		      else if (STRINGP (object))
! 			offset = buf - SSDATA (object);
!
  #ifdef EMACS_HAS_USECS
  		      wait_reading_process_output (0, 20000, 0, 0, Qnil, NULL, 0);
  #else
  		      wait_reading_process_output (1, 0, 0, 0, Qnil, NULL, 0);
  #endif
!
! 		      if (BUFFERP (object))
! 			buf = (char *) BUF_BYTE_ADDRESS (XBUFFER (object),
! 							 offset);
! 		      else if (STRINGP (object))
! 			buf = offset + SSDATA (object);
  		    }
  		  else
  		    /* This is a real error.  */
  		    report_file_error ("writing to process", Fcons (proc, Qnil));
  		}
! 	      buf += written;
! 	      len -= written;
! 	      this -= written;
  	    }
  	}
      }
    else
      {
--- 5696,5721 ----
                          }
  #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */

!                       /* Put what we should have written in
!                          wait_queue */
!                       write_queue_push_front (p, cur_object,
cur_buf, cur_len);
  #ifdef EMACS_HAS_USECS
                        wait_reading_process_output (0, 20000, 0, 0,
Qnil, NULL, 0);
  #else
                        wait_reading_process_output (1, 0, 0, 0, Qnil, NULL, 0);
  #endif
!                       /* reread queue, to see what is left */
!                       break;
                      }
                    else
                      /* This is a real error.  */
                      report_file_error ("writing to process", Fcons
(proc, Qnil));
                  }
!               cur_buf += written;
!               cur_len -= written;
              }
          }
+       while (!NILP (p->write_queue));
      }
    else
      {
*************** send_process (volatile Lisp_Object proc,
*** 5631,5638 ****
        deactivate_process (proc);
        error ("SIGPIPE raised on process %s; closed it", SDATA (p->name));
      }
-
-   UNGCPRO;
  }

  DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
--- 5728,5733 ----

=== modified file 'src/process.h'
*** src/process.h	2012-01-19 07:21:25 +0000
--- src/process.h	2012-03-25 16:18:18 +0000
*************** struct Lisp_Process
*** 77,82 ****
--- 77,84 ----
      Lisp_Object encode_coding_system;
      /* Working buffer for encoding.  */
      Lisp_Object encoding_buf;
+     /* Queue for storing waiting writes */
+     Lisp_Object write_queue;

  #ifdef HAVE_GNUTLS
      Lisp_Object gnutls_cred_type;

[-- Attachment #2: echo-server.c --]
[-- Type: text/x-csrc, Size: 1855 bytes --]

#include <stdio.h>
#include <stdlib.h>
#include <sys/types.h>
#include <sys/socket.h>
#include <arpa/inet.h>
#include <string.h>
#include <unistd.h>
#include <errno.h>
#include <signal.h>

volatile int serversock, sock;

void kill_me(int sig) 
{
  close(serversock); close(sock);
  exit(1);
}

#define PORT 12345

/** binds to port PORT and prints everything received that is not the ascii-letter a */
int main(int argc, char **argv) { 
  signal(SIGINT, kill_me); 
  serversock = socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);

  if (serversock == -1) { 
    perror("Error creating socket");
    exit(1);
  }
  
  int on = 1;
  if (setsockopt(serversock, SOL_SOCKET, SO_REUSEADDR, (char*)&on, sizeof(on)) == -1) {
    perror("Setsockopt");
    exit(1);
  }
    
  struct sockaddr_in server = {0};
  server.sin_family = AF_INET;
  server.sin_addr.s_addr = htonl(INADDR_ANY);
  server.sin_port = htons(PORT);

  if (bind(serversock, (struct sockaddr *) &server, sizeof(server)) == -1) {
    perror("Error binding socket");
    exit(1);
  }

  if (listen(serversock, 2) == -1) {
    perror("Listening for connection");
    exit(1);
  }
  

  while (1) {
    struct sockaddr_in client;
    int sock;
    unsigned int clientlen = sizeof(client);

    /* Wait for client connection */
    sock = accept(serversock, (struct sockaddr *) &client, &clientlen);
    if (sock == -1) {
      perror("Accepting connection");
      exit(1);
    }
    
    int n;
    do {
      sleep(1);
      char buf[20001];
      n = recv(sock, buf, 20000, 0);
      if (n == -1) {
        perror("Failed...");
        if (!(errno == EINTR || errno == EAGAIN || errno == EWOULDBLOCK)) 
          break;
      } 
      int i;
      
      for (i = 0; i < n; ++i) {
        if (buf[i] != 'a') 
          putchar(buf[i]);
      }
    } while(n);
    close(sock);
  }
  close(serversock);
}

[-- Attachment #3: write-queue-issue.el --]
[-- Type: text/x-emacs-lisp, Size: 967 bytes --]

;;; -*- lexical-binding: t -*-

(defun test-many-connections () 
  (let* ((connection (open-network-stream 
                      "localhost" nil "localhost" 12345))
         (str (let ((var "")) 
                (dotimes (i 5000 var) 
                  (setq var (concat "aaaaaaaaaaaaaaaaaaaaaaaaaa" var))))))
    (dotimes (i 30 connection)
      (run-with-idle-timer 
       0.0001 nil (lambda () 
                    (with-temp-buffer  
                      (insert str)
                      (insert "\n")
                      (insert (number-to-string i))
                      (message "Sending: %S" i )
                      (process-send-region connection 
                                           (point-min) 
                                           (point-max))
                      (message "%S sent" i)))))))

(setq our-test-process
      (progn (when (boundp 'our-test-process) (delete-process our-test-process)) 
	     (test-many-connections)))

[-- Attachment #4: 10815.patch --]
[-- Type: text/x-patch, Size: 13493 bytes --]

=== modified file 'src/process.c'
*** src/process.c	2012-03-23 12:23:14 +0000
--- src/process.c	2012-03-26 15:20:30 +0000
***************
*** 631,636 ****
--- 631,637 ----
    p->status = Qrun;
    p->mark = Fmake_marker ();
    p->kill_without_query = 0;
+   p->write_queue = Qnil;
  
  #ifdef ADAPTIVE_READ_BUFFERING
    p->adaptive_read_buffering = 0;
***************
*** 5366,5371 ****
--- 5367,5462 ----
    longjmp (send_process_frame, 1);
  }
  
+ /* In send_process, when a write fails temporarily,
+    wait_reading_process_output is called.
+ 
+    It may execute user code, for example timers, that sometimes
+    attempt to write new data to the same process. Data must be ensured
+    to be sent in the right order, and certainly not be interspersed
+    half-completed with other writes.
+    (See bug #10815)
+ 
+    To amend this problem the process write_queue has been added.
+    It is a list with each entry having the form:
+ 
+    (string . (offset . length))
+ 
+    where string is a lisp string, offset is the offset into the
+    string's bytesequence, from where we should begin to send and
+    length is the number of bytes left to send.
+  */
+ 
+ /* Create a new entry in write_queue,
+ 
+     input_obj should be a buffer, string or Qt/Qnil
+     buf is a pointer to the string sequence of the input_obj or a C
+     string in case of Qt/Qnil
+ */
+ static void
+ write_queue_push (struct Lisp_Process *p, Lisp_Object input_obj,
+                   const char *buf, int len, int front)
+ {
+   EMACS_INT offset;
+   Lisp_Object entry, obj;
+ 
+   if (STRINGP (input_obj))
+     {
+       offset = buf - SSDATA (input_obj);
+       obj = input_obj;
+     }
+   else
+     {
+       offset = 0;
+       obj = make_unibyte_string (buf, len);
+     }
+ 
+   entry = Fcons (obj, Fcons (make_number (offset), make_number (len)));
+ 
+   if (front)
+     p->write_queue = Fcons (entry, p->write_queue);
+   else
+     p->write_queue = nconc2 (p->write_queue, Fcons (entry, Qnil));
+ }
+ 
+ static void
+ write_queue_push_front (struct Lisp_Process *p, Lisp_Object obj,
+                         const char *buf, EMACS_INT len)
+ {
+   write_queue_push (p, obj, buf, len, 1);
+ }
+ 
+ static void
+ write_queue_push_back (struct Lisp_Process *p, Lisp_Object obj,
+                        const char *buf, EMACS_INT len)
+ {
+   write_queue_push (p, obj, buf, len, 0);
+ }
+ 
+ /* remove the first element in process' write_queue and
+    put its contents in obj, buf and len or return -1 if
+    write_queue is empty */
+ static int
+ write_queue_pop_front (struct Lisp_Process *p, Lisp_Object *obj, const
+                        char **buf, EMACS_INT *len) {
+   Lisp_Object entry, offset_length;
+   EMACS_INT offset;
+ 
+   if (NILP (p->write_queue))
+     return -1;
+ 
+   entry = XCAR (p->write_queue);
+   p->write_queue = XCDR (p->write_queue);
+ 
+   *obj = XCAR (entry);
+   offset_length = XCDR (entry);
+ 
+   *len = XINT (XCDR (offset_length));
+   offset = XINT (XCAR (offset_length));
+   *buf = SDATA (*obj) + offset;
+ 
+   return 0;
+ }
+ 
  /* Send some data to process PROC.
     BUF is the beginning of the data; LEN is the number of characters.
     OBJECT is the Lisp object that the data comes from.  If OBJECT is
***************
*** 5375,5381 ****
     for encoding before it is sent.
  
     This function can evaluate Lisp code and can garbage collect.  */
- 
  static void
  send_process (volatile Lisp_Object proc, const char *volatile buf,
  	      volatile EMACS_INT len, volatile Lisp_Object object)
--- 5466,5471 ----
***************
*** 5384,5394 ****
    struct Lisp_Process *p = XPROCESS (proc);
    ssize_t rv;
    struct coding_system *coding;
-   struct gcpro gcpro1;
    void (*volatile old_sigpipe) (int);
  
-   GCPRO1 (object);
- 
    if (p->raw_status_new)
      update_status (p);
    if (! EQ (p->status, Qrun))
--- 5474,5481 ----
***************
*** 5500,5624 ****
    if (!setjmp (send_process_frame))
      {
        p = XPROCESS (proc);  /* Repair any setjmp clobbering.  */
- 
        process_sent_to = proc;
-       while (len > 0)
- 	{
- 	  EMACS_INT this = len;
  
! 	  /* Send this batch, using one or more write calls.  */
! 	  while (this > 0)
! 	    {
! 	      EMACS_INT written = 0;
! 	      int outfd = p->outfd;
! 	      old_sigpipe = (void (*) (int)) signal (SIGPIPE, send_process_trap);
  #ifdef DATAGRAM_SOCKETS
! 	      if (DATAGRAM_CHAN_P (outfd))
! 		{
! 		  rv = sendto (outfd, buf, this,
! 			       0, datagram_address[outfd].sa,
! 			       datagram_address[outfd].len);
! 		  if (0 <= rv)
! 		    written = rv;
! 		  else if (errno == EMSGSIZE)
! 		    {
! 		      signal (SIGPIPE, old_sigpipe);
! 		      report_file_error ("sending datagram",
! 					 Fcons (proc, Qnil));
! 		    }
! 		}
! 	      else
  #endif
! 		{
  #ifdef HAVE_GNUTLS
! 		  if (p->gnutls_p)
! 		    written = emacs_gnutls_write (p, buf, this);
! 		  else
! #endif
! 		    written = emacs_write (outfd, buf, this);
! 		  rv = (written ? 0 : -1);
! #ifdef ADAPTIVE_READ_BUFFERING
! 		  if (p->read_output_delay > 0
! 		      && p->adaptive_read_buffering == 1)
! 		    {
! 		      p->read_output_delay = 0;
! 		      process_output_delay_count--;
! 		      p->read_output_skip = 0;
! 		    }
  #endif
! 		}
! 	      signal (SIGPIPE, old_sigpipe);
  
! 	      if (rv < 0)
! 		{
! 		  if (0
  #ifdef EWOULDBLOCK
! 		      || errno == EWOULDBLOCK
  #endif
  #ifdef EAGAIN
! 		      || errno == EAGAIN
  #endif
! 		      )
! 		    /* Buffer is full.  Wait, accepting input;
! 		       that may allow the program
! 		       to finish doing output and read more.  */
! 		    {
! 		      EMACS_INT offset = 0;
  
  #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
! 		      /* A gross hack to work around a bug in FreeBSD.
! 			 In the following sequence, read(2) returns
! 			 bogus data:
! 
! 			 write(2)	 1022 bytes
! 			 write(2)   954 bytes, get EAGAIN
! 			 read(2)   1024 bytes in process_read_output
! 			 read(2)     11 bytes in process_read_output
! 
! 			 That is, read(2) returns more bytes than have
! 			 ever been written successfully.  The 1033 bytes
! 			 read are the 1022 bytes written successfully
! 			 after processing (for example with CRs added if
! 			 the terminal is set up that way which it is
! 			 here).  The same bytes will be seen again in a
! 			 later read(2), without the CRs.  */
! 
! 		      if (errno == EAGAIN)
! 			{
! 			  int flags = FWRITE;
! 			  ioctl (p->outfd, TIOCFLUSH, &flags);
! 			}
  #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
  
! 		      /* Running filters might relocate buffers or strings.
! 			 Arrange to relocate BUF.  */
! 		      if (BUFFERP (object))
! 			offset = BUF_PTR_BYTE_POS (XBUFFER (object),
! 						   (unsigned char *) buf);
! 		      else if (STRINGP (object))
! 			offset = buf - SSDATA (object);
! 
  #ifdef EMACS_HAS_USECS
! 		      wait_reading_process_output (0, 20000, 0, 0, Qnil, NULL, 0);
  #else
! 		      wait_reading_process_output (1, 0, 0, 0, Qnil, NULL, 0);
  #endif
! 
! 		      if (BUFFERP (object))
! 			buf = (char *) BUF_BYTE_ADDRESS (XBUFFER (object),
! 							 offset);
! 		      else if (STRINGP (object))
! 			buf = offset + SSDATA (object);
! 		    }
! 		  else
! 		    /* This is a real error.  */
! 		    report_file_error ("writing to process", Fcons (proc, Qnil));
! 		}
! 	      buf += written;
! 	      len -= written;
! 	      this -= written;
! 	    }
! 	}
      }
    else
      {
--- 5587,5721 ----
    if (!setjmp (send_process_frame))
      {
        p = XPROCESS (proc);  /* Repair any setjmp clobbering.  */
        process_sent_to = proc;
  
!       /* if there is already data in the write_queue, put the new data
!          in the back of queue, otherwise just ignore it */
!       if (!NILP (p->write_queue))
!         write_queue_push_back (p, object, buf, len);
! 
!       /* until NILP (p->write_queue) */
!       do
!         {
!           EMACS_INT cur_len;
!           const char *cur_buf;
!           Lisp_Object cur_object;
! 
!           /* if write_queue is empty, just ignore it */
!           if (NILP (p->write_queue))
!             {
!               cur_len = len;
!               cur_buf = buf;
!               cur_object = object;
!             }
!           else
!             write_queue_pop_front (p, &cur_object, &cur_buf, &cur_len);
! 
!           while (cur_len > 0)
!             {
!               /* Send this batch, using one or more write calls.  */
!               EMACS_INT written = 0;
!               int outfd = p->outfd;
!               old_sigpipe = (void (*) (int)) signal (SIGPIPE, send_process_trap);
  #ifdef DATAGRAM_SOCKETS
!               if (DATAGRAM_CHAN_P (outfd))
!                 {
!                   rv = sendto (outfd, cur_buf, cur_len,
!                                0, datagram_address[outfd].sa,
!                                datagram_address[outfd].len);
!                   if (0 <= rv)
!                     written = rv;
!                   else if (errno == EMSGSIZE)
!                     {
!                       signal (SIGPIPE, old_sigpipe);
!                       report_file_error ("sending datagram",
!                                          Fcons (proc, Qnil));
!                     }
!                 }
!               else
  #endif
!                 {
  #ifdef HAVE_GNUTLS
!                   if (p->gnutls_p)
!                     written = emacs_gnutls_write (p, cur_buf, cur_len);
!                   else
  #endif
!                     written = emacs_write (outfd, cur_buf, cur_len);
  
!                   rv = (written ? 0 : -1);
! #ifdef ADAPTIVE_READ_BUFFERING
!                   if (p->read_output_delay > 0
!                       && p->adaptive_read_buffering == 1)
!                     {
!                       p->read_output_delay = 0;
!                       process_output_delay_count--;
!                       p->read_output_skip = 0;
!                     }
! #endif
!                 }
!               signal (SIGPIPE, old_sigpipe);
! 
!               if (rv < 0)
!                 {
!                   if (0
  #ifdef EWOULDBLOCK
!                       || errno == EWOULDBLOCK
  #endif
  #ifdef EAGAIN
!                       || errno == EAGAIN
  #endif
!                       )
!                     /* Buffer is full.  Wait, accepting input;
!                        that may allow the program
!                        to finish doing output and read more.  */
!                     {
!                       EMACS_INT offset = 0;
  
  #ifdef BROKEN_PTY_READ_AFTER_EAGAIN
!                       /* A gross hack to work around a bug in FreeBSD.
!                          In the following sequence, read(2) returns
!                          bogus data:
! 
!                          write(2)	 1022 bytes
!                          write(2)   954 bytes, get EAGAIN
!                          read(2)   1024 bytes in process_read_output
!                          read(2)     11 bytes in process_read_output
! 
!                          That is, read(2) returns more bytes than have
!                          ever been written successfully.  The 1033 bytes
!                          read are the 1022 bytes written successfully
!                          after processing (for example with CRs added if
!                          the terminal is set up that way which it is
!                          here).  The same bytes will be seen again in a
!                          later read(2), without the CRs.  */
! 
!                       if (errno == EAGAIN)
!                         {
!                           int flags = FWRITE;
!                           ioctl (p->outfd, TIOCFLUSH, &flags);
!                         }
  #endif /* BROKEN_PTY_READ_AFTER_EAGAIN */
  
!                       /* Put what we should have written in
!                          wait_queue */
!                       write_queue_push_front (p, cur_object, cur_buf, cur_len);
  #ifdef EMACS_HAS_USECS
!                       wait_reading_process_output (0, 20000, 0, 0, Qnil, NULL, 0);
  #else
!                       wait_reading_process_output (1, 0, 0, 0, Qnil, NULL, 0);
  #endif
!                       /* reread queue, to see what is left */
!                       break;
!                     }
!                   else
!                     /* This is a real error.  */
!                     report_file_error ("writing to process", Fcons (proc, Qnil));
!                 }
!               cur_buf += written;
!               cur_len -= written;
!             }
!         }
!       while (!NILP (p->write_queue));
      }
    else
      {
***************
*** 5631,5638 ****
        deactivate_process (proc);
        error ("SIGPIPE raised on process %s; closed it", SDATA (p->name));
      }
- 
-   UNGCPRO;
  }
  
  DEFUN ("process-send-region", Fprocess_send_region, Sprocess_send_region,
--- 5728,5733 ----

=== modified file 'src/process.h'
*** src/process.h	2012-01-19 07:21:25 +0000
--- src/process.h	2012-03-25 16:18:18 +0000
***************
*** 77,83 ****
      Lisp_Object encode_coding_system;
      /* Working buffer for encoding.  */
      Lisp_Object encoding_buf;
! 
  #ifdef HAVE_GNUTLS
      Lisp_Object gnutls_cred_type;
  #endif
--- 77,85 ----
      Lisp_Object encode_coding_system;
      /* Working buffer for encoding.  */
      Lisp_Object encoding_buf;
!     /* Queue for storing waiting writes */
!     Lisp_Object write_queue;
!     
  #ifdef HAVE_GNUTLS
      Lisp_Object gnutls_cred_type;
  #endif

bug#10815: #10815 counterintuitive results with process-send-string

[Chong Yidong]

Troels Nielsen <bn.troels@gmail.com> writes:

> I have a proposed patch, which fixes the ordering.

This patch looks good, and I've have committed it to trunk after some
minor edits.  Thank you very much.