@EXPORT = qw(check_url);
}
+# Prototypes
+sub check_http_url($$$$);
+sub check_ftp_dir_entry($$);
+sub check_ftp_url($$$$);
+sub check_unknown_url($$$$);
+sub check_url($$);
+################
+
sub check_http_url($$$$)
{
- use Net::HTTP;
- use Net::HTTPS;
+ require LWP::UserAgent;
my ($protocol, $host, $path, $file) = @_;
- my $s;
- if ($protocol eq "http") {
- $s = Net::HTTP->new(Host => $host, Timeout => 120);
- }
- elsif ($protocol eq "https") {
- $s = Net::HTTPS->new(Host => $host, Timeout => 120);
- }
- else {
- print " Unhandled http protocol \"$protocol\"";
- return 3;
- }
- if (! $s) {
- print " " . $@;
- return 3;
- }
+ my $ua = LWP::UserAgent->new;
my $getp = "/";
if ($path ne "") {
$getp .= $path;
$getp .= "/$file";
}
}
- #print " Trying to use GET => \"$getp\"";
- $s->write_request(GET => $getp, 'User-Agent' => "Mozilla/5.0");
- my($code, $mess, %h) = $s->read_response_headers;
-
- # Try to read something
my $buf;
- my $n = $s->read_entity_body($buf, 1024);
- if (! defined($n)) {
- print " Read from \"$protocol://$host$getp\" failed";
+ $ua->agent("Firefox/43.0");
+ my $response = $ua->get("$protocol://$host$getp");
+ if ($response->is_success) {
+ $buf = $response->decoded_content;
+ }
+ else {
+ print " " . $response->status_line . ": ";
return 3;
}
+ my @title = ();
+ my $res = 0;
+ while ($buf =~ s/\<title\>([^\<]*)\<\/title\>//i) {
+ my $title = $1;
+ $title =~ s/[\r\n]/ /g;
+ $title =~ s/ +/ /g;
+ $title =~ s/^ //;
+ $title =~ s/ $//;
+ push(@title, $title);
+ print "title = \"$title\": ";
+ if ($title =~ /Error 404|Not Found/) {
+ print " Page reports 'Not Found' from \"$protocol://$host$getp\": ";
+ $res = 3;
+ }
+ }
+ return $res;
}
# Returns ($err, $isdir)
return(1,$isdir);
}
+sub check_ftp2_url($$$$)
+{
+ my ($protocol, $host, $path, $file) = @_;
+
+ my $checkentry = 1;
+ print "\nhost $host\n";
+ print "path $path\n";
+ print "file $file\n";
+ my $url = "$protocol://$host";
+ $path =~ s/\/$//;
+ if (defined($file)) {
+ $url = "$url/$path/$file";
+ }
+ else {
+ $url = "$url/$path/.";
+ }
+ print "curl $url, file = $file\n";
+ my %listfiles = ();
+ if (open(FFTP, "curl --anyauth -l $url|")) {
+ while (my $l = <FFTP>) {
+ chomp($l);
+ $listfiles{$l} = 1;
+ }
+ close(FFTP);
+ }
+ if (%listfiles) {
+ if (! defined($file)) {
+ return(0, "OK");
+ }
+ elsif (defined($listfiles{$file})) {
+ return(0, "OK");
+ }
+ elsif (defined($listfiles{"ftpinfo.txt"})) {
+ return(0, "Probably a directory");
+ }
+ else {
+ return(1, "Not found");
+ }
+ }
+ else {
+ return(1, "Error");
+ }
+}
+
sub check_ftp_url($$$$)
{
use Net::FTP;
my $found2 = 0;
for my $f ( @{$rEntries}) {
#print "Entry: $path $f\n";
- my ($res1,$isdir) = &check_ftp_dir_entry($file,$f);
+ my ($res1,$isdir) = check_ftp_dir_entry($file,$f);
if ($res1 == 1) {
$found = 1;
last;
#
# Main entry
-sub check_url($)
+sub check_url($$)
{
- my($url) = @_;
+ my($url,$use_curl) = @_;
my $file = undef;
my ($protocol,$host,$path);
return 2;
}
if ($protocol =~ /^https?$/) {
- return &check_http_url($protocol, $host, $path, $file);
+ return check_http_url($protocol, $host, $path, $file);
}
elsif ($protocol eq "ftp") {
my $message;
- ($res, $message) = &check_ftp_url($protocol, $host, $path, $file);
+ if ($use_curl) {
+ ($res, $message) = check_ftp2_url($protocol, $host, $path, $file);
+ }
+ else {
+ ($res, $message) = check_ftp_url($protocol, $host, $path, $file);
+ }
return $res;
}
else {
# it never should reach this point
print " What protocol is '$protocol'?";
- $res = &check_unknown_url($protocol, $host, $path, $file);
+ $res = check_unknown_url($protocol, $host, $path, $file);
return $res;
}
}