Join GitHub today
GitHub is home to over 50 million developers working together to host and review code, manage projects, and build software together.
Sign upList form of pipe open not implemented on Win32 #13574
Comments
From @tonycozCreated by @tonycozTrying to open a pipe with multi-arg open on Win32 fails with: List form of pipe open not implemented at io\openpid.t line 56. This is a feature request, which I'll probably end up implementing. Perl Info |
From @tonycozOn Mon Feb 03 15:52:32 2014, tonyc wrote:
Patch attached for picking apart. Tony |
From @tonycoz0001-perl-121159-implement-list-form-of-pipe-open-for-Win.patchFrom f04c2d5a64b66921d59d618e7acad9520ac49fbd Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Tue, 19 Aug 2014 16:04:11 +1000
Subject: [perl #121159] implement list form of pipe open for Win32
---
t/win32/system.t | 2 +-
t/win32/system_tests | 11 +++++++-
win32/win32.c | 68 +++++++++++++++++++++++++++++++++++++------------
3 files changed, 62 insertions(+), 19 deletions(-)
diff --git a/t/win32/system.t b/t/win32/system.t
index a6a94cb..939a02d 100644
--- a/t/win32/system.t
+++ b/t/win32/system.t
@@ -151,7 +151,7 @@ while (<$T>) {
note "want: $expect";
note "got : $_";
}
- ok($expect eq $_);
+ ok($expect eq $_, $comment // '');
}
}
close $T;
diff --git a/t/win32/system_tests b/t/win32/system_tests
index e2445ed..8307222 100644
--- a/t/win32/system_tests
+++ b/t/win32/system_tests
@@ -87,7 +87,7 @@ my @av = (
['" "', 'a" "b" "c', "abc"],
);
-print "1.." . (@commands * @av * 2) . "\n";
+print "1.." . (@commands * @av * 3) . "\n";
for my $cmds (@commands) {
for my $args (@av) {
my @all_args;
@@ -119,5 +119,14 @@ for my $cmds (@commands) {
}
}
$^D = 0;
+
+ note "# pipe [".join(";", @cmds, @args). "]";
+ if (open my $io, "|-", @cmds, @args) {
+ print <$io>;
+ close $io;
+ }
+ else {
+ print "Failed pipe open: $!\n";
+ }
}
}
diff --git a/win32/win32.c b/win32/win32.c
index 26d419e..2009254 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -136,6 +136,8 @@ static int do_spawn2_handles(pTHX_ const char *cmd, int exectype,
const int *handles);
static int do_spawnvp_handles(int mode, const char *cmdname,
const char * const *argv, const int *handles);
+static PerlIO * do_popen(const char *mode, const char *command, IV narg,
+ SV **args);
static long find_pid(pTHX_ int pid);
static void remove_dead_process(long child);
static int terminate_process(DWORD pid, HANDLE process_handle, int sig);
@@ -146,7 +148,7 @@ static char* wstr_to_str(const wchar_t* wstr);
static long filetime_to_clock(PFILETIME ft);
static BOOL filetime_from_time(PFILETIME ft, time_t t);
static char* create_command_line(char *cname, STRLEN clen,
- const char * const *args);
+ const char * const *args);
static char* qualified_path(const char *cmd);
static void ansify_path(void);
static LRESULT win32_process_message(HWND hwnd, UINT msg,
@@ -2931,22 +2933,13 @@ win32_pipe(int *pfd, unsigned int size, int mode)
DllExport PerlIO*
win32_popenlist(const char *mode, IV narg, SV **args)
{
- Perl_croak_nocontext("List form of pipe open not implemented");
- return NULL;
-}
+ get_shell();
-/*
- * a popen() clone that respects PERL5SHELL
- *
- * changed to return PerlIO* rather than FILE * by BKS, 11-11-2000
- */
+ return do_popen(mode, NULL, narg, args);
+}
-DllExport PerlIO*
-win32_popen(const char *command, const char *mode)
-{
-#ifdef USE_RTL_POPEN
- return _popen(command, mode);
-#else
+STATIC PerlIO*
+do_popen(const char *mode, const char *command, IV narg, SV **args) {
int p[2];
int handles[3];
int parent, child;
@@ -2955,6 +2948,7 @@ win32_popen(const char *command, const char *mode)
int childpid;
DWORD nhandle;
int lock_held = 0;
+ const char **args_pvs = NULL;
/* establish which ends read and write */
if (strchr(mode,'w')) {
@@ -3008,8 +3002,33 @@ win32_popen(const char *command, const char *mode)
{
dTHX;
- if ((childpid = do_spawn2_handles(aTHX_ command, EXECF_SPAWN_NOWAIT, handles)) == -1)
- goto cleanup;
+ if (command) {
+ if ((childpid = do_spawn2_handles(aTHX_ command, EXECF_SPAWN_NOWAIT, handles)) == -1)
+ goto cleanup;
+
+ }
+ else {
+ int i;
+
+ Newx(args_pvs, narg + 1 + w32_perlshell_items, const char *);
+ for (i = 0; i < narg; ++i)
+ args_pvs[i] = SvPV_nolen(args[i]);
+ args_pvs[i] = NULL;
+
+ if ((childpid = do_spawnvp_handles(P_NOWAIT, args_pvs[0], args_pvs, handles)) == -1) {
+ if (errno == ENOEXEC || errno == ENOENT) {
+ /* possible shell-builtin, invoke with shell */
+ Move(args_pvs, args_pvs+w32_perlshell_items, narg+1, const char *);
+ for (i = 0; i < w32_perlshell_items; ++i)
+ args_pvs[i] = w32_perlshell_vec[i];
+ if ((childpid = do_spawnvp_handles(P_NOWAIT, args_pvs[0], args_pvs, handles)) == -1)
+ goto cleanup;
+ }
+ else
+ goto cleanup;
+ }
+ Safefree(args_pvs);
+ }
win32_close(p[child]);
@@ -3026,9 +3045,24 @@ cleanup:
/* we don't need to check for errors here */
win32_close(p[0]);
win32_close(p[1]);
+ Safefree(args_pvs);
return (NULL);
+}
+
+/*
+ * a popen() clone that respects PERL5SHELL
+ *
+ * changed to return PerlIO* rather than FILE * by BKS, 11-11-2000
+ */
+DllExport PerlIO*
+win32_popen(const char *command, const char *mode)
+{
+#ifdef USE_RTL_POPEN
+ return _popen(command, mode);
+#else
+ return do_popen(mode, command, 0, NULL);
#endif /* USE_RTL_POPEN */
}
--
1.7.4.msysgit.0
|
From @bulk88On Mon Aug 18 23:05:20 2014, tonyc wrote:
win32_popen returns a PerlIO*, which is wrong since win32_* are C lib level replacements, not general perl api. If something. It should be called Perl_do_popen, and remove win32_popen. + Move(args_pvs, args_pvs+w32_perlshell_items, narg+1, const char *); Why is 1 a Move and the other is a for loop? How about alloca instead of the Newx? -- |
|
The RT System itself - Status changed from 'new' to 'open' |
From @janduboisOn Thu, Aug 28, 2014 at 3:09 PM, bulk88 via RT
Perl is not using alloca(). alloca() allocates from the C stack, Cheers, |
From @tonycozOn Thu Aug 28 15:09:34 2014, bulk88 wrote:
win32_popen() emulates the Unix popen(), and since we're in perl land, it returns a PerlIO * instead of a FILE * (it used to return FILE *).
Good point on the for loop, I've changed it to a Copy(). Your mention of alloca() did get me thinking - the SvPV_nolen(args[i]) calls can croak, which would leak memory. I've removed the Safefree(args_pvs) calls and added SAVEFREEPV(args_pvs) instead. Tony |
From @tonycoz0001-perl-121159-implement-list-form-of-pipe-open-for-Win.patchFrom 6ee3639b5f28ab48797ae5b8faeea3f88d13e747 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 1 Oct 2014 16:19:52 +1000
Subject: [PATCH] [perl #121159] implement list form of pipe open for Win32
---
t/win32/system.t | 2 +-
t/win32/system_tests | 11 +++++++-
win32/win32.c | 66 +++++++++++++++++++++++++++++++++++++-------------
3 files changed, 60 insertions(+), 19 deletions(-)
diff --git a/t/win32/system.t b/t/win32/system.t
index a6a94cb..939a02d 100644
--- a/t/win32/system.t
+++ b/t/win32/system.t
@@ -151,7 +151,7 @@ while (<$T>) {
note "want: $expect";
note "got : $_";
}
- ok($expect eq $_);
+ ok($expect eq $_, $comment // '');
}
}
close $T;
diff --git a/t/win32/system_tests b/t/win32/system_tests
index e2445ed..8307222 100644
--- a/t/win32/system_tests
+++ b/t/win32/system_tests
@@ -87,7 +87,7 @@ my @av = (
['" "', 'a" "b" "c', "abc"],
);
-print "1.." . (@commands * @av * 2) . "\n";
+print "1.." . (@commands * @av * 3) . "\n";
for my $cmds (@commands) {
for my $args (@av) {
my @all_args;
@@ -119,5 +119,14 @@ for my $cmds (@commands) {
}
}
$^D = 0;
+
+ note "# pipe [".join(";", @cmds, @args). "]";
+ if (open my $io, "|-", @cmds, @args) {
+ print <$io>;
+ close $io;
+ }
+ else {
+ print "Failed pipe open: $!\n";
+ }
}
}
diff --git a/win32/win32.c b/win32/win32.c
index 26d419e..21cdcc6 100644
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -136,6 +136,8 @@ static int do_spawn2_handles(pTHX_ const char *cmd, int exectype,
const int *handles);
static int do_spawnvp_handles(int mode, const char *cmdname,
const char * const *argv, const int *handles);
+static PerlIO * do_popen(const char *mode, const char *command, IV narg,
+ SV **args);
static long find_pid(pTHX_ int pid);
static void remove_dead_process(long child);
static int terminate_process(DWORD pid, HANDLE process_handle, int sig);
@@ -146,7 +148,7 @@ static char* wstr_to_str(const wchar_t* wstr);
static long filetime_to_clock(PFILETIME ft);
static BOOL filetime_from_time(PFILETIME ft, time_t t);
static char* create_command_line(char *cname, STRLEN clen,
- const char * const *args);
+ const char * const *args);
static char* qualified_path(const char *cmd);
static void ansify_path(void);
static LRESULT win32_process_message(HWND hwnd, UINT msg,
@@ -2931,22 +2933,13 @@ win32_pipe(int *pfd, unsigned int size, int mode)
DllExport PerlIO*
win32_popenlist(const char *mode, IV narg, SV **args)
{
- Perl_croak_nocontext("List form of pipe open not implemented");
- return NULL;
-}
+ get_shell();
-/*
- * a popen() clone that respects PERL5SHELL
- *
- * changed to return PerlIO* rather than FILE * by BKS, 11-11-2000
- */
+ return do_popen(mode, NULL, narg, args);
+}
-DllExport PerlIO*
-win32_popen(const char *command, const char *mode)
-{
-#ifdef USE_RTL_POPEN
- return _popen(command, mode);
-#else
+STATIC PerlIO*
+do_popen(const char *mode, const char *command, IV narg, SV **args) {
int p[2];
int handles[3];
int parent, child;
@@ -2955,6 +2948,7 @@ win32_popen(const char *command, const char *mode)
int childpid;
DWORD nhandle;
int lock_held = 0;
+ const char **args_pvs = NULL;
/* establish which ends read and write */
if (strchr(mode,'w')) {
@@ -3008,8 +3002,32 @@ win32_popen(const char *command, const char *mode)
{
dTHX;
- if ((childpid = do_spawn2_handles(aTHX_ command, EXECF_SPAWN_NOWAIT, handles)) == -1)
- goto cleanup;
+ if (command) {
+ if ((childpid = do_spawn2_handles(aTHX_ command, EXECF_SPAWN_NOWAIT, handles)) == -1)
+ goto cleanup;
+
+ }
+ else {
+ int i;
+
+ Newx(args_pvs, narg + 1 + w32_perlshell_items, const char *);
+ SAVEFREEPV(args_pvs);
+ for (i = 0; i < narg; ++i)
+ args_pvs[i] = SvPV_nolen(args[i]);
+ args_pvs[i] = NULL;
+
+ if ((childpid = do_spawnvp_handles(P_NOWAIT, args_pvs[0], args_pvs, handles)) == -1) {
+ if (errno == ENOEXEC || errno == ENOENT) {
+ /* possible shell-builtin, invoke with shell */
+ Move(args_pvs, args_pvs+w32_perlshell_items, narg+1, const char *);
+ Copy(w32_perlshell_vec, args_pvs, w32_perlshell_items, const char *);
+ if ((childpid = do_spawnvp_handles(P_NOWAIT, args_pvs[0], args_pvs, handles)) == -1)
+ goto cleanup;
+ }
+ else
+ goto cleanup;
+ }
+ }
win32_close(p[child]);
@@ -3028,7 +3046,21 @@ cleanup:
win32_close(p[1]);
return (NULL);
+}
+
+/*
+ * a popen() clone that respects PERL5SHELL
+ *
+ * changed to return PerlIO* rather than FILE * by BKS, 11-11-2000
+ */
+DllExport PerlIO*
+win32_popen(const char *command, const char *mode)
+{
+#ifdef USE_RTL_POPEN
+ return _popen(command, mode);
+#else
+ return do_popen(mode, command, 0, NULL);
#endif /* USE_RTL_POPEN */
}
--
1.7.4.msysgit.0
|
From @tonycozOn Tue Sep 30 23:42:36 2014, tonyc wrote:
Applied as aac983a. Tony |
|
@tonycoz - Status changed from 'open' to 'resolved' |
Migrated from rt.perl.org#121159 (status was 'resolved')
Searchable as RT121159$