#! C:\Perl\Perl\bin\perl.exe
# test.cgi
# ========
# if this file is named test.txt, rename it to test.cgi
# don't forget to change the first line to point to your perl directory.
$scriptlocation = qq~$ENV{'REQUEST_URI'}~;
$scriptlocation =~ s/(.*?)\?$ENV{'QUERY_STRING'}/$1/ig;
$thisurl = qq~http://$ENV{'HTTP_HOST'}$scriptlocation~;
$scriptfilename = qq~$ENV{'SCRIPT_FILENAME'}~;
$scriptfilename =~ s/(.*?)test.cgi/$1/ig;
sub split_string {
my ($string, $hash, $altdelim) = @_;
if($altdelim && $$string =~ m~;~) { @pairs = split(/;/, $$string); }
else { @pairs = split(/&/, $$string); }
foreach $pair (@pairs) {
($name,$value) = split(/=/, $pair);
$name =~ tr/+/ /;
$name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
if (exists($hash->{$name})) {
$hash->{$name} .= ", $value";
} else {
$hash->{$name} = $value;
}
}
}
if ($ENV{REQUEST_METHOD} eq 'POST') {
read(STDIN, my $input, $ENV{CONTENT_LENGTH});
split_string(\$input, \%FORM)
}
split_string(\$ENV{QUERY_STRING}, \%INFO, 1);
$action = $INFO{'action'};
if ($action eq "login") { &Login }
else { $m2y = qq~$thisurl~; &Print; }
sub Login {
##################### Fill in next three varibles. ######################
$url = ""; # Full URL to YaBB 2 forum. Must include http:// and YaBB.cgi or YaBB.pl
$user = "";
$pass = "";
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->agent("MyCoolBrowser/0.1");
use HTTP::Cookies;
$cookie_jar = HTTP::Cookies->new(
'file' => "$scriptfilename/cookies.m2y",
'autosave' => 1,
'ignore_discard' => 1,
);
use HTTP::Response;
use HTTP::Request::Common qw(POST);
use LWP::UserAgent;
$ua = LWP::UserAgent->new;
my $req = POST "$url", [ action => "login2", username => "$user", passwrd => "$pass", cookielength => 1 ];
$yoyo = $ua->request($req)->header;
$yoyo2 = $ua->request($req)->as_string;
$yoyo2 =~ s~\n~
~ig;
# $cookie_jar->add_cookie_header($yoyo);
# $cookie_jar->save;
$ua->cookie_jar($cookie_jar);
use LWP::Simple;
my $content = get qq~$url~;
die "Couldn't get $url" unless defined $content;
$m2y = qq~$yoyo2~;
# $m2y = qq~$content~;
&Print;
}
sub Print {
print "Content-Type: text/html\n\n";
print qq~
Cookie Test
~;
print $m2y;
print qq~
~;
}