Hello,
I could really use some help here. I have had the following outstanding
problem for two weeks. I have read the mod_perl coding guidelines and the
code below actually comes from page 7 the counter example.
Background: My web site requires a login with a name and password, then I
create a login string and I have to open up a socket into a application that
lives on a Unix box, (so I use IO::Socket). I followed the coding guidelines
on page 7, but still have an issue. The first time they log in, the socket
is created and all is good. If I login the next time, it is as if the socket
is not being recreated, or something funny. It doesn't work after the first
time.
Now I know some of this is caused by the persistant mod-perl. But I have
used all my variables, and I have called the subroutines with a require like
the example, but it still doesn't work.
I am showing all code below. Could someone PLEASE glance at that and tell me
if you see anything silly. I tried this with ActiveStates .plex and it does
the same thing.
I usually don't try wolf, but I have been hacking on this for two weeks with
no success.
### code I call from the browser ####
#! perl -w
use CGI;
use strict;
use vars qw($q);
$q = CGI->new;
print $q->header;
print $q->start_html();
print "BEGIN HERE<BR>";
### THE NAME AND PASSWORD COME FROM A HTML SOURCE IF NOT TESTING FOR AS.
my $password = $q->param('password');
my $username = $q->param('username');
print "$password is password and $username is username<br>\n";
open(ISCRYPT, "D:/Apache/cgi-bin/plex/iscrypt \"$password\" |") or
die("Problems encrypting pw: $!");
my @password = <ISCRYPT>;
close(ISCRYPT);
my $epwd = $password[0];
my $msg = "USERLOGIN\t$username\t$epwd\n";
print "$msg is msg<br>\n";
require "D:/Apache/mod_perl/plex/socket.cgi";
my ($status, $response) = &ask($msg);
print qq{$status and $response is status and response<br>};
#### the code for the require ######
my $handle;
sub ask
{
my ($message) = @_;
&makeSocket;
&SendMessage($message);
my ($status,$response) = &GetResponse();
close($handle);
return ($status, $response);
undef $status;
undef $response;
}
sub makeSocket
{
use IO::Socket;
$counter = 0;
$handle = IO::Socket::INET->new(Proto => 'tcp',
PeerAddr => '208.238.162.204',
PeerPort => '8000',
Type => SOCK_STREAM) or die $@;
$handle->autoflush(1);
$counter++;
print "$counter is counter<br>\n";
print qq{<pre>Connected: 208.238.162.204:8000</pre>};
return 1;
}
sub GetResponse {
my $count = 0;
my $err = 0;
my $response;
my $cc;
my $header;
while ($err < 50) {
if (read($handle, $cc, 1, 0) == 1) {
$header .= $cc;
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($handle, $response, $rspsize, 0)) {
if ($response =~ /RESPONSE\s*OK/) {
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$/) {
die("unknown socket mediabank response: $header");
return -1;
} else {
# keep going haven't hit a newline yet
}
$count++;
} else {
$err++;
}
}
return 0;
}
sub SendMessage
{
my ($message) = @_;
unless ($message) {
die("No message in \'SendMessage\'");
}
my $msgid = int(rand(1000));
$message = $msgid . "\t" . $message;
my $msgsize = length($message);
print "$message and $msgsize is message and msgsize<br>\n";
print $handle "\%BEGIN\t$msgsize\n$message";
}
1;
Scott Purcell
