#!/usr/bin/perl
#
# $Id$
#
use lib qw(/usr/lib/libDrakX);
use standalone; # Should be set first

use strict;
use LWP::UserAgent; # to retrieve url
my $ua = LWP::UserAgent->new;

use Getopt::Long; # get command line arg

# interactive:
use interactive;
my $in; # will contain interacrive if need
use urpm;
my $urpm = new urpm;

# i18n
use Locale::gettext;
Locale::gettext::textdomain("urpmi.setup");

# Global var
my %param; # user param (ver, arch)
my $softver="0.3.9e";
my %list_source; # list of mirror
my %globinfo; # global info from server
  
sub help {
    my %help;
    my ($cmd) = @_;
    $help{'add'} =
    _("urpmi.setup add [media=mirror]...\n").
    _("Add a media from mirror list:\n").
    _("- media is the name (main, contrib...)\n").
    _("- mirror is the dns name (ex: ftp.lip6.fr)\n")
    ;
    $help{'update'} =
    _("urpmi.setup update [medium]...\n").
    _("update medium list\n")
    ;
    $help{'remove'} =
    _("urpmi.setup remove [medium]...\n").
    _("remove medium list\n")
    ;
    $help{'list'} =
    _("urpmi.setup list [name]\n").
    _("List available mirror for media name").
    _("if no name is given, list available media")
    ;

    _("Urpmi setup %s (GPL): Olivier Thauvin <thauvin\@aerov.jussieu.fr>\n", $softver) .
    _("Usage: urpmi.setup [options] [[add|remove|update|list] [arg]]\n") .
    _("options (*= can be set in /etc/urpmi/mirror.config):\n") . 
    _("  -h|--help           Gives this message\n") .
    _("  -t|--test           Only shows what it does\n") .
    _("* -v|--verbose        Makes it verbose\n") .
    _("* -u|--url     url    Url to use to retrieve list\n") .
    _("*   |--mdkver  ver    forces mdk version to ver\n") .
    _("*   |--arch    arch   forces architecture to arch\n") .
    _("    |--http_proxy     proxy server to use (http://server:port/)\n") .
    _("    |--ftp_proxy      proxy server to use (ftp://server:port/)\n").
    "\n" . $help{$cmd}
    ;
}

sub info {
    my $info;
    foreach my $media (@{$urpm->{media}}) {
        $info .= "\n#-> " . $media->{name} . "\n";
        $info .= _("Url is %s\n", $media->{url} . ' with ' . $media->{with_hdlist});
        $info .= _("Local hdlist is %s\n", $media->{hdlist});
        $media->{update} and $info .= _("Is an update media\n");
    }

    _("you're using url: %s\n", $param{url}) . 
    _("Mandrake version: %s\n", $param{mdkver}).
    _("Arch: %s\n", $param{'arch'}).
    _("http proxy server: %s\n", $param{http_proxy}  ? $param{http_proxy} : _("(None)")).
    _("ftp proxy server: %s\n", $param{ftp_proxy}  ? $param{ftp_proxy} : _("(None)")).
    $info;
}

# Get system info
sub get_current_ver {
    open (VER, "/etc/mandrake-release") or die 'Can\'t open mandrake-release';
    my @s = split(" ", <VER>);
    $param{mdkver} = $s[4] =~ /\(Cooker\)/ ? 'cooker' : $s[3];
    $param{arch} = $s[6];
    close(VER);
}

# Read the config file
sub parse_config {
    local (*CONF, $_);
    open(CONF, "/etc/urpmi/mirror.config") or warn _("Can't open configuration file.\n");
    while (<CONF>) {
        s/#.*//;         # no comments
        s/^\s+//;        # no leading white
        s/\s+$//;        # no trailing white
        length or next;      # anything left?
        my ($option, $value) = split(/\s*=\s*/, $_, 2);
        $param{$option} = $value;
    }
    close(CONF);
}

sub save_config	{
    my (%paramt) = @_;
    local *CONF;
    open CONF, "> /etc/urpmi/mirror.config" or return 1;
    print CONF $_ . "=" . $paramt{$_} . "\n" foreach ("url");
    close CONF;
    open CONF, "> /etc/urpmi/proxy.cfg" or return 1;
    $paramt{$_} and print CONF $_ . "=" . $paramt{$_} . "\n" foreach ("http_proxy", "ftp_proxy");
    $paramt{proxyuser} and print CONF "proxy_user=" . $paramt{proxyuser} . ':' . $paramt{proxypwd} . "\n";
    close CONF;
}
	
