diff options
Diffstat (limited to 'park-rpmdrake')
| -rwxr-xr-x | park-rpmdrake | 556 |
1 files changed, 0 insertions, 556 deletions
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); |