#!/usr/bin/perl
#   Licensed under the Apache License, Version 2.0 (the "License");
#   you may not use this file except in compliance with the License.
#   You may obtain a copy of the License at
#
#       http://www.apache.org/licenses/LICENSE-2.0
#
#   Unless required by applicable law or agreed to in writing, software
#   distributed under the License is distributed on an "AS IS" BASIS,
#   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#   See the License for the specific language governing permissions and
#   limitations under the License.


# Simple script to check if mirror has been set up correctly:
# - contents of specific header/readme samples - e.g. in /commons/ - must appear

# To check one mirror, provide this on the command line, otherwise
# the script will process all the http and ftp entries in mirrors.list
# and generate output in mirror_check.txt

use strict;
use Getopt::Std;
use LWP::UserAgent;
use HTML::TreeBuilder;
use Net::FTP;

# Configure which HTTP sub-directory to check, and what to look for in the output

my $httpdir = 'zzz';
my $hdrMatch = qr(<h\d>Apache Software Foundation Distribution Meta-Directory</h\d>);
my $ftrMatch = qr(This directory contains meta-data for the ASF mirroring system.);

my $http404 = 'zzz/___'; # Non-existent URL; should generate 404
my $httptxt = 'zzz/README'; # text file (without extension) should generate content-type text/plain or none

# Configure which FTP sub-directory(s) to check
my $ftpdir = 'subversion commons'; # can be a list, comma or space separated

# Default setting for $extpath, i.e. -P option
my $incdir = 'hadoop/common/alpha';  # can be a list, comma or space separated

# List of top-level directories that must be present in the index page
my @top_level_dirs=qw(
abdera
accumulo
ace
activemq
airavata
ant
apr
archiva
aries
avro
axis
beehive
bigtop
bval
buildr
camel
cassandra
cayenne
chemistry
click
cocoon
commons
continuum
couchdb
cxf
db
deltacloud
directmemory
directory
esme
excalibur
felix
forrest
flume
geronimo
gora
hadoop
hama
harmony
hbase
hive
hivemind
httpcomponents
httpd
ibatis
incubator
jackrabbit
jakarta
james
java-repository
jena
jmeter
juddi
karaf
lenya
libcloud
logging
lucene
lucy
mahout
manifoldcf
maven-repository
maven
mina
mrunit
myfaces
nutch
ode
ofbiz
oodt
oozie
openejb
openjpa
opennlp
openwebbeans
pdfbox
perl
pig
pivot
poi
portals
qpid
rave
river
roller
santuario
servicemix
shale
shindig
shiro
sling
spamassassin
sqoop
stdcxx
struts
subversion
synapse
tapestry
tcl
thrift
tika
tiles
tomcat
trafficserver
turbine
tuscany
uima
vcl
velocity
whirr
wicket
ws
xalan
xerces
xml
xmlbeans
xmlgraphics
zookeeper
zzz
);

# List of directories that must be present in the incubator index page
my @incubator_dirs=qw(
ace
ambari
amber
any23
bigtop
bloodhound
celix
chukwa
clerezza
cloudstack
cordova
crunch
deltaspike
droids
etch
flex
giraph
hcatalog
imperius
isis
jspwiki
kafka
kato
mesos
mrunit
nmaven
npanday
odftoolkit
olio
openmeetings
opennlp
photark
rat
s4
sis
stanbol
stonehenge
syncope
tashi
wink
wookie
);

my %opts;
# -A age - quick check of the mirror age
# -B check backup sites (only) for TLDs
# -C code - only process countries matching the parameter
# -D switch on FTP debug
# -F only process ftp sites
# -H only process http sites
# -I check for stale incubator directories and exit
# -O output - override default output file "check_mirror.txt"
# -P pathlist - check additional path(s) on each site
# -Q pathlist - quick check of path(s) on each site; no other checks are done. Paths to dirs must end in / to avoid redirect to index.
# -S slow FTP check; process all top-level directories instead of just $ftpdir
# -T check for TABLE entries (default false)
# -V save HTTP pages that fail validation

