#!/usr/bin/perl ################################################################################ # Mdkupdate # # # # Copyright (C) 2002-2004 Mandriva # # # # Daouda Lo # # # # 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 common; use interactive; 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/bundle/'; my $VERSION = "3"; 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: ", $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(" --bundle file.bundle - parse and install package from .bundle metainfo file. "); exit(0); } my ($auto, $applet, $mnf, $noX, $bundle); my %options = ( 'auto' => \$auto, 'a|applet' => \$applet, 'mnf' => \$mnf, 'noX' => \$noX, 'b|bundle:s' => sub { $bundle = $_[1] || 'webbundle' } ); GetOptions(%options); $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 Dumper($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 { my $bundle_info; my %bundle_vars = getVarsFromSh($bundle); $wc->{USER_EMAIL} 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); $res eq 'OK' and $bundle_info = mdkonline::soap_query_bundle($wc, $bundle_vars{BUNDLE}); print Dumper($bundle_info); if ($bundle_info->{status}) { my @bundles; my ($media, $mirrors, $bundle) = ($bundle_info->{data}{media_name}, $bundle_info->{data}{mirrors}, $bundle_info->{data}{bundle}); add_media($media, $_, 'hdlist.cz', '') foreach keys %$mirrors; $bundle =~ s/\.rpm$//; push(@bundles, $bundle); install_pkgs($in, \@bundles, $media, { is_bundle => 1 }); } } 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 { system "/usr/sbin/urpmi", "--auto", "--media", $media_name, @$choosed; system "/usr/sbin/urpmi", "--auto-select", "--media", $media_name if $o_options->{is_bundle}; $? == 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) = @_; eval { system "/usr/sbin/urpmi.removemedia", $media_name; system "/usr/sbin/urpmi.addmedia", $option, $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`)))); }