diff --git a/src/c/unixsys.d b/src/c/unixsys.d index 0e65d00b2..daed4a52e 100644 --- a/src/c/unixsys.d +++ b/src/c/unixsys.d @@ -404,6 +404,107 @@ ecl_stream_to_HANDLE(cl_object s, bool output) } #endif +#if defined(ECL_MS_WINDOWS_HOST) +static void +create_descriptor(cl_object stream, cl_object direction, + HANDLE *child, int *parent) { + SECURITY_ATTRIBUTES attr; + HANDLE current = GetCurrentProcess(); + attr.nLength = sizeof(SECURITY_ATTRIBUTES); + attr.lpSecurityDescriptor = NULL; + attr.bInheritHandle = TRUE; + + if (stream == @':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; + if (CreatePipe(&tmp, child, &attr, 0) == 0) + return; + + if (DuplicateHandle(current, tmp, current, + &tmp, 0, FALSE, + DUPLICATE_CLOSE_SOURCE | + DUPLICATE_SAME_ACCESS) == 0) + return; + + if (direction == @':input') { +#ifdef cygwin + *parent = cygwin_attach_handle_to_fd + (0, -1, tmp, S_IRWXU, GENERIC_WRITE); +#else + *parent = _open_osfhandle + ((intptr_t)tmp, _O_WRONLY); +#endif + } + else { +#ifdef cygwin + *parent = cygwin_attach_handle_to_fd + (0, -1, tmp, S_IRWXU, GENERIC_READ); +#else + *parent = _open_osfhandle + ((intptr_t)tmp, _O_RDONLY); +#endif + } + + if (*parent < 0) + printf("open_osfhandle failed\n"); + } + else if (Null(stream)) { + *child = NULL; + } + else if (!Null(cl_streamp(stream))) { + HANDLE stream_handle = ecl_stream_to_HANDLE + (stream, direction == @':output'); + if (stream_handle == INVALID_HANDLE_VALUE) { + FEerror(":INPUT argument to RUN-PROGRAM does not " + "have a file handle:~%~S", 1, stream); + } + DuplicateHandle(current, stream_handle, + current, child, 0, TRUE, + DUPLICATE_SAME_ACCESS); + } + else { + FEerror("Invalid ~S argument to EXT:RUN-PROGRAM", 1, stream); + } +} +#else +static void +create_descriptor(cl_object stream, cl_object direction, + int *child, int *parent) { + if (stream == @':stream') { + int fd[2]; + pipe(fd); + if (direction == @':input') { + *parent = fd[1]; + *child = fd[0]; + } else { + *parent = fd[0]; + *child = fd[1]; + } + } + else if (Null(stream)) { + if (direction == @':output') + *child = open("/dev/null", O_WRONLY); + else + *child = open("/dev/null", O_RDONLY); + } + else if (!Null(cl_streamp(stream))) { + *child = ecl_stream_to_handle + (stream, direction == @':output'); + if (*child >= 0) { + *child = dup(*child); + } else { + FEerror(":INPUT argument to RUN-PROGRAM does not " + "have a file handle:~%~S", 1, stream); + } + } + else { + FEerror("Invalid ~S argument to EXT:RUN-PROGRAM", 1, stream); + } +} +#endif + @(defun ext::run-program (command argv &key (input @':stream') (output @':stream') (error @'t') (wait @'t') (environ ECL_NIL) (if_output_exists @':supersede')) @@ -418,6 +519,30 @@ ecl_stream_to_HANDLE(cl_object s, bool output) command = si_copy_to_simple_base_string(command); argv = cl_mapcar(2, @'si::copy-to-simple-base-string', argv); process = make_external_process(); + +{ + if (input == @'t') + input = ecl_symbol_value(@'*standard-input*'); + if (ECL_STRINGP(input) || ECL_PATHNAMEP(input)) + input = cl_open(5, input, + @':direction', @':input', + @':if-does-not-exist', @':error'); + + if (output == @'t') + output = ecl_symbol_value(@'*standard-output*'); + if (ECL_STRINGP(output) || ECL_PATHNAMEP(output)) + output = cl_open(7, output, + @':direction', @':output', + @':if-exists', if_output_exists, + @':if-does-not-exist', @':create'); + + if (error == @'t') + error = ecl_symbol_value(@'*error-output*'); + if (ECL_STRINGP(error) || ECL_PATHNAMEP(error)) + error = cl_open(7, error, + @':direction', @':output', + @':if-does-not-exist', @':create'); +} #if defined(ECL_MS_WINDOWS_HOST) { BOOL ok; @@ -426,7 +551,6 @@ ecl_stream_to_HANDLE(cl_object s, bool output) HANDLE child_stdout, child_stdin, child_stderr; HANDLE current = GetCurrentProcess(); HANDLE saved_stdout, saved_stdin, saved_stderr; - SECURITY_ATTRIBUTES attr; cl_object env_buffer; char *env = NULL; @@ -444,173 +568,10 @@ ecl_stream_to_HANDLE(cl_object s, bool output) env_buffer = from_list_to_execve_argument(environ, NULL); env = env_buffer->base_string.self; } + create_descriptor(input, @':input', &child_stdin, &parent_write); + create_descriptor(output, @':output', &child_stdout, &parent_read); + create_descriptor(error, @':output', &child_stderr, &parent_error); - attr.nLength = sizeof(SECURITY_ATTRIBUTES); - attr.lpSecurityDescriptor = NULL; - attr.bInheritHandle = TRUE; - AGAIN_INPUT: - 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) { -#ifdef cygwin - parent_write = - cygwin_attach_handle_to_fd - (0, -1, tmp, S_IRWXU, GENERIC_WRITE); -#else - parent_write = _open_osfhandle((intptr_t)tmp, - _O_WRONLY /*| _O_TEXT*/); -#endif - 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 */ - input = ecl_symbol_value(@'*standard-input*'); - goto AGAIN_INPUT; - } else if (Null(input)) { - child_stdin = NULL; - /*child_stdin = open("/dev/null", O_RDONLY);*/ - } else if (!Null(cl_streamp(input))) { - /* If stream provides a handle, pass it to the child. Otherwise - * complain. */ - HANDLE stream_handle = ecl_stream_to_HANDLE(input, 0); - unlikely_if (stream_handle == INVALID_HANDLE_VALUE) { - FEerror(":INPUT argument to RUN-PROGRAM does not " - "have a file handle:~%~S", 1, input); - } - DuplicateHandle(current, stream_handle, - /*GetStdHandle(STD_INPUT_HANDLE)*/ - current, &child_stdin, 0, TRUE, - DUPLICATE_SAME_ACCESS); - } else if (ECL_STRINGP(input) || ECL_PATHNAMEP(input)) { - input = cl_open(5, input, - @':direction', @':input', - @':if-does-not-exist', @':error'); - goto AGAIN_INPUT; - } else { - FEerror("Invalid :INPUT argument to EXT:RUN-PROGRAM", 1, - input); - } - AGAIN_OUTPUT: - 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) { -#ifdef cygwin - parent_read = - cygwin_attach_handle_to_fd - (0, -1, tmp, S_IRWXU, GENERIC_READ); -#else - parent_read = _open_osfhandle((intptr_t)tmp, - _O_RDONLY /*| _O_TEXT*/); -#endif - 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 */ - output = ecl_symbol_value(@'*standard-output*'); - goto AGAIN_OUTPUT; - } else if (Null(output)) { - child_stdout = NULL; - } else if (!Null(cl_streamp(output))) { - HANDLE stream_handle = ecl_stream_to_HANDLE(output, 1); - unlikely_if(stream_handle == INVALID_HANDLE_VALUE) { - FEerror(":OUTPUT argument to RUN-PROGRAM does not " - "have a file handle:~%~S", 1, output); - } - DuplicateHandle(current, stream_handle, - /*GetStdHandle(STD_OUTPUT_HANDLE)*/ - current, &child_stdout, 0, TRUE, - DUPLICATE_SAME_ACCESS); - } else if (ECL_STRINGP(output) || ECL_PATHNAMEP(output)) { - output = cl_open(7, output, - @':direction', @':output', - @':if-exists', if_output_exists, - @':if-does-not-exist', @':create'); - goto AGAIN_OUTPUT; - } else { - FEerror("Invalid :OUTPUT argument to EXT:RUN-PROGRAM", 1, - output); - } - AGAIN_ERROR: - 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 == @':stream') { - HANDLE tmp; - ok = CreatePipe(&tmp, &child_stderr, &attr, 0); - if (ok) { - ok = DuplicateHandle(current, tmp, current, - &tmp, 0, FALSE, - DUPLICATE_CLOSE_SOURCE | - DUPLICATE_SAME_ACCESS); - if (ok) { -#ifdef cygwin - parent_error = - cygwin_attach_handle_to_fd - (0, -1, tmp, S_IRWXU, GENERIC_READ); -#else - parent_error = _open_osfhandle((intptr_t)tmp, - _O_RDONLY /*| _O_TEXT*/); -#endif - if (parent_error < 0) - printf("open_osfhandle failed\n"); - } - } - } else if (error == @'t') { - /* The child inherits a duplicate of our output - handle. Creating a duplicate avoids problems when - the child closes it */ - error = ecl_symbol_value(@'*error-output*'); - goto AGAIN_ERROR; - } else if (Null(error)) { - child_stderr = NULL; - } else if (!Null(cl_streamp(error))) { - HANDLE stream_handle = ecl_stream_to_HANDLE(error, 1); - unlikely_if (stream_handle == INVALID_HANDLE_VALUE) { - FEerror(":ERROR argument to RUN-PROGRAM does not " - "have a file handle:~%~S", 1, error); - } - DuplicateHandle(current, stream_handle, - /*GetStdHandle(STD_ERROR_HANDLE)*/ - current, &child_stderr, 0, TRUE, - DUPLICATE_SAME_ACCESS); - } else if (ECL_STRINGP(error) || ECL_PATHNAMEP(error)) { - error = cl_open(7, error, - @':direction', @':output', - @':if-does-not-exist', @':create'); - goto AGAIN_ERROR; - } else { - FEerror("Invalid :ERROR argument to EXT:RUN-PROGRAM:~%~S", 1, - error); - } add_external_process(the_env, process); #if 1 ZeroMemory(&st_info, sizeof(STARTUPINFO)); @@ -679,91 +640,11 @@ ecl_stream_to_HANDLE(cl_object s, bool output) int pipe_fd[2]; argv = CONS(command, ecl_nconc(argv, ecl_list1(ECL_NIL))); argv = _ecl_funcall3(@'coerce', argv, @'vector'); - AGAIN_INPUT: - if (input == @':stream') { - int fd[2]; - pipe(fd); - parent_write = fd[1]; - child_stdin = fd[0]; - } else if (input == @'t') { - input = ecl_symbol_value(@'*standard-input*'); - goto AGAIN_INPUT; - } else if (Null(input)) { - child_stdin = open("/dev/null", O_RDONLY); - } else if (!Null(cl_streamp(input))) { - child_stdin = ecl_stream_to_handle(input, 0); - if (child_stdin >= 0) { - child_stdin = dup(child_stdin); - } else { - FEerror(":INPUT argument to RUN-PROGRAM does not " - "have a file handle:~%~S", 1, input); - } - } else if (ECL_STRINGP(input) || ECL_PATHNAMEP(input)) { - input = cl_open(5, input, - @':direction', @':input', - @':if-does-not-exist', @':error'); - goto AGAIN_INPUT; - } else { - FEerror("Invalid :INPUT argument to EXT:RUN-PROGRAM:~%~S", 1, - input); - } - AGAIN_OUTPUT: - if (output == @':stream') { - int fd[2]; - pipe(fd); - parent_read = fd[0]; - child_stdout = fd[1]; - } else if (output == @'t') { - output = ecl_symbol_value(@'*standard-output*'); - goto AGAIN_OUTPUT; - } else if (Null(output)) { - child_stdout = open("/dev/null", O_WRONLY); - } else if (!Null(cl_streamp(output))) { - child_stdout = ecl_stream_to_handle(output, 1); - unlikely_if (child_stdout < 0) { - FEerror(":OUTPUT argument to RUN-PROGRAM does not " - "have a file handle:~%~S", 1, output); - } - child_stdout = dup(child_stdout); - } else if (ECL_STRINGP(output) || ECL_PATHNAMEP(output)) { - output = cl_open(7, output, - @':direction', @':output', - @':if-exists', if_output_exists, - @':if-does-not-exist', @':create'); - goto AGAIN_OUTPUT; - } else { - FEerror("Invalid :OUTPUT argument to EXT:RUN-PROGRAM:~%~S", 1, - output); - } - AGAIN_ERROR: - if (error == @':output') { - child_stderr = child_stdout; - } else if (error == @':stream') { - int fd[2]; - pipe(fd); - parent_error = fd[0]; - child_stderr = fd[1]; - } else if (error == @'t') { - error = ecl_symbol_value(@'*error-output*'); - goto AGAIN_ERROR; - } else if (Null(error)) { - child_stderr = open("/dev/null", O_WRONLY); - } else if (!Null(cl_streamp(error))) { - child_stderr = ecl_stream_to_handle(error, 1); - unlikely_if (child_stderr < 0) { - FEerror(":ERROR argument to RUN-PROGRAM does not " - "have a file handle:~%~S", 1, error); - } - child_stderr = dup(child_stderr); - } else if (ECL_STRINGP(error) || ECL_PATHNAMEP(error)) { - output = cl_open(7, error, - @':direction', @':output', - @':if-does-not-exist', @':create'); - goto AGAIN_ERROR; - } else { - FEerror("Invalid :ERROR argument to EXT:RUN-PROGRAM:~%~S", 1, - error); - } + + create_descriptor(input, @':input', &child_stdin, &parent_write); + create_descriptor(output, @':output', &child_stdout, &parent_read); + create_descriptor(error, @':output', &child_stderr, &parent_error); + add_external_process(the_env, process); pipe(pipe_fd); child_pid = fork();