sub urltofile {
    my $file;
    if ($param{url} =~ m{^(http|ftp)://}) {
        $file = ($ENV{TMPDIR} || $ENV{TMP} || "/tmp")."setup.list.tmp";
        $ENV{http_proxy} ? $ua->proxy(['http', 'ftp'], $ENV{http_proxy}) : $ua->proxy(['http', 'ftp'], $urpm->{proxy}{http_proxy});
        my $req = HTTP::Request->new('GET', $param{'url'});
        my $res = $ua->request($req, $file);
        return $res->is_success ? $file : '';
    }
    $param{url} =~ /^file:(.*)/;
    $1;
}

sub parse_url {
    %globinfo = ();
    %list_source = ();
    local (*URLLIST, $_);
    open (URLLIST, urltofile()) or return 1;
    while (<URLLIST>) {
          s/#.*//;         # no comments
          s/^\s+//;        # no leading white
          s/\s+$//;        # no trailing white
          length or next;  # anything left?

          my ($name, $mdkver, $arch, $location, $url) = split(':',$_,5);
          if (!$name) {
              $globinfo{$arch}{$location} = $url;
          } else {
              $url =~ m|^(.*)://(.+?)/(.*)|;
              my $mach = $1."://".$2;
              ($mdkver eq $param{'mdkver'} || $mdkver eq '*') && 
                ($arch eq $param{'arch'} || $arch eq '*' || $arch eq 'noarch') and
                  @{$list_source{$name}{$mach}}{'url', 'location'} = ($url, $location);
          }
      }
    close(URLLIST);
    0;
}

# Batch function
sub batch_add_source {
    my @l = @_;
    if (parse_url()) {
        print STDERR _("Can't read mirror list from:\n %s",$param{'url'});
        exit;
    }
    add_source_from_list((split '=')[0, 1]) foreach (@l)
}

sub batch_remove_source { remove_source(@_) }

sub batch_update_source { update_source(@_) }

sub batch_list_source {
    my ($name) = @_;
    my @res = list_source($name);
    #XXX : why use a hash? why not do that : @res = map { s/\|.*// } @res; print join("\n", sort @res) . "\n";
    my %list = map { s/\|.*//; $_ => ''} @res;
    print join("\n", sort keys %list) . "\n";
}
	
# Interatice function
# Ask in widows server to use for each media
sub ask_add_source {
    parse_url() and $in->ask_warn(_("error"), _("Can't read mirror list from:\n %s", $param{url})), return;
    scalar keys %list_source or $in->ask_warn(_("Nothing can be add"), _("I am sorry, I can't find any media for your system.\n Are you sure your setting are good ?")), return;

    my (%user, @lsource, %msource, %ftp);
    my @installed_source = map { $_->{name} } @{$urpm->{media}};
    foreach my $name (sort keys %list_source) {
        %{$msource{$name}}= map { $list_source{$name}{$_}{location} .' (' . $_ .')' => $_ } keys %{$list_source{$name}};
        $msource{$name}{_("  -not set-  ")} = '';
        push @lsource, { val => $name.":", type =>'button', clicked =>
                         sub { $in->ask_warn($name, $globinfo{source}{$name} ? $globinfo{source}{$name} : _("No description available")) } 
                       };
        if (grep { /^$name$/ } @installed_source) {
            push @lsource, { val => _("Already exist, remove it to reinstall"), type => 'label' };
        } else {
            push @lsource, { val => \$user{$name}, type => 'combo',
                             list => [sort keys %{$msource{$name}} ]
                           };
        }
    }
    $in->ask_from(_("Media list"), _("Select a source to add in your urpmi base"), [@lsource]) or return;
    $msource{$_}{$user{$_}} and $ftp{$_} = $msource{$_}{$user{$_}} foreach (keys %user);

    if (scalar keys %ftp && $in->ask_from(_("OK to setup ?"), _("Are you sure you want to setup urpmi for use %s", join(',', keys %ftp)), [{ val => \$param{synthesis},  type => 'bool', label => _("Use synthesis instead hdlist") }] )) {
        my $wait = $in->wait_message(_("Please wait"), _("Adding medium %s", join(',', keys %ftp)));
        add_source_from_list($_, $ftp{$_}) foreach (keys %ftp)
    }
}
	
# Main menu of app
sub menu {
    my $retour;
    $in->ask_from(_("urpmi setup"), _("What do you want to do ?"), [ 
	{ type => 'button', clicked_may_quit => sub { $retour = "add" }, val => _("Add web media from database") }, 
	{ type => 'button', clicked_may_quit => sub { $retour = "addmedia" }, val => _("Add manually urpmi media") }, 
	{ type => 'button', clicked_may_quit => sub { $retour = "update" }, val => _("Update urpmi base") }, 
	{ type => 'button', clicked_may_quit => sub { $retour = "remove" }, val => _("Remove medium") }, 
	{ type => 'button', clicked_may_quit => sub { $retour = "listw" }, val => _("List available medium") }, 
	{ type => 'button', clicked_may_quit => sub { $retour = "config" }, val => _("Configuration") }, 
	{ type => 'button', clicked_may_quit => sub { $retour = "infow" }, val => _("System information") }, 
	# { type => 'button', clicked_may_quit => sub { $retour="help"; }, val => _("Command line help")} 
	] );
    $retour;
}
	
# ask in window wich installed media to uninstall
sub ask_remove_source {
    my (@medias, %toremove);
    push @medias, { val => \$toremove{$_->{name}}, label => $_->{name}." (".($_->{url} =~ m|(.*://.+?)/|)[0].")", type => 'bool' } foreach (@{$urpm->{media}});

    scalar @medias or $in->ask_warn(_("No source"), _("No media are actually setup, nothing to remove")), return;
    $in->ask_from(_("Installed medium"), _("Choose medium to remove"), [@medias]) or return;
    $toremove{$_} or delete $toremove{$_} foreach (keys %toremove);
    if (scalar keys %toremove && $in->ask_yesorno(_("Removing source ?"), _("Are you sure you want to remove %s ?", join (',', keys %toremove)))) {
        my $wait = $in->wait_message(_("Please wait"), _("Removing medium %s", join (',', keys %toremove)));
        remove_source(keys %toremove);
    }
}

# Ask in window which media to update
sub ask_update_source() {
    my (@medias, %toupdate);
    push @medias, {val => \$toupdate{$_->{name}}, label=> $_->{name}, type => 'bool'} foreach (@{$urpm->{media}});
    $in->ask_from('', _("Select urpmi medium want to update"), [@medias]) or return; 
    $toupdate{$_} or delete $toupdate{$_} foreach (keys %toupdate);
    if (scalar keys %toupdate) {
        my $wait = $in->wait_message(_("Please wait"), _("Updating urpmi base %s", join(",", keys %toupdate)));
        update_source(keys %toupdate);
    }
}

# list available media from url
# show in window
sub ask_list_source {
    if (scalar list_source()) {
        $in->ask_from_treelist(_("Medium list"), _("Availlable medium for your system"), "|", [list_source()]);
    } else {
        $in->ask_warn(_("No media found"), _("I am sorry, I can't find any media for your system.\n Are you sure your setting are good ?"));
    }
}
	
# interactive manual add media
# ask path and other info to try to add a non list media
sub ask_add_media {
    my ($findhd, $isupdate, $name, $hdlist, $path) = (0);
    do {
        $in->ask_from(_("Add media"), _("Add media"), [
            { val => \$name, type => 'entry', label =>  _("Choose a name for this media:") },
            { label => _("Is an update media:"), val=> \$isupdate, type => 'bool' },
            { val => \$path, type => 'entry', label =>  _("Select path of RPMS:") },
            { val => _("Browse"), type => 'button', clicked => sub { $path = $in->ask_file("", $path) } },
            { val => \$hdlist, type => 'entry', label => _("Relative path of hdlist,\n if empty, it will try find it:") } 
        ]) or return;
    } while (! ($name && $path ) && $in->ask_warn(_("Error"), _("You must enter a name and a path")));
    $hdlist or $findhd = 1;
    $path =~ m/.*:\// or $path = "file://".$path;
	
    my $ok;
    while (!$ok) {
        $urpm->add_medium($name, $path, $hdlist, update => $isupdate);
        $urpm->update_media(probe_with_hdlist => $findhd);
        my ($medium) = grep { $_->{name} eq $name } @{$urpm->{media}};
	
        $medium->{modified} or return;
        $in->ask_from(_("Add media"), _("No hdlist found, give one if need, or cancel to abort"), [ { val => \$hdlist, type => 'entry' } ]) or $ok = 1;
        $findhd = 0;
        $urpm->remove_selected_media($name);
        $urpm->update_media(noclean => 0);
    }
}

# interactive config
sub config {
    my %paramt = %param;
    $in->ask_from('', _("Here you can change settings.\nTake care to keep compatibility with your system!"), [
        {label => _("http proxy"), val => \$paramt{"http_proxy"}, type=> 'entry'},
        {label => _("ftp proxy"), val => \$paramt{"ftp_proxy"}, type=> 'entry'},
        {label => _("user"), val => \$paramt{"proxyuser"}, type=> 'entry' },
        {label => _("passwd"), val => \$paramt{"proxypwd"}, type=> 'entry', hidden=>1},
        {label => _("Mandrake version"), val => \$paramt{"mdkver"}, type=> 'entry'},
        {label => _("Architecture"), val => \$paramt{"arch"}, type=> 'entry'},
        {label => _("Url for server list"), val => \$paramt{"url"}, type=> 'entry'},
	{label => _("Use synthesis instead hdlist"), val => \$paramt{"synthesis"}, type => 'bool' }, 
        {label => _("Save configuration"), val => _("Save and validate"), type => 'button', clicked_may_quit => sub { print STDERR save_config(%paramt);  }}
	]) and %param = %paramt;
    @{$urpm->{proxy}}{qw(http_proxy ftp_proxy user pwd)} = @param{qw(http_proxy ftp_proxy proxyuser proxypwd)};
}

# Non Interactive function
#

# add a media from list retrieve
# want name and machine name
sub add_source_from_list {
    my ($name, $machine) = @_;
    if (!$list_source{$name}{$machine}) {
        print STDERR _("Mirror %s doesn't have %s, I can't add it\n", $machine, $name); return; }
    my $is_update = 0;
    $globinfo{'urpmiopt'}{$name} =~ /--update/ and $is_update = 1;
    my ($url, $with, $hdlist) = split(' ', $list_source{$name}{$machine}{'url'});
    $hdlist = "synthesis.".$hdlist if ($param{synthesis});
    print STDERR $hdlist;
    add_source(($name, $url, $hdlist, $is_update));
}

# add a source only with hdlist
sub add_source {
    my ($name, $url, $hdlist, $is_update) = @_;
    $urpm->add_medium($name, $url, $hdlist, update => $is_update);
    $urpm->update_media(update => 1);
    my ($medium) = grep { $_->{name} eq $name } @{$urpm->{media}};
    ($medium->{modified}) and $urpm->remove_selected_media($name);
}

# update urpmi base list
sub update_source {	
    my @medias = @_;
    $urpm->select_media(@medias);
    #- force ignored media to be returned alive.
    $_->{modified} and delete $_->{ignore} foreach (@{$urpm->{media}});
    $urpm->update_media(noclean => 0);
}
	
# remove media list
sub remove_source {
    my @medias = @_;
    $urpm->select_media(@medias);
    $urpm->remove_selected_media;
    $urpm->update_media(noclean => 0);	
}

# only list available source from url
sub list_source {
    my ($name) = @_;
    my @list;
    parse_url() and return;
    if ($name) {
        @list = map { $list_source{$name}{$_}{'location'} . ' (' . $_ . ')' } keys %{$list_source{$name}}; 
    } else {
        foreach my $name (keys %list_source) {
            push (@list, map { $name.'|'.$list_source{$name}{$_}{'location'}.' ('.$_ .')' } keys %{$list_source{$name}});
        }
    }
    @list;
}
	
# Begin main
$ua->agent("Urpmi.Setup/$softver");

# Get system config
get_current_ver;
parse_config;

# Get command line option (overwrite default config)
GetOptions (
    'h|help' => \$param{help},
    'mdkver=s' => \$param{mdkver},
    'arch=s' => \$param{arch},
    'syn' => \$param{synthesis},
    'u|url=s' => \$param{url},
    't|test' => \$param{test},
    'V|verbose' => \$param{verbose},
    'http_proxy=s' => \$param{http_proxy},
    'ftp_port=s' => \$param{ftp_proxy},
    'proxyuser=s' => \$param{proxyuser},
    'proxypwd=s' => \$param{proxypwd}
);

$param{verbose} or $urpm->{log} = sub {}; # Ta gueule
$urpm->read_config; # Read the config


foreach (['http_proxy', 'http_proxy'], ['ftp_proxy', 'ftp_proxy'], ['proxyuser', 'user'], ['proxypwd', 'pwd']) {
    $param{$_->[0]} ? $urpm->{proxy}{$_->[1]} = $param{$_->[0]} : $param{$_->[0]} = $urpm->{proxy}{$_->[1]};
}

my ($action, @argument) = @ARGV;

if ($param{'help'}) {
    unshift @argument, $action;
    $action = 'help';
}

for ($action) {
    /^help$/ and do { print help(@argument); exit; };
    /^list$/ and do { batch_list_source(@argument); exit; };
    /^info$/ and do { print STDERR info(@argument); exit; };
    #- here we can check for unknown action ?
}

if (@argument) {
    for ($action) {
	/^add$/    and batch_add_source(@argument);
	/^update$/ and batch_update_source(@argument);
	/^remove$/ and batch_remove_source(@argument);
    }
    exit;
}
	
$in = 'interactive'->vnew('su', 'default');

while (local $_ = $action || menu()) {
    /^infow$/ and $in->ask_warn(_("Info"), info());
    /^help$/ and $in->ask_warn(_("Help"), help(""));
    /^add$/ and ask_add_source();
    /^update$/ and ask_update_source();
    /^remove$/ and ask_remove_source();
    /^listw$/ and ask_list_source();
    /^addmedia$/ and ask_add_media();
    /^config$/ and config();
    $action and exit;
}

$in->exit;