List form of pipe open not implemented on Win32

[p5pRT]

Migrated from rt.perl.org#121159 (status was 'resolved')

Searchable as RT121159$

[p5pRT]

From @tonycoz

Created by @tonycoz

Trying 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

Flags:
    category=core
    severity=low

Site configuration information for perl 5.19.9:

Configured by tony at Mon Feb  3 15:40:18 2014.

Summary of my perl5 (revision 5 version 19 subversion 9) configuration:
  Derived from: f06c882585eac59ec68dbf93c87659cb62a24000
  Platform:
    osname=MSWin32, osvers=6.1, archname=MSWin32-x64-multi-thread
    uname=''
    config_args='undef'
    hint=recommended, useposix=true, d_sigaction=undef
    useithreads=define, usemultiplicity=define
    use64bitint=define, use64bitall=undef, uselongdouble=undef
    usemymalloc=n, bincompat5005=undef
  Compiler:
    cc='cl', ccflags ='-nologo -GF -W3 -Od -MD -Zi -DDEBUGGING -fp:precise -DWIN32 -D_CONSOLE -DNO_STRICT -DWIN64 -DCONSERVATIVE -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE  -DPERL_TEXTMODE_SCRIPTS -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO',
    optimize='-Od -MD -Zi -DDEBUGGING -fp:precise',
    cppflags='-DWIN32'
    ccversion='15.00.30729.01', gccversion='', gccosandvers=''
    intsize=4, longsize=4, ptrsize=8, doublesize=8, byteorder=12345678
    d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=8
    ivtype='__int64', ivsize=8, nvtype='double', nvsize=8, Off_t='__int64', lseeksize=8
    alignbytes=8, prototype=define
  Linker and Libraries:
    ld='link', ldflags ='-nologo -nodefaultlib -debug  -libpath:"c:\notthere\lib\CORE"  -machine:AMD64 "/manifestdependency:type='Win32' name='Microsoft.Windows.Common-Controls' version='6.0.0.0' processorArchitecture='*' publicKeyToken='6595b64144ccf1df' language='*'"'
    libpth=\lib
    libs=oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib  comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib  netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib  version.lib odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib
    perllibs=oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib  comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib  netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib  version.lib odbc32.lib odbccp32.lib comctl32.lib msvcrt.lib
    libc=msvcrt.lib, so=dll, useshrplib=true, libperl=perl519.lib
    gnulibc_version=''
  Dynamic Linking:
    dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
    cccdlflags=' ', lddlflags='-dll -nologo -nodefaultlib -debug  -libpath:"c:\notthere\lib\CORE"  -machine:AMD64 "/manifestdependency:type='Win32' name='Microsoft.Windows.Common-Controls' version='6.0.0.0' processorArchitecture='*' publicKeyToken='6595b64144ccf1df' language='*'"'

Locally applied patches:
    uncommitted-changes


@INC for perl 5.19.9:
    lib
    C:/Users/tony/dev/perl/git/perl/lib
    .


Environment for perl 5.19.9:
    HOME (unset)
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH (unset)
    LOGDIR (unset)
    PATH=c:\Program Files (x86)\Microsoft Visual Studio 9.0\VC\Bin\amd64;c:\Program Files (x86)\Microsoft Visual Studio 9.0\VC\vcpackages;c:\Program Files (x86)\Microsoft Visual Studio 9.0\Common7\IDE;C:\apps\platsdk\win7\Bin\x64;C:\apps\platsdk\win7\Bin;C:\Windows\Microsoft.NET\Framework64\v3.5;C:\Windows\Microsoft.NET\Framework\v3.5;C:\Windows\Microsoft.NET\Framework64\v2.0.50727;C:\Windows\Microsoft.NET\Framework\v2.0.50727;C:\apps\platsdk\win7\Setup;C:\Program Files (x86)\NVIDIA Corporation\PhysX\Common;C:\Program Files\NVIDIA GPU Computing Toolkit\CUDA\v5.0\bin\;C:\Program Files\NVIDIA GPU Computing Toolkit\CUDA\v5.0\libnvvp\;C:\Program Files\Common Files\MICROSOFT SHARED\WINDOWS LIVE;C:\PROGRAM FILES (X86)\MIKTEX 2.8\MIKTEX\BIN;C:\Windows\SYSTEM32;C:\Windows;C:\Windows\SYSTEM32\WBEM;C:\APPS\GIT\GIT\CMD;C:\PROGRAM FILES (X86)\ORACLE\BERKELEY DB 11GR2 5.3.15\BIN;C:\Program Files\WIDCOMM\Bluetooth Software\;C:\Program Files\WIDCOMM\Bluetooth Software\syswow64;C:\Windows\System32\WindowsPowerShell\v1.0\;C:\Windows\System32\WindowsPowerShell\v1.0\;C:\Program Files (x86)\QuickTime\QTSystem\
    PERL_BADLANG (unset)
    SHELL (unset)

[p5pRT]

From @tonycoz

On Mon Feb 03 15​:52​:32 2014, tonyc wrote​:

Trying 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.

Patch attached for picking apart.

Tony

[p5pRT]

From @tonycoz

0001-perl-121159-implement-list-form-of-pipe-open-for-Win.patch

From 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

[p5pRT]

From @bulk88

On Mon Aug 18 23​:05​:20 2014, tonyc wrote​:

Patch attached for picking apart.

Tony

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 *);
+ for (i = 0; i < w32_perlshell_items; ++i)
+ args_pvs[i] = w32_perlshell_vec[i];

Why is 1 a Move and the other is a for loop? How about alloca instead of the Newx?

--
bulk88 ~ bulk88 at hotmail.com

[p5pRT]

The RT System itself - Status changed from 'new' to 'open'

[p5pRT]

From @jandubois

On Thu, Aug 28, 2014 at 3​:09 PM, bulk88 via RT
<perlbug-followup@​perl.org> wrote​:

How about alloca instead of the Newx?

Perl is not using alloca(). alloca() allocates from the C stack,
which is a limited resource. And it doesn't even detect out-of-memory
conditions; it will simply crash (well, technically the behavior is
undefined when you exhaust stack space).

Cheers,
-Jan

[p5pRT]

From @tonycoz

On Thu Aug 28 15​:09​:34 2014, bulk88 wrote​:

On Mon Aug 18 23​:05​:20 2014, tonyc wrote​:

Patch attached for picking apart.

Tony

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.

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 *).

+ 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];

Why is 1 a Move and the other is a for loop? How about alloca instead
of the Newx?

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

[p5pRT]

From @tonycoz

0001-perl-121159-implement-list-form-of-pipe-open-for-Win.patch

From 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

[p5pRT]

From @tonycoz

On Tue Sep 30 23​:42​:36 2014, tonyc wrote​:

On Thu Aug 28 15​:09​:34 2014, bulk88 wrote​:

On Mon Aug 18 23​:05​:20 2014, tonyc wrote​:

Patch attached for picking apart.

Tony

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.

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 *).

+ 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];

Why is 1 a Move and the other is a for loop? How about alloca instead
of the Newx?

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.

Applied as aac983a.

Tony

[p5pRT]

@tonycoz - Status changed from 'open' to 'resolved'