#!/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.9d";
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 {
    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)=@_;
    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="/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=();
    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 {
              my $mach=$url;
              $mach =~ s|^.*://||;
              $mach =~ s|/.*$||;
              ($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 %list;
    my @res=list_source($name);
    %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 {
    if (parse_url()) {
        $in->ask_warn(_("error"), _("Can\'t read mirror list from:\n %s",$param{'url'}));
        return; }
    if (! scalar %list_source ) {
        $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;
    my @lsource;
    my %msource;
    my %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}} ] };
        }
    }
    return if (! $in->ask_from(_("Source list"),_("Select a source to add in your urpmi base"),[@lsource]));
    foreach (keys %user) {
        $ftp{$_}= $msource{$_}{$user{$_}} if ($msource{$_}{$user{$_}});	
    }

    if (scalar %ftp and $in->ask_yesorno(_("OK to setup ?"), _("Are you sure you want to setup urpmi for use %s",join(',',keys %ftp)))) {
        my $wait=$in->wait_message(_("Please wait"),_("Adding medium %s",join(',',keys %ftp)));
        foreach (keys %ftp) { add_source_from_list($_,$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")} 
    ] );
    return $retour;
}
	
# ask in window wich installed media to uninstall
sub ask_remove_source() {
    my @medias;
    my %toremove;
    foreach (@{$urpm->{media}}) { 
        push @medias, { val => \$toremove{$_->{name}}, label => $_->{name}, type => 'bool' };}
    if (! scalar @medias) { 
        $in->ask_warn(_("No source"),
         _("No media are actually setup, nothing to remove")); 
	return; 
    }
    return if (! $in->ask_from(_("Installed medium"),_("Choose medium to remove"),[@medias]));
    foreach (keys %toremove) { delete $toremove{$_} if (!$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;
    my %toupdate;
    foreach (@{$urpm->{media}})
        { push @medias, {val => \$toupdate{$_->{name}}, label=> $_->{name}, type => 'bool'};}
    $in->ask_from('',_("Select urpmi medium want to update"),[@medias]) || return; 
    foreach (keys %toupdate) { delete $toupdate{$_} if (!$toupdate{$_}); }
    if (%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 {
    my @list=list_source();
    scalar @list ?
     $in->ask_from_treelist(_("list"),_("list"),"|",[list_source()]) :
     $in->ask_warn(_("No media find"),_("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 $path;
    my $hdlist;
    my $name;
    my $isupdate;
    my $findhd=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")));
    $findhd=1 if (! $hdlist);
    $path= "file://".$path if ($path !~ m/.*:\//);
	
    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}};
	
        if (!$medium->{modified}) { return }
        else {
            $in->ask_from(_("Add media"),_("No hdlist found, give one if need, or cancel t o 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;
    %param=%paramt if ($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 => _("Save configuration"), val => _("Save and validate"), type => 'button', clicked_may_quit => sub { print STDERR save_config(%paramt);  }}
	]) );
        $urpm->{proxy}{http_proxy}=$param{http_proxy};
        $urpm->{proxy}{ftp_proxy}=$param{ftp_proxy};
        $urpm->{proxy}{user}=$param{proxyuser};
        $urpm->{proxy}{pwd}=$param{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;
    $is_update=1 if ( $globinfo{'urpmiopt'}{$name} =~ /--update/ );
    my ($url,$with,$hdlist) = split(' ', $list_source{$name}{$machine}{'url'});
    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}};
    $urpm->remove_selected_media($name) if ($medium->{modified})
}

# update urpmi base list
sub update_source {	
    my @medias=@_;
    $urpm->select_media(@medias);
    #- force ignored media to be returned alive.
    foreach (@{$urpm->{media}}) {
        $_->{modified} and delete $_->{ignore};}
    $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;
    return if (parse_url());
    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}}); 
        }
    }
    return @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'},
    "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

$param{'http_proxy'} ? $urpm->{proxy}{http_proxy}=$param{'http_proxy'} : $param{'http_proxy'}=$urpm->{proxy}{http_proxy};
$param{'ftp_proxy'} ? $urpm->{proxy}{ftp_proxy}=$param{'ftp_proxy'} : $param{'ftp_proxy'}=$urpm->{proxy}{ftp_proxy};
$param{'proxyuser'} ?  $urpm->{proxy}{user}=$param{'proxyuser'} : $param{'proxyuser'}=$urpm->{proxy}{user};
$param{'proxypwd'} ?  $urpm->{proxy}{pwd}=$param{'proxypwd'} : $param{'proxypwd'}=$urpm->{proxy}{pwd};

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

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

if ($action =~ /^help$/) { print help(@argument); exit; }
if ($action =~ /^list$/) {batch_list_source(@argument); exit; }
if ($action =~ /^info$/) {print STDERR info(@argument); exit; }

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

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

$in->exit;