[Help-smalltalk] [PATCH] osprocess: Introduce a simple sub-process package

[Holger Hans Peter Freyther]

From: Holger Hans Peter Freyther <address@hidden>

The >>#popen: code does not return the pid which makes shutting down
the forked process quite difficult. Introduce a sub-process package
that can be used to fork, kill and read from the stdout/stdin.

This package should be more deeply integrated with the sysdep layer,
e.g. it assumes that SIGCHLD, SIGFPE is handled by sysdep (e.g. a
popen was previously used). It would be nice if one could have a Sempahore
for the SIGCHLD like one has with the fileOp: operations.

2012-12-28  Holger Freyther  <address@hidden>

        * configure.ac: Add a OSProcess package.
---
 ChangeLog                            |    4 +
 configure.ac                         |    1 +
 packages/osprocess/ChangeLog         |    6 ++
 packages/osprocess/Makefile.am       |   10 +++
 packages/osprocess/Makefile.frag     |    5 ++
 packages/osprocess/OSProcess.st      |  156 ++++++++++++++++++++++++++++++++++
 packages/osprocess/OSProcessTests.st |    7 ++
 packages/osprocess/gst_osprocess.c   |  153 +++++++++++++++++++++++++++++++++
 packages/osprocess/package.xml       |   14 +++
 9 files changed, 356 insertions(+)
 create mode 100644 packages/osprocess/ChangeLog
 create mode 100644 packages/osprocess/Makefile.am
 create mode 100644 packages/osprocess/Makefile.frag
 create mode 100644 packages/osprocess/OSProcess.st
 create mode 100644 packages/osprocess/OSProcessTests.st
 create mode 100644 packages/osprocess/gst_osprocess.c
 create mode 100644 packages/osprocess/package.xml

diff --git a/ChangeLog b/ChangeLog
index ec896ef..f129065 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,7 @@
+2012-12-28  Holger Freyther  <address@hidden>
+
+       * configure.ac: Add a OSProcess package.
+
 2013-03-30  Holger Hans Peter Freyther  <address@hidden>
 
        * configure.ac: Introduce the Tooling package.
diff --git a/configure.ac b/configure.ac
index d58028a..fbf1ce9 100644
--- a/configure.ac
+++ b/configure.ac
@@ -576,6 +576,7 @@ GST_PACKAGE_ENABLE([Compiler], [stinst/compiler])
 GST_PACKAGE_ENABLE([Parser], [stinst/parser])
 GST_PACKAGE_ENABLE([ClassPublisher], [stinst/doc])
 GST_PACKAGE_ENABLE([ProfileTools], [profile])
+GST_PACKAGE_ENABLE([OSProcess], [osprocess], [], [], [Makefile], 
[gst-osprocess.la])
 GST_PACKAGE_ENABLE([ROE], [roe])
 GST_PACKAGE_ENABLE([SandstoneDb], [sandstonedb])
 GST_PACKAGE_ENABLE([Seaside-Core], [seaside/core])
