#!/usr/bin/perl -w

#- Copyright (C) 2004 trem (tremyfr@yahoo.fr)
#-
#- This program is free software; you can redistribute it and/or modify
#- it under the terms of the GNU General Public License as published by
#- the Free Software Foundation; either version 2, or (at your option)
#- any later version.
#-
#- This program is distributed in the hope that it will be useful,
#- but WITHOUT ANY WARRANTY; without even the implied warranty of
#- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#- GNU General Public License for more details.
#-
#- You should have received a copy of the GNU General Public License
#- along with this program; if not, write to the Free Software
#- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

#
# This script don't manage rsync yet
#
# todo:
# - add rsync check
#

use strict;
use threads;
use threads::shared;
use Net::FTP;
use LWP::Simple;
use Getopt::Long;
use MDK::Common;

my @liste_urls  : shared;
my %hash_server : shared;
my %hash_mirror : shared;
my $nb_valide   : shared;
my $nb_evite    : shared;
my $verbose   = 0;
my $help      = 0;
my @lines;
my $thr;

my $verification = 0;

#
# analyser program argument
#
GetOptions( "verbose" => \$verbose,
	    "help"    => \&usage
	  );

sub usage {
  print "usage: $0 [options]
[options]
  - v                           : verbose
  - h --help                    : write this help

  This program search mirror from an old list of mirror (list_mirror.all).
  Results are written in 'list_mirror.working'.
";
exit(0);
}

#
# we parse all files
#
die("no 'list_mirror.all' file") unless ( -f "list_mirror.all" );
eval {
   @lines = cat_("list_mirror.all");
   map { chomp; push(@liste_urls, $_); } @lines;
};


#
# we eliminate mirror who are several times in the list
#
@liste_urls = &eliminate_double(@liste_urls);

#
# we read list_mirror.working to avoid researching them again
#
if(-f "list_mirror.working") {
  @lines = cat_("list_mirror.working");

  foreach (@lines) {
    chomp;
    $hash_server{&serveur($_)} = 1;
    $hash_mirror{$_}           = 1;
  }
  print "Il existe déjà : ", scalar keys %hash_server, "\n";
}

#
# we launch thread (first test with only 10 threads)
#
for (1..10) {
  $thr = threads->new(\&verifier);
}

#
# we wait threads
#
foreach $thr (threads->list) {
  # Don't join the main thread or ourselves
  if ($thr->tid && !threads::equal($thr, threads->self)) {
    $thr->join;
  }
}

#
# we write the list in file : list_mirror.working
#
print "Number of possible mirrors : ", scalar(keys %hash_mirror), "\n";
open(FILE, ">list_mirror.working");
map ( {print FILE "$_\n";} keys %hash_mirror );
close(FILE);


# ==============================================================================
#
# SUBROUTINE
#
# ==============================================================================
sub eliminate_double {
  my %h = ();
  # map( {if(/^ftp:\/\/(.*)\/[^\/]+$/) { $h{$1} = 1; }} @_);
  map ( { $h{$_} = 1; } @_ );

  return (keys %h);
}

