I cannot get a simple script to work. I get the following error when I
debug it.
1 Can't locate socket.pm in @INC (@INC contains:
/usr/lib/perl5/5.6.0/i686-linux /usr/lib/perl5/5.6.0
/usr/lib/perl5/site_perl/5.6.0/i686-linux /usr/lib/perl5/site_perl/5.6.0
/usr/lib/perl5/site_perl .) line 2.
2 BEGIN failed--compilation aborted line 2.
So I assume it is my socket.pm
But it is on a host so I am not sure. Any suggestions?
#!/usr/bin/perl
use socket;
open (F, "<adc.cfg");
@commands=<F>;
close (F);
foreach (@commands)
{
eval $_;
}
######################################################################
# Main Section #
######################################################################
if ($ENV{CONTENT_LENGTH}>0){sysread(STDIN,$data,$ENV{CONTENT_LENGTH});}
else {($data=$ENV{QUERY_STRING});}
@data=split("&",$data);
foreach (@data)
{
/([^=]+)=(.*)/ && do
{
($field,$value)=($1,$2);
$value=~s/\+/ /g;
$value=~s/%([0-9a-fA-F]{2})/pack('C',hex($1))/eg;
if ($field eq "target")
{
if ($data{$field}){$data{$field}="$data{$field}##$value";}
else {$data{$field}=$value;}
}
else
{
if ($data{$field}){$data{$field}="$data{$field},$value";}
else {$data{$field}=$value;}
}
}
}
$encline=crypt($data{name},$data{name}).":".crypt($data{password},$data{pass
word});
open (F, "<$basepath/adcenter.pwd");
flock(F,$LOCK_EX);
@pass=<F>;
flock(F,$LOCK_UN);
close (F);
chop($admpass=shift(@pass));
&errauth if ($admpass ne $encline);
$sockaddr = 'S n a4 x8';
open (F,"<$adcpath/temp/count");
flock(F,$LOCK_EX);
$count=<F>;
flock(F,$LOCK_UN);
close (F);
open (F,"<$basepath/adcenter.db");
flock(F,$LOCK_EX);
@users=<F>;
flock(F,$LOCK_UN);
close (F);
$count=0 if (!$count);
$total=scalar(@users);
if ($count<$total)
{
($username,$url)=split("\t",$users[$count]);
$server=$url;
$server=~s/http:\/\///i;
$url.="/" unless ($url=~/\/$/ || $url=~/\.html$/ || $url=~/\.htm$/);
($server,@garbage)=split("/",$server);
&open_port;
$message="GET $url HTTP/1.0\n\n";
$len=length($message);
syswrite(S,$message,$len);
@html=<S>;
close(S);
if ($html[0]=~/200 OK/){&parse;}
else
{
open(F,">>$adcpath/temp/res");
flock(F,$LOCK_EX);
print F "$username:Dead link\n";
flock(F,$LOCK_UN);
close(F);
}
$count++;
open (F,">$adcpath/temp/count");
flock(F,$LOCK_EX);
print F $count;
flock(F,$LOCK_UN);
close (F);
open (F,"<$adcpath/template/robot.tpl");
@htmlpage=<F>;
close (F);
$htmlpage=join("\n",@htmlpage);
print "HTTP/1.0 200 Found\n" if ($sysid eq "Windows");
print "content-type: text/html\n\n";
eval $htmlpage;
exit;
}
else
{
open (F,"<$adcpath/temp/res");
flock(F,$LOCK_EX);
@words=<F>;
flock(F,$LOCK_UN);
close (F);
foreach(@words)
{
chop;
($username,$reason)=split(":",$_);
push(@result,"<form action=\"$cgi/adcadmin.pl\" method=\"post\"><input
type=\"hidden\" name=\"name\" value=\"$data{name}\"><input type=\"hidden\"
name=\"password\" value=\"$data{password}\"><input type=\"hidden\"
name=\"username\" value=\"$username\"><li><b>Username:</b> <a
href=\"$cgi/adcgnfo.pl?name=$username&method=userinfo\"
target=\"_blank\">$username</a></li><br>Problem: $reason<br><center><input
type=\"submit\" name=\"method\" value=\"remove\"><input type=\"submit\"
name=\"method\" value=\"disable\"></center></form>\n");
}
push(@result,"<li>Nothing found</li\n") if (scalar(@result)==0);
unlink ("$adcpath/temp/count");
unlink ("$adcpath/temp/res");
open (F,"<$adcpath/template/robres.tpl");
@htmlpage=<F>;
close (F);
$htmlpage=join("",@htmlpage);
print "HTTP/1.0 200 Found\n" if ($sysid eq "Windows");
print "content-type: text/html\n\n";
eval $htmlpage;
exit;
}
sub open_port
{
&error("<li>Internal server error, please try again later or contact to <a
href=\"mailto:$email\";>administrator</a> if you got this problem several
times</li>") unless
(socket(S,PF_INET,SOCK_STREAM,(getprotobyname('tcp'))[2]));
$farg=sockaddr_in(80,inet_aton($server));
&errors unless (connect(S,$farg));
}
sub error
{
@error=@_;
open (F,"<$adcpath/template/errors.tpl");
@htmlpage=<F>;
close (F);
$htmlpage=join("\n",@htmlpage);
print "HTTP/1.0 200 Found\n" if ($sysid eq "Windows");
print "content-type: text/html\n\n";
eval $htmlpage;
exit;
}
sub parse
{
$html=join("",@html);
unless ($html=~/\<\!--begin $owntitle code--\>/i)
{
open (F,">>$adcpath/temp/res");
flock(F,$LOCK_EX);
print F "$username:No code\n";
flock(F,$LOCK_UN);
close (F);
}
}
sub errors
{
open(F,">>$adcpath/temp/res");
flock(F,$LOCK_EX);
print F "$username:Dead link\n";
flock(F,$LOCK_UN);
close(F);
$count++;
open (F,">$adcpath/temp/count");
flock(F,$LOCK_EX);
print F $count;
flock(F,$LOCK_UN);
close (F);
open (F,"<$adcpath/template/robot.tpl");
@htmlpage=<F>;
close (F);
$htmlpage=join("\n",@htmlpage);
print "HTTP/1.0 200 Found\n" if ($sysid eq "Windows");
print "content-type: text/html\n\n";
eval $htmlpage;
exit;
}
sub errauth
{
open (F,"<$adcpath/template/errautha.tpl");
@htmlpage=<F>;
close (F);
$htmlpage=join("\n",@htmlpage);
print "HTTP/1.0 200 Found\n" if ($sysid eq "Windows");
print "content-type: text/html\n\n";
eval $htmlpage;
exit;
}
Scott
WWW.Swap-Ads.Com
10,000 Free Impressions
New and Growing Banner Exchange
--
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
