Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

List form of pipe open not implemented on Win32 #13574

Closed
p5pRT opened this issue Feb 3, 2014 · 10 comments

Comments

@p5pRT
Copy link
Collaborator

@p5pRT p5pRT commented Feb 3, 2014

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

Searchable as RT121159$

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Feb 3, 2014

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 19, 2014

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 19, 2014

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 28, 2014

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 28, 2014

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

@p5pRT

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Aug 28, 2014

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 1, 2014

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 1, 2014

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 22, 2014

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

This comment has been minimized.

Copy link
Collaborator Author

@p5pRT p5pRT commented Oct 22, 2014

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

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
1 participant
You can’t perform that action at this time.