sub verifier {
  my $url;

  do {
    eval {
      lock(@liste_urls);
      $url = shift @liste_urls;
    };

    if($url) {
    &test_url($url);

    if($url =~ /^(.*)\/[M|m]andrake[L|l]inux$/)
      {
	&test_url($1);
      }

    if($url =~ /^(.*)\/[M|m]andrake-devel$/)
      {
	&test_url($1);
      }

    if($url =~ /^(.*)\/[M|m]andrake$/)
      {
	&test_url($1);
      }

    if($url =~ /^(.*)\/[M|m]andrake\//)
      {
	&test_url($1);
      }
  }
  } while($url);
}



sub test_url {
  my $url2 = shift;

  my $existe_deja = 0;

  #
  # already checked ?
  #
  eval {
    lock(%hash_server);
    if(defined($hash_server{&serveur($url2)}) && ($hash_server{&serveur($url2)} == 1)) {
      print "miroir évité : ", &serveur($url2), "," if($verbose == 1);
      print " Nb évités : ", $nb_evite++, "\n"       if($verbose == 1);
      $existe_deja = 1;
    }
  };

  return if($existe_deja);

  #
  # ftp
  #
  if($url2 =~ /^ftp:\/\/([^\/]+)(\/.*)/)
    {
      my $serveur = $1;
      my $chemin  = $2;
      my $trouve  = 0;

      $trouve = check_ftp($serveur, $chemin);
      if($trouve == 1) {
	  my $liste = ls_url($serveur, $chemin);
	  print "$liste\n" if($verbose == 1);
	  $trouve = 0;
        
	  # on recherche un Mandrakelinux
	  foreach my $u (split(/ /, $liste))
	  {
	      if(($trouve == 0) && ($u =~ /[M|m]andrake[L|l]inux$/)) {
		  $trouve = mdk_ftp($serveur, "$chemin/$u");
		  if($trouve == 1) {
		lock(%hash_server);
		$hash_server{"ftp://${serveur}"}             = 1;
		$hash_mirror{"ftp://${serveur}${chemin}/$u"} = 1;
		eval {
		    # lock($nb_valide);
		    print "valide ($nb_valide): ftp://${serveur}${chemin}/$u\n" if($verbose == 1);
		    $nb_valide++;
		};
		last;
	    }
	      }
	  }
	  
	  # on recherche un Mandrake
	  foreach my $u (split(/ /, $liste))
	  {
	      if(($trouve == 0) && ($u =~ /[M|m]andrake$/)) {
		  $trouve = mdk_ftp($serveur, "$chemin/$u");
		  if($trouve == 1) {
		      lock(%hash_server);
		      $hash_server{"ftp://${serveur}"} = 1;
		      $hash_mirror{"ftp://${serveur}${chemin}/$u"} = 1;
		      eval {
			  # lock($nb_valide);
			  print "valide ($nb_valide): ftp://${serveur}${chemin}/$u\n" if($verbose == 1);
			  $nb_valide++;
		      };
		      last;
		  }
	      }
	  }
	  
	  # 
      }
  }

  #
  # http
  #
  if($url2 =~ /^http:\/\/([^\/]+)(\/.*)/)
    {
      my $serveur = $1;
      my $chemin  = $2;
      my $trouve  = 0;

      $trouve = check_http("http://$serveur");
      if($trouve) {
	print "l'url http://${serveur}${chemin} existe\n" if($verbose);
	my @liste = ls_http("http://${serveur}${chemin}");
	print "@liste\n" if($verbose == 1);
	$trouve = 0;

	$trouve = mdk_http("http://${serveur}${chemin}");
	if($trouve == 1) {
	    lock(%hash_server);
	    if(!defined($hash_server{"http://${serveur}"})) {
		$hash_server{"http://${serveur}"}             = 1;
		$hash_mirror{"http://${serveur}${chemin}"} = 1;
		eval {
		    # lock($nb_valide);
		    print "valide ($nb_valide): http://${serveur}${chemin}\n" if($verbose == 1);
		    $nb_valide++;
		};
	    }
	}
	    
	foreach my $u (@liste) {
	    if(($trouve == 0) && ($u =~ /[M|m]andrake[L|l]inux$/)) {
		$trouve = mdk_http("http://${serveur}${chemin}/$u");
		if($trouve == 1) {
		    lock(%hash_server);
		    if(!defined($hash_server{"http://${serveur}"})) {
			$hash_server{"http://${serveur}"}             = 1;
		  $hash_mirror{"http://${serveur}${chemin}/$u"} = 1;
		  eval {
		    # lock($nb_valide);
		    print "valide ($nb_valide): http://${serveur}${chemin}/$u\n" if($verbose == 1);
		    $nb_valide++;
		  };
		}
		last;
	      }
	    }

	    if(($trouve == 0) && ($u =~ /[M|m]andrake$/)) {
	      $trouve = mdk_http("http://${serveur}${chemin}/$u");
	      if($trouve == 1) {
		lock(%hash_server);
		if(!defined($hash_server{"http://${serveur}"})) {
		  $hash_server{"http://${serveur}"}             = 1;
		  $hash_mirror{"http://${serveur}${chemin}/$u"} = 1;
		  eval {
		    # lock($nb_valide);
		    print "valide ($nb_valide): http://${serveur}${chemin}/$u\n" if($verbose == 1);
		    $nb_valide++;
		  };
		}
		last;
	      }
	    }

	  }
      }
    }

}

sub check_ftp {
  my $server = shift;
  my $base_directory = shift;
  my @list_rpms = ();

  eval {
    my $ftp = Net::FTP->new("$server", Passive => 1, Timeout => 15) or die("can't create ftp");
    $ftp->login("anonymous","anonymous\@anonymous.com") or die("can't login");
    $ftp->cwd("$base_directory") or die("can't cwd");
  };

  if($@) {
    return 0;
  }

  return 1;
}

sub check_http {
  my $url  = shift;
  my $retour = head($url);

  if($retour) {
    my $metaurl = quotemeta($url);
    return 1 if $retour->base =~ /$metaurl/i;
  }
  return 0;
}

sub ls_http {
  my $url = shift;
  my $page = get("$url");
  return 0 if(!defined($page));
  # my @liste = ($page =~ /<A HREF="([^"\/]+)\/?">\1\/?<\/A>/g);
  my @liste = ($page =~ /([^"\/]+)\/?">\1\/?<\/A>/g);
  return @liste;
}

sub mdk_http {
  my $url = shift;

  return 0 if(!check_http("${url}"));
  return 0 if(!check_http("${url}/official"));
  return 0 if(!check_http("${url}/devel"));

  return 1;
}


sub mdk_ftp {
  my $server = shift;
  my $base_directory = shift;
  my @list_rpms = ();

  eval {
    my $ftp = Net::FTP->new("$server", Passive => 1, Timeout => 15) or die("can't create ftp");
    $ftp->login("anonymous","anonymous\@anonymous.com") or die("can't login");
    $ftp->cwd("$base_directory")          or die("can't cwd");
    $ftp->cwd("$base_directory/official") or die("can't cwd");
    $ftp->cwd("$base_directory/devel")    or die("can't cwd");
  };

  if($@) {
    return 0;
  }

  return 1;
}

sub ls_url {
  my $server = shift;
  my $base_directory = shift;
  my @dir = ();

  eval {
    my $ftp = Net::FTP->new("$server", Passive => 1, Timeout => 15) or return 0;
    print "ftp ($server)\t" if($verbose == 1);
    $ftp->login("anonymous","anonymous\@anonymous.com") or return 0;
    print "login\t" if($verbose == 1);
    $ftp->cwd("$base_directory/") or return 0;
    print "cwd ($base_directory)\t" if($verbose == 1);
    @dir = $ftp->dir();
    @dir = map { select_filename($_); } @dir;
    print "dir\n" if($verbose == 1);
  };

  if($@) {
    return "";
  }

  return join(' ', @dir);
}


sub select_filename {
  my $name = shift;

  if($name =~ /^l/) {
    if($name =~ /\s([^\s]+)\s+->\s/) {
      $name = $1;
    } else {
      $name = undef;
    }
  } else {
    if($name =~ /\s([^\s]+)$/) {
      $name = $1;
    } else {
      $name = undef;
    }
  }

  return $name;
}

#
# return the server name
#
sub serveur {
  my $url = shift;
  if($url =~ /^(\w+:\/\/[^\/]+)/) {
    return $1;
  }
  return "";
}