Cmake dist: Expand the list of not distributed files.

[lyx.git] / development / checkurls / CheckURL.pm

diff --git a/development/checkurls/CheckURL.pm b/development/checkurls/CheckURL.pm
index 339147a25b8152abbad83eff056ad1a4d49348e0..4ab70abfcbdeefe993615ae573736415b7ec9170 100755 (executable)
--- a/development/checkurls/CheckURL.pm
+++ b/development/checkurls/CheckURL.pm
@@ -20,28 +20,21 @@ BEGIN {
   @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;
@@ -54,17 +47,32 @@ sub check_http_url($$$$)
       $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)
@@ -96,6 +104,50 @@ sub check_ftp_dir_entry($$)
   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;
@@ -134,7 +186,7 @@ sub check_ftp_url($$$$)
       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;
@@ -192,9 +244,9 @@ sub check_unknown_url($$$$)
 
 #
 # Main entry
-sub check_url($)
+sub check_url($$)
 {
-  my($url) = @_;
+  my($url,$use_curl) = @_;
   my $file = undef;
   my ($protocol,$host,$path);
 
@@ -220,17 +272,22 @@ sub check_url($)
     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;
   }
 }