List 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' |
p5pRT commentedFeb 3, 2014
Migrated from rt.perl.org#121159 (status was 'resolved')
Searchable as RT121159$
The text was updated successfully, but these errors were encountered: