aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rwxr-xr-xpark-rpmdrake430
1 files changed, 430 insertions, 0 deletions
diff --git a/park-rpmdrake b/park-rpmdrake
new file mode 100755
index 00000000..6a7e7520
--- /dev/null
+++ b/park-rpmdrake
@@ -0,0 +1,430 @@
+#!/usr/bin/perl
+
+use Socket;
+
+use lib qw(/usr/lib/libDrakX);
+use lib qw(/home/pixel/gi/perl-install);
+use interactive::gtk;
+use run_program;
+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 host_to_string {
+ my ($host) = @_;
+ $host->{ip} || $host->{name};
+}
+
+sub scanssh_output_to_hosts {
+ [ map {
+ chomp;
+ if (my ($ip, $_version) = /(\S+) ([^<].*)/) {
+ raw_host_to_host($ip);
+ } else {
+ ();
+ }
+ } @_ ];
+}
+
+
+################################################################################
+# network ######################################################################
+################################################################################
+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_string($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_string($_) } @hosts ];
+}
+
+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);
+}
+
+sub networks_to_scanned_hosts {
+ my ($networks) = @_;
+ my $nb_hosts = networks_to_nb_hosts($networks);
+
+ my $w = ugtk2->new('drakpark');
+ 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 });
+
+ 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_name = $group->{name};
+ 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);
+ }
+ };
+ 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 host_to_string($_) } @{$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('', ($network ? N("You can't scan an IP address.") : '') . N("Select a network"));
+ }
+ });
+ }
+
+ $widgets{network}->signal_connect(clicked => sub {
+ my $s;
+ $in->ask_from_({ messages => N("Enter a network (eg: 192.168.1.0/28) or a IP"),
+ focus_first => 1 },
+ [ { val => \$s } ]) or return;
+ my $network = string_to_network($s);
+ push @{$group->{networks}}, $network;
+ $add_network->($network);
+ });
+
+ my $mainw = ugtk2->new(N("Urpmi Parallel Group chooser"));
+ 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("Name missing")), return 0;
+ $group->{name} eq $orig_name || every { $group->{name} ne $_->{name} } @$groups or
+ $in->ask_warn(N("Error"), N("Name already used")), return 0;
+
+ populated_networks_to_raw_hosts($group);
+ write_parallel_config($groups);
+ 1;
+ }) && $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"));
+ gtkadd($mainw->{window},
+ gtkpack_(Gtk2::VBox->new,
+ 1, create_scrolled_window($treelist),
+ 0, gtkpack(Gtk2::HBox->new, map { $_->{button} } @buttons)));
+ $mainw->main;
+}
+
+my $groups = read_parallel_config();
+#group_modify(interactive::gtk->new, $groups->[0], $groups);
+group_chooser(interactive::gtk->new, $groups);