diff --git a/packages/osprocess/ChangeLog b/packages/osprocess/ChangeLog
new file mode 100644
index 0000000..ce36962
--- /dev/null
+++ b/packages/osprocess/ChangeLog
@@ -0,0 +1,6 @@
+2012-12-27  Holger Hans Peter Freyther  <address@hidden>
+
+       * Makefile.am: Add.
+       * package.xml: Likewise.
+       * OSProcess.st: Likewise.
+       * gst_osprocess.c: Likewise.
diff --git a/packages/osprocess/Makefile.am b/packages/osprocess/Makefile.am
new file mode 100644
index 0000000..dfd78ce
--- /dev/null
+++ b/packages/osprocess/Makefile.am
@@ -0,0 +1,10 @@
+moduleexec_LTLIBRARIES = gst-osprocess.la
+
+AM_CPPFLAGS = -I$(top_srcdir)/libgst -I$(top_srcdir)/lib-src
+
+gst_module_ldflags = -rpath $(moduleexecdir) -release $(VERSION) -module \
+        -no-undefined -export-symbols-regex gst_initModule
+
+gst_osprocess_la_SOURCES = gst_osprocess.c
+gst_osprocess_la_LDFLAGS = $(gst_module_ldflags)
+
diff --git a/packages/osprocess/Makefile.frag b/packages/osprocess/Makefile.frag
new file mode 100644
index 0000000..94a75cf
--- /dev/null
+++ b/packages/osprocess/Makefile.frag
@@ -0,0 +1,5 @@
+OSProcess_FILES = \
+packages/osprocess/OSProcess.st packages/osprocess/ChangeLog 
packages/osprocess/OSProcessTests.st 
+$(OSProcess_FILES):
+$(srcdir)/packages/osprocess/stamp-classes: $(OSProcess_FILES)
+       touch $(srcdir)/packages/osprocess/stamp-classes
diff --git a/packages/osprocess/OSProcess.st b/packages/osprocess/OSProcess.st
new file mode 100644
index 0000000..c440e0c
--- /dev/null
+++ b/packages/osprocess/OSProcess.st
@@ -0,0 +1,156 @@
+"=====================================================================
+|
+|   External OSProcess handling
+|
+|
+ ======================================================================"
+
+"======================================================================
+|
+| Copyright 2012 Free Software Foundation, Inc.
+| Written by Holger Hans Peter Freyther
+| baesed on work by Gwenael Casaccio
+|
+| This file is part of the GNU Smalltalk class library.
+|
+| The GNU Smalltalk class library is free software; you can redistribute it
+| and/or modify it under the terms of the GNU Lesser General Public License
+| as published by the Free Software Foundation; either version 2.1, or (at
+| your option) any later version.
+| 
+| The GNU Smalltalk class library is distributed in the hope that it will be
+| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
+| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
+| General Public License for more details.
+| 
+| You should have received a copy of the GNU Lesser General Public License
+| along with the GNU Smalltalk class library; see the file COPYING.LIB.
+| If not, write to the Free Software Foundation, 59 Temple Place - Suite
+| 330, Boston, MA 02110-1301, USA.  
+|
+ ======================================================================"
+
+Object subclass: OSProcess [
+    | pid stdin stdout |
+    <category: 'OSProcess'>
+
+    OSProcess class >> fileDescriptorFamily [
+       <category: 'stream-family'>
+       ^ FileStream
+    ]
+
+    OSProcess class >> SIGINT [
+       <category: 'signals'>
+       ^ 2
+    ]
+
+    OSProcess class >> SIGKILL [
+       <category: 'signals'>
+       ^ 9
+    ]
+
+    OSProcess class >> kill: pid signal: asig [
+       <category: 'syscall'>
+       <cCall: 'kill' returning: #long args: #(#long #int)>
+    ]
+
+    OSProcess class >> waitpid: pid status: anIntPtr options: anInteger [
+       <category: 'syscall'>
+       <cCall: 'waitpid' returning: #long args: #(#long (#ptr #int) #int)>
+    ]
+
+    OSProcess class >> getpid [
+       <category: 'syscall'>
+       <cCall: 'getpid' returning: #long args: #()>
+    ]
+
+    OSProcess class >> getppid [
+       <category: 'syscall'>
+       <cCall: 'getppid' returning: #long args: #()>
+    ]
+
+    OSProcess class >> internalFork: command args: args stdin: outIn stdout: 
outOut [
+       <cCall: 'gst_osprocess_fork_and_exec' returning: #int args: #(#self 
#string (#ptr #string) #smalltalk #smalltalk #smalltalk)>
+    ]
+
+    OSProcess class >> forkAndExec: command args: args [
+       | argv i res pid in out|
+       <category: 'exec'>
+
+       "From ThisOSOSProcess. Make sure the last item is null terminated"
+       argv := (CStringType arrayType: args size + 2) gcNew.
+       argv at: 0 put: command.
+
+       "Add all arguments"
+       i := 1.
+       args do: [:arg |
+           argv at: i put: arg.
+           i := i + 1].
+
+       "Null terminate.. once more"
+       argv at: i put: nil.
+
+       "Fork now and get things out of the call."
+       in := self fileDescriptorFamily new.
+       out := self fileDescriptorFamily new.
+       pid := self internalFork: command args: argv
+                   stdin: in stdout: out.
+       pid < 0
+           ifTrue: [^self error: 'Failed to fork the process'].
+
+       "Initialize the sockets, the fds were set inside the fork"
+       in initialize.
+       out initialize.
+
+       ^ OSProcess new
+           stdin: in;
+           stdout: out;
+           pid: pid;
+           yourself.
+    ]
+
+    stdin: aStd [
+       <category: 'creation'>
+       stdin := aStd.
+    ]
+
+    stdout: aStd [
+       <category: 'creation'>
+       stdout := aStd.
+    ]
+
+    pid: aPid [
+       <category: 'creation'>
+       pid := aPid.
+    ]
+
+    stdin [
+       <category: 'stream'>
+       ^ stdin
+    ]
+
+    stdout [
+       <category: 'stream'>
+       ^ stdout
+    ]
+
+    kill [
+       <category: 'termination'>
+       ^ self sendSignal: self class SIGKILL.
+    ]
+
+    sendSignal: aSig [
+       <category: 'termination'>
+       ^ self class kill: pid signal: aSig.
+    ]
+
+    close [
+       stdin close.
+       stdout close.
+    ]
+]
+
+Eval [
+    "Install SIGCHLD handler..."
+    (FileStream popen: '/bin/true' dir: FileDescriptor read) close.
+]
diff --git a/packages/osprocess/OSProcessTests.st 
b/packages/osprocess/OSProcessTests.st
new file mode 100644
index 0000000..d858552
--- /dev/null
+++ b/packages/osprocess/OSProcessTests.st
@@ -0,0 +1,7 @@
+Eval [
+PackageLoader fileInPackage: #OSProcess.
+[
+       (OSProcess.OSProcess forkAndExec: 'ls' args: #('/')) inspect; close.
+       stdin next.
+] repeat.
+]
diff --git a/packages/osprocess/gst_osprocess.c 
b/packages/osprocess/gst_osprocess.c
new file mode 100644
index 0000000..b3f7316
--- /dev/null
+++ b/packages/osprocess/gst_osprocess.c
@@ -0,0 +1,153 @@
+/******************************* -*- C -*- ****************************
+ *
+ *      Subprocess handling
+ *
+ *
+ ***********************************************************************/
+/***********************************************************************
+ *
+ * Copyright 2012 Free Software Foundation, Inc.
+ * Written by Holger Hans Peter Freyther.
+ *
+ * Forking code from libgst/sysdep/posix/files.c:
+ * Copyright 1988,89,90,91,92,94,95,99,2000,2001,2002,2003,2006,2007,2008,2009
+ *
+ * This file is part of GNU Smalltalk.
+ *
+ * GNU Smalltalk is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU General Public License as published by the Free
+ * Software Foundation; either version 2, or (at your option) any later
+ * version.
+ *
+ * Linking GNU Smalltalk statically or dynamically with other modules is
+ * making a combined work based on GNU Smalltalk.  Thus, the terms and
+ * conditions of the GNU General Public License cover the whole
+ * combination.
+ *
+ * In addition, as a special exception, the Free Software Foundation
+ * give you permission to combine GNU Smalltalk with free software
+ * programs or libraries that are released under the GNU LGPL and with
+ * independent programs running under the GNU Smalltalk virtual machine.
+ *
+ * You may copy and distribute such a system following the terms of the
+ * GNU GPL for GNU Smalltalk and the licenses of the other code
+ * concerned, provided that you include the source code of that other
+ * code when and as the GNU GPL requires distribution of source code.
+ *
+ * Note that people who make modified versions of GNU Smalltalk are not
+ * obligated to grant this special exception for their modified
+ * versions; it is their choice whether to do so.  The GNU General
+ * Public License gives permission to release a modified version without
+ * this exception; this exception also makes it possible to release a
+ * modified version which carries forward this exception.
+ *
+ * GNU Smalltalk is distributed in the hope that it will be useful, but WITHOUT
+ * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ * FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for
+ * more details.
+ *
+ * You should have received a copy of the GNU General Public License along with
+ * GNU Smalltalk; see the file COPYING.  If not, write to the Free Software
+ * Foundation, 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
+ *
+ ***********************************************************************/
+
+#include "gstpub.h"
+
+#include <sys/types.h>          /* See NOTES */
+#include <sys/socket.h>
+
+#include <errno.h>
+#include <unistd.h>
+
+static VMProxy *vmProxy;
+
+typedef struct st_OSProcess {
+  OBJ_HEADER;
+  OOP pid;
+  OOP _stdin;
+  OOP _stdout;
+} *OSProcess;
+
+static pid_t
+gst_fork_and_exec (OOP self, const char *cmd, char * const argv[], OOP in, OOP 
out)
+{
+  /*
+   * TODO: The SIGCHLD handler needs to be installed by gst! It is depending
+   * on various usages!
+   *
+   * The whole code should be moved into the sysdeps and use waitpid with a
+   * queue like done for file-io to raise a semaphore once a process has
+   * entered.
+   * The forking code is taken from sysdep/posix/files.c
+   */
+
+  int stdin_pipe[2];
+  int stdout_pipe[2];
+
+  int result;
+
+  result = socketpair (AF_UNIX, SOCK_STREAM, 0, stdin_pipe);
+  if (result == -1)
+    return -1;
+  result = socketpair (AF_UNIX, SOCK_STREAM, 0, stdout_pipe);
+  if (result == -1) {
+    close(stdin_pipe[0]);
+    close(stdin_pipe[1]);
+    return -1;
+  }
+
+  /* TODO: create a pipe with close on exec to check if the process runs? */
+
+  /* We suppose it is a system that has fork.  */
+  result = fork ();
+  if (result == 0)
+    {
+      /* Child process */
+      close (stdin_pipe[0]);
+      close (stdout_pipe[0]);
+
+      /* Setup file descriptor */
+      dup2 (stdin_pipe[1], STDIN_FILENO);
+      dup2 (stdout_pipe[1], STDOUT_FILENO);
+      close (stdin_pipe[1]);
+      close (stdout_pipe[1]);
+
+      /* stderr is still going to the main stream */
+      /* close other fds? */
+
+      execvp(cmd, argv);
+
+      _exit (-1);
+      /*NOTREACHED*/
+    }
+
+  /* now close the client side of the socket.. */
+  close (stdin_pipe[1]);
+  close (stdout_pipe[1]);
+
+  if (result == -1)
+    {
+      int save_errno;
+      save_errno = errno;
+      /* forking failed */
+      close (stdin_pipe[0]);
+      close (stdout_pipe[0]);
+      errno = save_errno;
+      return (-1);
+    }
+
+
+    /* trying to return information */
+    vmProxy->strMsgSend(in, "setFD:", vmProxy->intToOOP(stdin_pipe[0]), NULL);
+    vmProxy->strMsgSend(out, "setFD:", vmProxy->intToOOP(stdout_pipe[0]), 
NULL);
+    return result;
+}
+
+void
+gst_initModule (VMProxy * proxy)
+
+{
+  vmProxy = proxy;
+  vmProxy->defineCFunc ("gst_osprocess_fork_and_exec", gst_fork_and_exec);
+}
diff --git a/packages/osprocess/package.xml b/packages/osprocess/package.xml
new file mode 100644
index 0000000..2c85f93
--- /dev/null
+++ b/packages/osprocess/package.xml
@@ -0,0 +1,14 @@
+<package>
+  <name>OSProcess</name>
+  <namespace>OSProcess</namespace>
+  <module>gst-osprocess</module>
+
+  <test>
+    <sunit>OSProcess.ProcessTest</sunit>
+    <filein>OSProcessTests.st</filein>
+  </test>
+
+  <filein>OSProcess.st</filein>
+
+  <file>ChangeLog</file>
+</package>
-- 
1.7.10.4