path: root/mdkupdate

#!/usr/bin/perl
################################################################################
# Mdkupdate                                                                    # 
#                                                                              #
# Copyright (C) 2002-2004 Mandriva                                             #
#                                                                              #
# Daouda Lo <daouda at mandriva dot com>                                       #
#                                                                              #
# This program is free software; you can redistribute it and/or modify         #
# it under the terms of the GNU General Public License Version 2 as            #
# published by the Free Software Foundation.                                   #
#                                                                              #
# 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 POSIX;
use lib qw(/usr/lib/libDrakX /usr/lib/libDrakX/drakfirsttime);
use standalone; # for explanations
use common;
use interactive;
use URI::Escape;

use mdkonline;
use urpm;

use Getopt::Long;

# for debug 
use Data::Dumper;

BEGIN { unshift @::textdomains, 'mdkupdate' }

require_root_capability();

my $confdir = '/root/.MdkOnline';
my $conffile = "$confdir/mdkupdate";

my $difflog = '/var/tmp/diff.log';
my $logfile = '/var/tmp/mdkupdate.log';


my $currentrpm = "$confdir/rpm_qa_installed_current";
my $afterrpm =  "$confdir/rpm_qa_installed_after";

my $startpage = 'http://start.mandriva.com/';

my $CLIENT_VERSION = "4";
my $YEARS = "2002-2006";

#for compatibilities with former versions
mkdir_p($confdir) if !-d $confdir;
-e '/root/.mdkupdate' and system "/bin/mv", "/root/.mdkupdate", $conffile;


sub usage() {
    print STDERR N("mdkupdate version %s
Copyright (C) %s Mandriva.
This is free software and may be redistributed under the terms of the GNU GPL.

usage:
", $CLIENT_VERSION, $YEARS) . N("  --help		- print this help message.
") . N("  --auto		- Mandriva Update launched automatically.
") . N("  --applet		- launch Mandriva Update.
") . N("  --mnf			- launch mnf specific scripts.
") . N("  --noX			- text mode version of Mandriva Update.
") . N("  --debug			- log what is done
") . N("  --bundle file.bundle	- parse and install package from .bundle metainfo file.
");
    exit(0);
}

my ($auto, $applet, $mnf, $noX, $bundle, $debug);
my %options = (
	       'auto'	    => \$auto,
	       'a|applet'   => \$applet,
	       'mnf'	    => \$mnf,
	       'noX'	    => \$noX,
            'd|debug'   => \$debug,
	       'b|bundle:s' => sub { $bundle = $_[1] || 'webbundle' } ,
	       'h|help'    => \&usage,
	      );

GetOptions(%options);

# workaround an issue with browsers that sometimes drop the --bundle option:
$bundle = shift @ARGV if $ARGV[0] =~ /\.bundle$/;

$bundle eq "webbundle" and mdkonline::get_site($startpage), exit(0);

my $in;

$bundle || $noX and $in = interactive->vnew;

my $result;
my $wc = mdkonline::read_conf();
-e $logfile and system "/bin/rm", $logfile;

if (!$bundle) {
    if ($wc->{HOST_ID} && $wc->{HOST_KEY}) {
	my $getupdates;
	$getupdates = mdkonline::soap_get_updates_for_host($wc->{HOST_ID}, $wc->{HOST_KEY});
	print Data::Dumper->Dump([ $getupdates ], [ qw(getupdates) ]);
	if ($getupdates->{message}) {
	    exit(0);
	    my $rpms_scheduled;
	    -f $currentrpm or rpm_qa($currentrpm);
	    my ($release) = mdkonline::get_release();
	    if ($applet) {
		my $rpm_exec_name = $release >= 2006.0 ? "/usr/bin/MandrivaUpdate" : "/usr/bin/MandrakeUpdate";
		my $is_no_media_update =  $release <= 10.1 ? '' : "--no-media-update";
		system $rpm_exec_name, "--no-confirmation", $is_no_media_update, "--media=update_source";
	    } elsif ($noX) {
		my $pkgs = ask_pkgs($in);
		install_pkgs($in, $pkgs, 'update_source') if $pkgs;
		$in->exit(0);
	    } elsif ($auto) { # FIXME
		auto_install_rpms($rpms_scheduled);
	    }
	    rpm_qa($afterrpm);
	    my $wc = mdkonline::read_conf();
	    my $need_upload = get_rpm_diff();
	    if ($need_upload || $auto || $mnf) {
		#- send configuration and get back key to use...
		$result = mdkonline::prepare_upload_conf($wc);
	    }
	    clean_dir();
	} else { # code return a problem to get updates
	    
	}
    } else { # no HOST_ID 
	
    }
} else {
    if (-d '/live/media/loopbacks') {
        $in->ask_warn(N("Warning"),
                      #-PO: here Live Install is currently *NOT* translated on the desktop, so it's better to keep as it:
                      N("You first need to install the system on your harddrive with the 'Live Install' wizard."));
        $in->exit(1);
    }
    my $bundle_info;
    my %bundle_vars = getVarsFromSh($bundle);
    rm_rf($bundle);
    
    $wc->{USER_EMAIL} && $wc->{HOST_ID} && $wc->{HOST_KEY}  or system("/usr/sbin/mdkonline");
    $wc = mdkonline::read_conf();
    $wc->{USER_EMAIL} or die("Configuration not uploaded to Mandriva Online");
    
    my $res = mdkonline::prepare_upload_conf($wc);
    if ($bundle_vars{CLIENT_VERSION} > $CLIENT_VERSION) {
        log::l("the client is too old in order to install the bundle $bundle_vars{BUNDLE}");
        $in->ask_warn(N("Warning"), N("The version of the Mandriva Online client is too old.

You need to update to a newer version. You can get a new one from http://start.mandriva.com"));
        $in->exit(1);
    }
    $res eq 'OK' and $bundle_info = mdkonline::soap_query_bundle($wc, $bundle_vars{BUNDLE});
    print Data::Dumper->Dump([ $bundle_info ], [ qw(bundle_info) ]);
    if ($bundle_info->{status}) {
	my @bundles;
	my $w = $in->wait_message(N("Please wait"), N("Preparing..."));
	my ($mirrors, $bundle) = ($bundle_info->{data}{mirrors}, $bundle_info->{data}{bundle});
     foreach my $mirror (@$mirrors) {
         next if $mirror->{mode} eq 'anon'; # nothing to do
         if ($mirror->{mode} eq 'auth') {
             # add "user:pass@" substring if needed:
             # user password & login provided by server on those provided with the bundle:
             $bundle_vars{USER} = $mirror->{user} if $mirror->{user};
             $bundle_vars{PASS} = $mirror->{pass} if $mirror->{pass};
	     my $encoded_login = uri_escape($bundle_vars{USER});
	     my $encoded_pass = uri_escape($bundle_vars{PASS});
             $mirror->{url} =~ s!^([^:]*)://!\1://$encoded_login:$encoded_pass@!;
         } else { # unknown method, aborting
             $in->ask_warn(N("Error"), N("This bundle is not well formated. Aborting."));
             $in->exit(1);
         } 
     }
	my %mirrors = map { $_->{name} => join('@', grep { $_ } $_->{auth}, $_->{url}) } @$mirrors;
	add_media($_, $mirrors{$_}, 'media_info/synthesis.hdlist.cz', '') foreach keys %mirrors;
	$bundle =~ s/-[^-]*-[^-]*\.[^.]*\.rpm$//;
	push @bundles, $bundle;
	install_pkgs($in, \@bundles, (find { /^bundle/ } keys %mirrors),
                  { is_bundle => 1,
                    auto_select => ($wc->{POST} =~ /AUTO_SELECT/ ? 1 : 0),
                    medias => [ keys %mirrors ],
                });
    } else {
        $in->ask_warn(N("Error"), N("An error occurred") . "\n\n" . $bundle_info->{message});
    }
}

sub ask_pkgs {
    my ($in) = @_;
    my $pkgs = get_updatable_pkgs();
    $in->ask_browse_tree_info('Mdkupdate', N("Choose which packages should be installed and Press Ok"),
			      {
			       node_state => sub { $pkgs->{$_[0]}{selected} ? 'selected' : 'unselected' },
			       build_tree => sub {
				   my ($add_node, $_flat) = @_;
				   $add_node->($_, undef) foreach sort keys %$pkgs;
			       },
			       grep_unselected => sub { grep { !$pkgs->{$_}{selected} } @_ },
			       toggle_nodes => sub {
				   my ($set_state, @nodes) = @_;
				   my $new_state = !$pkgs->{$nodes[0]}{selected};
				   foreach (@nodes) {
				       $set_state->($_, $new_state ? 'selected' : 'unselected');
				       $pkgs->{$_}{selected} = $new_state;
				   }
			       },
			       get_info => sub {},
			      }) or return keys %$pkgs; #- no change on cancel.
    [ grep { $pkgs->{$_}{selected} } keys %$pkgs ];
}

sub install_pkgs {
    my ($in, $choosed, $media_name, $o_options) = @_;
    $o_options ||= {};
    my $w = $in->wait_message(N("Please wait"), N("Installing packages ...\n"));
    eval {
        if (!$o_options->{is_bundle}) {
            log::l("applying the updates");
            system "/usr/sbin/gurpmi", "--auto", "--media", $media_name, @$choosed;
        } else {
            log::l("installing the bundle");
            system "/usr/bin/gurpmi", '--auto', if_($o_options->{auto_select}, "--auto-select"),
              if_($o_options->{medias}, "--media", join(',', @{$o_options->{medias}})),
                "--searchmedia", $media_name, @$choosed;
        }
	$? == 0 or die N("Unable to update packages from update_source medium.\n");
    };
    undef $w;
}

sub get_updatable_pkgs() {
    my $urpm = new urpm;
    $urpm->read_config;
    my %installable_pkgs; my @update_medias;
    my ($medium) = grep { $_->{name} eq "update_source" } @{$urpm->{media}};
    
    if ($medium) {
	$urpm->configure(media => $medium->{name});
	@update_medias = grep { !$_->{ignore} && $_->{update} } @{$urpm->{media}};
	$urpm->compute_installed_flags(URPM::DB::open);
	foreach my $pkg (@{$urpm->{depslist}}) {
	    $pkg->flag_upgrade or next;
	    my $selected = 0;
	    $pkg->flag_installed or next;
	    any { $pkg->id >= $_->{start} && $pkg->id <= $_->{end} } @update_medias or next;
	    $selected = member($pkg->name, qw(perl-URPM, urpmi, mdkonline, drakxtools)) ? 1 : 0;
	    $installable_pkgs{my_fullname($pkg)} = { selected => $selected, pkg => $pkg };
	}
    }
    \%installable_pkgs;
}

sub my_fullname {
    return '?-?-?' unless ref $_[0];
    my ($name, $version, $release) = $_[0]->fullname;
    "$name-$version-$release";
}

sub auto_install_rpms {
    my ($pkgs) = shift;
    my @pkg;
    push(@pkg, $_ . '.rpm') foreach @$pkgs;
    my $ret = update_pkgs(@pkg);
    $ret == 1 or output_p($logfile, "[mdkupdate] Error 100: Packages failed to upgrade");
}

sub add_media {
    my ($media_name, $mirror, $hdlist, $option) = @_;
    log::l("removing/adding the media $media_name");
    eval { 
	system "/usr/sbin/urpmi.removemedia", $media_name;
	# use curl because wget sometime fail on https url
	system "/usr/sbin/urpmi.addmedia", if_($option, $option), '--curl', $media_name, $mirror, "with", $hdlist;
    };
    $@ and die "Problem adding bundle media with urpmi";
}

sub prepare_media {
    my $mirror = shift;
    my ($r, $da, $is_x8664, $dist_name);
    ($r) = mdkonline::get_release();
    # retrieve dist and arch from /etc/mandrakelinux file
    $da = mdkonline::get_distro_type();
    my ($path2new_arch, $path2new_synthesis) = $r <= 10.0 ? ('/RPMS/', '../base/synthesis.hdlist.cz') : ('/main_updates/', 'media_info/synthesis.hdlist.cz');
    #sometimes server returns the full link http:// or ftp://
    ($is_x8664) = $da->{arch} =~ /(x86_64)/;
    $dist_name = $da->{name};
    my $fullpath2mir = if_($mirror !~ m!^(?:http|ftp)://! , "ftp://") . $mirror . if_($is_x8664, "/$is_x8664") . if_($dist_name, "/$dist_name") . "/$r" . $path2new_arch;
    add_media('update_source', $fullpath2mir, $path2new_synthesis, '--update');
}

sub update_pkgs {
    @_ or return;
    eval {
	system "/usr/sbin/urpmi", "--auto", "--media", "update_source", map { /^(.*)\.rpm$/ && $1 } @_;
	$? == 0 or die N("Unable to update packages from update_source medium.\n");
    };
    $@ and output_p($logfile, "[mdkupdate] Error 99: $@"), return 0;
    return 1;
}

sub get_rpm_diff() {
    my $isdif = `sdiff -s $afterrpm $currentrpm`;
    $isdif and output_p($difflog, $isdif), return 1;
    return 0;
}

sub new_rpm_base() {
    -f $afterrpm and system('/bin/mv', $afterrpm, $currentrpm);
}

sub clean_dir() {
    new_rpm_base();
    mdkonline::clean_confdir();
    output_p($logfile, 'OK');
}

sub rpm_qa {
    my ($file) = @_;
    output($file, chomp_(join('', sort(`rpm -qa`))));
}