Socket Nightmare On NT.

[Purcell, Scott]

Hello,
I am running mod_perl 1.2 on NT. I have been working with it for over 4
months, and am beginning to understand it. But for the past 4 months, I have
complained about a socket problem using IO socket. The only answer I got was
to turn the max child from 50 to 1. When I do that the IO::Socket module
works. But the site runs in a serial mode. Why use mod_perl then? It is
slower than running on a Macintosh. Anyway, I have to talk sockets for my
product to work. 

The code below works under cgi-bin all day long. But as I said it blows up
(works once) under mod_perl.

Is there anything I can do to get the sockets to work under mod_perl? Or
should I go back to cgi-bin applications? I am at the end of my rope and
could use some sound information. Anyone out there lend a hand?

Thanks,

Scott Purcell


### simple socket code #######
#! perl

use CGI;
use CGI::Carp qw/fatalsToBrowser/;

my $q = new CGI;
print $q->header();
print $q->start_html("HELLO");

use IO::Socket;

$socket = IO::Socket::INET->new(PeerAddr => 'xxx.238.162.xxx',
                                PeerPort => '9000',
                                Proto    => 'tcp') or
    die("No connect iosocket. $@\n");


my $username = 'VBO';
my $password = 'VBO';


open (ISCRYPT, "d:/Apache/mod_perl/vb/iscrypt \"$password\" |")
        or die("Cannot encrypt password for verification.");
my @password = <ISCRYPT>;
my $ePassword = $password[0];
close ISCRYPT;

$message = "999\tUSERLOGIN\t$username\t$ePassword\n";
my $msgsize = length($message);
print $socket "\%BEGIN\t$msgsize\n$message\n";
print "Message to $productName :\n<pre>$message</pre>\n\n";

&GetMessage($socket);


sub GetMessage {
    my $fh = shift;
    my $err = 0;
    my $header;
    my $response;

    while ($err < 50) {
        if (read($fh, $cc, 1, 0) == 1) {
            $header .= $cc;
            print "$header<br>\n";
            if ($header =~ /^\%BEGIN\s+(\d+)\r?\n/) {
                # we've acquired one line's worth of response
                my $rspsize = $1; # how much response to read
                if (read($fh, $response, $rspsize, 0)) {
                    if ($response =~ /RESPONSE\s*OK/) {
                        print "$response is response<br>\n";
                        return (1, $response);
                    } else {
                        return (-1, $response);
                    }
                } else {
                    return 0;
                }
            } elsif ($header =~ /\%CONTINUE\s*\r?\n/ || $header =~
/\%END\s*\r?\n/) {
                undef $header;
            } elsif ($header =~ /\n$/) {
                &squawk("unknown mediabank response: $header");
                return -1;
            } else {
                # keep going haven't hit a newline yet
            }
            $count++;
        } else {
            $err++;
        }
    }
    return 0;
}




close ($socket);
undef ($socket);