0.17-1mdk

3 files changed, 151 insertions, 37 deletions

diff --git a/mdkonline b/mdkonline
index 0a92da9a..bf9c21d0 100755
--- a/mdkonline
+++ b/mdkonline
@@ -37,6 +37,8 @@ use MIME::Base64 qw(encode_base64);
 use Sys::Hostname;
 use my_gtk qw(:helpers :wrappers :ask);
 
+my $VERSION = '0.17';
+
 $::isStandalone = 1;
 
 my $in = 'interactive'->vnew('su', 'default');
@@ -286,7 +288,7 @@ sub test_passwd () {
 	$passwd = md5_hex ($passwd); # or md5 () or md5_base64 ()
 	
 	my $ua = LWP::UserAgent->new;
-	$ua->agent("MdkOnlineAgent/0.15" . $ua->agent);
+	$ua->agent("MdkOnlineAgent/$VERSION" . $ua->agent);
 	my $w = $in->wait_message('',_("Connecting ...\n"),1);
 	my $request = HTTP::Request->new(GET => 'http://www.mandrakeexpert.com/firsttimewizard/validusercheck.php?u='.$login.'&p='.$passwd);
 	my $response = $ua->request($request);
@@ -317,6 +319,11 @@ sub send_config {
 #    print STDERR "Sending config\n";
     my $result = -1;
     
+    #- added to allow .mdkupdate.rpms file creation.
+    open FILE, ">/root/.mdkupdate.rpms" or die "Couldn't open /root/.mdkupdate.rpms : $!";
+    print FILE join ('', sort `rpm -qa`);
+    close FILE;
+
     report_config("/root/$login.$passwd.$box_name.online.log");
     `/usr/bin/bzip2 \\\-9 \\\-f /root/$login.$passwd.$box_name.online.log`;
 
@@ -332,7 +339,7 @@ sub send_config {
     close (FILEOUT);
 
     my $ua = LWP::UserAgent->new;
-    $ua->agent("MdkOnlineAgent/0.15" . $ua->agent);
+    $ua->agent("MdkOnlineAgent/$VERSION" . $ua->agent);
     my $w = $in->wait_message('',"Sending configuration...");
     my $response = $ua->request(POST 'https://www.mandrakeonline.net/wizard.php',
 
@@ -369,7 +376,7 @@ sub step_wizard {
     writ_on_pixmaps($vbox_welc,"default.png",_("Welcome to MandrakeOnline"),540,100);
     my $label_welc = new Gtk::Label(_("At this step You are supposed to have an account on MandrakeOnline.\nThis assistant will help you to upload your configuration\n(packages, hardware configuration) to a centralized database in\norder to keep you informed about security updates and useful upgrades.\n"));
     $label_welc->set_uposition(20,150);
-    $label_welc->set_justify(left);
+    $label_welc->set_justify('left');
     $vbox_welc->pack_start($label_welc,0,0,1);
     my $hbox_subs= new Gtk::HBox(0,0);
     $hbox_subs->set_uposition(50,300);
@@ -400,7 +407,7 @@ sub step_wizard {
     writ_on_pixmaps($vbox_rev,"default.png",_("Sending your Configuration"),540,100);
     my $label_rev = new Gtk::Label(_("In order to benefit from MandrakeOnline services,\nwe are about to upload your configuration.\n\nThe Wizard will now send the following information to MandrakeSoft:\n1) the list of packages you have installed on your system,\n2) your hardware configuration.\n\nIf you feel uncomfortable by that idea, or do not want to benefit from this service,\nplease press 'Cancel'. By pressing 'Next', you allow us to keep you informed\nabout security updates and useful upgrades via personalized email alerts.\nFurthermore, you benefit from discounted paid support services on\nwww.mandrakeexpert.com.\nFinally, an email alias with your username\@mandrakeonline.net will be provided to you."));
     $label_rev->set_uposition(20,150);
-    $label_rev->set_justify(left);
+    $label_rev->set_justify('left');
     $vbox_rev->pack_start($label_rev,0,0,1);
     $notebook_global->append_page($vbox_rev,new Gtk::Label("revision"));
 
@@ -415,7 +422,7 @@ sub step_wizard {
     my $vbox_oksend= new Gtk::VBox(0,0);
     writ_on_pixmaps($vbox_oksend,"default.png",_("Finished"),540,100);
     my $label_oksend = new Gtk::Label("\n\n" . _("Your upload was successful!") . "\n" . _("From now you will receive on security and updates \nannouncements thanks to MandrakeOnline.")."\n\n"._("MandrakeOnline offers you the ability to automate the updates.\nA program will run regulary in your system waiting for new updates\n"));
-    $label_oksend->set_justify(left);
+    $label_oksend->set_justify('left');
     $vbox_oksend->pack_start($label_oksend,$true ,$true,1);
 
 #automated mode
@@ -451,7 +458,7 @@ sub header { "
 ********************************************************************************";
 	 }
 open (FILE,"> $file") || die "Couldn't open $file : $!"; 
-join '', map { chomp; print FILE "$_\n" }
+map { chomp; print FILE "$_\n" }
     header("scsi"), cat_("/proc/scsi/scsi"),
     header("lsmod"), cat_("/proc/modules"),
     header("cmdline"), cat_("/proc/cmdline"),
@@ -558,9 +565,9 @@ sub pack_box_identity {
     my $Label_wg1=new Gtk::Label($label1);
     my $Label_wg2=new Gtk::Label($label2);
     my $Label_wg3=new Gtk::Label($label3);
-    Gtk::Label::set_justify($Label_wg1,right);
-    Gtk::Label::set_justify($Label_wg2,right);
-    Gtk::Label::set_justify($Label_wg3,right);
+    Gtk::Label::set_justify($Label_wg1,'right');
+    Gtk::Label::set_justify($Label_wg2,'right');
+    Gtk::Label::set_justify($Label_wg3,'right');
     $table->attach_defaults( $Label_wg1, 0, 1, 0, 1);
     $table->attach_defaults( $entry1, 1, 2, 0, 1);
     $table->attach_defaults( $Label_wg2, 0, 1, 1, 2);
diff --git a/mdkonline.spec b/mdkonline.spec
index c75e5f73..8bdbd106 100644
--- a/mdkonline.spec
+++ b/mdkonline.spec
@@ -1,11 +1,11 @@
 # Changed by Makefile of cvs.
-%define version 0.16
+%define version 0.17
 %define name mdkonline
 
 Summary:	The Mandrake Online Tool  
 Name:		%{name}
 Version:	%{version}
-Release: 	5mdk
+Release: 	1mdk
 # get the source from our cvs repository (see
 # http://www.linuxmandrake.com/en/cvs.php3)
 Source0:	%{name}-%{version}.tar.bz2
@@ -82,6 +82,12 @@ rm -rf $RPM_BUILD_ROOT
 %{_liconsdir}/*.png
 
 %changelog
+* Wed Oct  9 2002 François Pons <fpons@mandrakesoft.com> 0.17-1mdk
+- fixed to make sure the list of rpm is always sent to server.
+- use urpmi media for update in order to use non scheduled packages.
+- fixed to propagate version to user agent.
+- removed most of perl warnings of mdkonline and mdkupdate.
+
 * Thu Sep 12 2002 Daouda LO <daouda@mandrakesoft.com> 0.16-5mdk
 - Use cvs spec file to update package (for Pablo and co)
 
diff --git a/mdkupdate b/mdkupdate
index c81b74ee..393fd659 100755
--- a/mdkupdate
+++ b/mdkupdate
@@ -25,6 +25,8 @@ use Digest::MD5  qw(md5 md5_hex md5_base64);
 use HTTP::Request;
 use HTTP::Request::Common;
 use LWP::UserAgent;
+use Net::HTTPS; #for https connections 
+use MIME::Base64 qw(encode_base64);
 use MDK::Common;
 use lib qw(/usr/lib/libDrakX);
 use Locale::gettext;
@@ -42,8 +44,9 @@ $logfile = "/var/log/mdkupdate.log";
 my $url_upload_diff = "https://www.mandrakeonline.net/online_dif.php";
 my $url_get_rpms = "https://www.mandrakeonline.net/online_update.php";
 my $rpms_rep = "/root/tmp/";
-my $VERSION = "0.16";
-my $security = 0;
+my $VERSION = "0.17";
+my $security = grep { /^-?-security$/ } @ARGV;
+my $update = grep { /^-?-update$/ } @ARGV;
 
 sub usage {
     print STDERR _("mdkupdate version %s
@@ -51,29 +54,115 @@ Copyright (C) 2002 MandrakeSoft.
 This is free software and may be redistributed under the terms of the GNU GPL.
 
 usage:
-") . _("  --help         - print this help message.
+", $VERSION) . _("  --help         - print this help message.
 ") . _("  --security     - use only security media.
+") . _("  --update       - update all information.
 ") . _("  -v             - verbose mode.
-", $VERSION );
+");
     exit(0);
 }
 
+grep { $_ !~ /^-?-(v|update|security)$/ } @ARGV and usage;
+
 my %o = getVarsFromSh("/root/.mdkupdate");
-rpm_qa("/root/rpm_qa_installed_before");
+if (! -s "/root/.mdkupdate.rpms" || $update) {
+    #- added to allow .mdkupdate.rpms file creation.
+    open FILE, ">/root/.mdkupdate.rpms" or die "Couldn't open /root/.mdkupdate.rpms : $!";
+    print FILE join ('', sort `rpm -qa`);
+    close FILE;
+    #- send configuration and get back key to use...
+    $o{CURRENTKEY} = send_config($o{LOGIN},$o{PASS},$o{BOX});
+}
+#rpm_qa("/root/rpm_qa_installed_before");
 update_rpms($o{LOGIN},$o{PASS},$o{BOX},$o{CURRENTKEY});
 rpm_qa("/root/rpm_qa_installed_after");
 my %new = getVarsFromSh("/root/.mdkupdate");
 send_rpm_dif($new{LOGIN},$new{PASS},$new{BOX},$new{OLDKEY});
 clean_dir();
 
-sub update_rpms () {
+################################################################################
+# taken from mdkonline to perform complete update of rpm list (by diff), it has
+# been decided to do exactly what mdkonline does the first time to update the db.
+################################################################################
+sub report_config {
+    my ($file) = @_;
+sub header { "
+********************************************************************************
+* $_[0]
+********************************************************************************";
+	 }
+open (FILE,"> $file") || die "Couldn't open $file : $!";
+map { chomp; print FILE "$_\n" }
+    header("scsi"), cat_("/proc/scsi/scsi"),
+    header("lsmod"), cat_("/proc/modules"),
+    header("cmdline"), cat_("/proc/cmdline"),
+    header("pcmcia: stab"), cat_("$prefix/var/lib/pcmcia/stab") || cat_("$prefix/var/run/stab"),
+    header("usb"), cat_("/proc/bus/usb/devices"),
+    header("partitions"), cat_("/proc/partitions"),
+    header("cpuinfo"), cat_("/proc/cpuinfo"),
+    header("install.log"), cat_("$prefix/root/drakx/install.log"),
+    header("fstab"), cat_("$prefix/etc/fstab"),
+    header("lilo.conf"), cat_("$prefix/etc/lilo.conf"),
+    header("menu.lst"), cat_("$prefix/boot/grub/menu.lst"),
+    header("/etc/modules.conf"), cat_("$prefix/etc/modules.conf"),
+    header("rpm -qa"), join ('', sort `rpm -qa`),
+    header("mandrake version"), cat_('/etc/redhat-release');
+close(FILE);
+}
+sub send_config {
+    # When we arrive here, we're sure the login/passwd is correct
+    my ($login, $passwd, $box_name) = @_;
+#    print STDERR "Sending config\n";
+    my $result = -1;
+    
+    report_config("/root/$login.$passwd.$box_name.online.log");
+    `/usr/bin/bzip2 \\\-9 \\\-f /root/$login.$passwd.$box_name.online.log`;
+
+    # Turn the binary file into a uuencoded ascii file
+    open (FILE, "/root/$login.$passwd.$box_name.online.log.bz2") or die "$!";
+    my ($chunk, $buffer);
+    while (read(FILE, $chunk, 60*57)) {
+	$buffer .= $chunk;
+    }
+    close (FILE);
+    open (FILEOUT, "> /root/$login.$passwd.$box_name.online.log.bz2.uue") or die "$!";
+	print FILEOUT encode_base64($buffer);
+    close (FILEOUT);
+
+    my $ua = LWP::UserAgent->new;
+    $ua->agent("MdkOnlineAgent/$VERSION" . $ua->agent);
+    my $response = $ua->request(POST 'https://www.mandrakeonline.net/wizard.php',
+
+				Content_Type => 'form-data',
+				Content => [submit => "upload_wizard",
+					    wizard => ["/root/$login.$passwd.$box_name.online.log.bz2.uue"]
+					    ]);
+    # Check the outcome of the response
+    #print "REPONSE: ".$response->content."\n";
+    if ($response->is_success) {
+	$result = ($response->content =~ /^TRUE(.*)/) ? 0 : -1;
+	#print("key is $1\n");
+	$key = $1; 
+    } else {
+	# pb with the connection ?
+	$result = -1;
+    }
+
+    unlink "/root/$login.$passwd.$box_name.online.log.bz2";
+    unlink "/root/$login.$passwd.$box_name.online.log.bz2.uue";
+
+    $result == 0 && $key;
+}
+################################################################################
+
+sub update_rpms {
     my ($login,$password,$box_name,$curkey) =@_;
     my $result = -1;
     my $string;
     
     if ($login && $password && $login !~ /\s+/ && $password !~ /\s+/) {
 	my $ua = LWP::UserAgent->new;
-	$ua->agent("MdkUpdateAgent/0.15" . $ua->agent);
+	$ua->agent("MdkUpdateAgent/$VERSION" . $ua->agent);
 	my $request = HTTP::Request->new(GET => $url_get_rpms.'?log='.$login.'&pass='.$password.'&host='.$box_name.'&key='.$curkey);
 	my $response = $ua->request($request);
 	$string = $response->content;
@@ -82,7 +171,7 @@ sub update_rpms () {
 	} else {
 	    log_it(_("Connection problem")."\n"._("MandrakeUpdate could not contact the site, we will try again"));
 	    clean_dir();
-	    exit -1;
+	    exit 1;
 	}
     } else {
 	$result = -1; 
@@ -102,37 +191,47 @@ sub update_rpms () {
 		LOGIN => $l{LOGIN} ,
 	    });
 	    my @junk= splice(@str_m,0,3);
-	    my $mir_full = "ftp://" . $l{MIRROR} . "/" . $l{VER} ."/" . "RPMS"."/";
+	    my $mir_full = "ftp://$l{MIRROR}/$l{VER}/RPMS/";
 	    update_packages($mir_full,@str_m);
-	} else { log_it("problem occur $str_m\n");}
+	} else { log_it("problem occur $str_m\n"); }
 	    	    
     } else {
 	log_it(_("Your login or password may be wrong")."\n"._("You'll need to have an account on MandrakeOnline, or update your subscription")."\n"._("For any problem send mail to support\@mandrakeonline.net\n"));
 	clean_dir();
-	exit -1;
+	exit 1;
     }
 }
 
 sub update_packages {
     my ($mir,@str) = @_;
-    chdir($rpms_rep) or log_it("\ncannot chdir to $rpms_rep\n");
-    $full_rpm = join(' ',@str);
-    print "@str\n";
-    foreach (@str) {
-	-x "/usr/bin/wget" or die _("wget is missing\n");
-	`/usr/bin/wget -nc $mir$_`;
-    }
-    `urpmi $full_rpm`;
-    foreach $pack (@str) {
-	system("rm -f $pack");
-    }	
+    @str or return;
+    eval {
+	system "/usr/sbin/urpmi.removemedia", "mdkupdate";
+	system "/usr/sbin/urpmi.addmedia", "-c", "mdkupdate", $mir, "with", "../base/hdlist.cz";
+	$? == 0 or die _("unable to create mdkupdate medium\n");
+	system "/usr/sbin/urpmi", "--auto", "--clean", "--media", "mdkupdate", map { /^(.*)\.rpm$/ && $1 } @str;
+	$? == 0 or die _("unable to update packages from mdkupdate medium\n");
+    };
+    $@ and die;
+#    chdir($rpms_rep) or log_it("\ncannot chdir to $rpms_rep\n");
+#    $full_rpm = join(' ',@str);
+#    print "@str\n";
+#    foreach (@str) {
+#	-x "/usr/bin/wget" or die _("wget is missing\n");
+#	`/usr/bin/wget -nc $mir$_`;
+#    }
+#    `urpmi $full_rpm`;
+#    foreach $pack (@str) {
+#	system("rm -f $pack");
+#    }	
 }
 
 sub send_rpm_dif {
     my ($login,$password,$box_name,$oldkey) =@_;
-    `sdiff -s /root/rpm_qa_installed_after /root/rpm_qa_installed_before >/root/$login.$password.$box_name.$oldkey.dif`;
+    #`sdiff -s /root/rpm_qa_installed_after /root/rpm_qa_installed_before >/root/$login.$password.$box_name.$oldkey.dif`;
+    `sdiff -s /root/rpm_qa_installed_after /root/.mdkupdate.rpms >/root/$login.$password.$box_name.$oldkey.dif`;
     my $ua = LWP::UserAgent->new;
-    $ua->agent("MdkOnlineAgent/0.15" . $ua->agent);
+    $ua->agent("MdkOnlineAgent/$VERSION" . $ua->agent);
     my $response = $ua->request(POST "https://www.mandrakeonline.net/online_dif.php",
 
 				Content_Type => 'form-data',
@@ -143,9 +242,11 @@ sub send_rpm_dif {
     print "REPONSE: ".$response->content."\n";
 }
 
-sub clean_dir() {
+sub clean_dir {
+    unlink "/root/.mdkupdate.rpms";
+    rename "/root/rpm_qa_installed_after", "/root/.mdkupdate.rpms";
+
     system("rm -f /root/*.dif /root/rpm_qa_installed_before /root/rpm_qa_installed_after");    
-    exit 1;
 }
 
 sub rpm_qa {