split park-rpmdrake out of rpmdrake

2 files changed, 1 insertions, 557 deletions

diff --git a/Makefile b/Makefile
index e4aaf379..90ecc371 100644
--- a/Makefile
+++ b/Makefile
@@ -24,7 +24,7 @@ install: $(ALL)
 		(cd $$n; $(MAKE) install) \
 	done
 	install -d $(SBINDIR)
-	install rpmdrake park-rpmdrake MandrivaUpdate edit-urpm-sources.pl gurpmi.addmedia $(SBINDIR)
+	install rpmdrake MandrivaUpdate edit-urpm-sources.pl gurpmi.addmedia $(SBINDIR)
 	ln -sf rpmdrake $(SBINDIR)/rpmdrake-remove
 	install -d $(BINDIR)
 	ln -sf $(RELATIVE_SBIN)/rpmdrake $(BINDIR)/rpmdrake
diff --git a/park-rpmdrake b/park-rpmdrake
deleted file mode 100755
index 26f444c2..00000000
--- a/park-rpmdrake
+++ /dev/null
@@ -1,556 +0,0 @@
-#!/usr/bin/perl
-
-use Socket;
-
-use lib qw(/usr/lib/libDrakX);
-use interactive::gtk; 
-use run_program;
-use standalone;
-use common;
-use ugtk2 qw(:helpers :wrappers :create);
-
-
-my @_local_networks = qw(
-    169.254.0.0/16 172.16.0.0/12 192.0.2.0/24 192.168.0.0/16 
-
-    0.0.0.0/7 2.0.0.0/8 5.0.0.0/8 7.0.0.0/8 
-    10.0.0.0/8 23.0.0.0/8 27.0.0.0/8 
-    31.0.0.0/8 36.0.0.0/7 39.0.0.0/8
-    41.0.0.0/8 42.0.0.0/8 49.0.0.0/8 
-    50.0.0.0/8 58.0.0.0/7 70.0.0.0/7 72.0.0.0/5
-    83.0.0.0/8 84.0.0.0/6 88.0.0.0/5 96.0.0.0/3 
-    
-    127.0.0.0/8 197.0.0.0/8
-    198.18.0.0/15 223.0.0.0/8 240.0.0.0/4
-);
-
-
-sub ip_to_bit_string { pack('C4', split('\.', $_[0])) }
-sub bit_string_to_ip { join('.', unpack('C4', $_[0])) }
-sub mask_class_to_bitmask { pack("N", (2 ** $_[0] - 1) << (32 - $_[0])) }
-
-
-################################################################################
-# raw_host and host ############################################################
-################################################################################
-sub raw_host_to_host {
-    my ($raw_host) = @_;
-    if ($raw_host =~ /^\d+\./) {
-	my $name = gethostbyaddr(Socket::inet_aton($raw_host), Socket::AF_INET());
-	$name =~ s/\.$//;
-	{ ip => $raw_host, name => $name };
-    } else {
-	my $raw_ip = scalar gethostbyname($raw_host);
-	{ ip => $raw_ip && Socket::inet_ntoa($raw_ip), name => $raw_host };
-    }
-}
-
-sub raw_hosts_to_hosts {
-    my ($raw_hosts) = @_;
-    [ map { raw_host_to_host($_) } @$raw_hosts ];
-}
-
-sub host_to_raw_host {
-    my ($host) = @_;
-    $host->{ip} || $host->{name};
-}
-
-sub host_to_string {
-    my ($host) = @_;
-    $host->{name} || $host->{ip};
-}
-
-sub scanssh_output_to_hosts {
-    [ map { 
-	chomp; 
-	if (my ($ip) = /([.\d]+)/) {
-	    raw_host_to_host($ip);
-	} else {
-	    ();
-	}
-    } @_ ];
-}
-
-
-################################################################################
-# networks #####################################################################
-################################################################################
-sub apply_netmask {
-    my ($ip, $network) = @_;
-    if ($network->{bitmask}) {
-	bit_string_to_ip(ip_to_bit_string($ip) & $network->{bitmask});
-    } else {
-	$ip;
-    }
-}
-
-sub networks_to_nb_hosts {
-    my ($networks) = @_;
-    sum(map { $_->{mask_class} ? 2 ** (32 - $_->{mask_class}) : 1 } @$networks);
-}
-
-sub string_to_network {
-    my ($s) = @_;
-    if (my ($ip, $mask_class) = $s =~ m!(.*)/(\d+)!) {
-	my $network = { mask_class => $mask_class, bitmask => mask_class_to_bitmask($mask_class) };
-	$network->{base} = apply_netmask($ip, $network);
-	$network;
-    } else {
-	raw_host_to_host($s);
-    }
-}
-sub string_to_networks {
-    [ map { string_to_network($_) } split(' ', $_[0]) ];
-}
-sub network_to_string {
-    my ($network) = @_;
-    $network->{mask_class} ? $network->{base} . '/' . $network->{mask_class} : host_to_raw_host($network);
-}
-sub networks_to_string {
-    my ($networks) = @_;
-    join(' ', map { network_to_string($_) } @$networks);
-}
-
-sub default_networks() {
-    my @l = `LC_ALL=C LANGUAGE=C /sbin/ip addr show` =~ /^\s*inet\s(\S+)/mg;
-    [ map { string_to_network($_) } grep { !/^127\./ } @l ];
-}
-
-
-sub default_group() {
-    { name => '', protocol => 'ssh', medias => [], raw_hosts => [], networks => default_networks() };
-}
-
-sub populate_networks_with_raw_hosts {
-    my ($group) = @_;
-    
-    $_->{hosts} = [] foreach @{$group->{networks}};
-
-    my @other;
-  RAW: foreach (@{$group->{raw_hosts}}) {
-	my $host = raw_host_to_host($_);
-	$host->{selected} = 1;
-	foreach my $network (@{$group->{networks}}) {
-	    if ($host->{ip} && apply_netmask($host->{ip}, $network) eq $network->{base}) {
-		push @{$network->{hosts}}, $host;
-		next RAW;
-	    }	    
-	}
-	push @other, $host;
-    }
-    push @{$group->{networks}}, @other;
-}
-
-sub populated_networks_to_raw_hosts {
-    my ($group) = @_;
-
-    my @hosts;
-
-    #- remove unused networks and non-networks
-    @{$group->{networks}} = grep { 
-	my @l = grep { $_->{selected} } $_->{mask_class} ? @{$_->{hosts}} : $_;
-	push @hosts, @l;
-	$_->{mask_class} && @l;
-    } @{$group->{networks}};
-
-    $group->{raw_hosts} = [ map { host_to_raw_host($_) } @hosts ];
-}
-
-################################################################################
-# ssh ##########################################################################
-################################################################################
-sub private_key() { "$ENV{HOME}/.ssh/id_dsa" }
-sub public_key() { private_key() . '.pub' }
-
-sub generate_keygen {
-    my ($private_key) = @_;
-    system('ssh-keygen', '-P', '', '-t', 'dsa', '-f', $private_key);
-}
-
-sub ssh_command_interactive {
-    my ($command, $host_name, $get_password) = @_;
-
-    require Expect;
-		
-    my $expect = Expect->spawn(@$command) or die "can't run @$command\n";
-
-    $expect->log_stdout($::testing);
-
-    my $timeout = 10;
-    my $nb_retry;
-    $expect->expect($timeout,
-		    [ qr/password: $/, sub { 
-			  my $password = $get_password->($nb_retry++);
-			  $expect->send("$password\n");
-			  Expect::exp_continue();
-		      } ],
-		    [ qr!The authenticity of host .* can't be established.*continue connecting \Q(yes/no)?\E $!s, sub { $expect->send("yes\n") } ],
-		    [ qr/Permission denied/, sub { die sprintf("Permission denied transferring on %s", $host_name) } ],
-		    [ qr/No such file or directory/, sub { die sprintf("No such file or directory on %s", $host_name) } ],
-		    [ timeout => sub { die sprintf("%s not responding", $host_name) } ],
-		   ); 
-
-    my $exit_stat = $expect->exitstatus;
-    $expect->hard_close;
-    $exit_stat == 0 or die "@$command failed\n";
-}
-
-sub ssh_copy_id {
-    my ($public_key, $login_user, $host_name, $get_password) = @_;
-
-    if (system('ssh', '-o', 'PasswordAuthentication no', '-o', 'StrictHostKeyChecking no', $login_user . '@' . $host_name, 'true') == 0) {
-	#- already configured
-	1;
-    } else {
-	my @command = ('ssh-copy-id', '-i', $public_key, $login_user . '@' . $host_name);
-	warn "ssh_copy_id @command\n";
-	ssh_command_interactive(\@command, $host_name, $get_password);
-    }
-}
-
-sub allow_ssh_on_hosts {
-    my ($in, $hosts) = @_;
-
-    if (! -e public_key()) {
-	my $_w = $in->wait_message(N("Please wait"), N("Generating SSH authentication keys"));
-	generate_keygen(private_key());
-    }
-    eval {
-	my $password;
-	foreach my $host (map { host_to_string($_) } @$hosts) {
-	    my $ask_password = sub {
-		my ($retry) = @_;
-		if ($retry || ! defined $password) {
-		    $in->ask_from_({ messages => 
-N("We propose to configure hosts to allow access from this root account using the key %s.
-
-If you enter the root password for host %s, we will copy the public key to the authorized_keys", private_key(), $host),
-				     focus_first => 1,
-				   },
-				  [ { val => \$password, hidden => 1 } ]) or die 'cancel';
-		}
-		$password;
-	    };
-	    ssh_copy_id(public_key(), 'root', $host, $ask_password);
-	}
-    };
-    if ($@) {
-	return if $@ =~ /^cancel/;
-	die;
-    }
-    1;
-}
-
-################################################################################
-# urpmi config file ############################################################
-################################################################################
-my $parallel_config_file = '/etc/urpmi/parallel.cfg';
-sub read_parallel_config() {
-    [ map {
-	chomp;
-	my $networks = s/ # networks:(.*)// && string_to_networks($1);
-	s/#.*//; s/\s*$//;
-        my ($name, $protocol, $command) = split(':', $_, 3) or warn "Warning, unrecognized line in $parallel_config_file:\n$_";
-        my @medias = $protocol =~ s/\(([^\)]+)\)$// ? split(/,/, $1) : ();
-
-	my @raw_hosts = 
-	  $protocol eq 'ssh' ? split(':', $command) : 
-	  $protocol eq 'ka-run' ? $command =~ /-m (\S+)/g :
-	    die "unknown protocol $protocol in $parallel_config_file";
-
-        { name => $name, protocol => $protocol, medias => \@medias, raw_hosts => \@raw_hosts, networks => $networks };
-    } cat_($parallel_config_file) ];
-}
-
-sub write_parallel_config {
-    my ($conf) = @_;
-
-    my @l = map { 
-	my $command =
-	  $_->{protocol} eq 'ssh' ? join(':', @{$_->{raw_hosts}}) 
-	    : join(' ', '-c ssh', map { "-m $_" } @{$_->{raw_hosts}});
-
-	my $protocol = $_->{protocol} . (@{$_->{medias}} ? '(' . join(',', @{$_->{medias}}) . ')' : '');
-
-	join(':', $_->{name}, $protocol, $command) .
-	  ($_->{networks} ? ' # networks:' . networks_to_string($_->{networks}) : '') .
-	  "\n";
-    } @$conf;
-
-    print @l;
-    output($parallel_config_file, @l);
-}
-
-################################################################################
-# interface ####################################################################
-################################################################################
-sub networks_to_scanned_hosts {
-    my ($networks) = @_;
-    my $nb_hosts = networks_to_nb_hosts($networks);
-
-    my $w = ugtk2->new(N("Please wait"));
-    $w->{real_window}->set_transient_for($::main_window);
-    ugtk2::set_main_window_size($w);
-    my $progress = Gtk2::ProgressBar->new;
-
-    my $output;
-    my ($textscroll, $pid) = 
-      ugtk2::gtk_new_TextView_get_log('scanssh ' . networks_to_string($networks), 
-				      sub { $output .= $_[0]; 
-					    my $ratio = listlength($output =~ /\n/g) / ($nb_hosts + 1);
-					    $progress->set_fraction($ratio); 
-					    $_[0] },
-				      sub { Gtk2->main_quit }) or return;
-
-    gtkadd($w->{window}, 
-	   gtkpack_(Gtk2::VBox->new,
-		    0, gtkpack_(Gtk2::HBox->new, 
-				0, N("Please wait, scanning network..."),
-				1, $progress),
-		    1, $textscroll,
-		    0, gtksignal_connect(Gtk2::Button->new("Stop"), clicked => sub { kill 9, $pid }),
-	      ));
-    $w->main;
-
-    scanssh_output_to_hosts(split("\n", $output));
-}
-
-sub group_modify {
-    my ($in, $group, $groups) = @_;
-    my @orig_raw_hosts = @{$group->{raw_hosts}};
-    my %widgets = (
-	name => gtkset_text(Gtk2::Entry->new, $group->{name}),
-	protocol => Gtk2::OptionMenu->new_with_strings([ 'ssh', 'ka-run' ], $group->{protocol}),
-        scan => Gtk2::Button->new(N("Scan")),
-	network => Gtk2::Button->new(N("Add a network")),
-    );
-
-    my $tree_model = Gtk2::TreeStore->new('Glib::Int', 'Glib::String', 'Glib::String', 'Glib::String');
-    my $tree = Gtk2::TreeView->new_with_model($tree_model);
-    $tree->get_selection->set_mode('browse');
-
-    {
-	my $col = Gtk2::TreeViewColumn->new_with_attributes(N("Network & IP"), Gtk2::CellRendererText->new, text => 1);
-	$col->set_sort_column_id(1);
-	$tree->append_column($col);
-	$col->clicked;
-    }
-    {
-	my $col = Gtk2::TreeViewColumn->new_with_attributes(N("Name"), Gtk2::CellRendererText->new, text => 2);
-	$col->set_sort_column_id(2);
-	$tree->append_column($col);
-    }
-    {
-	my $col = Gtk2::TreeViewColumn->new_with_attributes(undef, my $toggle = Gtk2::CellRendererToggle->new, active => 0);
-	$tree->append_column($col);
-
-	$toggle->signal_connect(toggled => sub {
-	    my (undef, $path_str, $tree_model) = @_;
-	    my $iter = $tree_model->get_iter_from_string($path_str);
-	    my $val = !$tree_model->get($iter, 0);
-	    $tree_model->set($iter, 0 => $val);
-
-	    #- select/deselect all hosts in that network
-	    $tree_model->iter_each_children($iter, sub { $tree_model->set($_[0], 0 => $val) });
-        }, $tree_model);
-    }
-
-    $tree_model->set_sort_func(1, sub { 
-				   my ($tree_model, $a, $b) = @_;
-				   $tree_model->get($a, 3) cmp $tree_model->get($b, 3);
-			       });
-
-    my $add_host = sub { 
-	my ($host, $o_parent) = @_;
-	$tree_model->append_set($o_parent, [ 0 => $host->{selected}, 1 => $host->{ip}, 2 => $host->{name}, 3 => ip_to_bit_string($host->{ip}) ]);
-    };
-    my $add_network = sub {
-	my ($network) = @_;
-	if ($network->{mask_class}) {
-	    my $w = $tree_model->append_set(undef, [ 0 => 0, 1 => network_to_string($network) ]);
-	    $add_host->($_, $w) foreach @{$network->{hosts}};
-	    $tree->expand_row($tree_model->get_path($w), 0);
-	} else {
-	    $add_host->($network);
-	}
-    };
-    if (!@{$group->{networks}}) {
-	$group->{networks} = default_networks();
-    }
-    populate_networks_with_raw_hosts($group);
-    $add_network->($_) foreach @{$group->{networks}};
-
-    my $get_from_widgets = sub {
-	foreach ('name', 'protocol') {
-	    $group->{$_} = $widgets{$_}->get_text;
-	}
-
-	$tree_model->iter_each_children(undef, sub {
-	    my ($iter) = @_;
-	    my $s = $tree_model->get($iter, 1);
-	    my $network = find { $s eq network_to_string($_) } @{$group->{networks}};
-	    $network->{selected} = $tree_model->get($iter, 0);
-	    $tree_model->iter_each_children($iter, sub {
-		my $s = $tree_model->get($_[0], 1);
-		my $host = find { $s eq $_->{ip} } @{$network->{hosts}};
-		$host->{selected} = $tree_model->get($_[0], 0);
-	    });
-	});
-    };
-
-    my %size_groups = map { $_ => Gtk2::SizeGroup->new('horizontal') } qw(label widget);
-    my $label_and_widget = sub {
-	my ($label, $widget) = @_;
-	gtkpack_(Gtk2::HBox->new, 
-		 0, gtkadd_widget($size_groups{label}, $label), 
-		 1, gtkadd_widget($size_groups{widget}, $widget));
-    };
-
-    {
-	my $selected = [];
-	$tree->get_selection->signal_connect(changed => sub {
-	    my ($selection) = @_;
-	    my ($tree_model, $iter) = $selection->get_selected or return;
-	    my $s = $tree_model->get($iter, 1);
-	    my $network = find { $s eq network_to_string($_) } @{$group->{networks}};
-	    $widgets{scan}->set_sensitive($network && $network->{mask_class});
-	    $selected = [ $iter, $network ];
-	});
-	$widgets{scan}->signal_connect(clicked => sub {
-	    my ($iter, $network) = @$selected;
-	    if ($network && $network->{mask_class}) {
-		my $hosts = networks_to_scanned_hosts([ $network ]);
-		@{$network->{hosts}} = uniq_ { $_[0]{ip} } @{$network->{hosts}}, @$hosts;
-
-		my %have = map { $_ => 1 } @{$network->{hosts}}; #- have been added
-		$add_host->($_, $iter) foreach grep { $have{$_} } @$hosts;
-		$tree->expand_row($tree_model->get_path($iter), 0);
-	    } else {
-		$widgets{scan}->set_sensitive(0);
-		$in->ask_warn(N("Warning"), ($network ? N("You can't scan an IP address.") : '') . N("Select a network"));
-	    }
-	});
-    }
-
-    $widgets{network}->signal_connect(clicked => sub {
-	my $s = $in->ask_from_entry(N("Information"), N("Enter a network (eg: 192.168.1.0/28) or a IP")) or return;
-	my $network = string_to_network($s);
-	if (0) {
-	    $in->ask_yesorno(N("Warning"), N("The network %s is public, not a local network (scanning over internet could be illegal)
-Do you really want to use this network?"));
-	}
-	push @{$group->{networks}}, $network;
-	$add_network->($network);
-    });
-
-    my $mainw = ugtk2->new(N("Urpmi Parallel Group chooser"));
-    $mainw->{real_window}->set_transient_for($::main_window);
-    local $::main_window = $mainw->{real_window};
-    ugtk2::set_main_window_size($mainw);
-    gtkadd($mainw->{window},
-	   gtkpack_(Gtk2::VBox->new,
-		    0, $label_and_widget->(N("Name"), $widgets{name}),
-		    0, $label_and_widget->(N("Protocol"), $widgets{protocol}),
-		    1, gtkpack_(Gtk2::HBox->new,
-				1, create_scrolled_window($tree),
-				0, gtkpack__(Gtk2::VBox->new,
-					     $widgets{scan},
-					     $widgets{network},
-					     )),
-		    0, $mainw->create_okcancel,
-		  ));
-    ($group->{name} ? $mainw->{ok} : $widgets{name})->grab_focus;
-
-    $mainw->main(sub {
-	$get_from_widgets->();
-
-	$group->{name} or $in->ask_warn(N("Error"), N("Group name is missing")), return 0;
-	every { $_ == $group || $group->{name} ne $_->{name} } @$groups or 
-	  $in->ask_warn(N("Error"), N("Name already used")), return 0;
-
-	(my $pkg_for_protocol = "urpm::parallel_$group->{protocol}") =~ s/-/_/g;
-	if (! eval "require $pkg_for_protocol; 1") {
-	    $in->do_pkgs->ensure_is_installed("urpmi-parallel-$group->{protocol}") or return;
-	}
-
-	populated_networks_to_raw_hosts($group);
-	write_parallel_config($groups);
-	1;
-    }) or return;
-
-    if (my @new_hosts = difference2($group->{raw_hosts}, \@orig_raw_hosts)) {
-	allow_ssh_on_hosts($in, raw_hosts_to_hosts(\@new_hosts));
-    }
-
-    $group;
-}
-
-sub group_add {
-    my ($in, $groups) = @_;
-    my $group = group_modify($in, default_group(), $groups) or return;
-    push @$groups, $group;
-    write_parallel_config($groups);
-    $group;
-}
-
-sub group_remove {
-    my ($in, $group, $groups) = @_;
-   
-    $in->ask_yesorno(N("Warning"), N("Really remove group %s?", $group->{name})) or return;
-    @$groups = grep { $_ != $group } @$groups;
-    write_parallel_config($groups);
-    1;
-}
-
-sub group_use {
-    my ($in, $group) = @_;
-    @{$group->{raw_hosts}} or $in->ask_warn(N("Error"), N("This group doesn't have any hosts")), return 0;
-    exec 'rpmdrake', "--parallel=$group->{name},$group->{raw_hosts}[0]";
-}
-
-sub group_chooser {
-    my ($in, $groups) = @_;
-    my ($treelist, $set, $group);
-    my $list_for_interactive = { format => sub { $_[0]{name} } , formatted_list => [ map { $_->{name} } @$groups ], list => $groups, val => \$group };
-    my $changed = sub { $set->($group) };
-
-    my @buttons = (
-	{ kind => 'add', name => N("New Group"), action => sub { group_add($in, $groups) } },
-	{ kind => 'remove', name => N("Remove Group"), action => sub { group_remove($in, $group, $groups) } },
-	{ kind => 'modify', name => N("Modify Group"), action => sub { group_modify($in, $group, $groups) } },
-		   my $modify =
-	{ kind => 'modify', name => N("Use Group"), action => sub { group_use($in, $group) } },
-	{ kind => '', name => N("Quit"), action => sub { ugtk2::exit() } },
-    );
-    my $do_action = sub {
-	my ($button) = @_;
-	interactive::gtk::add_modify_remove_action($button, \@buttons, $list_for_interactive, $treelist) and $changed->();
-    };
-
-    ($treelist, $set) = interactive::gtk::create_treeview_list($list_for_interactive, sub {}, $changed, 
-							       sub { $do_action->($modify) if $_[1]->type =~ /^2/ });
-
-    foreach my $button (@buttons) {
-	$button->{button} = Gtk2::Button->new($button->{name});
-	$button->{button}->signal_connect(clicked => sub { $do_action->($button) });
-    }
-    interactive::gtk::add_modify_remove_sensitive(\@buttons, $list_for_interactive);
-
-    my $mainw = ugtk2->new(N("Urpmi Parallel Group chooser"));
-    $::main_window = $mainw->{real_window};
-    gtkadd($mainw->{window},
-	   gtkpack_(Gtk2::VBox->new,
-		    1, create_scrolled_window($treelist),
-		    0, gtkpack(Gtk2::HBox->new, map { $_->{button} } @buttons)));
-    $mainw->main;
-}
-
-my $icon = '/usr/share/mcc/themes/default/drakpark-mdk.png';
-$ugtk2::wm_icon = $icon if -f $icon;
-
-push @::textdomains, 'rpmdrake';
-
-my $groups = read_parallel_config();
-my $in = interactive->vnew('su');
-#group_modify($in, $groups->[0], $groups);
-group_chooser($in, $groups);