[rt.cpan.org #61813] crash when using test-async.pl inside PerlCallback, callback system useless

[email protected] ("patcat88 via RT") Fri, 1 Oct 2010 08:04:25 -0400

Newsgroups	perl.libwin32
Message-ID	<[email protected]>

Fri Oct 01 08:04:22 2010: Request 61813 was acted upon.
Transaction: Ticket created by [email protected]
       Queue: Win32-Internet
     Subject: crash when using test-async.pl inside PerlCallback, callback
 system useless
   Broken in: 0.084
    Severity: Critical
       Owner: Nobody
  Requestors: [email protected]
      Status: new
 Ticket <URL: https://rt.cpan.org/Ticket/Display.html?id=61813 >


I updated test-async.pl to talk to a real FTP server, ftp.activeware.com
is dead. 

A crash is triggered at line 82 "$FTP->Get($file, "index.html", 1, 0, 2);"

I included a picture of what Visual Studio debugger said. I can't
analyze the bug any further. The debugger says the crash happened at dSP
macro inside PerlCallback in internet.xs

ActivePerl 5.10.0 build 1003, Windows XP SP3, Win32::Internet 0.084

output of test-async.pl was
-------------------------------------------
I.handle=13369348
callback=0, constant=-1
SetStatusCallback=0
Buffer=
Doing FTP()...
Returned from FTP()...
Error=0The operation completed successfully.
FTP.handle=13369352
STATUS(after FTP)=
Doing Get()...
---------------------------------

w32inet.PNG (image/png, 54.1 KB) - not displayed

test-async.pl (application/octet-stream, 3.8 KB)

#
# TEST-ASYNC.PL
# Test Win32::Internet's Asynchronous Operations
# by Aldo Calpini <[email protected]>
#
# WARNING: this code is most likely to fail with almost-random errors
#          I don't know what is wrong here, any hint will be greatly
#          appreciated! 

use Win32::Internet;

$params{'flags'} = INTERNET_FLAG_ASYNC;
$params{'opentype'} = INTERNET_OPEN_TYPE_DIRECT;
$I = new Win32::Internet(\%params);

# print "Error: ", $I->Error(), "\n";
print "I.handle=", $I->{'handle'}, "\n";

$return = $I->SetStatusCallback();
print "SetStatusCallback=$return";
print "ERROR" if $return eq undef;
print "\n";

$buffer = $I->QueryOption(INTERNET_OPTION_READ_BUFFER_SIZE);
print "Buffer=$buffer\n";

$host = "ftp.mozilla.org";
$user = "anonymous";
$pass = "dada\@perl.it";


print "Doing FTP()...\n";

$handle2 = $I->FTP($FTP, $host, $user, $pass, 21, 1);

print "Returned from FTP()...\n";

($n, $t) = $I->Error();

if($n == 997) {
  print "Going asynchronous...\n";
  ($status, $info) = $I->GetStatusCallback(1);
  while($status != 100 and $status != 70) {
    if($oldstatus != $status) {
      if($status == 60) {
        $FTP->{'handle'} = $info;
      } elsif($status == 10) {
        print "resolving name...                   \n";
      } elsif($status == 11) {
        print "name resolved...                    \n";
      } elsif($status == 20) {
        print "connecting...                       \n";
      } elsif($status == 21) {
        print "connected...                        \n";
      } elsif($status == 30) {
        print "sending...                          \n";
      } elsif($status == 31) {
        print "$info bytes sent.                   \n";
      } elsif($status == 40) {    
        print "receiving...                        \n";
      } elsif($status == 41) {      
        print "$info bytes received.               \n";
      } else {
        print "status=$status\n";
      }    
    }
    $oldstatus = $status;
    ($status, $info) = $I->GetStatusCallback(1);
  }
} else {
  print "Error=", $I->Error(), "\n";
}
print "FTP.handle=", $FTP->{'handle'}, "\n";
print "STATUS(after FTP)=", $I->GetStatusCallback(1), "\n";

#                                    "/pub/microsoft/sdk/activex13.exe",

print "Doing Get()...\n";

$file = "index.html";

$FTP->Get($file, "index.html", 1, 0, 2);

print "Returned from Get()...\n";

($n, $t) = $I->Error();
if($n == 997) {
  print "Going asynchronous...\n";
  $bytes = 0;
  $oldstatus = 0;
  ($status, $info) = $I->GetStatusCallback(2);
  while($status != 100 and $status != 70) {
    # print "status=$status info=$info\n";
    # if($oldstatus!=$status) {
      if($status == 10) {
        print "resolving name...                   \n";
      } elsif($status == 11) {
        print "name resolved...                    \n";
      } elsif($status == 20) {
        print "connecting...                       \n";
      } elsif($status == 21) {
        print "connected...                        \n";
      #} elsif($status == 30) {
      #  print "sending...                          \n";
      } elsif($status == 31) {
        print "$info bytes sent.                   \n";
      #} elsif($status == 40) {    
      #  print "receiving...                       \n";
      } elsif($status == 41) {      
        $bytes = $bytes+$info;
        print "$bytes bytes received.              \n";
      #} else {
      #  print "status=$status\n";
      }
    # }
    $oldstatus = $status;
    undef $status, $info;
    ($status, $info) = $I->GetStatusCallback(2);
  } 
} else {
  print "Error=[$n] $t\n";
}
print "\n";
($status, $info) = $I->GetStatusCallback(2);
print "STATUS(after Get)=$status\n";
print "Error=", $I->Error(), "\n";
exit(0);