=== 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