#!/usr/bin/perl -w

#- Copyright (C) 2004-2005 trem (trem@zarb.org)
#-
#- 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.

use strict;
use Net::Ping;
use Time::HiRes;
use Net::FTP;
use LWP::Simple;
use Getopt::Long;
use MDK::Common;
use Net::hostent;

# ================================================
# todo :
# - gui : --gui
# - remplace new_hash by {}
# ================================================

my @types;
my @versions;
my @mirrors_mdk;
my @mirrors_plf;
my @commands;

my %mirrors = ("classic" => \@mirrors_mdk,
	       "plf"     => \@mirrors_plf
	      );

my %FAI = ( "proxad"        => "free",
            "club-internet" => "club-internet",
            "wanadoo"       => "wanadoo",
            "aol"           => "aol",
            "noos"          => "noos"
	  );

my $release   = "";
my $arch      = "";
my $isp       = "";
my $verbose   = 0;
my $noclean   = 0;
my $synthesis = 0;
my $prefix    = "";
my $server    = "";

GetOptions("verbose"   => \$verbose,
           "help"      => \&help,
           "release=s" => \$release,
	   "arch=s"    => \$arch,
           "noclean"   => \$noclean,
           "synthesis" => \$synthesis,
	   "server=s"  => \$server,
	   "prefix=s"  => \$prefix
          );


# read the config file and test mirror (with ping)
read_config_file();

# detect release and arch
$release ||= detect_release();
$arch    ||= detect_arch();
$isp     ||= detect_isp();

die "release not found\n" unless $release;
die "arch not found\n"    unless $arch;

print "release = $release\n";
print "arch    = $arch\n";
print "isp     = $isp\n" if $isp;
print "\n";

# search the version information 
my $version = search_version($release, $arch);
print "version not found !\n" unless $version;

# generate commands
push(@commands, "urpmi.removemedia -a") unless $noclean;
generate_command($version);

# print commands
print "$_\n" foreach @commands;

# run commands
print "Do you want to exec this commands (y/N) ? ";
my $answer = <>; 
chomp($answer);
map { system($_) } @commands if $answer eq "y" || $answer eq "yes";


# ==================================================================================================
#
#                             Sub Program
#
# ==================================================================================================

#
# generate commands to run
#
sub generate_command {
  my $version = shift;

  foreach my $t (split('\|', $version->{type})) {
    my $type = search_type($t);
    die("error : type not found") unless $type;
    my $line = $type->{line};
    $line = substitute_version($line, $version);

    # if a mirror has been specified
    if($server) {
      my $m = search_mirror($server, $type->{list});
      if($m) {
	next if add_command($line, $m);
      }
    }

    # check if the isp has a mirror
    if($isp) {
      my $quote;
      foreach (keys %FAI) {
	$quote = $_ if $isp eq $FAI{$_};
      }
      my $m = search_mirror($quote, $type->{list});
      if($m) {
	next if add_command($line, $m);
      }
    }

    # check mirror
    foreach my $m (@{$mirrors{$type->{list}}}) {	
      last if add_command($line, $m);
    }

  }
}

#
# add command 
# check if the mirror is valid
# if yes, the line is added with this mirror
# return : 0 -> mirror isn't valid
#          1 -> mirror is valid (and we use it)
sub add_command {
  my $line   = shift;
  my $mirror = shift;

  $line =~ s/<mirror>/$mirror->{url}/g;
  my ($name, $rpmdir, $hdlist, $options) = split('\|', $line);
  $hdlist =~ s/hdlist/synthesis.hdlist/g if $synthesis;

  my $correct = check_mirror($rpmdir, $hdlist);
  if ($correct) {
    push(@commands, "urpmi.addmedia $options $prefix$name $rpmdir with $hdlist");
    return 1;
  }

  return 0;
}

#
# check if a mirror is valid
#
sub check_mirror {

  my $rpmdir = shift;
  my $hdlist = shift;

  if ($rpmdir =~ m|^ftp://([^/]+)(/.*)$|) {
    return &check_ftp($1, $2, $hdlist);
  }

  if ($rpmdir =~ m|^http://|) {
    return &check_http($rpmdir, $hdlist);
  }

  return 0;
}

#
# check if a ftp mirror is valid
#
sub check_ftp {

    my $server         = shift;
    my $base_directory = shift;
    my $hdlist         = shift;

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

    if ($@) {
      print $@ if $verbose;
      return 0;
    }

    return 1;
}

#
# check if an http mirror is valid
#
sub check_http {

  my $server = shift;
  my $hdlist = shift;

  return 0 unless &check_page($server);
  return 0 unless &check_page($server . "/" . $hdlist);

  return 1;
}

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

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

#
# search the hash (with informations) about version (name, arch, mirror list, ...)
#
sub search_version {
  my $name = shift;
  my $arch = shift;

  foreach (@versions) {
    return $_ if $_->{name} eq $name && $_->{arch} eq $arch;
  }

  return undef;
}

#
# search the hash (with informations) about mirror
#
sub search_type {
  my $name = shift;

  foreach (@types) {
    return $_ if $_->{name} eq $name;
  }

  return undef;
}

#
# search mirror
#
sub search_mirror {
  my $mirror = shift;
  my $type   = shift;

  return undef unless $mirror && $type;

  $mirror = quotemeta($mirror);
  foreach (@{$mirrors{$type}}) {
    return $_ if ($_->{url} =~ /$mirror/);
  }

  return undef;
}


#
#
#
sub substitute_version {
  my $text    = shift;
  my $version = shift;

  foreach (keys %$version) {
    $text =~ s/<$_>/$$version{$_}/g;
  }
  return $text;
}

