mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-12 12:21:15 -08:00
Implement RUN-PROGRAM for Windows
This commit is contained in:
jjgarcia
parent
a14b12704b
commit
f96d87cf6c
2 changed files with 189 additions and 35 deletions
|
|
@ -1454,9 +1454,7 @@ cl_symbols[] = {
|
|||
{MP_ "WITHOUT-INTERRUPTS", MP_CONSTANT, NULL, -1, OBJNULL},
|
||||
#endif
|
||||
|
||||
#ifndef mingw32
|
||||
{EXT_ "RUN-PROGRAM", SI_ORDINARY, si_run_program, -1, OBJNULL},
|
||||
#endif
|
||||
|
||||
/* Tag for end of list */
|
||||
{NULL, CL_ORDINARY, NULL, -1, OBJNULL}};
|
||||
|
|
|
|||
222
src/c/unixsys.d
222
src/c/unixsys.d
|
|
@ -18,6 +18,12 @@
|
|||
#include <fcntl.h>
|
||||
#include "ecl.h"
|
||||
#include "internal.h"
|
||||
#ifdef mingw32
|
||||
#include "w32api.h"
|
||||
#include "wtypes.h"
|
||||
#include "winbase.h"
|
||||
#include "io.h"
|
||||
#endif
|
||||
|
||||
cl_object
|
||||
si_system(cl_object cmd)
|
||||
|
|
@ -69,18 +75,169 @@ si_close_pipe(cl_object stream)
|
|||
@(return)
|
||||
}
|
||||
|
||||
#ifndef mingw32
|
||||
@(defun ext::run-program (command argv &key (input @':stream') (output @':stream')
|
||||
(error @'nil'))
|
||||
cl_object input_pipe_read, input_pipe_write;
|
||||
cl_object output_pipe_read, output_pipe_write;
|
||||
int input_pipe[2], output_pipe[2];
|
||||
int child_stdin, child_stdout, child_stderr;
|
||||
(error @'t'))
|
||||
int parent_write = 0, parent_read = 0;
|
||||
int child_pid;
|
||||
cl_object stream_write;
|
||||
cl_object stream_read;
|
||||
@{
|
||||
command = cl_string(command);
|
||||
argv = cl_mapcar(2, @'string', argv);
|
||||
#ifdef mingw32
|
||||
{
|
||||
BOOL ok;
|
||||
STARTUPINFO st_info;
|
||||
PROCESS_INFORMATION pr_info;
|
||||
HANDLE child_stdout, child_stdin, child_stderr;
|
||||
HANDLE current = GetCurrentProcess();
|
||||
HANDLE saved_stdout, saved_stdin, saved_stderr;
|
||||
SECURITY_ATTRIBUTES attr;
|
||||
|
||||
/* Enclose each argument, as well as the file name
|
||||
in double quotes, to avoid problems when these
|
||||
arguments or file names have spaces */
|
||||
command =
|
||||
cl_format(4, Cnil,
|
||||
make_simple_string("~S~{ ~S~}"),
|
||||
command, argv);
|
||||
|
||||
attr.nLength = sizeof(SECURITY_ATTRIBUTES);
|
||||
attr.lpSecurityDescriptor = NULL;
|
||||
attr.bInheritHandle = TRUE;
|
||||
if (input == @':stream') {
|
||||
/* Creates a pipe that we can read from what the child
|
||||
writes to it. We duplicate one extreme of the pipe
|
||||
so that the child does not inherit it. */
|
||||
HANDLE tmp;
|
||||
ok = CreatePipe(&child_stdin, &tmp, &attr, 0);
|
||||
if (ok) {
|
||||
ok = DuplicateHandle(current, tmp, current,
|
||||
&tmp, 0, FALSE,
|
||||
DUPLICATE_CLOSE_SOURCE |
|
||||
DUPLICATE_SAME_ACCESS);
|
||||
if (ok) {
|
||||
parent_write = _open_osfhandle(tmp, _O_WRONLY | _O_TEXT);
|
||||
if (parent_write < 0)
|
||||
printf("open_osfhandle failed\n");
|
||||
}
|
||||
}
|
||||
} else if (input == @'t') {
|
||||
/* The child inherits a duplicate of our input
|
||||
handle. Creating a duplicate avoids problems when
|
||||
the child closes it */
|
||||
DuplicateHandle(current, GetStdHandle(STD_INPUT_HANDLE),
|
||||
current, &child_stdin, 0, TRUE,
|
||||
DUPLICATE_SAME_ACCESS);
|
||||
} else {
|
||||
child_stdin = NULL;
|
||||
/*child_stdin = open("/dev/null", O_RDONLY);*/
|
||||
}
|
||||
if (output == @':stream') {
|
||||
/* Creates a pipe that we can write to and the
|
||||
child reads from. We duplicate one extreme of the
|
||||
pipe so that the child does not inherit it. */
|
||||
HANDLE tmp;
|
||||
ok = CreatePipe(&tmp, &child_stdout, &attr, 0);
|
||||
if (ok) {
|
||||
ok = DuplicateHandle(current, tmp, current,
|
||||
&tmp, 0, FALSE,
|
||||
DUPLICATE_CLOSE_SOURCE |
|
||||
DUPLICATE_SAME_ACCESS);
|
||||
if (ok) {
|
||||
parent_read = _open_osfhandle(tmp, _O_RDONLY | _O_TEXT);
|
||||
if (parent_read < 0)
|
||||
printf("open_osfhandle failed\n");
|
||||
}
|
||||
}
|
||||
} else if (output == @'t') {
|
||||
/* The child inherits a duplicate of our output
|
||||
handle. Creating a duplicate avoids problems when
|
||||
the child closes it */
|
||||
DuplicateHandle(current, GetStdHandle(STD_OUTPUT_HANDLE),
|
||||
current, &child_stdout, 0, TRUE,
|
||||
DUPLICATE_SAME_ACCESS);
|
||||
} else {
|
||||
child_stdout = NULL;
|
||||
/*child_stdout = open("/dev/null", O_WRONLY);*/
|
||||
}
|
||||
if (error == @':output') {
|
||||
/* The child inherits a duplicate of its own output
|
||||
handle.*/
|
||||
DuplicateHandle(current, child_stdout, current,
|
||||
&child_stderr, 0, TRUE,
|
||||
DUPLICATE_SAME_ACCESS);
|
||||
} else if (error == @'t') {
|
||||
/* The child inherits a duplicate of our output
|
||||
handle. Creating a duplicate avoids problems when
|
||||
the child closes it */
|
||||
DuplicateHandle(current, GetStdHandle(STD_ERROR_HANDLE),
|
||||
current, &child_stderr, 0, TRUE,
|
||||
DUPLICATE_SAME_ACCESS);
|
||||
} else {
|
||||
child_stderr = NULL;
|
||||
/*child_stderr = open("/dev/null", O_WRONLY);*/
|
||||
}
|
||||
#if 1
|
||||
ZeroMemory(&st_info, sizeof(STARTUPINFO));
|
||||
st_info.cb = sizeof(STARTUPINFO);
|
||||
st_info.lpTitle = NULL; /* No window title, just exec name */
|
||||
st_info.dwFlags = STARTF_USESTDHANDLES; /* Specify std{in,out,err} */
|
||||
st_info.hStdInput = child_stdin;
|
||||
st_info.hStdOutput = child_stdout;
|
||||
st_info.hStdError = child_stderr;
|
||||
ZeroMemory(&pr_info, sizeof(PROCESS_INFORMATION));
|
||||
ok = CreateProcess(NULL, command->string.self,
|
||||
NULL, NULL, /* lpProcess/ThreadAttributes */
|
||||
TRUE, /* Inherit handles (for files) */
|
||||
/*CREATE_NEW_CONSOLE |*/
|
||||
0,
|
||||
NULL, /* Inherit environment */
|
||||
NULL, /* Current directory */
|
||||
&st_info, /* Startup info */
|
||||
&pr_info); /* Process info */
|
||||
#else
|
||||
saved_stdin = GetStdHandle(STD_INPUT_HANDLE);
|
||||
saved_stdout = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||
saved_stderr = GetStdHandle(STD_ERROR_HANDLE);
|
||||
SetStdHandle(STD_INPUT_HANDLE, child_stdin);
|
||||
SetStdHandle(STD_OUTPUT_HANDLE, child_stdout);
|
||||
SetStdHandle(STD_ERROR_HANDLE, child_stderr);
|
||||
ZeroMemory(&st_info, sizeof(STARTUPINFO));
|
||||
st_info.cb = sizeof(STARTUPINFO);
|
||||
ZeroMemory(&pr_info, sizeof(PROCESS_INFORMATION));
|
||||
ok = CreateProcess(NULL, command->string.self,
|
||||
NULL, NULL, /* lpProcess/ThreadAttributes */
|
||||
TRUE, /* Inherit handles (for files) */
|
||||
/*CREATE_NEW_CONSOLE |*/
|
||||
0,
|
||||
NULL, /* Inherit environment */
|
||||
NULL, /* Current directory */
|
||||
&st_info, /* Startup info */
|
||||
&pr_info); /* Process info */
|
||||
SetStdHandle(STD_INPUT_HANDLE, saved_stdin);
|
||||
SetStdHandle(STD_OUTPUT_HANDLE, saved_stdout);
|
||||
SetStdHandle(STD_ERROR_HANDLE, saved_stderr);
|
||||
#endif
|
||||
if (ok) {
|
||||
CloseHandle(pr_info.hProcess);
|
||||
CloseHandle(pr_info.hThread);
|
||||
child_pid = pr_info.dwProcessId;
|
||||
} else {
|
||||
const char *message;
|
||||
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
|
||||
FORMAT_MESSAGE_ALLOCATE_BUFFER,
|
||||
0, GetLastError(), 0, (void*)&message, 0, NULL);
|
||||
printf("%s\n", message);
|
||||
LocalFree(message);
|
||||
child_pid = -1;
|
||||
}
|
||||
}
|
||||
#else
|
||||
{
|
||||
int child_pid;
|
||||
argv = CONS(command, nconc(argv, CONS(Cnil, Cnil)));
|
||||
argv = cl_funcall(3, @'coerce', argv, @'vector');
|
||||
if (input == @':stream') {
|
||||
int fd[2];
|
||||
pipe(fd);
|
||||
|
|
@ -108,10 +265,6 @@ si_close_pipe(cl_object stream)
|
|||
} else {
|
||||
child_stderr = open("/dev/null", O_WRONLY);
|
||||
}
|
||||
command = cl_string(command);
|
||||
argv = cl_mapcar(2, @'string', argv);
|
||||
argv = CONS(command, nconc(argv, CONS(Cnil, Cnil)));
|
||||
argv = cl_funcall(3, @'coerce', argv, @'vector');
|
||||
child_pid = fork();
|
||||
if (child_pid == 0) {
|
||||
/* Child */
|
||||
|
|
@ -133,34 +286,37 @@ si_close_pipe(cl_object stream)
|
|||
argv_ptr[j] = arg->string.self;
|
||||
}
|
||||
}
|
||||
if (execvp(command->string.self, (const char **)argv_ptr) < 0) {
|
||||
if (execvp(command, argv_ptr) < 0) {
|
||||
abort();
|
||||
}
|
||||
}
|
||||
close(child_stdin);
|
||||
close(child_stdout);
|
||||
close(child_stderr);
|
||||
}
|
||||
#endif
|
||||
if (child_pid < 0) {
|
||||
if (parent_write) close(parent_write);
|
||||
if (parent_read) close(parent_read);
|
||||
parent_write = 0;
|
||||
parent_read = 0;
|
||||
FEerror("Could not spawn subprocess to run ~S.", 1, command);
|
||||
}
|
||||
if (parent_write > 0) {
|
||||
stream_write = ecl_make_stream_from_fd(command, parent_write,
|
||||
smm_output);
|
||||
} else {
|
||||
/* Parent */
|
||||
close(child_stdin);
|
||||
close(child_stdout);
|
||||
close(child_stderr);
|
||||
if (child_pid < 0) {
|
||||
if (parent_write) close(parent_write);
|
||||
if (parent_read) close(parent_read);
|
||||
FEerror("Could not spawn subprocess to run ~S.", 1, command);
|
||||
}
|
||||
if (parent_write) {
|
||||
stream_write = ecl_make_stream_from_fd(command, parent_write,
|
||||
smm_output);
|
||||
} else {
|
||||
stream_write = cl_core.null_stream;
|
||||
}
|
||||
if (parent_read) {
|
||||
stream_read = ecl_make_stream_from_fd(command, parent_read,
|
||||
smm_input);
|
||||
} else {
|
||||
stream_read = cl_core.null_stream;
|
||||
}
|
||||
parent_write = 0;
|
||||
stream_write = cl_core.null_stream;
|
||||
}
|
||||
if (parent_read > 0) {
|
||||
stream_read = ecl_make_stream_from_fd(command, parent_read,
|
||||
smm_input);
|
||||
} else {
|
||||
parent_read = 0;
|
||||
stream_read = cl_core.null_stream;
|
||||
}
|
||||
@(return ((parent_read || parent_write)?
|
||||
make_two_way_stream(stream_read, stream_write) :
|
||||
Cnil))
|
||||
@)
|
||||
#endif
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue