Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Re: ActivePerl Gtk2::Helper Hangs

by bulk88 (Priest)
on Nov 28, 2013 at 08:05 UTC ( [id://1064759]=note: print w/replies, xml ) Need Help??


in reply to ActivePerl Gtk2::Helper Hangs

Running your first script, the perl process hung/blocked on a syncronous read to the NPFS Win32 Named Pipe that is the cmd.exe process std handles. 
     ntdll.dll!_KiFastSystemCallRet@0()     
     ntdll.dll!_NtReadFile@36()  + 0xc    
     kernel32.dll!_ReadFile@20()  + 0x67    
>    msvcr71.dll!_read_lk(int fh=0x00000005, void * buf=0x01ab870c, un
+signed int cnt=0x00000001)  Line 154 + 0x15    C
     msvcr71.dll!_read(int fh=0x00000005, void * buf=0x01ab870c, unsig
+ned int cnt=0x00000001)  Line 75 + 0xc    C
     perl512.dll!win32_read(int fd=0x00000005, void * buf=0x01ab870c, 
+unsigned int cnt=0x00000001)  Line 3746 + 0x12    C
     perl512.dll!PerlLIORead(IPerlLIO * piPerl=0x00285774, int handle=
+0x00000005, void * buffer=0x01ab870c, unsigned int count=0x00000001) 
+ Line 1049 + 0x11    C++
     perl512.dll!Perl_pp_sysread(interpreter * my_perl=0x00393f04)  Li
+ne 1711 + 0x34    C
     perl512.dll!Perl_runops_debug(interpreter * my_perl=0x00393f04)  
+Line 2049 + 0xd    C
     perl512.dll!Perl_call_sv(interpreter * my_perl=0x00393f04, sv * s
+v=0x00829f74, volatile long flags=0x0000000a)  Line 2605 + 0x36    C
     Glib.dll!gperl_closure_marshal(_GClosure * closure=0x00e025d0, _G
+Value * return_value=0x0006f888, unsigned int n_param_values=0x000000
+02, const _GValue * param_values=0x0006f8a8, void * invocation_hint=0
+x00000000, void * marshal_data=0x00393f04)  Line 105 + 0x96    C
     libgobject-2.0-0.dll!g_closure_invoke(_GClosure * closure=0x00e02
+5d0, _GValue * return_value=0x0006f888, unsigned int n_param_values=0
+x00000002, const _GValue * param_values=0x0006f8a8, void * invocation
+_hint=0x00000000)  Line 771 + 0x1b    
     libgobject-2.0-0.dll!io_watch_closure_callback(_GIOChannel * chan
+nel=0x00dcecf0, GIOCondition condition=G_IO_IN, void * data=0x00e025d
+0)  Line 94 + 0x15    
     libglib-2.0-0.dll!g_io_win32_dispatch(_GSource * source=0x00e0258
+0, int (void *)* callback=0x00b3c1c0, void * user_data=0x00e025d0)  L
+ine 979 + 0x1f    
     libglib-2.0-0.dll!g_main_dispatch(_GMainContext * context=0x00dc9
+698)  Line 2442 + 0xf    
     libglib-2.0-0.dll!g_main_context_dispatch(_GMainContext * context
+=0x00dc9698)  Line 3013 + 0x9    
     libglib-2.0-0.dll!g_main_context_iterate(_GMainContext * context=
+0x00dc9698, int block=0x00000001, int dispatch=0x00000001, _GThread *
+ self=0x00dc2ad8)  Line 3091 + 0x9    
     libglib-2.0-0.dll!g_main_loop_run(_GMainLoop * loop=0x00e3c2c8)  
+Line 3299 + 0x13    
     libgtk-win32-2.0-0.dll!gtk_main()  Line 1244 + 0x9    
     Gtk2.dll!XS_Gtk2_main(interpreter * my_perl=0x00393f04, cv * cv=0
+x0098af94)  Line 523    C
     perl512.dll!Perl_pp_entersub(interpreter * my_perl=0x00393f04)  L
+ine 2882 + 0x10    C
     perl512.dll!Perl_runops_debug(interpreter * my_perl=0x00393f04)  
+Line 2049 + 0xd    C
     perl512.dll!S_run_body(interpreter * my_perl=0x00393f04, long old
+scope=0x00000001)  Line 2308 + 0xd    C
     perl512.dll!perl_run(interpreter * my_perl=0x00393f04)  Line 2233
+ + 0xd    C
     perl512.dll!RunPerl(int argc=0x00000002, char * * argv=0x00283e08
+, char * * env=0x00284ed8)  Line 270 + 0x9    C++
     perl.exe!main(int argc=0x00000002, char * * argv=0x00283e08, char
+ * * env=0x00282c88)  Line 23 + 0x12    C
     perl.exe!mainCRTStartup()  Line 398 + 0xe    C
     kernel32.dll!_BaseProcessStart@4()  + 0x23

[download]
In Perl, the hang happened at 
sub preview_call {
    my $buffer;
    my $rl = sysread($rfh,$buffer,1);<<<<<<<<<<<<<<<<<<<<<<<<<<
    if(defined($rl)){
        print "$rl + $buffer\n";
        while (Gtk2->events_pending()) {Gtk2->main_iteration();}
        return 1;
    }else{
        print "undefined\n";
        return 0;
    }
}

[download]
Long story short, select() on Win32, in C and in Perl, only works on sockets. Most POSIXy code assumes all FDs/handles are the same "type", so the authors never try to get Win32 async I/O models into their non-blocking POSIX code. You need to call PeekNamedPipe from kernel32 before doing a sysread() or read() from Perl. If the buffer has zero bytes, your read() will hang until some bytes are written to the pipe, or the other end of the pipe is closed.

Here is some untested code for calling PeekNamedPipe 
use Win32API::File;
use Win32;
use Win32::API;
{
my $api;
die "PeekNamedPipe"
    if ! ($api= Win32::API::More->Import("kernel32", "
BOOL PeekNamedPipe(
  HANDLE hNamedPipe,
  LPVOID lpBuffer,
  DWORD nBufferSize,
  LPDWORD lpBytesRead,
  LPDWORD lpTotalBytesAvail,
  LPDWORD lpBytesLeftThisMessage
);"));
}
##########################
my ($TotalBytesAvail, $ret) = (0);
my $hnd = Win32API::File::FdGetOsFHandle($rfh->fileno()); #get Win32 k
+ernel handle from Perl land
if($hnd == Win32API::File::INVALID_HANDLE_VALUE()) {
    die "bad hnd";
}
$ret = PeekNamedPipe($hnd, undef, 0, undef, $TotalBytesAvail, undef);
if(!$ret) {
    my $err = Win32::GetLastError();
    die "PNP failed $err $^E";
 }
if($TotalBytesAvail) {
    #can safely read
}

[download]
Code is recycled from https://rt.perl.org/Ticket/Display.html?id=120330.

Replies are listed 'Best First'.
Re^2: ActivePerl Gtk2::Helper Hangs
by renegadex (Beadle) on Nov 28, 2013 at 10:40 UTC
    Hi Bulk88, thanks for the fast reply, im still studying your code and how to use it. Its quite a handful to absorb hehehe!
    Mabuhay Civil Engineers! :D
[reply]
Re^2: ActivePerl Gtk2::Helper Hangs
by renegadex (Beadle) on Nov 29, 2013 at 03:03 UTC
    Hi bulk88,

    I've been trying to adopt your codes to mine and I get this error that there was an overflow every time I call sub add_job on run-time by pressing the Button A 
    *** unhandled exception in callback:
***   Win32::API::Call: parameter 5 had a buffer overflow at (eval 18)
+ line 2.
***  ignoring at pipecall.pl line 65.

    [download]

    this is my new code 
    #!/usr/bin/perl -w

use strict;
use Gtk2 '-init';
use Gtk2::Helper;
use Data::Dumper;
use FileHandle;
use IPC::Open2;
use Win32API::File;
use Win32;
use Win32::API;

{
my $api;
die "PeekNamedPipe"
    if ! ($api= Win32::API::More->Import("kernel32", "
            BOOL PeekNamedPipe(
            HANDLE hNamedPipe,
            LPVOID lpBuffer,
            DWORD nBufferSize,
            LPDWORD lpBytesRead,
            LPDWORD lpTotalBytesAvail,
            LPDWORD lpBytesLeftThisMessage
        );"));
}

my $wfh = FileHandle->new();
my $rfh = FileHandle->new();
open2($rfh,$wfh,"C:\\Windows\\System32\\cmd.exe");
my $hnd = Win32API::File::FdGetOsFHandle($rfh->fileno()); #get Win32 k
+ernel handle from Perl land
if($hnd == Win32API::File::INVALID_HANDLE_VALUE()) {
    die "bad hnd";
}



my $tag = Gtk2::Helper->add_watch($rfh, 'in',\&preview_call);

my $window = Gtk2::Window->new();
$window->signal_connect("destroy",sub{Gtk2->main_quit();});
$window->set_size_request(300,300);

    my $hbox = Gtk2::HBox->new();
    $window->add($hbox);

        my $button = Gtk2::Button->new("A");
        $button->signal_connect('clicked'=>sub{
                add_job();
            });
        $hbox->pack_start($button,1,1,0);
        $button = Gtk2::Button->new("B");
        $button->signal_connect('clicked'=>sub{
                print "i do nothing\n";
            });
        $hbox->pack_start($button,1,1,0);

$window->show_all();

Gtk2->main();

sub preview_call {
    my $bRead = 0;
    my $bLeft = 0;
    my $bAvail = 0;
    my $ret = 0;
    my $buffer;
    
    
    $ret = PeekNamedPipe($hnd,undef,0,undef,$bAvail,undef);

    if(!$ret) {
        my $err = Win32::GetLastError();
        die "PNP failed $err $^E";
    }
    
    if($bAvail) {
        print "Available: $bAvail\n";
        sysread($rfh,$buffer,1);
        print $buffer . "\n";
    }else{

    }
    return 1;
}

sub add_job {
    print $wfh "dir\n";
}

    [download]
    Mabuhay Civil Engineers! :D
[reply]
[d/l]
[select]
      I think you hit a bug in Win32::API. 
      2013-06-27  Win32::API v0.76_02    bulk88
..........
   - Fixed, Win32::API::More::Import created Win32::API objs,
     not Win32::API::More

      [download]
      upgrade to 0.76_02 or newer (Win32::API::More objects do automatic packing and unpacking of pointers to numbers, Win32::API objects require you to call pack and unpack yourself to convert the string/buffer filled with C-style binary numbers to Perl numbers)

      or convert the Win32::API::More->Import( to Win32::API->Import(, then pad out $bAvail with $bAvail = "\x00" x 4;, then after PeekNamedPipe, if successful, do unpack('L', $bAvail). Previous sentence is a summary of Win32::API.

      What happened was, because there isn't automatic packing my $bAvail = 0; was stringfied to "0", which is 1 byte long. The C function PeekNamedPipe wrote 4 bytes to $bAvail, even though $bAvail had only 1 byte space. An anti-memory corruption detector in Win32::API caught the mistake.
[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: note [id://1064759]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others surveying the Monastery: (2)
As of 2024-04-24 23:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found