getopts('ABC:DFHIO:PQ:STV',\%opts) or die;

my $ageonly      = $opts{A};
my $backuponly   = $opts{B};
my $cconly       = $opts{C};
my $ftpDebug     = $opts{D};
my $ftponly      = $opts{F};
my $httponly     = $opts{H};
my $output       = $opts{O} || 'check_mirror.txt';
my $extpath      = $opts{P} || $incdir;
my $quickPath    = $opts{Q};
my $ftpFullCheck = $opts{S};
my $tableCheck   = $opts{T};
my $saveBadHTTP  = $opts{V};

if ($opts{I}) {
    $|=1;
    print "Incubator entries also present as TLPs: ";
    my $tmp=join ',','_',@top_level_dirs,'_'; # ensure leading and trailing , for each entry
    for(@incubator_dirs) {
        print "$_ " if $tmp =~ m/,$_,/;
    }
    print "\n";
    exit;
}


my $ua = LWP::UserAgent->new(requests_redirectable => []); # Don't allow auto redirects
$ua->agent("MirrorCheck/0.2");
$ua->timeout(30);

my $site = shift;  # Single site, or name of file listing the sites

if ($site) {
  while ($site) {
    if ($site =~ m!^(http://|ftp://)!) {
        check($site);        
    } elsif (-r $site) {
        print "Reading from $site\n";
        open SITE,"<", $site or die "Cannot open $site $!";
        open OUT,">",$output or die "Cannot open output file: $output $!\n";
        select OUT;
        $|=1;    
        while(<SITE>) {
            last if m/^---/; # to allow processing of nags/ files
            chomp;
            my ($url) = split;
            check($url);
        }
        close SITE;
    } else {
        print "$site unexpected: please supply URL or file name\n";
    }
    $site = shift;
  }
  exit;
}

open LIST,"<mirrors.list" or die "Cannot open mirrors.list input file\n";

unless ($backuponly) {
  open OUT,">",$output or die "Cannot open output file: $output $!\n";
  select OUT;    
}
$|=1; # Ensure output is flushed in case have to kill script

my $count=0;
while(<LIST>){
   my ($type,$cc,$url,undef)=split;
   if (lc($cc) eq 'backup') {
        next unless $backuponly;
        check($url, $cc);
        next;   
   }
   next if $backuponly;
   printboth ("Wrong scheme: $_") unless $url =~ m!^$type://!;
   next if defined $cconly && $cc !~ m!$cconly!o;
   check($url, $cc);
}
if ($backuponly) {
    $ua->proxy(http => 'http://minotaur-2.apache.org');
    check('http://www.apache.org/dist/', 'Backup');
} else {
    print "Checked $count sites\n";
}
close LIST;
close OUT;
exit;

sub printboth{
    my $msg = shift;
    print STDERR $msg unless $site && ! -r $site;
    print $msg;
}

sub check{
  my $url=shift;
  my $cc=shift || '';
  checkHTTP($url, $httpdir, $cc) if $url =~ m!^http://! && !$ftponly;
  checkFTP( $url, $ftpdir, $cc)  if $url =~ m!^ftp://! && !$httponly;
}

sub checkIndex{ # Check the TLP or Incubator index page
    my $base=shift;
    my $path=shift;
    my $url=$base . $path;
    my $res=shift;
    my $cc=shift;
    my $server=shift;
    my $index_name=shift;
    my $index_ref=shift;
    my $age=shift;
    my @missing=(); # Missing from index page
    for(@$index_ref) {
        # Could also be without trailing slash (non-Apache server) or could be > xxx/< (apache)
        push @missing,$_ unless $res->content =~ m!> ?$_/?<!; # must see dir in index page
    }
    if ($backuponly) {
        my $root = HTML::TreeBuilder->new_from_content($res->content);
        my %tlds = ();
        @tlds{@$index_ref} = (1) x @$index_ref;
        for (@{  $root->extract_links('a')  }) {
            my ($link, $element, $attr, $tag) = @$_;
            if ($link =~ m!^(\w+)/$!){
                print STDERR "Missing from $index_name list: $1\n" unless defined $tlds{$1} 
                    || $1 eq 'ooo'; # Exclude ooo from list as not all mirrors carry it
            };
        }
        $root->delete;
    }

    if (scalar @missing) {
        if (scalar @missing == scalar @$index_ref) { # failed to match anything; save the response
          savePage($url, $res);
        } else { # Not all missing
          #printboth("Checking if entries are missing or have protection issues\n");
          for(@missing) {
            my $dir = $_; # save the array entry
            $_ .= '(' . checkPage($url, $dir) . ')'; # warning: updates the array entry
          }            
        }
        printboth "$base $path - $cc - $server ($age min) - FAIL: Missing $index_name directories: " . join(' ', @missing) . "\n";
        return 0; # caller should not continue beyond first error
    }
    return 1;
}

sub checkHTTP{
  $count++;
  my $url=shift;
  my $dir=shift;
  my $cc = shift;
  print STDERR "Checking $url in $cc\n";


  my $res;

  my $fail = 0; # Count failures

  if (defined $quickPath) { # Check only these paths
    print STDERR "Checking quick path(s) $quickPath\n";
    for(split/[ ,]/, $quickPath) {
      fetchPage($url, "$_");
    }
    return; # done
  }

  $res = fetchPage($url, 'zzz/time.txt') or return; # Cannot easily continue from this failure
  my $time = $res->content;
  my $len = length($time);
  chomp $time; # Should only have trailing LF
  my $age = int((time - $time)/60); # secs => mins
  my $gmtime = gmtime($time);
  printboth "$url - AGE: $age min TIME: $gmtime GMT (len $len)\n";

  return if $ageonly;

  my $server = $res->headers->server || 'unknown';

  my $ct = $res->header('Content-Type') || 'text/plain'; # check valid content-type
  if (index($ct,'text/plain') != 0) {
      printboth "$url zzz/time.txt - $cc - $server ($age min) - FAIL: content-type $ct\n";
      $fail++;
  }

  $res = fetchPage($url) or return; # Cannot easily continue from this failure
  # check main content
  if (length($res->content) == 0) {
      printboth "$url - $cc - $server ($age min) - FAIL: No content in index page\n";
      return;  # Cannot easily continue from this failure
  }
  my $hasHTMLheader = $res->content =~ m!<html( [^>]+)?>!i && $res->content =~ m!<body>!i;
  my $hasHTMLtrailer = $res->content =~ m!</html>!i && $res->content =~ m!</body>!i;
  if ($hasHTMLheader && ! $hasHTMLtrailer) { # No HTML trailer
          printboth "$url - $cc - $server ($age min) - WARN: Incomplete index page\n"; # may be due to timeout
          savePage($url, $res);
          # skip page content check, but carry on to check other content
  } else {
    if (!$hasHTMLheader) {
          printboth "$url - $cc - $server ($age min) - WARN: Missing HTML and BODY tags\n";
          savePage($url, $res);
    }
    # Check format of icon image tags - this will help to detect Apache server behind non-Apache proxy and vice-versa
    # N.B. this check may need to be adjusted to allow for different server versions, hence WARN only at present
    my $imgIcons = $res->content =~ m!<(img|IMG) (src|SRC)="/icons/!; # Should be in index output from Apache server
    if (!$imgIcons) {
          printboth "$url - $cc - $server ($age min) - WARN: Missing or unexpected img icon tags\n";
          savePage($url, $res);      
    }
  
    checkIndex($url, '', $res, $cc, $server, 'TLP', \@top_level_dirs, $age) or $fail++;

    # Check incubator index page
    $res = fetchPage($url, 'incubator/') or return;  # Cannot easily continue from this failure
    checkIndex($url, 'incubator/', $res, $cc, $server, 'Incubator', \@incubator_dirs, $age) or $fail++;

  }
  my $code = checkPage($url, 'harmony/'); # Should be redirected
  if ($code != 301) {
      printboth "$url harmony/ - $cc - $server ($age min) - WARN: Expected code 301, actual $code\n";
      savePage($url, $res);
      # return; # continue (WARN)
  }
  if ($backuponly) {
      print STDERR scalar gmtime($time)," $time $age\n";
  }
  return if $backuponly;
  
  # Now check subdir for header and footer
  $res = fetchPage($url, "${dir}/") or return; # Could we continue from here?

  # Not allowed to change content here, so should never see table
  if ($tableCheck) {
      if ($res->content =~ m!<table!) {
          printboth "$url $dir - $cc - $server ($age min) - WARN: TABLE detected\n"; # has been used to add adverts to pages
          savePage($url, $res);
      }  
  }
  my $hdr = ($res->content =~ $hdrMatch);
  my $ftr = ($res->content =~ $ftrMatch);
  if ($hdr && $ftr) {
      # drop thru
  } elsif ($hdr){
      printboth "$url $dir - $cc - $server ($age min) - FAIL: No footer\n";
      savePage($url, $res);
      $fail++;
  } elsif ($ftr) {
      printboth "$url $dir - $cc - $server ($age min) - FAIL: No header\n";
      savePage($url, $res);
      $fail++;
  } else {
      printboth "$url $dir - $cc - $server ($age min) - FAIL: No header & no footer\n";
      savePage($url, $res);
      $fail++;
  }
  # Now check the additional path(s)
  if (defined $extpath) {
    print STDERR "Checking additional path(s) $extpath\n";
    for(split/[ ,]/, $extpath) {
      fetchPage($url, "$_/") or $fail++;
    }
  }
  # Now check that missing entries generate a 404.
  my $req = HTTP::Request->new(HEAD => "${url}${http404}");
  $res = $ua->request($req);
  if ($res->code == 200) {
      printboth "$url $http404 - $cc - $server ($age min) - FAIL: not 404 for invalid page\n";
      $fail++;
  }

  # Now check that text files have the correct content-type
  $req = HTTP::Request->new(HEAD => "${url}${httptxt}");
  $res = $ua->request($req);
  $ct = $res->header('Content-Type') || 'text/plain';
  if (index($ct,'text/plain') != 0) {
      printboth "$url $httptxt - $cc - $server ($age min) - FAIL: file Content-Type=$ct\n";
      $fail++;
  }
  if ($fail) {
      printboth "$url $dir - $cc - $server ($age min) - FAIL: $fail failure(s) detected\n";
  } else {
      printboth "$url $dir - $cc - $server ($age min) - OK\n";   
  }
}

# Check if page exists
sub checkPage{
  my $base=shift;
  my $path=shift||'';
  my $url=$base . $path;
  my $req = HTTP::Request->new(GET => "${url}");
  my $res = $ua->request($req);
  return $res->code;
}

sub fetchPage{
  my $base=shift;
  my $path=shift||'';
  my $url=$base . $path;
  print STDERR "Fetching $url\n";
  my $req = HTTP::Request->new(GET => "${url}");
  my $res = $ua->request($req);

  if ($res->is_success) {
      my $failed = $res->header("X-Died"); # special header which indicates an internal error, e.g. timeout
      if (defined $failed) {
          printboth "$url - FAIL: $failed\n";
          return undef;
      }
      my $requri = $req->uri->as_string;
      my $resuri = $res->base->as_string;
      printboth "$url - WARN: REDIRECT to: $resuri\n" unless $requri eq $resuri;
      if ($res->content =~ m!(.*Trend Micro.*)!) {# TM thinks it is bad
          printboth "$url - WARN: AV:  $1\n";
      } elsif ($res->content =~ m!OpenDNS! || index($res->content,'<body onLoad="location.replace(bredir') > 0) {
          printboth "$url - WARN: No DNS entry\n";
      } else {
          return $res;
      }
  }
  else {
      printboth "$base $path - FAIL: '" .  $res->status_line . "'\n";
  }
  return undef;
}

sub savePage{ # (url, result) Save html content
  return unless $saveBadHTTP;
  my ($url, $res) = @_;
  my $host = $url;
  $host =~ s!http://!!;
  $host =~ s!/.*!!;
  open MISS,">","tmp/${host}.tmp" or warn "Cannot open tmp/${host}.tmp $!";
  print MISS $res->content;
  close MISS;    
}

sub checkFTP{
  $count++;
  my $url=shift;
  my $dir = shift; # additional directories to check
  my $cc = shift;
  print STDERR "Checking $url ($dir) in $cc\n";

  my $time;
  eval {
      $time=logincwd($url, $dir);
  };
  if ($@) {
      printboth "$url - $cc - FAIL: $@";  
  } else {
      my $age=int((time-$time)/60);
      printboth "$url - $cc ($age min) - OK\n";
  }
}

sub logincwd() {
  my $url = shift;
  my $dir = shift;
  $url =~ s!ftp://!!;
  my ($host, $asfdir) = split('/', $url, 2);
  my $ftp = Net::FTP->new($host, Debug => $ftpDebug)
    or die "Cannot connect to $host: $@";
  $ftp->login("anonymous",'-anonymous@')
    or die "Cannot login to $host ", $ftp->message;
  $ftp->cwd($asfdir)
    or die "CWD $asfdir: ", $ftp->message;
  my ($time_text, $time_handle);
  open($time_handle, '>', \$time_text) or die "Cannot open time handle";
  my $time = $ftp->get('zzz/time.txt', $time_handle)
    or die "Failed to list $asfdir: ", $ftp->message;
  chomp $time_text;
  if (defined $quickPath) {
    print STDERR "Checking quick path(s) $quickPath\n";
    my $cwd = $ftp->pwd();
    for(split/[ ,]/, $quickPath) {
      $ftp->cwd($_)
        or die "CWD $_: ", $ftp->message;
      $ftp->cwd($cwd);
    }
    $ftp->quit;
    return $time_text;
  }
  my @files = $ftp->dir()
    or die "Failed to list $asfdir: ", $ftp->message;
  my %files=();
  #drwxr-xr-x    3 0        0            4096 Jun 05 20:40 abdera
  for(@files){
      print "$_\n" if $ftpDebug;
      if (m!^d!) {
          my @fields = split;
          if (scalar @fields == 9) {
              my $perm = $fields[0];
              my $name = $fields[-1];
              $files{$name} = $perm;
          } else {
              print "$url: unexpected entry $_\n";
          }
      }
  }
  # Basic check that directories are listed
  for(@top_level_dirs) {
      die "Cannot find dir $_\n" unless defined $files{$_}; 
  }

  # Check incubator entries
  @files = $ftp->dir('incubator')
    or die "Failed to list $asfdir/incubator: ", $ftp->message;
  %files=();
  #drwxr-xr-x    3 0        0            4096 Jun 05 20:40 abdera
  for(@files){
      print "$_\n" if $ftpDebug;
      if (m!^d!) {
          my @fields = split;
          if (scalar @fields == 9) {
              my $perm = $fields[0];
              my $name = $fields[-1];
              $files{$name} = $perm;
          } else {
              print "$url: unexpected entry $_\n";
          }
      }
  }
  for(@incubator_dirs) {
      die "Cannot find incubator dir $_\n" unless defined $files{$_}; 
  }


  # Optionally check all TLP entries
  for ($ftpFullCheck ? @top_level_dirs : split(/[ ,]/, $dir)) { 
    $ftp->cwd($_)
      or die "CWD $_: ", $ftp->message;
    $ftp->cdup();
  }
  # Now check the additional path(s)
  if (defined $extpath) {
    print STDERR "Checking additional path(s) $extpath\n";
    my $cwd = $ftp->pwd();
    for(split/[ ,]/, $extpath) {
      $ftp->cwd($_)
        or die "CWD $_: ", $ftp->message;
      $ftp->cwd($cwd);
    }
  }
  $ftp->quit;
  return $time_text;
}
