diff options
| -rwxr-xr-x | park-rpmdrake | 430 |
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); |