Perl web fetching script, please help

[Alex Merek]

Greets all!

Trying to write a web fetching script that goes out on a couple of websites I have an account with and grabs the data. The following works with some of the sites where I'm able to pass my auth info directly in GET string or via a single cookie, but some others I can't get it to work with as there seem to be more than one cookie set up. A total of 3 session cookies actually - SESSION_ID which contains an 18 character id, HASH, which contains 24 character id I'm guessing, and a USERNAME which is empty.



sub getWebpage {
### Declare constants
my $PORT = 80;
my $BIG = 1024*1024;
my $TCP = join('', getprotobyname('tcp'));
### Read passed in variables
my ($server, $document, $cookie) = @_;
### Initialize local variables
my @addrs; my $dummy; my $len; my $data; my $xyz;
### Set HTTP headers
my @Headers = ('User-Agent', 'http-get/1.1');
if ($cookie) {
@Headers = (@Headers, "Cookie", $cookie);
}
### Resolve $server, stores IP octets in @addrs
if ($server =~ /^[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+$/) {
@addrs = pack('C4', split(/\./,$server));
} else {
($dummy,$dummy,$dummy,$dummy, @addrs) = gethostbyname($server);
}
### Creates remote socket
my $remote = pack("S n a4 x8", 2, $PORT, $addrs[0]);
### Create socket S to $remote and connect to it
socket(S, 2, 1, $TCP) || die "ERROR: Connect failed<BR>\n";
connect(S, $remote) || die "ERROR: Connect failed<BR>\n";
select(S); $| = 1;
select(STDOUT); $| = 1;
### Form HTTP request command
my $request = "GET $document HTTP/1.0\r\n";
while ($#Headers > 0) {
$request = $request . "$Headers[0]: $Headers[1]\r\n";
shift(@Headers); shift(@Headers);
}
$request = $request . "\r\n";
### Issue request over S
print(S $request);
### Read data from S
while ($len = sysread(S, $data, $BIG)) {
$xyz .= $data;
}
### Close socket S
close(S);
### Return the webpage
return $xyz;
}



I'm new to PERL and cookies so have no idea what I'm doing. Can someone please help me rewrite this script so it can set more than one cookie in a row, or perhaps suggest a solution to this delema? Here's what I got after trying to mess with it, but keep getting 400 Bad request errors =\.



sub getWebpage {
### Declare constants
my $PORT = 80;
my $BIG = 1024*1024;
my $TCP = join('', getprotobyname('tcp'));
### Read passed in variables
my ($server, $document, $cookie, $cookie2, $cookie3) = @_;
### Initialize local variables
my @addrs; my $dummy; my $len; my $data; my $xyz;
### Set HTTP headers
my @Headers = ('User-Agent', 'http-get/1.1');
if ($cookie) {
@Headers = (@Headers, "Cookie", $cookie);
}

if ($cookie2) {
@Headers = (@Headers, "Cookie", $cookie2);
}
if ($cookie3){
@Headers = (@Headers, "Cookie", $cookie3);
}
### Resolve $server, stores IP octets in @addrs
if ($server =~ /^[0-9]+\.[0-9]+\.[0-9]+\.[0-9]+$/) {
@addrs = pack('C4', split(/\./,$server));
} else {
($dummy,$dummy,$dummy,$dummy, @addrs) = gethostbyname($server);
}
### Creates remote socket
my $remote = pack("S n a4 x8", 2, $PORT, $addrs[0]);
### Create socket S to $remote and connect to it
socket(S, 2, 1, $TCP) || die "ERROR: Connect failed<BR>\n";
connect(S, $remote) || die "ERROR: Connect failed<BR>\n";
select(S); $| = 1;
select(STDOUT); $| = 1;
### Form HTTP request command
my $request = "GET $document HTTP/1.0\r\n";
while ($#Headers > 0) {
$request = $request . "$Headers[0]: $Headers[1]\r\n";
shift(@Headers); shift(@Headers);
}
$request = $request . "\r\n";
### Issue request over S
print(S $request);
### Read data from S
while ($len = sysread(S, $data, $BIG)) {
$xyz .= $data;
}
### Close socket S
close(S);
### Return the webpage
return $xyz;
}



thanks alot!

[dchidelf]

If your problem is truely that you need to send more than one cookie...

There should only be one 'Cookie' header in the http request.

If there are multiple cookies the header should be
Cookie: name=value; name=value; name=value
NOT
Cookie: name=value
Cookie: name=value
Cookie: name=value

so maybe:

...
my ($server, $document, @cookies) = @_;
...
if($#cookies >= 0){
push(@Headers, "Cookie" , join('; ',@cookies));
}

instead of

...
my ($server, $document, $cookie, $cookie2, $cookie3) = @_;
...
if ($cookie) {
@Headers = (@Headers, "Cookie", $cookie);
}

if ($cookie2) {
@Headers = (@Headers, "Cookie", $cookie2);
}
if ($cookie3){
@Headers = (@Headers, "Cookie", $cookie3);
}


might work...

[Alex Merek]

aye, figures :D thanks much