Commit d28b0047 authored by Philipp Stephani's avatar Philipp Stephani

Add a module function to open a file descriptor connected to a pipe.

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.

* etc/NEWS: Document 'open_channel' function.
parent 934b3c9e
Pipeline #5092 passed with stage
in 56 minutes and 17 seconds
......@@ -2022,6 +2022,20 @@ variable values and buffer content may have been modified in arbitrary
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
......
......@@ -743,6 +743,7 @@ Some file name handlers may not support @code{make-process}. In such
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
......
......@@ -258,6 +258,10 @@ called when the function object is garbage-collected. Use
'set_function_finalizer' to set the finalizer and
'get_function_finalizer' to retrieve it.
** Modules can now open a channel to an existing pipe process using
the new module function 'open_channel'. Modules can use this
functionality to asynchronously send data back to Emacs.
** 'file-modes', 'set-file-modes', and 'set-file-times' now have an
optional argument specifying whether to follow symbolic links.
......
......@@ -88,6 +88,7 @@ To add a new module function, proceed as follows:
#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));
}
/* 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;
}
......
......@@ -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);
......@@ -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;
}
/* 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 @@ amounts of data in one go. */);
DEFSYM (Qinterrupt_process_functions, "interrupt-process-functions");
DEFSYM (Qnull, "null");
DEFSYM (Qpipe_process_p, "pipe-process-p");
defsubr (&Sprocessp);
defsubr (&Sget_process);
......
......@@ -300,6 +300,8 @@ extern Lisp_Object remove_slash_colon (Lisp_Object);
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 */
......@@ -30,6 +30,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#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 @@ emacs_module_init (struct emacs_runtime *ert)
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
......
......@@ -424,4 +424,18 @@ See Bug#36226."
;; 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment