#!/usr/bin/perl
#
# File is maintained in Mandriva SVN, only the configuration is adapted for PLF:
# http://svn.mandriva.com/cgi-bin/viewvc.cgi/soft/build_system/mirror/mirrorlist/trunk/
#
# Copyright (c) 2006 Mandriva
# author: Florent Villard <warly@mandriva.com>
# Published under the GPL license
#
# Parse the mirrors.xml and generate appropriate list files to be uploaded on the main server
#
#

use strict;
use Net::FTP;
use LWP::Simple;
use Fcntl ':flock';
use File::Temp qw(:POSIX);
use MDK::Common;

my %distributions = (
    'cooker' => {
        root => 'mandriva/cfg',
        version => 'cooker',
        arch => [ 'i586', 'x86_64' ],
        distrib => { media => 'free/binary',
                media_root => 'mandriva',
                trailing_arch => 1 },
	symlink_to => '2012.0',
    },
    '2011' => {
        root => 'mandriva/cfg',
        version => '2011',
        arch => [ 'i586', 'x86_64' ],
        distrib => { media => 'free/backports/binary',
            media_root => 'mandriva',
            trailing_arch => 1 },
	symlink_to => '2011.0',
    },
    '2010.2' => {
        root => 'mandriva/cfg',
        version => '2010.2',
        arch => [ 'i586', 'x86_64', 'ppc' ],
        distrib => { media => 'free/backports/binary',
            media_root => 'mandriva',
            trailing_arch => 1 },
        symlink_to => '2010.1',
    },
    '2010.0' => {
        root => 'mandriva/cfg',
        version => '2010.0',
        arch => [ 'i586', 'x86_64', 'ppc' ],
        distrib => { media => 'free/backports/binary',
            media_root => 'mandriva',
            trailing_arch => 1 },
    },
    '2009.1' => {
	root => 'mandriva/cfg',
	version => '2009.1',
	arch => [ 'i586', 'x86_64', 'ppc' ],
	distrib => { media => 'free/backports/binary',
	    media_root => 'mandriva',
	    trailing_arch => 1 },
    },
    '2009.0' => {
        root => 'mandriva/cfg',
        version => '2009.0',
        arch => [ 'i586', 'x86_64', 'ppc' ],
        distrib => { media => 'free/backports/binary',
            media_root => 'mandriva',
            trailing_arch => 1 },
    },
    '2008.1' => {
	root => 'mandriva/cfg',
	version => '2008.1',
	arch => [ 'i586', 'x86_64', 'ppc' ],
	distrib => { media => 'free/backports/binary',
	    media_root => 'mandriva',
	    trailing_arch => 1 },
    }
);
my $reference = 'localhost';
my $user = 'plf';
my $remotecommand = '/home/mandrake/bin/last_rpm';
my $program_name = 'generatelist';
my $remotepath = '/home/mandrake/mirror/MandrivaLinux/';
my @type = ('distrib');

my @distribs = keys %distributions;

my $update;
if ($ARGV[0] eq '--update') {
    shift @ARGV;
    $update = 1;
} 
my $fork = 1;
if ($ARGV[0] eq '--nofork') {
    shift @ARGV;
    $fork = 0;
}
if ($ARGV[0] =~ m/^--distrib=(.+)$/) {
    @distribs = $1;
    shift @ARGV;
}
my $file = $ARGV[0];
-f $file or usage();

my %last;
my %output;
my %fail;
foreach my $name (@distribs) {
    my $distrib = $distributions{$name};
    my $version_path = $distrib->{version_path} || $distrib->{version};
    foreach my $arch (@{$distrib->{arch}}) {
	foreach my $type (@type) {
	    my $media = $distrib->{$type}{media};
	    my $path = $distrib->{$type}{path};
	    $media or next;
	    my $rpm;
	    print "Checking last rpm for $name/$arch/$media ($name.$arch.$type.lastrpm)\n";
	    if ($update) {
		my $root = $distrib->{$type}{alt_root} || $distrib->{root};
		my $command = "ssh -x $user\@$reference $remotecommand $remotepath/$root/$path/$version_path/$arch/$media/";
		print STDERR "$program_name: running $command\n";
		$rpm = `$command`;
		chomp $rpm;
		$rpm ||= "media_info/hdlist.cz"; #- check hdlist if no rpm file is available yet
		open my $file, ">$name.$arch.$type.lastrpm" or die "Could not open lastrpm file";
		print $file $rpm;
	    } else {
		open my $file, "$name.$arch.$type.lastrpm" or die "Could not open lastrpm file";
		$rpm = <$file>;
		# just in case we add extra \n manually
		chomp $rpm;
	    }
	    print STDERR "$program_name: last rpm to check for $version_path/$arch is $rpm\n";
	    $last{$name}{$arch}{$type} = $rpm;
	}
	open my $fh, ">$name.$arch.list";
	$output{$name}{$arch} = "$name.$arch.list";
	close $fh;
	open my $fh, ">fail.$name.$arch.list";
	$fail{$name}{$arch} = "fail.$name.$arch.list";
	close $fh;
    }
}

