Skip Menu |
Report information
Id: 121159
Status: resolved
Priority: 0/
Queue: perl5

Owner: tonyc <tony [at] develop-help.com>
Requestors: tonyc <tony [at] develop-help.com>
Cc:
AdminCc:

Operating System: mswin32
PatchStatus: (no value)
Severity: low
Type: core
Perl Version: 5.19.9
Fixed In: (no value)



Date: Tue, 4 Feb 2014 10:52:20 +1100
Subject: List form of pipe open not implemented on Win32
To: perlbug [...] perl.org
From: Tony Cook <tony [...] develop-help.com>
Download (untitled) / with headers
text/plain 4.3k
This is a bug report for perl from tony@develop-help.com, generated with the help of perlbug 1.40 running under perl 5.19.9. ----------------------------------------------------------------- [Please describe your issue here] 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. [Please do not change anything below this line] ----------------------------------------------------------------- --- 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)
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 292b
On Mon Feb 03 15:52:32 2014, tonyc wrote: Show quoted text
> 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
Subject: 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
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 568b
On Mon Aug 18 23:05:20 2014, tonyc wrote: Show quoted text
> > 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
From: Jan Dubois <jand [...] activestate.com>
To: bulk 88 via RT <perlbug-followup [...] perl.org>
Date: Thu, 28 Aug 2014 16:13:08 -0700
CC: Perl 5 Porters <perl5-porters [...] perl.org>
Subject: Re: [perl #121159] List form of pipe open not implemented on Win32
Download (untitled) / with headers
text/plain 383b
On Thu, Aug 28, 2014 at 3:09 PM, bulk88 via RT <perlbug-followup@perl.org> wrote: Show quoted text
> 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
RT-Send-CC: perl5-porters [...] perl.org
On Thu Aug 28 15:09:34 2014, bulk88 wrote: Show quoted text
> 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 *). Show quoted text
> + 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
Subject: 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
RT-Send-CC: perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 1.1k
On Tue Sep 30 23:42:36 2014, tonyc wrote: Show quoted text
> 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 aac983ac3f3f3578c7e34568e0e028c420f3c1f8. Tony


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org