Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

Win32::Internet crash, XS, callbacks, perl stack & context, windows api, interpreter thread safety, 1 perl, many C threads by windows

by patcat88 (Deacon)
on Oct 06, 2010 at 07:15 UTC ( [id://863726]=perlquestion: print w/replies, xml ) Need Help??

patcat88 has asked for the wisdom of the Perl Monks concerning the following question:

I tried to use Win32::Internet 0.084 Win32-Internet on CPAN, and found a crash in it involving the windows API, XS, callbacks, threading, and deep dark undocumented behaviour inside perl. I filed a bug at rt://61813 but I doubt the author will ever fix it since he hasn't released anything since 2008 on CPAN as far as I can tell, so as far as I'm concerned Win32::Internet is abandoned. If theres a bug I have to fix it myself. My XS and C skills are not very much more than Hello World. Bear with me, this post is very long and detailed.

I recompile the module with this command line, "nmake clean & perl makefile.pl & nmake & nmake install", I had to run vcvars32.bat before being able to compile BTW. Also makefile.pl didn't want to include wininet.lib so I patched it. Patch is included below if you need it. Activestate CPAN PPM bot is able to compile the module somehow with the original makefile.pl http://ppm4.activestate.com/MSWin32-x86/5.10/1000/J/JD/JDB/Win32-Internet-0.084.d/log-20080616T113425.txt. I use ActivePerl 5.10.0 Build 1003, on Windows XP SP3, with Visutal Studio 2003.

I discovered the reason the callbacks crash is that windows sometimes runs the callback inside a thread that windows made inside perl.exe (confirmed by procmon and my patched XS), and Perl_get_context(), which is run by dSP; returns a null pointer, only when its in a different thread than the main perl engine. I don't know why Perl_get_context() is returning a null pointer in another thread. Why isn't the perl engine variable/function available in all threads in the perl process? is it a bug or a feature of perl? Can someone enlighten me whats going on?

I did some research, and found someone had something similar but I don't understand the problem he had, but I saw the solution he had in http://www.nntp.perl.org/group/perl.ithreads/2008/08/msg1319.html, and I tried the idea of having a C static with the perl engine pointer saved in it and the callback using the static to give the perl engine pointer to PERL_SET_CONTEXT(); to make our callback aware of the perl engine, and then Perl_get_context() will not return a null pointer. perlcall never mentions engine pointers or context perlguts only skims over the purpose of PERL_SET_CONTEXT and implies PERL_GET_CONTEXT is private to core and you have no reason to care what it is since it should only be used internally by macros. What type is "some_perl" in " PERL_SET_CONTEXT(some_perl);"? where do I get it? Useless! perlapi says undocumented, but its marked public in embed.fnc! Anyways.

I also tried putting dTHX; before dSP; which I've seen other XS modules do but that didn't fix the problem. I couldn't figure out any solution from Win32::API::Callback, PM or XS. I'm not sure if Win32::API::Callback would've had the same problems using WinInet that Win32::Internet has (the callback being run inside a different thread than the thread with the perl interpreter). In my amateur opinion, I couldn't see anything that would deal with Perl_get_context() giving null pointers, maybe a monk with more knowlege can tell me if Win32::API::Callback would suffer the same problem that Win32::Internet does in dealing with WinInet.

I dont know how safe or proper this fix I made is.
Will there be a memory leak or something because of the fact that I keep doing the PERL_SET_CONTEXT()s over and over and even inside the original perl thread? What about ithreads compatibility? In ithreads would my C static become unique or will it keep getting clobbered by different interpreters and the callback results will be posted to the wrong interpreter? Instead of the original authors's idea of having the C callback that is called by windows run a Perl PM callback with the C callback's parameters passed, and the Perl PM callback saves it in the PM package global in a hash, should some non-perl-ish IPC mechanism (I only know of MMF on Win32 Perl) be used to return the result to perl and then you dont have to move around the perl engine pointer?

Another idea I got from Microsoft's documentation on WinInet is, for the context number to be a pointer back to something in your application, rather than just a consecutivly assigned interger you used. Would a more thread safe solution than the C static or some complicated MMF IPC done from XS land/C, be, to use pack() to get a pointer to a struct/scalar that has the perl engine ptr, HINTERNET handle and the user's original context number as 3 unsigned longs/DWORDs/4bytes, and the pointer becomes the context number given to Windows? The C callback will get its perl engine ptr by dereferencing the ptr (I think), and it would allow for multiple Win32::Internet objects since each context number (which is now a pointer to a unique struct) is now unique. The PM gets the perl engine pointer from an XS function that returns it (sounds easy for me to impliment).

Or would a safer idea be to get rid of the PM globals in Win32::Internet for storing the callback results and make a Perl method in the PM that will store the callback results in the object instance, and the pointer/context number given to windows points to the inside of a scalar which has a struct/fixed length string of 3 longs (perl engine pointer for PERL_SET_CONTEXT, ref/pointer of blessed PM object that will go on the perl stack for call_method() as in perlcall, and the user's original context number), the C callback runs the method in the PM object, and the PM method gets its parameters from the perl stack/@_?

Another idea I had was, each object instance of Win32::Internet would have a status hash inside it, the hash names are the user's context number, value is pre-padded/allocated in perl with 8 bytes, 2 longs/DWORDs (x operator). The pointer from pack becomes the context number parameter given to windows, the callback has no idea what perl is. It just copies its 2 DWORDs it got from windows into the pointer that it got in the "context number" which came from pack. Back in the PM the value is unpacked into 2 ints when the user calls the method to get the current callback status. I guess the status hash will be garbage collected automatically when the Win32::Internet object goes out of scope. The PM's DESTORY method which closes the WinInet handle, would make sure no more callbacks are fired and they don't try to write to pointers that represent garbage collected scalars? Whats this poisoning I hear about? Should I test for it in my hypothetical "perl unaware" callback? How safe is this callback strategy compared to the 2 others above?

I saw in the post about the C static used to move the perl engine pointer http://www.nntp.perl.org/group/perl.ithreads/2008/08/msg1319.html, he was using mutexes. Are mutexes needed for Win32::Internet? Can 2 different callbacks in 2 different threads safely share 1 perl engine? are they even sharing a perl engine or just the "perl stack pointer", which I don't fully understand what that term is. Can 2 different callbacks in 2 different threads run their PM Perl callback functions without colliding (will the perl bytecode ops get interleved to garbage)? And more importantly, is it safe in the first place to call a perl method in the perl interpretor from a thread that isn't the thread that the perl interpretor lives in? is there a risk of the perl interpretor being busy doing something else and its unsafe to interact with it from another thread inside the perl.exe?

I have found very little information on XS and multiple C threads with 1 perl interpreter on the internet. I hope my long post makes sense, it was written in pieces over a few days.

Here is the sample script with PERL_SET_CONTEXT() commented out, it replicates the original bug inside the implementation. What is interesting is until I press the "Dont Send" button in the crash box on Windows XP, "sleeping while downloading" keeps appearing, so the main perl engine thread is still alive and kicking. 
C:\Documents and Settings\Owner\Desktop>perl w32inethttpsample.pl
Perl perl land thread id=27716
callback=0, constant=-1
PerlCallback: entering
PerlCallback: got context=1 mystatus=60
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=27716
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
r=13369352
Connection num=0,text=The operation completed successfully.
callback INTERNET_STATUS_HANDLE_CREATED 13369352
PerlCallback: entering
PerlCallback: got context=2 mystatus=60
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=27716
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
callback INTERNET_STATUS_HANDLE_CREATED 13369356
OpenRequest num=122,text=The data area passed to a system call is too 
+small.
We are at last point before SendRequest(), which will trigger the cras
+h
Press any key to continue . . .
SendRequest num=997,text=Overlapped I/O operation is in progress.
callback INTERNET_STATUS_HANDLE_CREATED 13369356
sleeping while downloading
PerlCallback: entering
PerlCallback: got context=2 mystatus=320
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=6728
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00000000
sleeping while downloading
sleeping while downloading
sleeping while downloading
sleeping while downloading

C:\Documents and Settings\Owner\Desktop>

[download]
Below is same sample script with PERL_SET_CONTEXT being run. 
C:\Documents and Settings\Owner\Desktop>perl w32inethttpsample.pl
Perl perl land thread id=48644
callback=0, constant=-1
PerlCallback: entering
PerlCallback: got context=1 mystatus=60
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=48644
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
r=13369352
Connection num=0,text=The operation completed successfully.
callback INTERNET_STATUS_HANDLE_CREATED 13369352
PerlCallback: entering
PerlCallback: got context=2 mystatus=60
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=48644
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
callback INTERNET_STATUS_HANDLE_CREATED 13369356
OpenRequest num=122,text=The data area passed to a system call is too 
+small.
We are at last point before SendRequest(), which will trigger the cras
+h
Press any key to continue . . .
SendRequest num=997,text=Overlapped I/O operation is in progress.
callback INTERNET_STATUS_HANDLE_CREATED 13369356
sleeping while downloading
PerlCallback: entering
PerlCallback: got context=2 mystatus=320
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=45252
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
PerlCallback: entering
PerlCallback: got context=2 mystatus=10
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=45252
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
PerlCallback: entering
PerlCallback: got context=2 mystatus=11
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=45252
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
PerlCallback: entering
PerlCallback: got context=2 mystatus=20
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=45252
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
PerlCallback: entering
PerlCallback: got context=2 mystatus=21
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=45252
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
PerlCallback: entering
PerlCallback: got context=2 mystatus=30
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=45252
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
PerlCallback: entering
PerlCallback: got context=2 mystatus=31
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=45252
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
PerlCallback: entering
PerlCallback: got context=2 mystatus=40
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=45252
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
PerlCallback: entering
PerlCallback: got context=2 mystatus=41
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=45252
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
PerlCallback: entering
PerlCallback: got context=2 mystatus=110
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=45252
PerlCallback: GetLastError() =10035
PerlCallback: GetLastError() =10035
PerlCallback: pointer from Perl_get_context() =00233BFC
PerlCallback: entering
PerlCallback: got context=2 mystatus=320
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=45252
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
PerlCallback: entering
PerlCallback: got context=2 mystatus=10
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=45252
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
PerlCallback: entering
PerlCallback: got context=2 mystatus=11
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=45252
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
PerlCallback: entering
PerlCallback: got context=2 mystatus=20
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=45252
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
PerlCallback: entering
PerlCallback: got context=2 mystatus=21
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=45252
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
PerlCallback: entering
PerlCallback: got context=2 mystatus=30
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=45252
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
PerlCallback: entering
PerlCallback: got context=2 mystatus=31
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=45252
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
PerlCallback: entering
PerlCallback: got context=2 mystatus=40
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=45252
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
PerlCallback: entering
PerlCallback: got context=2 mystatus=41
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=45252
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
PerlCallback: entering
PerlCallback: got context=2 mystatus=100
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=45252
PerlCallback: GetLastError() =0
PerlCallback: GetLastError() =0
PerlCallback: pointer from Perl_get_context() =00233BFC
HTTP code = 200
callback INTERNET_STATUS_REQUEST_COMPLETE 0
first 40 chars of file are "<!doctype html><html><head><meta http-eq"
PerlCallback: entering
PerlCallback: got context=2 mystatus=70
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=48644
PerlCallback: GetLastError() =10035
PerlCallback: GetLastError() =10035
PerlCallback: pointer from Perl_get_context() =00233BFC
PerlCallback: entering
PerlCallback: got context=1 mystatus=70
PerlCallback: myWin32InternetPerlInterpreterPtr=00233BFC
PerlCallback: ThreadId=48644
PerlCallback: GetLastError() =10035
PerlCallback: GetLastError() =10035
PerlCallback: pointer from Perl_get_context() =00233BFC

C:\Documents and Settings\Owner\Desktop>

[download]
Heres the sample script I am using to generate the above 2 test runs. 
#!/usr/bin/perl -w
use Win32; #for Win32::GetCurrentThreadId()
use Win32::Internet;
%s = (
'10' => 'INTERNET_STATUS_RESOLVING_NAME',
'11' => 'INTERNET_STATUS_NAME_RESOLVED',
'20' => 'INTERNET_STATUS_CONNECTING_TO_SERVER',
'21' => 'INTERNET_STATUS_CONNECTED_TO_SERVER',
'30' => 'INTERNET_STATUS_SENDING_REQUEST',
'31' => 'INTERNET_STATUS_REQUEST_SENT',
'40' => 'INTERNET_STATUS_RECEIVING_RESPONSE',
'41' => 'INTERNET_STATUS_RESPONSE_RECEIVED',
'42' => 'INTERNET_STATUS_CTL_RESPONSE_RECEIVED',
'43' => 'INTERNET_STATUS_PREFETCH',
'50' => 'INTERNET_STATUS_CLOSING_CONNECTION',
'51' => 'INTERNET_STATUS_CONNECTION_CLOSED',
'60' => 'INTERNET_STATUS_HANDLE_CREATED',
'70' => 'INTERNET_STATUS_HANDLE_CLOSING',
'80' => 'INTERNET_STATUS_DETECTING_PROXY',
'100' => 'INTERNET_STATUS_REQUEST_COMPLETE',
'110' => 'INTERNET_STATUS_REDIRECT',
'120' => 'INTERNET_STATUS_INTERMEDIATE_RESPONSE',
'140' => 'INTERNET_STATUS_USER_INPUT_REQUIRED',
'200' => 'INTERNET_STATUS_STATE_CHANGE',
'320' => 'INTERNET_STATUS_COOKIE_SENT',
'321' => 'INTERNET_STATUS_COOKIE_RECEIVED',
'324' => 'INTERNET_STATUS_PRIVACY_IMPACTED',
'325' => 'INTERNET_STATUS_P3P_HEADER',
'326' => 'INTERNET_STATUS_P3P_POLICYREF',
'327' => 'INTERNET_STATUS_COOKIE_HISTORY'
);

$c = new Win32::Internet({'flags'=>INTERNET_FLAG_ASYNC});
print "Perl perl land thread id=".Win32::GetCurrentThreadId()."\n";
$c->SetStatusCallback();
print 'r='.$c->HTTP($http, "google.com", undef, undef, undef, undef, 1
+)."\n";
($num, $text) = $c->Error();
print "Connection num=$num,text=$text\n";

#($status, $info) = $c->GetStatusCallback(1);
#print 'callback '.$s{$status}." $info \n";

$http->OpenRequest($req, '/', 'GET', 'HTTP/1.1', '', undef, 0, 2);

#($status, $info) = $c->GetStatusCallback(2);
#print 'callback '.$s{$status}." $info \n";

($num, $text) = $http->Error();
print "OpenRequest num=$num,text=$text\n";
print "We are at last point before SendRequest(), which will trigger t
+he crash\n";
system('pause');
$req->SendRequest();
($num, $text) = $http->Error();
print "SendRequest num=$num,text=$text\n";

#($status, $info) = $c->GetStatusCallback(2);
#print 'callback '.$s{$status}." $info \n";

while($req->QueryInfo("",HTTP_QUERY_STATUS_CODE) == 0) {print "sleepin
+g while downloading\n"; sleep 1;}
print "HTTP code = ".$req->QueryInfo("",HTTP_QUERY_STATUS_CODE)."\n";

#($status, $info) = $c->GetStatusCallback(2);
#print 'callback '.$s{$status}." $info \n";

$file = $req->ReadEntireFile();
print 'first 40 chars of file are "'.substr($file,0,40)."\"\n";
 
$http->Close();

[download]
The below is the patch file against Internet.xs 
--- internet.xs.old    2008-04-15 20:01:52.000000000 -0400
+++ internet.xs    2010-10-05 03:18:24.609375000 -0400
@@ -57,7 +57,7 @@
 
 // VALUES FILLED IN BY PerlCallback
 DWORD status = -1;
-
+static PerlInterpreter *myWin32InternetPerlInterpreterPtr;
 static time_t ft2timet(FILETIME *ft)
 {
     SYSTEMTIME st;
@@ -824,7 +824,22 @@
     // ;)
 
     // if(mystatus!=status) {
-        dSP;
+        SV **sp;
+        void * myptr;
+        printf("PerlCallback: entering\n");
+        printf("PerlCallback: got context=%d mystatus=%d\n",context,m
+ystatus);
+        printf("PerlCallback: myWin32InternetPerlInterpreterPtr=%p\n"
+,myWin32InternetPerlInterpreterPtr);
+        
+        //comment below out to trigger original crash/bug in Win32::I
+nternet and recompile
+        PERL_SET_CONTEXT(myWin32InternetPerlInterpreterPtr);
+        
+        printf("PerlCallback: ThreadId=%d\n",GetCurrentThreadId());
+        printf("PerlCallback: GetLastError() =%d\n",GetLastError());
+        myptr = PERL_GET_CONTEXT;
+        printf("PerlCallback: GetLastError() =%d\n",GetLastError());
+        printf("PerlCallback: pointer from Perl_get_context() =%p\n",
+myptr);
+        //can't use dSP because we are after variable declarations
+        sp = PL_stack_sp;
         ENTER;
         SAVETMPS;
         PUSHMARK(sp);
@@ -889,6 +904,7 @@
     LPCTSTR proxybypass
     DWORD flags
 CODE:
+    myWin32InternetPerlInterpreterPtr = my_perl;
     RETVAL = InternetOpen(agent,type,proxy,proxybypass,flags);
 OUTPUT:
     RETVAL

[download]
If anyone wants, here is my modified makefile.pl patch 
--- makefile.pl.old    2008-02-22 18:41:48.000000000 -0500
+++ makefile.pl    2010-10-03 21:23:51.500000000 -0400
@@ -22,16 +22,18 @@
 use Config qw(%Config);
 sub const_loadlibs {
     my ($self) = @_;
-    if ($^O eq "MSWin32") {
-    if ($Config{cc} =~ /^gcc/i) {
-        $self->{LDLOADLIBS} .= " -lwininet";
-    }
-    elsif ($Config{cc} =~ /^bcc/i) {
-        $self->{LDLOADLIBS} .= " inet.lib";
-    }
-    elsif ($] == 5.006 && $Config{cc} =~ /^cl/i) {
-        $self->{LDLOADLIBS} .= " wininet.lib";
-    }
-    }
+    $self->{LDLOADLIBS} .= " wininet.lib";
+
+#    if ($^O eq "MSWin32") {
+#    if ($Config{cc} =~ /^gcc/i) {
+#        $self->{LDLOADLIBS} .= " -lwininet";
+#    }
+#    elsif ($Config{cc} =~ /^bcc/i) {
+#        $self->{LDLOADLIBS} .= " inet.lib";
+#    }
+#    elsif ($] == 5.006 && $Config{cc} =~ /^cl/i) {
+#        $self->{LDLOADLIBS} .= " wininet.lib";
+#    }
+ #   }
     return $self->SUPER::const_loadlibs;
 }

[download]
  • Comment on Win32::Internet crash, XS, callbacks, perl stack & context, windows api, interpreter thread safety, 1 perl, many C threads by windows
  • Select or Download Code

Replies are listed 'Best First'.
Re: Win32::Internet crash, XS, callbacks, perl stack & context, windows api, interpreter thread safety, 1 perl, many C threads by windows
by BrowserUk (Patriarch) on Oct 06, 2010 at 08:54 UTC

    In a nutshell, when you ask Win32::Internet to do an async request, it calls you back to tell you when the request completes. That callback is called on a C thread created by the system for the purpose. Perl (obviously) has no knowledge of that thread, so it has never been initialised with an interpreter context. Hence Perl_get_context() cannot return the "context" that would be required in order to allow you to use an interpreter within that thread.

    In very simplistic terms--because those are the only terms I know this in--the perl interpreter needs to retain some information--CWD %ENV, @INC etc--in order to function. Pre-threaded days, this information was stored in C static storage. One interpreter, one copy, no problem.

    When threading was added, some of this previously process global state needed to be replicated on a per-thread/interpreter basis. Obviously one lump of C static storage wasn't going to cut it, so they invented "contexts". Essentially, this is a dynamically allocated piece of storage--1 per interpreter/thread--and clone the initial threads variables into it. It is the pointer to this per-thread storage that is returned by Perl_get_context().

    Because the thread started by the asynchronous inet request is not started by perl, it doesn't have a "context", hence you get the null return from Perl_get_context(); and everything goes tits-up when you attempt to use the perlapi without one.

    What your patch does is to bypass the initial problem by providing a "context" (PerlInterpreter *) via Perl_set_context(). But as you have never initialised that pointer to point to a PerlInterpreter structure, you're living on borrowed time.

    If the callback sub attempted to do anything that modified the interpreters state--which means just about anything more than it currently does--then the perlapi would attempt to indirect through that pointer and obviously crash.

    You might consider initialising it properly using perl_alloc() and perl_construct() (See perlembed for details), but you'd then have to ensure than you clean up afterward--perl_destruct() & perl_free(). And doing that for every callback would get very expensive.

    You might consider initialising the perlInterpreter once, in new(), if the ASYNC flag is set, and clean it up in the DESTROY method.

    Another--and I think better--option might be to not use perl in the callback at all. That is, have a pure C callback function that you pass to SetCallback() and have that store the relevant information in a C array, ("indexed" by the context value supplied on the OpenRequest()). Thereby avoiding the need to get a context in the callback.

    You retain the OpenRequest() context value and use it to retrieve the information from the C array when QueryInfo() is called.

    There is much more to this, much of which I don't fully understand, but I'll stop there before this post rivals yours for length :)

    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
[select]
Re: Win32::Internet crash, XS, callbacks, perl stack & context, windows api, interpreter thread safety, 1 perl, many C threads by windows
by sundialsvc4 (Abbot) on Oct 06, 2010 at 13:17 UTC

    In situations similar-but-different to this, I also have found that the best thing to use for “a callback” is a very short stub routine ... written in baggage-free “C.”   All that the callback routine does, really, is to store relevant status information and send some kind of a signal.   High-level languages such as Perl usually carry a lot of baggage around with them ... but a callback does not really need to have one.

    Mutual-exclusion, of course, is quite a necessity ... but in the callback routine you use the same low-level OS primitives that you know the high-level language will also respect and use.   (You aren’t using the language’s constructs, but you make certain that the two pieces of code will interlock as they should.)

    I have also learned, again quite painfully, that whenever an API provides for a “handle” (as they, of course, always do...), that handle ought to be a random number that can be safely looked-up in a hash owned by you.   In other words, it should never be “a pointer.”   Aside from the fact that we are now routinely dealing with 64-bit addresses (and 32-bit legacy integer handles), a pointer can’t be verified ... so it is a “memory stomp” waiting to happen.   Random handles, on the other hand, can be looked-up and thereby verified... and if they are no longer present in the hash structure (for whatever reason), we have “a reportable bug-condition” (probably), “but not a stomp.”

    The callback logic, then, might go something like this:

    1. Grab a mutual-exclusion object (using a low-level OS call).
    2. Look up the handle that is provided.   If it cannot be found, release the mutex and exit silently.
    3. Store the information into the data-structure thus located.   This data structure should be a buffer that the high-level language side already carved out for you.   Check it for bogosity...
    4. Signal an event that the main logic might be waiting for.   Unlock the mutex and exit.

      My idea of stress testing the algorithm is removing the sleep from while not done loop in the sample script, and replacing the sleep with usleep(1);.

      I've added mutexes guarding the getting of the callback status from the global PM hash, and the calling of the Perl method that sets the status into the global PM hash from XS.

      I consider stability, FOR NOW, to be 10 runs without crashes or perl panics or strange errors on the console. 
      void WINAPI CALLBACK
PerlCallback(HINTERNET h, 
       DWORD context, 
       DWORD mystatus, 
       LPVOID mystatusinfo, 
       DWORD mystatuslength) {

    DWORD myret;
    HINTERNET myhandle;

    // Let's try with perl_call_method
    // ...to clarify:
    // a C routine 
    // called from Perl
    // callbacks this C routine 
    // that callbacks a Perl routine.
    // ;)

    // if(mystatus!=status) {
        SV **sp;
          HANDLE hMutex;
          char mutexname [sizeof("Win32InternetPerlMutex") + sizeof(DW
+ORD)*8];
          DWORD waitres;
          //char [23 + sizeof(DWORD)*8] mutexname;
        //void * myptr;
        //printf("PerlCallback: entering\n");
        printf("PerlCallback: got handle=%d context=%d mystatus=%d\n",
+h,context,mystatus);
        //printf("PerlCallback: myWin32InternetPerlInterpreterPtr=%p\n
+",myWin32InternetPerlInterpreterPtr);
        
        //comment below out to trigger original crash/bug in Win32::In
+ternet and recompile
        PERL_SET_CONTEXT(myWin32InternetPerlInterpreterPtr);
        
        //printf("PerlCallback: ThreadId=%d\n",GetCurrentThreadId());
        //printf("PerlCallback: GetLastError() =%d\n",GetLastError());
        //myptr = PERL_GET_CONTEXT;
        //printf("PerlCallback: GetLastError() =%d\n",GetLastError());
        //printf("PerlCallback: pointer from Perl_get_context() =%p\n"
+,myptr);
        //can't use dSP because we are after variable declarations
        sp = PL_stack_sp;
        ENTER;
        SAVETMPS;
        PUSHMARK(sp);
        // XPUSHs(sv_2mortal(newSVpv("Win32::Internet\0",0)));
        XPUSHs(sv_2mortal(newSViv(context)));
        XPUSHs(sv_2mortal(newSViv(mystatus)));
        switch(mystatus) {
        case INTERNET_STATUS_HANDLE_CREATED:
            myhandle=(HINTERNET) *(LPHINTERNET)mystatusinfo;
            XPUSHs(sv_2mortal(newSViv((DWORD) myhandle)));
            break;
        case INTERNET_STATUS_RESPONSE_RECEIVED:
        case INTERNET_STATUS_REQUEST_SENT:
            myret=(DWORD) *(LPDWORD)mystatusinfo;
            // printf("PerlCallback: received/sent(%d) %d bytes\n",mys
+tatus,myret);
            XPUSHs(sv_2mortal(newSViv(myret)));
            break;
        default:
            XPUSHs(sv_2mortal(newSViv(0)));
            break;
        }
        PUTBACK;
        // printf("PerlCallback: calling callback with context=%d, sta
+tus=%d\n",context,mystatus);
          sprintf(mutexname ,"Win32InternetPerlMutex%u", GetCurrentPro
+cessId());
          //printf("PerlCallback: mutexname=%s\n",mutexname);
          hMutex = OpenMutex(MUTEX_ALL_ACCESS, FALSE, mutexname);
          if (hMutex == NULL) printf("PerlCallback: OpenMutex error: %
+d\n", GetLastError() );
          else printf("PerlCallback: OpenMutex successfully opened the
+ mutex.\n");
          waitres = WaitForSingleObject(hMutex,500000);
          printf("PerlCallback: wait result =%d\n",waitres);



        perl_call_pv("Win32::Internet::callback", G_DISCARD);

          printf("PerlCallback: release mutex res=%d\n",ReleaseMutex(h
+Mutex));
          CloseHandle(hMutex);
          
        FREETMPS;
        LEAVE;

    // }
    // status=mystatus;
    // return;
}

      [download]
      was never stable until usleep(100000); 
      void WINAPI CALLBACK
PerlCallback(HINTERNET h, 
       DWORD context, 
       DWORD mystatus, 
       LPVOID mystatusinfo, 
       DWORD mystatuslength) {

    DWORD myret;
    HINTERNET myhandle;



    // Let's try with perl_call_method
    // ...to clarify:
    // a C routine 
    // called from Perl
    // callbacks this C routine 
    // that callbacks a Perl routine.
    // ;)

    // if(mystatus!=status) {
        SV **sp;
          HANDLE hMutex;
          char mutexname [sizeof("Win32InternetPerlMutex") + sizeof(DW
+ORD)*8];
          DWORD waitres;
          //char [23 + sizeof(DWORD)*8] mutexname;
        //void * myptr;
        //printf("PerlCallback: entering\n");
          sprintf(mutexname ,"Win32InternetPerlMutex%u", GetCurrentPro
+cessId());
          //printf("PerlCallback: mutexname=%s\n",mutexname);
          hMutex = OpenMutex(MUTEX_ALL_ACCESS, FALSE, mutexname);
          if (hMutex == NULL) printf("PerlCallback: OpenMutex error: %
+d\n", GetLastError() );
          else printf("PerlCallback: OpenMutex successfully opened the
+ mutex.\n");
          waitres = WaitForSingleObject(hMutex,500000);
          printf("PerlCallback: wait result =%d\n",waitres);
        printf("PerlCallback: got handle=%d context=%d mystatus=%d\n",
+h,context,mystatus);
        //printf("PerlCallback: myWin32InternetPerlInterpreterPtr=%p\n
+",myWin32InternetPerlInterpreterPtr);
        
        //comment below out to trigger original crash/bug in Win32::In
+ternet and recompile
        PERL_SET_CONTEXT(myWin32InternetPerlInterpreterPtr);
        
        //printf("PerlCallback: ThreadId=%d\n",GetCurrentThreadId());
        //printf("PerlCallback: GetLastError() =%d\n",GetLastError());
        //myptr = PERL_GET_CONTEXT;
        //printf("PerlCallback: GetLastError() =%d\n",GetLastError());
        //printf("PerlCallback: pointer from Perl_get_context() =%p\n"
+,myptr);
        //can't use dSP because we are after variable declarations
        sp = PL_stack_sp;
        ENTER;
        SAVETMPS;
        PUSHMARK(sp);
        // XPUSHs(sv_2mortal(newSVpv("Win32::Internet\0",0)));
        XPUSHs(sv_2mortal(newSViv(context)));
        XPUSHs(sv_2mortal(newSViv(mystatus)));
        switch(mystatus) {
        case INTERNET_STATUS_HANDLE_CREATED:
            myhandle=(HINTERNET) *(LPHINTERNET)mystatusinfo;
            XPUSHs(sv_2mortal(newSViv((DWORD) myhandle)));
            break;
        case INTERNET_STATUS_RESPONSE_RECEIVED:
        case INTERNET_STATUS_REQUEST_SENT:
            myret=(DWORD) *(LPDWORD)mystatusinfo;
            // printf("PerlCallback: received/sent(%d) %d bytes\n",mys
+tatus,myret);
            XPUSHs(sv_2mortal(newSViv(myret)));
            break;
        default:
            XPUSHs(sv_2mortal(newSViv(0)));
            break;
        }
        PUTBACK;
        // printf("PerlCallback: calling callback with context=%d, sta
+tus=%d\n",context,mystatus);



        perl_call_pv("Win32::Internet::callback", G_DISCARD);

        FREETMPS;
        LEAVE;
          printf("PerlCallback: release mutex res=%d\n",ReleaseMutex(h
+Mutex));
          CloseHandle(hMutex);
    // }
    // status=mystatus;
    // return;
}

      [download]
      Only 1 out of 5 runs weren't stable at usleep(10000); in the getstatus loop in the test script.

      I'm guessing that some of what BrowserUk said in Win32::Internet crash, XS, callbacks, perl stack & context, windows api, interpreter thread safety, 1 perl, many C threads by windows, in suggesting starting a new perl instance every time the C callback was fired by Windows, rather than using the main perl instance, is the "safe" way to do it.

      I'm guessing a single perl instance isn't thread safe. From my amateur looking at the XS of [threads-shared], the "shared" variables have their own perl instance that lives with them, and the "context" is switched around before using perl functions. Neither the parent/main thread or child thread perl interpreters ever get to operate on the shared variables, I think. Mutexes guard the shared interpreter from being commanded by 2 or more threads at the same time I think.

      Saving a copy of the perl instance pointer to use from another thread would only work if I can put the other, main thread to sleep, without question. I wonder if http://msdn.microsoft.com/en-us/library/ms686345%28VS.85%29.aspx would work? or is it completely unacceptable to use that in anything remotely approaching production code?
[reply]
[d/l]
[select]

        I'm looking forward to seeing sundialsvc4's detailed and insightful responses to your questions.

[reply]

Back to 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: perlquestion [id://863726]
Approved by Corion
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others cooling their heels in the Monastery: (3)
As of 2024-04-24 22:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found