From: Philipp Stephani <p.stephani2@gmail.com>
To: emacs-devel@gnu.org
Cc: Philipp Stephani <phst@google.com>
Subject: [PATCH] Add a module function to open a file descriptor connected to a pipe.
Date: Thu, 26 Mar 2020 17:30:21 +0100 [thread overview]
Message-ID: <20200326163021.111847-1-phst@google.com> (raw)
A common complaint about the module API is that modules can't
communicate asynchronously with Emacs. While it isn't possible to
call arbitrary Emacs functions asynchronously, writing to a pipe
should always be fine and is a pretty low-hanging fruit.
This patch implements a function that adapts an existing pipe
process. That way, users can use familiar tools like process filters
or 'accept-process-output'.
* src/module-env-28.h: Add 'open_channel' module function.
* src/emacs-module.c (module_open_channel): Provide definition for
'open_channel'.
(initialize_environment): Use it.
* src/process.c (open_channel_for_module): New helper function.
(syms_of_process): Define necessary symbol.
* test/src/emacs-module-tests.el (module/async-pipe): New unit test.
* test/data/emacs-module/mod-test.c (signal_system_error): New helper
function.
(signal_errno): Use it.
(write_to_pipe): New function running in the background.
(Fmod_test_async_pipe): New test module function.
(emacs_module_init): Export it.
* doc/lispref/internals.texi (Module Misc): Document new module
function.
* doc/lispref/processes.texi (Asynchronous Processes): New anchor
for pipe processes.
---
doc/lispref/internals.texi | 14 ++++++++
doc/lispref/processes.texi | 1 +
src/emacs-module.c | 9 +++++
src/module-env-28.h | 3 ++
src/process.c | 12 +++++++
src/process.h | 2 ++
test/data/emacs-module/mod-test.c | 57 +++++++++++++++++++++++++++++--
test/src/emacs-module-tests.el | 14 ++++++++
8 files changed, 110 insertions(+), 2 deletions(-)
diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index 442f6d156b..0c24dac777 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -2022,6 +2022,20 @@ Module Misc
ways.
@end deftypefn
+@anchor{open_channel}
+@deftypefun int open_channel (emacs_env *@var{env}, emacs_value @var{pipe_process})
+This function, which is available since Emacs 27, opens a channel to
+an existing pipe process. @var{pipe_process} must refer to an
+existing pipe process created by @code{make-pipe-process}. @ref{Pipe
+Processes}. If successful, the return value will be a new file
+descriptor that you can use to write to the pipe. Unlike all other
+module functions, you can use the returned file descriptor from
+arbitrary threads, even if no module environment is active. You can
+use the @code{write} function to write to the file descriptor. Once
+done, close the file descriptor using @code{close}. @ref{Low-Level
+I/O,,,libc}.
+@end deftypefun
+
@node Module Nonlocal
@subsection Nonlocal Exits in Modules
@cindex nonlocal exits, in modules
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index f515213615..14cd079c56 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -743,6 +743,7 @@ Asynchronous Processes
cases, this function does nothing and returns @code{nil}.
@end defun
+@anchor{Pipe Processes}
@defun make-pipe-process &rest args
This function creates a bidirectional pipe which can be attached to a
child process. This is useful with the @code{:stderr} keyword of
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 60f16418ef..cdcbe061b5 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -88,6 +88,7 @@ Copyright (C) 2015-2020 Free Software Foundation, Inc.
#include "dynlib.h"
#include "coding.h"
#include "keyboard.h"
+#include "process.h"
#include "syssignal.h"
#include "sysstdio.h"
#include "thread.h"
@@ -977,6 +978,13 @@ module_make_big_integer (emacs_env *env, int sign,
return lisp_to_value (env, make_integer_mpz ());
}
+static int
+module_open_channel (emacs_env *env, emacs_value pipe_process)
+{
+ MODULE_FUNCTION_BEGIN (-1);
+ return open_channel_for_module (value_to_lisp (pipe_process));
+}
+
\f
/* Subroutines. */
@@ -1391,6 +1399,7 @@ initialize_environment (emacs_env *env, struct emacs_env_private *priv)
env->make_big_integer = module_make_big_integer;
env->get_function_finalizer = module_get_function_finalizer;
env->set_function_finalizer = module_set_function_finalizer;
+ env->open_channel = module_open_channel;
Vmodule_environments = Fcons (make_mint_ptr (env), Vmodule_environments);
return env;
}
diff --git a/src/module-env-28.h b/src/module-env-28.h
index a2479a8f74..5d884c148c 100644
--- a/src/module-env-28.h
+++ b/src/module-env-28.h
@@ -9,3 +9,6 @@
void (*set_function_finalizer) (emacs_env *env, emacs_value arg,
void (*fin) (void *) EMACS_NOEXCEPT)
EMACS_ATTRIBUTE_NONNULL (1);
+
+ int (*open_channel) (emacs_env *env, emacs_value pipe_process)
+ EMACS_ATTRIBUTE_NONNULL (1);
diff --git a/src/process.c b/src/process.c
index e4e5e57aee..07881d6c5d 100644
--- a/src/process.c
+++ b/src/process.c
@@ -8200,6 +8200,17 @@ restore_nofile_limit (void)
#endif
}
+int
+open_channel_for_module (Lisp_Object process)
+{
+ CHECK_PROCESS (process);
+ CHECK_TYPE (PIPECONN_P (process), Qpipe_process_p, process);
+ int fd = dup (XPROCESS (process)->open_fd[SUBPROCESS_STDOUT]);
+ if (fd == -1)
+ report_file_error ("Cannot duplicate file descriptor", Qnil);
+ return fd;
+}
+
\f
/* This is not called "init_process" because that is the name of a
Mach system call, so it would cause problems on Darwin systems. */
@@ -8446,6 +8457,7 @@ syms_of_process (void)
DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions");
DEFSYM (Qnull, "null");
+ DEFSYM (Qpipe_process_p, "pipe-process-p");
defsubr (&Sprocessp);
defsubr (&Sget_process);
diff --git a/src/process.h b/src/process.h
index 7884efc549..a783a31cb8 100644
--- a/src/process.h
+++ b/src/process.h
@@ -300,6 +300,8 @@ pset_gnutls_cred_type (struct Lisp_Process *p, Lisp_Object val)
extern void update_processes_for_thread_death (Lisp_Object);
extern void dissociate_controlling_tty (void);
+extern int open_channel_for_module (Lisp_Object);
+
INLINE_HEADER_END
#endif /* EMACS_PROCESS_H */
diff --git a/test/data/emacs-module/mod-test.c b/test/data/emacs-module/mod-test.c
index ec6948921f..61733f1ef4 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -30,6 +30,9 @@
#include <string.h>
#include <time.h>
+#include <pthread.h>
+#include <unistd.h>
+
#ifdef HAVE_GMP
#include <gmp.h>
#else
@@ -320,9 +323,9 @@ Fmod_test_invalid_finalizer (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
}
static void
-signal_errno (emacs_env *env, const char *function)
+signal_system_error (emacs_env *env, int error, const char *function)
{
- const char *message = strerror (errno);
+ const char *message = strerror (error);
emacs_value message_value = env->make_string (env, message, strlen (message));
emacs_value symbol = env->intern (env, "file-error");
emacs_value elements[2]
@@ -331,6 +334,12 @@ signal_errno (emacs_env *env, const char *function)
env->non_local_exit_signal (env, symbol, data);
}
+static void
+signal_errno (emacs_env *env, const char *function)
+{
+ signal_system_error (env, errno, function);
+}
+
/* A long-running operation that occasionally calls `should_quit' or
`process_input'. */
@@ -533,6 +542,49 @@ Fmod_test_function_finalizer_calls (emacs_env *env, ptrdiff_t nargs,
return env->funcall (env, Flist, 2, list_args);
}
+static void *
+write_to_pipe (void *arg)
+{
+ /* We sleep a bit to test that writing to a pipe is indeed possible
+ if no environment is active. */
+ const struct timespec sleep = {0, 500000000};
+ if (nanosleep (&sleep, NULL) != 0)
+ perror ("nanosleep");
+ FILE *stream = arg;
+ if (fputs ("data from thread", stream) < 0)
+ perror ("fputs");
+ if (fclose (stream) != 0)
+ perror ("close");
+ return NULL;
+}
+
+static emacs_value
+Fmod_test_async_pipe (emacs_env *env, ptrdiff_t nargs, emacs_value *args,
+ void *data)
+{
+ assert (nargs == 1);
+ int fd = env->open_channel (env, args[0]);
+ if (env->non_local_exit_check (env) != emacs_funcall_exit_return)
+ return NULL;
+ FILE *stream = fdopen (fd, "w");
+ if (stream == NULL)
+ {
+ signal_errno (env, "fdopen");
+ return NULL;
+ }
+ pthread_t thread;
+ int error
+ = pthread_create (&thread, NULL, write_to_pipe, stream);
+ if (error != 0)
+ {
+ signal_system_error (env, error, "pthread_create");
+ if (fclose (stream) != 0)
+ perror ("fclose");
+ return NULL;
+ }
+ return env->intern (env, "nil");
+}
+
/* Lisp utilities for easier readability (simple wrappers). */
/* Provide FEATURE to Emacs. */
@@ -614,6 +666,7 @@ #define DEFUN(lsym, csym, amin, amax, doc, data) \
Fmod_test_make_function_with_finalizer, 0, 0, NULL, NULL);
DEFUN ("mod-test-function-finalizer-calls",
Fmod_test_function_finalizer_calls, 0, 0, NULL, NULL);
+ DEFUN ("mod-test-async-pipe", Fmod_test_async_pipe, 1, 1, NULL, NULL);
#undef DEFUN
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 48d2e86a60..1f91795e1e 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -424,4 +424,18 @@ module/function-finalizer
;; but at least one.
(should (> valid-after valid-before)))))
+(ert-deftest module/async-pipe ()
+ "Check that writing data from another thread works."
+ (with-temp-buffer
+ (let ((process (make-pipe-process :name "module/async-pipe"
+ :buffer (current-buffer)
+ :coding 'utf-8-unix
+ :noquery t)))
+ (unwind-protect
+ (progn
+ (mod-test-async-pipe process)
+ (should (accept-process-output process 1))
+ (should (equal (buffer-string) "data from thread")))
+ (delete-process process)))))
+
;;; emacs-module-tests.el ends here
--
2.25.1.696.g5e7596f4ac-goog
next reply other threads:[~2020-03-26 16:30 UTC|newest]
Thread overview: 3+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-03-26 16:30 Philipp Stephani [this message]
2020-03-26 19:00 ` [PATCH] Add a module function to open a file descriptor connected to a pipe Eli Zaretskii
2020-03-26 20:51 ` Philipp Stephani
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20200326163021.111847-1-phst@google.com \
--to=p.stephani2@gmail.com \
--cc=emacs-devel@gnu.org \
--cc=phst@google.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).