From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Daiki Ueno Newsgroups: gmane.emacs.devel Subject: pipe Date: Fri, 13 Mar 2015 18:01:48 +0900 Message-ID: NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1426237344 1191 80.91.229.3 (13 Mar 2015 09:02:24 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Fri, 13 Mar 2015 09:02:24 +0000 (UTC) To: emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Fri Mar 13 10:02:23 2015 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1YWLU7-0001Fb-1Q for ged-emacs-devel@m.gmane.org; Fri, 13 Mar 2015 10:02:23 +0100 Original-Received: from localhost ([::1]:35797 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YWLU6-0003ry-H0 for ged-emacs-devel@m.gmane.org; Fri, 13 Mar 2015 05:02:22 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:48430) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YWLTk-0003qY-U4 for emacs-devel@gnu.org; Fri, 13 Mar 2015 05:02:05 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1YWLTe-0008Tz-34 for emacs-devel@gnu.org; Fri, 13 Mar 2015 05:02:00 -0400 Original-Received: from fencepost.gnu.org ([2001:4830:134:3::e]:35475) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1YWLTd-0008Tr-Qn for emacs-devel@gnu.org; Fri, 13 Mar 2015 05:01:53 -0400 Original-Received: from du-a.org ([2001:e41:db5e:fb14::1]:34132 helo=localhost.localdomain) by fencepost.gnu.org with esmtpsa (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1YWLTc-0007Nc-LD for emacs-devel@gnu.org; Fri, 13 Mar 2015 05:01:53 -0400 User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.4 (gnu/linux) X-detected-operating-system: by eggs.gnu.org: Error: Malformed IPv6 address (bad octet value). X-Received-From: 2001:4830:134:3::e X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.devel:183840 Archived-At: --=-=-= Content-Type: text/plain Related to: https://lists.gnu.org/archive/html/emacs-devel/2014-09/msg00777.html in which I proposed a generalization of start-process, in a similar way to open-network-stream and make-network-process. My motivation behind that was to avoid temporary files in epg.el, by using file descriptors other than 0 and 1 (as you know, gpg has options --status-fd, --command-fd, --attribute-fd, etc. for that). In order to do that, I thought that it would be inevitable to change the calling convention of start-process. However, I hesitate to do such an intrusive change. So, here is an alternative approach: - Add a new process type 'pipe, which represents a bidirectional pipe, not associated with a child process when it is created. - Add a new global variable process-pipe-list, which associates additional pipe processes with a child process, when start-process is called. This is needed for setting the FD_CLOEXEC flag on the child ends of the pipes so they are not leaked to other processes created later, and to delete the pipe processes when the real process is deleted. Here is a basic usage of this: (setq pipe1 (make-pipe-process :name "pipe1")) ;=> # (process-contact pipe1) ;=> (17 20) (kill-buffer "pipe1") ;=>t (process-contact pipe1) ;=> (-1 -1) (setq pipe1 (make-pipe-process :name "pipe1")) ;=> # (process-contact pipe1) ;=> (17 20) (setq pipe2 (make-pipe-process :name "pipe2")) (let ((process-connection-type nil) (process-pipe-list (list pipe1 pipe2))) (start-process-shell-command "process" (current-buffer) (format "\ echo hello to stdout; \ echo hello to pipe1 >&%d; \ echo hello to pipe2 >&%d" (nth 1 (process-contact pipe1)) (nth 1 (process-contact pipe2))))) This delivers the output lines to the respective process buffers: "pipe1", "pipe2", and the current buffer. Would this kind of feature be acceptable? I guess Stefan is not happy with the new global variable, set with dynamic binding. Anyway, I'm attaching a couple of patches: one is the implementation, and thew other is the usage in epg.el. It's already working with gpg, while I haven't tested it with gpgsm. Comments would be appreciated. Regards, -- Daiki Ueno --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Add-make-pipe-process.patch >From 37d86df013baa679d06d6c1ce048db74302b6d97 Mon Sep 17 00:00:00 2001 From: Daiki Ueno Date: Mon, 9 Mar 2015 09:50:32 +0900 Subject: [PATCH 1/2] Add make-pipe-process * lisp.h (emacs_pipe2): New function declaration. * sysdep.c (emacs_pipe2): New function. (emacs_pipe): Define as a wrapper around emacs_pipe2. * process.h (struct Lisp_Process): New member pipe_list. * process.c (PIPECONN_P): New macro. (PIPECONN1_P): New macro. (SUBPROCESS_STDIN, WRITE_TO_SUBPROCESS, READ_FROM_SUBPROCESS, SUBPROCESS_STDOUT, READ_FROM_EXEC_MONITOR, EXEC_MONITOR_OUTPUT): Move the enum before the use in... (Fprocess_contact): ...here. Handle pipe process specially. (Fdelete_process, Fprocess_status, Fset_process_buffer) (Fset_process_filter, Fset_process_sentinel, Fstop_process) (Fcontinue_process): Handle pipe process specially. (create_process): Respect Vprocess_pipe_list and Vprocess_standard_error. (Fmake_pipe_process): New function. (deactivate_process): Call Fdelete_process on associated pipe processes. (syms_of_process): New variables Vprocess_pipe_list and Vprocess_standard_error, register Qpipe and Smake_pipe_process. --- src/lisp.h | 1 + src/process.c | 344 +++++++++++++++++++++++++++++++++++++++++++++++++++------- src/process.h | 3 + src/sysdep.c | 14 ++- 4 files changed, 320 insertions(+), 42 deletions(-) diff --git a/src/lisp.h b/src/lisp.h index b730619..2e161da 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -4378,6 +4378,7 @@ extern void emacs_backtrace (int); extern _Noreturn void emacs_abort (void) NO_INLINE; extern int emacs_open (const char *, int, int); extern int emacs_pipe (int[2]); +extern int emacs_pipe2 (int[2], int); extern int emacs_close (int); extern ptrdiff_t emacs_read (int, void *, ptrdiff_t); extern ptrdiff_t emacs_write (int, void const *, ptrdiff_t); diff --git a/src/process.c b/src/process.c index 1d935ba..4e6c0b9 100644 --- a/src/process.c +++ b/src/process.c @@ -189,6 +189,8 @@ process_socket (int domain, int type, int protocol) #define NETCONN1_P(p) (EQ (p->type, Qnetwork)) #define SERIALCONN_P(p) (EQ (XPROCESS (p)->type, Qserial)) #define SERIALCONN1_P(p) (EQ (p->type, Qserial)) +#define PIPECONN_P(p) (EQ (XPROCESS (p)->type, Qpipe)) +#define PIPECONN1_P(p) (EQ (p->type, Qpipe)) /* Number of events of change of status of a process. */ static EMACS_INT process_tick; @@ -253,6 +255,25 @@ static bool process_output_skip; #define process_output_delay_count 0 #endif +/* Indexes of file descriptors in open_fds. */ +enum + { + /* The pipe from Emacs to its subprocess. */ + SUBPROCESS_STDIN, + WRITE_TO_SUBPROCESS, + + /* The main pipe from the subprocess to Emacs. */ + READ_FROM_SUBPROCESS, + SUBPROCESS_STDOUT, + + /* The pipe from the subprocess to Emacs that is closed when the + subprocess execs. */ + READ_FROM_EXEC_MONITOR, + EXEC_MONITOR_OUTPUT + }; + +verify (PROCESS_OPEN_FDS == EXEC_MONITOR_OUTPUT + 1); + static void create_process (Lisp_Object, char **, Lisp_Object); #ifdef USABLE_SIGIO static bool keyboard_bit_set (fd_set *); @@ -420,6 +441,11 @@ pset_write_queue (struct Lisp_Process *p, Lisp_Object val) { p->write_queue = val; } +static void +pset_pipe_list (struct Lisp_Process *p, Lisp_Object val) +{ + p->pipe_list = val; +} static Lisp_Object @@ -739,6 +765,7 @@ make_process (Lisp_Object name) pset_name (p, name); pset_sentinel (p, Qinternal_default_process_sentinel); pset_filter (p, Qinternal_default_process_filter); + pset_pipe_list (p, Qnil); XSETPROCESS (val, p); Vprocess_alist = Fcons (Fcons (name, val), Vprocess_alist); return val; @@ -846,7 +873,7 @@ nil, indicating the current buffer's process. */) p = XPROCESS (process); p->raw_status_new = 0; - if (NETCONN1_P (p) || SERIALCONN1_P (p)) + if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p)) { pset_status (p, list2 (Qexit, make_number (0))); p->tick = ++process_tick; @@ -912,7 +939,7 @@ nil, indicating the current buffer's process. */) status = p->status; if (CONSP (status)) status = XCAR (status); - if (NETCONN1_P (p) || SERIALCONN1_P (p)) + if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p)) { if (EQ (status, Qexit)) status = Qclosed; @@ -996,7 +1023,7 @@ Return BUFFER. */) CHECK_BUFFER (buffer); p = XPROCESS (process); pset_buffer (p, buffer); - if (NETCONN1_P (p) || SERIALCONN1_P (p)) + if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p)) pset_childp (p, Fplist_put (p->childp, QCbuffer, buffer)); setup_process_coding_systems (process); return buffer; @@ -1072,7 +1099,7 @@ The string argument is normally a multibyte string, except: } pset_filter (p, filter); - if (NETCONN1_P (p) || SERIALCONN1_P (p)) + if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p)) pset_childp (p, Fplist_put (p->childp, QCfilter, filter)); setup_process_coding_systems (process); return filter; @@ -1104,7 +1131,7 @@ It gets two arguments: the process, and a string describing the change. */) sentinel = Qinternal_default_process_sentinel; pset_sentinel (p, sentinel); - if (NETCONN1_P (p) || SERIALCONN1_P (p)) + if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p)) pset_childp (p, Fplist_put (p->childp, QCsentinel, sentinel)); return sentinel; } @@ -1192,13 +1219,14 @@ DEFUN ("process-query-on-exit-flag", DEFUN ("process-contact", Fprocess_contact, Sprocess_contact, 1, 2, 0, doc: /* Return the contact info of PROCESS; t for a real child. -For a network or serial connection, the value depends on the optional -KEY arg. If KEY is nil, value is a cons cell of the form (HOST -SERVICE) for a network connection or (PORT SPEED) for a serial -connection. If KEY is t, the complete contact information for the -connection is returned, else the specific value for the keyword KEY is -returned. See `make-network-process' or `make-serial-process' for a -list of keywords. */) +For a network or serial connection, or a pipe, the value depends on +the optional KEY arg. If KEY is nil, value is a cons cell of the form +(HOST SERVICE) for a network connection or (PORT SPEED) for a serial +connection, or (CHILD_INPUT CHILD_OUTPUT) for a pipe. If KEY is t, +the complete contact information for the connection is returned, else +the specific value for the keyword KEY is returned. See +`make-network-process' or `make-serial-process' for a list of +keywords. */) (register Lisp_Object process, Lisp_Object key) { Lisp_Object contact; @@ -1213,6 +1241,12 @@ list of keywords. */) Fprocess_datagram_address (process)); #endif + if (PIPECONN_P (process)) + { + struct Lisp_Process *p = XPROCESS (process); + return list2 (make_number (p->open_fd[SUBPROCESS_STDIN]), + make_number (p->open_fd[SUBPROCESS_STDOUT])); + } if ((!NETCONN_P (process) && !SERIALCONN_P (process)) || EQ (key, Qt)) return contact; if (NILP (key) && NETCONN_P (process)) @@ -1614,42 +1648,40 @@ close_process_fd (int *fd_addr) } } -/* Indexes of file descriptors in open_fds. */ -enum - { - /* The pipe from Emacs to its subprocess. */ - SUBPROCESS_STDIN, - WRITE_TO_SUBPROCESS, - - /* The main pipe from the subprocess to Emacs. */ - READ_FROM_SUBPROCESS, - SUBPROCESS_STDOUT, - - /* The pipe from the subprocess to Emacs that is closed when the - subprocess execs. */ - READ_FROM_EXEC_MONITOR, - EXEC_MONITOR_OUTPUT - }; - -verify (PROCESS_OPEN_FDS == EXEC_MONITOR_OUTPUT + 1); - static void create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) { struct Lisp_Process *p = XPROCESS (process); - int inchannel, outchannel; + int inchannel, outchannel, errchannel; pid_t pid; int vfork_errno; - int forkin, forkout; + int forkin, forkout, forkerr; bool pty_flag = 0; char pty_name[PTY_NAME_SIZE]; Lisp_Object lisp_pty_name = Qnil; sigset_t oldset; - inchannel = outchannel = -1; + inchannel = outchannel = errchannel = -1; if (!NILP (Vprocess_connection_type)) outchannel = inchannel = allocate_pty (pty_name); + else + { + if (!NILP (Vprocess_standard_error) + && NILP (Fmemq (Vprocess_standard_error, Vprocess_pipe_list))) + error ("process-standard-error is not in process-pipe-list"); + else + { + Lisp_Object tem; + + for (tem = Vprocess_pipe_list; CONSP (tem); tem = XCDR (tem)) + { + CHECK_PROCESS (XCAR (tem)); + if (!PIPECONN_P (XCAR (tem))) + error ("Process is not a pipe process"); + } + } + } if (inchannel >= 0) { @@ -1666,6 +1698,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) #else forkin = forkout = -1; #endif /* not USG, or USG_SUBTTY_WORKS */ + forkerr = -1; pty_flag = 1; lisp_pty_name = build_string (pty_name); } @@ -1678,6 +1711,22 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) outchannel = p->open_fd[WRITE_TO_SUBPROCESS]; inchannel = p->open_fd[READ_FROM_SUBPROCESS]; forkout = p->open_fd[SUBPROCESS_STDOUT]; + + if (!NILP (Vprocess_standard_error)) + { + struct Lisp_Process *pp = XPROCESS (Vprocess_standard_error); + + forkerr = pp->open_fd[SUBPROCESS_STDOUT]; + errchannel = pp->open_fd[READ_FROM_SUBPROCESS]; + + /* FORKERR will be redirected in child_setup. */ + fcntl (forkerr, F_SETFD, FD_CLOEXEC); + /* Close unnecessary file descriptors. */ + close_process_fd (&pp->open_fd[WRITE_TO_SUBPROCESS]); + close_process_fd (&pp->open_fd[SUBPROCESS_STDIN]); + } + + pset_pipe_list (p, Fcopy_sequence (Vprocess_pipe_list)); } #ifndef WINDOWSNT @@ -1720,6 +1769,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) char **volatile new_argv_volatile = new_argv; int volatile forkin_volatile = forkin; int volatile forkout_volatile = forkout; + int volatile forkerr_volatile = forkerr; struct Lisp_Process *p_volatile = p; pid = vfork (); @@ -1729,6 +1779,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) new_argv = new_argv_volatile; forkin = forkin_volatile; forkout = forkout_volatile; + forkerr = forkerr_volatile; p = p_volatile; pty_flag = p->pty_flag; @@ -1739,6 +1790,7 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) { int xforkin = forkin; int xforkout = forkout; + int xforkerr = forkerr; /* Make the pty be the controlling terminal of the process. */ #ifdef HAVE_PTYS @@ -1838,10 +1890,13 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) if (pty_flag) child_setup_tty (xforkout); + + if (xforkerr < 0) + xforkerr = xforkout; #ifdef WINDOWSNT - pid = child_setup (xforkin, xforkout, xforkout, new_argv, 1, current_dir); + pid = child_setup (xforkin, xforkout, xforkerr, new_argv, 1, current_dir); #else /* not WINDOWSNT */ - child_setup (xforkin, xforkout, xforkout, new_argv, 1, current_dir); + child_setup (xforkin, xforkout, xforkerr, new_argv, 1, current_dir); #endif /* not WINDOWSNT */ } @@ -1861,11 +1916,23 @@ create_process (Lisp_Object process, char **new_argv, Lisp_Object current_dir) else { /* vfork succeeded. */ + Lisp_Object tem; /* Close the pipe ends that the child uses, or the child's pty. */ close_process_fd (&p->open_fd[SUBPROCESS_STDIN]); close_process_fd (&p->open_fd[SUBPROCESS_STDOUT]); + for (tem = p->pipe_list; CONSP (tem); tem = XCDR (tem)) + { + struct Lisp_Process *pp = XPROCESS (XCAR (tem)); + + /* FIXME: Why we can't close them immediately? */ + if (pp->open_fd[SUBPROCESS_STDIN] >= 0) + fcntl (pp->open_fd[SUBPROCESS_STDIN], F_SETFD, FD_CLOEXEC); + if (pp->open_fd[SUBPROCESS_STDOUT] >= 0) + fcntl (pp->open_fd[SUBPROCESS_STDOUT], F_SETFD, FD_CLOEXEC); + } + #ifdef WINDOWSNT register_child (pid, inchannel); #endif /* WINDOWSNT */ @@ -1944,6 +2011,186 @@ create_pty (Lisp_Object process) p->pid = -2; } +DEFUN ("make-pipe-process", Fmake_pipe_process, Smake_pipe_process, + 0, MANY, 0, + doc: /* Create and return a bidirectional pipe process. + +In Emacs, pipes are represented by process objects, so input and +output work as for subprocesses, and `delete-process' closes a pipe. +However, a pipe process has no process id, it cannot be signaled, +and the status codes are different from normal processes. + +Arguments are specified as keyword/argument pairs. The following +arguments are defined: + +:name NAME -- NAME is the name of the process. It is modified if necessary to make it unique. + +:buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate +with the process. Process output goes at the end of that buffer, +unless you specify an output stream or filter function to handle the +output. If BUFFER is not given, the value of NAME is used. + +:coding CODING -- If CODING is a symbol, it specifies the coding +system used for both reading and writing for this process. If CODING +is a cons (DECODING . ENCODING), DECODING is used for reading, and +ENCODING is used for writing. + +:noquery BOOL -- When exiting Emacs, query the user if BOOL is nil and +the process is running. If BOOL is not given, query before exiting. + +:stop BOOL -- Start process in the `stopped' state if BOOL is non-nil. +In the stopped state, a serial process does not accept incoming data, +but you can send outgoing data. The stopped state is cleared by +`continue-process' and set by `stop-process'. + +:filter FILTER -- Install FILTER as the process filter. + +:sentinel SENTINEL -- Install SENTINEL as the process sentinel. + +usage: (make-pipe-process &rest ARGS) */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + Lisp_Object proc, contact; + struct Lisp_Process *p; + struct gcpro gcpro1; + Lisp_Object name, buffer; + Lisp_Object tem, val; + ptrdiff_t specpdl_count; + int inchannel, outchannel; + + if (nargs == 0) + return Qnil; + + contact = Flist (nargs, args); + GCPRO1 (contact); + + name = Fplist_get (contact, QCname); + CHECK_STRING (name); + proc = make_process (name); + specpdl_count = SPECPDL_INDEX (); + record_unwind_protect (remove_process, proc); + p = XPROCESS (proc); + + if (emacs_pipe2 (p->open_fd + SUBPROCESS_STDIN, O_BINARY) != 0 + || emacs_pipe2 (p->open_fd + READ_FROM_SUBPROCESS, O_BINARY) != 0) + report_file_error ("Creating pipe", Qnil); + outchannel = p->open_fd[WRITE_TO_SUBPROCESS]; + inchannel = p->open_fd[READ_FROM_SUBPROCESS]; + + /* Child doesn't need inchannel/outchannel after exec. */ + fcntl (inchannel, F_SETFD, FD_CLOEXEC); + fcntl (outchannel, F_SETFD, FD_CLOEXEC); + + fcntl (inchannel, F_SETFL, O_NONBLOCK); + fcntl (outchannel, F_SETFL, O_NONBLOCK); + + /* Record this as an active process, with its channels. */ + chan_process[inchannel] = proc; + p->infd = inchannel; + p->outfd = outchannel; + + FD_SET (inchannel, &input_wait_mask); + FD_SET (inchannel, &non_keyboard_wait_mask); + if (inchannel > max_process_desc) + max_process_desc = inchannel; + + buffer = Fplist_get (contact, QCbuffer); + if (NILP (buffer)) + buffer = name; + buffer = Fget_buffer_create (buffer); + pset_buffer (p, buffer); + + pset_childp (p, contact); + pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist))); + pset_type (p, Qpipe); + pset_sentinel (p, Fplist_get (contact, QCsentinel)); + pset_filter (p, Fplist_get (contact, QCfilter)); + pset_log (p, Qnil); + if (tem = Fplist_get (contact, QCnoquery), !NILP (tem)) + p->kill_without_query = 1; + if (tem = Fplist_get (contact, QCstop), !NILP (tem)) + pset_command (p, Qt); + eassert (! p->pty_flag); + +#ifdef ADAPTIVE_READ_BUFFERING + p->adaptive_read_buffering + = (NILP (Vprocess_adaptive_read_buffering) ? 0 + : EQ (Vprocess_adaptive_read_buffering, Qt) ? 1 : 2); +#endif + + /* Make the process marker point into the process buffer (if any). */ + if (BUFFERP (buffer)) + set_marker_both (p->mark, buffer, + BUF_ZV (XBUFFER (buffer)), + BUF_ZV_BYTE (XBUFFER (buffer))); + + tem = Fplist_member (contact, QCcoding); + if (!NILP (tem) && (!CONSP (tem) || !CONSP (XCDR (tem)))) + tem = Qnil; /* No error message (too late!). */ + + { + /* Setup coding systems for communicating with the network stream. */ + struct gcpro gcpro1; + /* Qt denotes we have not yet called Ffind_operation_coding_system. */ + Lisp_Object coding_systems = Qt; + Lisp_Object val; + + if (!NILP (tem)) + { + val = XCAR (XCDR (tem)); + if (CONSP (val)) + val = XCAR (val); + } + else if (!NILP (Vcoding_system_for_read)) + val = Vcoding_system_for_read; + else if ((!NILP (buffer) && NILP (BVAR (XBUFFER (buffer), enable_multibyte_characters))) + || (NILP (buffer) && NILP (BVAR (&buffer_defaults, enable_multibyte_characters)))) + /* We dare not decode end-of-line format by setting VAL to + Qraw_text, because the existing Emacs Lisp libraries + assume that they receive bare code including a sequence of + CR LF. */ + val = Qnil; + else + { + if (CONSP (coding_systems)) + val = XCAR (coding_systems); + else if (CONSP (Vdefault_process_coding_system)) + val = XCAR (Vdefault_process_coding_system); + else + val = Qnil; + } + pset_decode_coding_system (p, val); + + if (!NILP (tem)) + { + val = XCAR (XCDR (tem)); + if (CONSP (val)) + val = XCDR (val); + } + else if (!NILP (Vcoding_system_for_write)) + val = Vcoding_system_for_write; + else if (NILP (BVAR (current_buffer, enable_multibyte_characters))) + val = Qnil; + else + { + if (CONSP (coding_systems)) + val = XCDR (coding_systems); + else if (CONSP (Vdefault_process_coding_system)) + val = XCDR (Vdefault_process_coding_system); + else + val = Qnil; + } + pset_encode_coding_system (p, val); + } + /* This may signal an error. */ + setup_process_coding_systems (proc); + + specpdl_ptr = specpdl + specpdl_count; + + UNGCPRO; + return proc; +} + /* Convert an internal struct sockaddr to a lisp object (vector or string). The address family of sa is not included in the result. */ @@ -3861,6 +4108,7 @@ deactivate_process (Lisp_Object proc) int inchannel; struct Lisp_Process *p = XPROCESS (proc); int i; + Lisp_Object tem; #ifdef HAVE_GNUTLS /* Delete GnuTLS structures in PROC, if any. */ @@ -3919,6 +4167,9 @@ deactivate_process (Lisp_Object proc) max_process_desc = i; } } + + for (tem = p->pipe_list; CONSP (tem); tem = XCDR (tem)) + Fdelete_process (XCAR (tem)); } @@ -5879,7 +6130,8 @@ If PROCESS is a network or serial process, inhibit handling of incoming traffic. */) (Lisp_Object process, Lisp_Object current_group) { - if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process))) + if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process) + || PIPECONN_P (process))) { struct Lisp_Process *p; @@ -5908,7 +6160,8 @@ If PROCESS is a network or serial process, resume handling of incoming traffic. */) (Lisp_Object process, Lisp_Object current_group) { - if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process))) + if (PROCESSP (process) && (NETCONN_P (process) || SERIALCONN_P (process) + || PIPECONN_P (process))) { struct Lisp_Process *p; @@ -6955,7 +7208,7 @@ kill_buffer_processes (Lisp_Object buffer) FOR_EACH_PROCESS (tail, proc) if (NILP (buffer) || EQ (XPROCESS (proc)->buffer, buffer)) { - if (NETCONN_P (proc) || SERIALCONN_P (proc)) + if (NETCONN_P (proc) || SERIALCONN_P (proc) || PIPECONN_P (proc)) Fdelete_process (proc); else if (XPROCESS (proc)->infd >= 0) process_send_signal (proc, SIGHUP, Qnil, 1); @@ -7255,6 +7508,7 @@ syms_of_process (void) DEFSYM (Qreal, "real"); DEFSYM (Qnetwork, "network"); DEFSYM (Qserial, "serial"); + DEFSYM (Qpipe, "pipe"); DEFSYM (QCbuffer, ":buffer"); DEFSYM (QChost, ":host"); DEFSYM (QCservice, ":service"); @@ -7347,6 +7601,17 @@ The variable takes effect when `start-process' is called. */); Vprocess_adaptive_read_buffering = Qt; #endif + DEFVAR_LISP ("process-pipe-list", Vprocess_pipe_list, + doc: /* List of pipe processes attached to child process. +The value takes effect when `start-process' is called. */); + Vprocess_pipe_list = Qnil; + + DEFVAR_LISP ("process-standard-error", Vprocess_standard_error, + doc: /* Pipe process attached to standard error output of child process. +This process must be listed in `process-pipe-list'. +The value takes effect when `start-process' is called. */); + Vprocess_standard_error = Qnil; + defsubr (&Sprocessp); defsubr (&Sget_process); defsubr (&Sdelete_process); @@ -7372,6 +7637,7 @@ The variable takes effect when `start-process' is called. */); defsubr (&Sset_process_plist); defsubr (&Sprocess_list); defsubr (&Sstart_process); + defsubr (&Smake_pipe_process); defsubr (&Sserial_process_configure); defsubr (&Smake_serial_process); defsubr (&Sset_network_process_option); diff --git a/src/process.h b/src/process.h index 36979dc..b76ebd2 100644 --- a/src/process.h +++ b/src/process.h @@ -105,6 +105,9 @@ struct Lisp_Process Lisp_Object gnutls_cred_type; #endif + /* Pipe processes attached to this process. */ + Lisp_Object pipe_list; + /* After this point, there are no Lisp_Objects any more. */ /* alloc.c assumes that `pid' is the first such non-Lisp slot. */ diff --git a/src/sysdep.c b/src/sysdep.c index 0a0b0ac..2fe4624 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2257,19 +2257,27 @@ emacs_fopen (char const *file, char const *mode) /* Create a pipe for Emacs use. */ int -emacs_pipe (int fd[2]) +emacs_pipe2 (int fd[2], int flags) { #ifdef MSDOS return pipe (fd); #else /* !MSDOS */ - int result = pipe2 (fd, O_BINARY | O_CLOEXEC); + return pipe2 (fd, flags); +#endif /* !MSDOS */ +} + +int +emacs_pipe (int fd[2]) +{ + int result = emacs_pipe2 (fd, O_BINARY | O_CLOEXEC); +#ifndef MSDOS if (! O_CLOEXEC && result == 0) { fcntl (fd[0], F_SETFD, FD_CLOEXEC); fcntl (fd[1], F_SETFD, FD_CLOEXEC); } - return result; #endif /* !MSDOS */ + return result; } /* Approximate posix_close and POSIX_CLOSE_RESTART well enough for Emacs. -- 2.1.0 --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0002-epg-Avoid-using-temporary-files.patch >From ab2b2ec47b7b7eb22582fb138a134be6d0af84dd Mon Sep 17 00:00:00 2001 From: Daiki Ueno Date: Thu, 12 Mar 2015 16:47:57 +0900 Subject: [PATCH 2/2] epg: Avoid using temporary files * epg.el (epg-error-output): Abolish. (epg-context): Remove slot output-file, add slots error-process, status-process, and command-process. (epg--start): Separate stdout, stderr, --status-fd output, and --command-fd output using pipe process. (epg--process-filter): Define as a process filter for the pipe process watching the --status-fd output. (epg--process-sentinel): New sentinel. (epg-read-output): Use the content of process buffer, instead of temporary file. (epg-wait-for-status, epg-wait-for-completion): Read --status-fd output instead of the process output. (epg-reset): Kill all buffers associated with the process. (epg-delete-output-file): Abolish. (epg-decrypt-file, epg-decrypt-string, epg-verify-file) (epg-verify-string, epg-sign-file, epg-sign-string) (epg-encrypt-file, epg-encrypt-string) (epg-export-keys-to-file): Remove temporary file usage. --- lisp/epg.el | 182 +++++++++++++++++++++++++++++------------------------------- 1 file changed, 88 insertions(+), 94 deletions(-) diff --git a/lisp/epg.el b/lisp/epg.el index f665453..97119b1 100644 --- a/lisp/epg.el +++ b/lisp/epg.el @@ -40,7 +40,6 @@ (defvar epg-debug-buffer nil) (defvar epg-agent-file nil) (defvar epg-agent-mtime nil) -(defvar epg-error-output nil) ;; from gnupg/include/cipher.h (defconst epg-cipher-algorithm-alist @@ -209,11 +208,13 @@ signers sig-notations process - output-file result operation pinentry-mode - (error-output "")) + (error-output "") + error-process + status-process + command-process) ;; This is not an alias, just so we can mark it as autoloaded. ;;;###autoload @@ -558,8 +559,19 @@ callback data (if any)." (error "%s is already running in this context" (epg-context-program context))) (let* ((agent-info (getenv "GPG_AGENT_INFO")) + (error-buffer (generate-new-buffer " *epg-error*")) + (error-process (make-pipe-process :name "epg-error" + :buffer error-buffer + :noquery t)) + (status-buffer (generate-new-buffer " *epg-status*")) + (status-process (make-pipe-process :name "epg-status" + :buffer status-buffer + :noquery t + :filter #'epg--process-filter)) (args (append (list "--no-tty" - "--status-fd" "1" + "--status-fd" + (number-to-string + (nth 1 (process-contact status-process))) "--yes") (if (and (not (eq (epg-context-protocol context) 'CMS)) (string-match ":" (or agent-info ""))) @@ -570,12 +582,8 @@ callback data (if any)." (if (epg-context-home-directory context) (list "--homedir" (epg-context-home-directory context))) - (unless (eq (epg-context-protocol context) 'CMS) - '("--command-fd" "0")) (if (epg-context-armor context) '("--armor")) (if (epg-context-textmode context) '("--textmode")) - (if (epg-context-output-file context) - (list "--output" (epg-context-output-file context))) (if (epg-context-pinentry-mode context) (list "--pinentry-mode" (symbol-name (epg-context-pinentry-mode @@ -584,12 +592,25 @@ callback data (if any)." (coding-system-for-write 'binary) (coding-system-for-read 'binary) process-connection-type + (process-pipe-list (list error-process status-process)) + (process-standard-error error-process) (process-environment process-environment) (buffer (generate-new-buffer " *epg*")) process terminal-name agent-file - (agent-mtime '(0 0 0 0))) + (agent-mtime '(0 0 0 0)) + command-buffer command-process) + (unless (eq (epg-context-protocol context) 'CMS) + (setq command-buffer (generate-new-buffer " *epg-command*") + command-process (make-pipe-process :name "epg-command" + :buffer command-buffer + :noquery t)) + (push command-process process-pipe-list) + (setq args (append (list "--command-fd" + (number-to-string + (car (process-contact command-process)))) + args))) ;; Set GPG_TTY and TERM for pinentry-curses. Note that we can't ;; use `terminal-name' here to get the real pty name for the child ;; process, though /dev/fd/0" is not portable. @@ -626,6 +647,9 @@ callback data (if any)." (mapconcat #'identity args " "))))) (with-current-buffer buffer (if (fboundp 'set-buffer-multibyte) + (set-buffer-multibyte nil))) + (with-current-buffer status-buffer + (if (fboundp 'set-buffer-multibyte) (set-buffer-multibyte nil)) (make-local-variable 'epg-last-status) (setq epg-last-status nil) @@ -642,13 +666,15 @@ callback data (if any)." (make-local-variable 'epg-agent-file) (setq epg-agent-file agent-file) (make-local-variable 'epg-agent-mtime) - (setq epg-agent-mtime agent-mtime) - (make-local-variable 'epg-error-output) - (setq epg-error-output nil)) + (setq epg-agent-mtime agent-mtime)) + (setf (epg-context-error-process context) error-process) + (setf (epg-context-status-process context) status-process) + (if command-process + (setf (epg-context-command-process context) command-process)) (with-file-modes 448 (setq process (apply #'start-process "epg" buffer (epg-context-program context) args))) - (set-process-filter process #'epg--process-filter) + (set-process-sentinel process #'epg--process-sentinel) (setf (epg-context-process context) process))) (defun epg--process-filter (process input) @@ -658,8 +684,11 @@ callback data (if any)." (setq epg-debug-buffer (generate-new-buffer " *epg-debug*"))) (goto-char (point-max)) (insert input))) - (if (buffer-live-p (process-buffer process)) - (with-current-buffer (process-buffer process) + (when (buffer-live-p (process-buffer process)) + (let ((context + (with-current-buffer (process-buffer process) + epg-context))) + (with-current-buffer (process-buffer (epg-context-status-process context)) (save-excursion (goto-char (point-max)) (insert input) @@ -690,34 +719,28 @@ callback data (if any)." (if (and symbol (fboundp symbol)) (funcall symbol epg-context string))) - (setq epg-last-status (cons status string))) - ;; Record other lines sent to stderr. This assumes - ;; that the process-filter receives output only from - ;; stderr and the FD specified with --status-fd. - (setq epg-error-output - (cons (buffer-substring (point) - (line-end-position)) - epg-error-output))) + (setq epg-last-status (cons status string)))) (forward-line) - (setq epg-read-point (point))))))))) + (setq epg-read-point (point)))))))))) + +(defun epg--process-sentinel (_process _status) + ;; Do nothing. + ) (defun epg-read-output (context) "Read the output file CONTEXT and return the content as a string." - (with-temp-buffer - (if (fboundp 'set-buffer-multibyte) - (set-buffer-multibyte nil)) - (if (file-exists-p (epg-context-output-file context)) - (let ((coding-system-for-read 'binary)) - (insert-file-contents (epg-context-output-file context)) + (let ((buffer (process-buffer (epg-context-process context)))) + (if (buffer-live-p buffer) + (with-current-buffer buffer (buffer-string))))) (defun epg-wait-for-status (context status-list) "Wait until one of elements in STATUS-LIST arrives." - (with-current-buffer (process-buffer (epg-context-process context)) + (with-current-buffer (process-buffer (epg-context-status-process context)) (setq epg-pending-status-list status-list) (while (and (eq (process-status (epg-context-process context)) 'run) epg-pending-status-list) - (accept-process-output (epg-context-process context) 1)) + (accept-process-output (epg-context-status-process context) 1 0 1)) (if epg-pending-status-list (epg-context-set-result-for context 'error @@ -727,11 +750,11 @@ callback data (if any)." (defun epg-wait-for-completion (context) "Wait until the `epg-gpg-program' process completes." (while (eq (process-status (epg-context-process context)) 'run) - (accept-process-output (epg-context-process context) 1)) + (accept-process-output (epg-context-status-process context) 1 0 1)) ;; This line is needed to run the process-filter right now. (sleep-for 0.1) ;; Restore Emacs frame on text terminal, when pinentry-curses has terminated. - (if (with-current-buffer (process-buffer (epg-context-process context)) + (if (with-current-buffer (process-buffer (epg-context-status-process context)) (and epg-agent-file (> (float-time (or (nth 5 (file-attributes epg-agent-file)) '(0 0 0 0))) @@ -740,24 +763,26 @@ callback data (if any)." (epg-context-set-result-for context 'error (nreverse (epg-context-result-for context 'error))) - (with-current-buffer (process-buffer (epg-context-process context)) - (setf (epg-context-error-output context) - (mapconcat #'identity (nreverse epg-error-output) "\n")))) + (with-current-buffer (process-buffer (epg-context-error-process context)) + (setf (epg-context-error-output context) (buffer-string)))) (defun epg-reset (context) "Reset the CONTEXT." - (if (and (epg-context-process context) - (buffer-live-p (process-buffer (epg-context-process context)))) - (kill-buffer (process-buffer (epg-context-process context)))) + (let ((processes + (delq nil + (list (epg-context-process context) + (epg-context-error-process context) + (epg-context-status-process context) + (epg-context-command-process context))))) + (dolist (process processes) + (if (buffer-live-p (process-buffer process)) + (kill-buffer (process-buffer process))))) (setf (epg-context-process context) nil) + (setf (epg-context-error-process context) nil) + (setf (epg-context-status-process context) nil) + (setf (epg-context-command-process context) nil) (setf (epg-context-edit-callback context) nil)) -(defun epg-delete-output-file (context) - "Delete the output file of CONTEXT." - (if (and (epg-context-output-file context) - (file-exists-p (epg-context-output-file context))) - (delete-file (epg-context-output-file context)))) - (eval-and-compile (if (fboundp 'decode-coding-string) (defalias 'epg--decode-coding-string 'decode-coding-string) @@ -833,7 +858,7 @@ callback data (if any)." (setq encoded-passphrase-with-new-line passphrase-with-new-line passphrase-with-new-line nil)) - (process-send-string (epg-context-process context) + (process-send-string (epg-context-command-process context) encoded-passphrase-with-new-line))) (quit (epg-context-set-result-for @@ -870,8 +895,8 @@ callback data (if any)." (if (funcall (or (intern-soft (concat "epg--prompt-GET_BOOL-" string)) #'epg--prompt-GET_BOOL) context string) - (process-send-string (epg-context-process context) "y\n") - (process-send-string (epg-context-process context) "n\n")) + (process-send-string (epg-context-command-process context) "y\n") + (process-send-string (epg-context-command-process context) "n\n")) (quit (epg-context-set-result-for context 'error @@ -883,7 +908,7 @@ callback data (if any)." (let ((entry (assoc string epg-prompt-alist)) inhibit-quit) (condition-case nil - (process-send-string (epg-context-process context) + (process-send-string (epg-context-command-process context) (concat (read-string (if entry (cdr entry) @@ -1469,8 +1494,8 @@ You can then use `write-region' to write new data into the file." notations))) (defun epg-cancel (context) - (if (buffer-live-p (process-buffer (epg-context-process context))) - (with-current-buffer (process-buffer (epg-context-process context)) + (if (buffer-live-p (process-buffer (epg-context-status-process context))) + (with-current-buffer (process-buffer (epg-context-status-process context)) (epg-context-set-result-for epg-context 'error (cons '(quit) @@ -1480,18 +1505,23 @@ You can then use `write-region' to write new data into the file." (defun epg-start-decrypt (context cipher) "Initiate a decrypt operation on CIPHER. -CIPHER must be a file data object. +CIPHER must be a data object. If you use this function, you will need to wait for the completion of `epg-gpg-program' by using `epg-wait-for-completion' and call `epg-reset' to clear a temporary output file. If you are unsure, use synchronous version of this function `epg-decrypt-file' or `epg-decrypt-string' instead." - (unless (epg-data-file cipher) - (error "Not a file")) (setf (epg-context-operation context) 'decrypt) (setf (epg-context-result context) nil) - (epg--start context (list "--decrypt" "--" (epg-data-file cipher))) + (if (epg-data-file cipher) + (epg--start context (list "--decrypt" "--" (epg-data-file cipher))) + (epg--start context (list "--decrypt")) + (if (eq (process-status (epg-context-process context)) 'run) + (process-send-string (epg-context-process context) + (epg-data-string cipher))) + (if (eq (process-status (epg-context-process context)) 'run) + (process-send-eof (epg-context-process context)))) ;; `gpgsm' does not read passphrase from stdin, so waiting is not needed. (unless (eq (epg-context-protocol context) 'CMS) (epg-wait-for-status context '("BEGIN_DECRYPTION")))) @@ -1510,33 +1540,22 @@ If you are unsure, use synchronous version of this function If PLAIN is nil, it returns the result as a string." (unwind-protect (progn - (setf (epg-context-output-file context) - (or plain (epg--make-temp-file "epg-output"))) (epg-start-decrypt context (epg-make-data-from-file cipher)) (epg-wait-for-completion context) (epg--check-error-for-decrypt context) (unless plain (epg-read-output context))) - (unless plain - (epg-delete-output-file context)) (epg-reset context))) (defun epg-decrypt-string (context cipher) "Decrypt a string CIPHER and return the plain text." - (let ((input-file (epg--make-temp-file "epg-input")) - (coding-system-for-write 'binary)) + (let ((coding-system-for-write 'binary)) (unwind-protect (progn - (write-region cipher nil input-file nil 'quiet) - (setf (epg-context-output-file context) - (epg--make-temp-file "epg-output")) - (epg-start-decrypt context (epg-make-data-from-file input-file)) + (epg-start-decrypt context (epg-make-data-from-string cipher)) (epg-wait-for-completion context) (epg--check-error-for-decrypt context) (epg-read-output context)) - (epg-delete-output-file context) - (if (file-exists-p input-file) - (delete-file input-file)) (epg-reset context)))) (defun epg-start-verify (context signature &optional signed-text) @@ -1599,8 +1618,6 @@ To check the verification results, use `epg-context-result-for' as follows: which will return a list of `epg-signature' object." (unwind-protect (progn - (setf (epg-context-output-file context) - (or plain (epg--make-temp-file "epg-output"))) (if signed-text (epg-start-verify context (epg-make-data-from-file signature) @@ -1610,8 +1627,6 @@ which will return a list of `epg-signature' object." (epg-wait-for-completion context) (unless plain (epg-read-output context))) - (unless plain - (epg-delete-output-file context)) (epg-reset context))) (defun epg-verify-string (context signature &optional signed-text) @@ -1636,8 +1651,6 @@ which will return a list of `epg-signature' object." input-file) (unwind-protect (progn - (setf (epg-context-output-file context) - (epg--make-temp-file "epg-output")) (if signed-text (progn (setq input-file (epg--make-temp-file "epg-signature")) @@ -1648,7 +1661,6 @@ which will return a list of `epg-signature' object." (epg-start-verify context (epg-make-data-from-string signature))) (epg-wait-for-completion context) (epg-read-output context)) - (epg-delete-output-file context) (if (and input-file (file-exists-p input-file)) (delete-file input-file)) @@ -1707,8 +1719,6 @@ If it is nil or 'normal, it makes a normal signature. Otherwise, it makes a cleartext signature." (unwind-protect (progn - (setf (epg-context-output-file context) - (or signature (epg--make-temp-file "epg-output"))) (epg-start-sign context (epg-make-data-from-file plain) mode) (epg-wait-for-completion context) (unless (epg-context-result-for context 'sign) @@ -1717,8 +1727,6 @@ Otherwise, it makes a cleartext signature." (list "Sign failed" (epg-errors-to-string errors))))) (unless signature (epg-read-output context))) - (unless signature - (epg-delete-output-file context)) (epg-reset context))) (defun epg-sign-string (context plain &optional mode) @@ -1737,8 +1745,6 @@ Otherwise, it makes a cleartext signature." (coding-system-for-write 'binary)) (unwind-protect (progn - (setf (epg-context-output-file context) - (epg--make-temp-file "epg-output")) (if input-file (write-region plain nil input-file nil 'quiet)) (epg-start-sign context @@ -1753,7 +1759,6 @@ Otherwise, it makes a cleartext signature." (signal 'epg-error (list "Sign failed" (epg-errors-to-string errors)))))) (epg-read-output context)) - (epg-delete-output-file context) (if input-file (delete-file input-file)) (epg-reset context)))) @@ -1814,8 +1819,6 @@ If CIPHER is nil, it returns the result as a string. If RECIPIENTS is nil, it performs symmetric encryption." (unwind-protect (progn - (setf (epg-context-output-file context) - (or cipher (epg--make-temp-file "epg-output"))) (epg-start-encrypt context (epg-make-data-from-file plain) recipients sign always-trust) (epg-wait-for-completion context) @@ -1829,8 +1832,6 @@ If RECIPIENTS is nil, it performs symmetric encryption." (list "Encrypt failed" (epg-errors-to-string errors))))) (unless cipher (epg-read-output context))) - (unless cipher - (epg-delete-output-file context)) (epg-reset context))) (defun epg-encrypt-string (context plain recipients @@ -1849,8 +1850,6 @@ If RECIPIENTS is nil, it performs symmetric encryption." (coding-system-for-write 'binary)) (unwind-protect (progn - (setf (epg-context-output-file context) - (epg--make-temp-file "epg-output")) (if input-file (write-region plain nil input-file nil 'quiet)) (epg-start-encrypt context @@ -1868,7 +1867,6 @@ If RECIPIENTS is nil, it performs symmetric encryption." (signal 'epg-error (list "Encrypt failed" (epg-errors-to-string errors))))) (epg-read-output context)) - (epg-delete-output-file context) (if input-file (delete-file input-file)) (epg-reset context)))) @@ -1894,8 +1892,6 @@ If you are unsure, use synchronous version of this function "Extract public KEYS." (unwind-protect (progn - (setf (epg-context-output-file context) - (or file (epg--make-temp-file "epg-output"))) (epg-start-export-keys context keys) (epg-wait-for-completion context) (let ((errors (epg-context-result-for context 'error))) @@ -1905,8 +1901,6 @@ If you are unsure, use synchronous version of this function (epg-errors-to-string errors))))) (unless file (epg-read-output context))) - (unless file - (epg-delete-output-file context)) (epg-reset context))) (defun epg-export-keys-to-string (context keys) -- 2.1.0 --=-=-=--