# this is multiplied by the number of arch
my $children = 2;
my $pid;
my $line = 0;
my ($tmpfile, $tmpfh) = create_lock();
my ($check);

my %done;
open my $mirrors, $file or usage();
while (<$mirrors>) {
    $line++;
    print STDERR "Children=$children\n";
    chomp($_);
    s/#.*//g;
    $_ or next;
    $done{$_} and next;
    # intermediate var to prevent problem with empty fields
    my %param = map { my ($a, $b) = split('=',$_); ($a, $b) } split ',';
    #print;
    #print "URL $param{url}\n";
    if ($param{url} =~ m!^(([^:]+)://([^/|]+)/?([^|]*))(.*)!) {
	my ($url, $method, $host, $path, $rest) = ($1, $2, $3, $4, $5);
	$url =~ s!/$!!;
	print "url $url method $method host $host path $path rest $rest\n";
	# Fork here because we must not send several checks on a mirror which will likely 
	# multiple connection from the same IP
	# keel a done list py url, though, not to check a same mirror multiple time
	if ($fork && ($pid=fork())) {
	    # fork to do the real work (because mirror response can take a while)
	    $done{$_} = 1;
	    $children--;
	} else {
	    get_latitude_longitude_country_zone($host, \%param);

	    my $prefix;
	    foreach my $var (qw(continent zone country state city latitude longitude bandwith restricted bw version branch type arch)) {
		$prefix .= "$var=$param{$var}," if $param{$var};
	    }

	    if ($param{check} eq 'no') {
		# should include it as this
		if ($param{version} && $param{arch}) {
		    print "OK no check $url ($param{version}/$param{arch}\n";
		    lockfile();
		    open my $fh, ">>$output{$param{version}}{$param{arch}}";
		    print $fh "${prefix},url=$url\n";
		    close $fh;
		    unlockfile();
		} else {
		    print "FAILED no check $url ($param{version}/$param{arch}\n";
		}
	    } else {
		foreach my $name (@distribs) {
		    my $distrib = $distributions{$name};
                    my $version = $distrib->{version};
                    my $version_path = $distrib->{version_path} || $version;
		    foreach my $arch (@{$distrib->{arch}}) {
			foreach my $type (@type) {
			    my $media = $distrib->{$type}{media};
			    my $typepath = $distrib->{$type}{path};
			    my $file = $media ? $last{$name}{$arch}{$type} : $distrib->{$type}{file}
                              or next;
			    my $root = $distrib->{$type}{alt_root} || $distrib->{root};
			    foreach my $testpath (($typepath ? "$root/$typepath": ()), $root) {
				my ($distroot, $checkpath) = _distroot_and_checkpath($distrib->{$type}, $testpath, $version_path, $arch);
				my $checkurl = "$url/$checkpath";
				$done{$checkurl} and next;
				$done{$checkurl} = 1;
				my $fullurl = "$checkurl/$file";
				print STDERR "$program_name: checking host $host path $path/$testpath version $version_path arch $arch media $media file $file\n";
				my $r;
				if ($param{restricted}) {
				    $r = 1; #- we can't check restricted mirrors, add them unconditionally
				} elsif ($method eq 'rsync') {
				    $r = !system("rsync --timeout=45 $fullurl/ &> /dev/null");
				} elsif ($method eq 'ftp') {
				    $r = check_ftp($host, "$path/$checkpath", $file);
				} else {
				    $r = check_http($fullurl);
				}
				lockfile();
				if (!$r) {
				    print "FAILED $checkurl ($version_path/$arch)\n";
				    open my $fh, ">>$fail{$name}{$arch}";
				    print $fh "${prefix}version=$version,arch=$arch,type=$type,url=$url/$distroot\n";
				    close $fh;
				    unlockfile();
				} else {
				    print "OK $checkurl ($version_path/$arch)\n";
				    open my $fh, ">>$output{$name}{$arch}";
				    print $fh "${prefix}version=$version,arch=$arch,type=$type,url=$url/$distroot\n";
				    close $fh;
				    unlockfile();
				    # likely if one url is ok we should not test the other ones
				    last;
				}
			    }
			}
		    }
		}
		exit if $fork;
	    }
	}
    } else {
	print STDERR "unknown line $line: $_\n";
	next;
    }
    while ($children <= 0) {
	wait;
	$children++;
    }
}

use POSIX ":sys_wait_h";
waitpid(-1, WNOHANG);
my ($ok, $fail);
foreach my $name (@distribs) {
    my $distrib = $distributions{$name};
    foreach my $arch (@{$distrib->{arch}}) {
	my $fh;
	if (open $fh, $output{$name}{$arch}) {
	    while (<$fh>) { $ok++ }
	    close $fh;
	}
	symlinkf($output{$name}{$arch}, "$distrib->{symlink_to}.$arch.list")
          if $distrib->{symlink_to};
	if (open $fh, $fail{$name}{$arch}) {
	    while (<$fh>) { $fail++ }
	    close $fh;
	}
    }
}
$check = $ok + $fail;
	
print STDERR "Total: $check mirrors checked $ok OK $fail BAD\n";

remove_lock();
exit;

sub _distroot_and_checkpath {
    my ($distrib_with_type, $testpath, $version_path, $arch) = @_;
    my $media = $distrib_with_type->{media};

    my $distroot = "$testpath/$version_path" . (!$distrib_with_type->{no_arch} && "/$arch");
    $distroot =~ s,/+,/,;

    # {media_root} allows a different $root for the media which is checked for $file.
    # (trailing_arch} allows the arch to go after the media_name (need {no_arch} or {media_root})
    # eg: media.cfg in plf/mandriva/cfg/<version>/<arch>/media/media_info/
    #     whereas medias are in plf/mandriva/<version>/<media_name>/<arch>
    my $mediaroot = $distrib_with_type->{media_root} ?
        $distrib_with_type->{media_root} . "/$version_path" . (!$distrib_with_type->{trailing_arch} && "/$arch") :
	$distroot;
    $mediaroot =~ s,/+,/,;

    my $checkpath = $mediaroot . ($media && "/$media") . ($distrib_with_type->{trailing_arch} && "/$arch");

    $distroot, $checkpath;
}

sub create_lock() {
    tmpnam();
}

sub lockfile() {
    flock($tmpfh, LOCK_EX);
}

sub unlockfile() {
    flock($tmpfh, LOCK_UN);
}

sub remove_lock() {
    unlink($tmpfile);
    close($tmpfh);
}

sub check_ftp {
    my ($host, $dir, $file) = @_;

    my $ftp = Net::FTP->new($host, Debug => 0, Timeout => 45, Passive => 1) or return 0;

    $ftp->login("anonymous", '-anonymous@') or return 0;

    $ftp->cwd($dir) or return 0;

    if ($file) {
	    my @res = $ftp->dir($file);
	    return 0 if !@res;
    }
    1;
}

sub check_http {
    my ($url) = @_;

    my ($_content_type, $_document_length, $_modified_time, $_expires, $_server) = head($url) or return 0;
    
#     if ( !$document_length ) {
# 	lock();
# 	print STDERR "Empty document on $url\n";
# 	unlock();
# 	return 0;
#     }

    return 1;
}

sub get_latitude_longitude_country_zone {
    my ($host, $param) = @_;

    $host =~ s/.*\@//; # remove user from url

    my $xml_has_value = $param->{latitude} && $param->{longitude};

    my $cache = "geoip/.cache/$host";
    if (-e $cache && !$xml_has_value) {
	($param->{latitude}, $param->{longitude}, $param->{zone}) = `cat $cache` =~ /(\S+) (\S+) (.*)/;
    }

    my ($latitude, $longitude, $country_code) = `geoip/geoip-city-lookup geoip/GeoLiteCity.dat $host` =~ /(\S+) (\S+) (.*)/;
    if (!$latitude && !$longitude) {
	print STDERR "geoip: could not find latitude/longitude for $host\n" if !$xml_has_value;
	return;
    }

    if ($param->{latitude} && $param->{latitude} != $latitude) {
	print STDERR "geoip: $_" foreach `host $host`;
	print STDERR "geoip: modifying latitude for $host: $latitude instead of $param->{latitude}\n";
    }
    if ($param->{longitude} && $param->{longitude} != $longitude) {
	print STDERR "geoip: $_" foreach `host $host`;
	print STDERR "geoip: modifying longitude for $host: $longitude instead of $param->{longitude}\n";
    }
    $param->{latitude}  = $latitude;
    $param->{longitude} = $longitude;
    $param->{zone} = $country_code;
    system("echo $latitude $longitude $country_code > $cache");
}

sub usage() {
    print "\n\tusage:\n\n\t\t\t$0 [--nofork] [--update] [--distrib=<distrib>] mirrors.list\n\n";
    exit;
}