#
# read the config file 
# fill @versions, @types, @mirrors
#
sub read_config_file {

  $|=1; # don't buffer
  print "read config file ... ";

  # read config file
  my $page = get("http://www.zarb.org/~trem/urpmi.neuneu/neuneu.conf");
  my @lines = split(/\n/, $page);
  print "done\n";

  # parse the file
  my $refh;
  my $classic = 0;
  my $plf     = 0;

  print "Checking mirror " unless $verbose;

  foreach (@lines) {
    chomp;

    # next line if this line is a comment
    next if /^\s+#/;

    if (m|</type>|) {
      push(@types, $refh);
    }
    if (m|</version>|) {
      push(@versions, $refh);
    }
    $classic = 0 if m|</classic>|;
    $plf     = 0 if m|</plf>|;

    if (/^(\w+)="([^"]+)"/) {
      $refh->{$1} = $2;
    }

    if ($classic || $plf) {
      print "Check server $_ ... " if $verbose;
      print "." unless $verbose;
      my ($nb, $time) = &tester_serveur($_);
      if ($nb) {
	my $refh = new_hash();
	$refh->{url}  = $_;
	$refh->{nb}   = $nb;
	$refh->{time} = $time;
	push(@mirrors_mdk, $refh) if $classic;
	push(@mirrors_plf, $refh) if $plf;
      }
      print "done\n" if $verbose;
    }

    $refh    = new_hash() if /<type>/ || /<version>/;
    $classic = 1 if /<classic>/;
    $plf     = 1 if /<plf>/;
  }

  print "\n" unless $verbose;
  @mirrors_mdk = sort { compare_mirror($a, $b) } @mirrors_mdk;
  @mirrors_plf = sort { compare_mirror($a, $b) } @mirrors_plf;
}

sub print_type {
  foreach (@_) {
    print "----------------------------------------\n";
    foreach my $n (keys %$_) {
      print "$n : ", $_->{$n}, "\n";
    }
  }
}

sub new_hash {
  my %h;
  return \%h;
}

#
# detect the release
#
sub detect_release {

  my $release = read_release_file();
 
  foreach (@versions) {
    my $text = $_->{text};
    $text = quotemeta($text);
    return $_->{name} if $release =~ /$text/;
  }

  return undef;
}

#
# detect architecture
#
sub detect_arch {

  my $release = read_release_file();

  if ($release =~ /for\s+(\w+)$/) {
     return $1;	
  }

 return undef;
}

#
# read the release file 
#
sub read_release_file {

  my $release;

  # check if the file exist and read it
  if (-f "/etc/mandrakelinux-release") {
    $release = cat_("/etc/mandrakelinux-release");
    chomp($release);
  }
  if (! $release && -f "/etc/mandrake-release") {
    $release = cat_("/etc/mandrake-release");
    chomp($release);
  }

  if (! $release && $verbose) {
    print "error: file /etc/mandrake-release and /etc/mandrakelinux-release don't exist\n";
  }

  return $release;
}

# =========================================================
# teste si un serveur est vivant
# retourne :
# - le nombre de ping qui ont réussit
# - le temps moyen de réponse
# =========================================================
my %ServerAccessTime;
sub tester_serveur {
  my $url         = shift;
  my $nb_retour   = 0;
  my $temps_moyen = 0;
  my $host;

  if ($url =~ m|^ftp://([^/]+)|) {
    $host = $1;
  }

  if ($url =~ m|^http://([^/]+)|) {
    $host = $1;
  }

  return 0,0 unless $host;


  if (defined($ServerAccessTime{$host})) {
    return split(':', $ServerAccessTime{$host});
  }

  foreach (1..3) {
    my $p = Net::Ping->new("icmp");
    $p->hires;
    my ($ret, $duration, $ip) = $p->ping($host, 2);
    $p->close;
    if ($ret) {
      $temps_moyen += 1000 * $duration;
      $nb_retour++;
    } else {
      last;
    }
  }

  $temps_moyen /= $nb_retour if $nb_retour;
  $ServerAccessTime{$host} = "$nb_retour:$temps_moyen";
  return $nb_retour, $temps_moyen;
}

sub compare_mirror {
  my $a = $_[0];
  my $b = $_[1];

  return  1 if $a->{nb} < $b->{nb};
  return -1 if $a->{nb} > $b->{nb};

  return  1 if $a->{time} > $b->{time};
  return  0 if $a->{time} == $b->{time};
  return -1 if $a->{time} < $b->{time};

  die;
}

sub help {
  print "usage: $0 [options]\n";
  print "\t--release\tchoose the release\n";
  print "\t--arch\t\tchoose the architecture\n";
  print "\t--noclean\tdon't clean old media\n";
  print "\t--synthesis\tuse synthesis\n";
  print "\t--server\tselect the server\n";
  print "\t--prefix\tadd a prefix to mirror name\n";
  print "\t--verbose\tverbose mode\n";
  print "example: $0 --release=community --arch=i586\n";
  exit;
}


#
# detect ISP
#
sub get_ip {
  my $page = get("http://checkip.dyndns.org/");
  chomp($page);
  if($page =~ /(\d+\.\d+\.\d+\.\d+)/) { return $1; }
  return "";
}

sub get_host_from_ip {
  my $ip   = shift;
  my $host = gethost($ip);
  return $host->name if(defined($host));
  return "";
}

sub get_isp_from_host {
  my $host = shift;
  foreach (keys %FAI) {
    my $testfai = quotemeta($_);
    if($host =~ /$testfai/) { return $FAI{$_}; }
  }
  return "Unknown ISP";
}

sub detect_isp {
  my $ip   = get_ip();
  my $host = get_host_from_ip($ip);
  return  get_isp_from_host($host);
}