master d28b004: Add a module function to open a file descriptor connected to a pipe.

[Philipp Stephani]

branch: master
commit d28b00476890f791a89b65007e5f20682b3eaa0d
Author: Philipp Stephani <address@hidden>
Commit: Philipp Stephani <address@hidden>

    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.
---
 doc/lispref/internals.texi        | 14 ++++++++++
 doc/lispref/processes.texi        |  1 +
 etc/NEWS                          |  4 +++
 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 ++++++++++
 9 files changed, 114 insertions(+), 2 deletions(-)

diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi
index 442f6d1..0c24dac 100644
--- a/doc/lispref/internals.texi
+++ b/doc/lispref/internals.texi
@@ -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
diff --git a/doc/lispref/processes.texi b/doc/lispref/processes.texi
index f515213..14cd079 100644
--- a/doc/lispref/processes.texi
+++ b/doc/lispref/processes.texi
@@ -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
diff --git a/etc/NEWS b/etc/NEWS
index 910d9fa..a2cb4b0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -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.
 
diff --git a/src/emacs-module.c b/src/emacs-module.c
index 60f1641..cdcbe06 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -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;
 }
diff --git a/src/module-env-28.h b/src/module-env-28.h
index a2479a8..5d884c1 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 e4e5e57..07881d6 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;
+}
+
 
 /* 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);
diff --git a/src/process.h b/src/process.h
index 7884efc..a783a31 100644
--- a/src/process.h
+++ b/src/process.h
@@ -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 */
diff --git a/test/data/emacs-module/mod-test.c 
b/test/data/emacs-module/mod-test.c
index ec69489..61733f1 100644
--- a/test/data/emacs-module/mod-test.c
+++ b/test/data/emacs-module/mod-test.c
@@ -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
 
diff --git a/test/src/emacs-module-tests.el b/test/src/emacs-module-tests.el
index 48d2e86..1f91795 100644
--- a/test/src/emacs-module-tests.el
+++ b/test/src/emacs-module-tests.el
@@ -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