From 0c77eeabed86bbe54662d435016d7290ffd74141 Mon Sep 17 00:00:00 2001 From: Pascal Rigaux Date: Sun, 5 Sep 1999 23:02:56 +0000 Subject: no_comment --- perl-install/install_steps.pm | 14 ++++--------- perl-install/install_steps_interactive.pm | 35 +++++++++++++++++-------------- perl-install/interactive_gtk.pm | 10 ++++----- perl-install/keyboard.pm | 2 +- perl-install/pkgs.pm | 6 ++++++ 5 files changed, 35 insertions(+), 32 deletions(-) (limited to 'perl-install') diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm index b9ffd80ee..6e8bff2e9 100644 --- a/perl-install/install_steps.pm +++ b/perl-install/install_steps.pm @@ -232,16 +232,10 @@ sub addUser($) { my $p = $o->{prefix}; my @passwd = cat_("$p/etc/passwd");; - !$u{name} || member($u{name}, map { (split ':')[0] } @passwd) and return; - - unless ($u{uid}) { - my @uids = map { (split ':')[2] } @passwd; - for ($u{uid} = 500; member($u{uid}, @uids); $u{uid}++) {} - } - unless ($u{gid}) { - my @gids = map { (split ':')[2] } cat_("$p/etc/group"); - for ($u{gid} = 500; member($u{gid}, @gids); $u{gid}++) {} - } + !$u{name} || getpwnam($u{name}) and return; + + for ($u{uid} = 500; getpwuid($u{uid}); $u{uid}++) {} + for ($u{gid} = 500; getgrgid($u{gid}); $u{gid}++) {} $u{home} ||= "/home/$u{name}"; $u{password} = crypt_($u{password}) if $u{password}; diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm index a4571ec7b..dee757d8b 100644 --- a/perl-install/install_steps_interactive.pm +++ b/perl-install/install_steps_interactive.pm @@ -417,26 +417,29 @@ sub addUser($) { my ($o) = @_; $o->{user} ||= {}; $o->{user}{password2} ||= $o->{user}{password}; - my $sup = $o->{user}; + my $u = $o->{user}; my @fields = qw(name password password2 realname); my @shells = install_any::shells($o); - $o->ask_from_entries_ref(_("Add user"), - _("Enter a user"), - [_("User name"), _("Password"), _("Password (again)"), _("Real name"), _("Shell"),], - [(map { \$sup->{$_}} @fields), - {val => \$sup->{shell}, list => \@shells, not_edit => !$::expert}, - ], - complete => sub { - $sup->{password} eq $sup->{password2} or $o->ask_warn('', [ _("You must enter the same password"), _("Please try again") ]), return (1,2); - (length $sup->{password} < 6) and $o->ask_warn('', _("This password is too simple")), return (1,1); - $sup->{name} or $o->ask_warn('', _("Please give a user name")), return (1,0); - $sup->{name} =~ /^[a-z0-9_-]+$/ or $o->ask_warn('', _("The user name must contain only lower cased letters, numbers, `-' and `_'")), return (1,0); - return 0; - } - - ); + $o->ask_from_entries_ref( + _("Add user"), + _("Enter a user"), + [ _("Real name"), _("User name"), _("Password"), _("Password (again)"), _("Shell") ], + [ (map { \$u->{$_}} @fields), + {val => \$u->{shell}, list => \@shells, not_edit => !$::expert}, + ], + focus_out => sub { + ($u->{name}) = $u->{realname} =~ /\U(\S+)/ if $_[0] eq 0; + }, + complete => sub { + $u->{password} eq $u->{password2} or $o->ask_warn('', [ _("You must enter the same password"), _("Please try again") ]), return (1,2); + (length $u->{password} < 6) and $o->ask_warn('', _("This password is too simple")), return (1,1); + $u->{name} or $o->ask_warn('', _("Please give a user name")), return (1,0); + $u->{name} =~ /^[a-z0-9_-]+$/ or $o->ask_warn('', _("The user name must contain only lower cased letters, numbers, `-' and `_'")), return (1,0); + return 0; + }, + ); install_steps::addUser($o); $o->{user} = {}; goto &addUser if $::expert; diff --git a/perl-install/interactive_gtk.pm b/perl-install/interactive_gtk.pm index cb3258d3b..c0582ea51 100644 --- a/perl-install/interactive_gtk.pm +++ b/perl-install/interactive_gtk.pm @@ -76,7 +76,7 @@ sub ask_many_from_list_refW($$$$$) { sub ask_from_entries_refW { my ($o, $title, $messages, $l, $val, %hcallback) = @_; - my $num_champs = @{$l}; + my $num_fields = @{$l}; my $ignore = 0; #to handle recursivity my $w = my_gtk->new($title, %$o); @@ -101,7 +101,7 @@ sub ask_from_entries_refW { my @updates = mapn { my ($entry, $ref) = @_; - return sub { ${$ref->{val}} = comb_entry($entry, $ref)->get_text }; + sub { ${$ref->{val}} = comb_entry($entry, $ref)->get_text }; } \@entries, $val; my @updates_inv = mapn { @@ -111,7 +111,7 @@ sub ask_from_entries_refW { } \@entries, $val; - for (my $i = 0; $i < $num_champs; $i++) { + for (my $i = 0; $i < $num_fields; $i++) { my $ind = $i; #cos lexical bindings pb !! my $entry = $entries[$i]; #changed callback @@ -122,7 +122,7 @@ sub ask_from_entries_refW { &{$hcallback{changed}}($ind); #update all the value $ignore = 1; - foreach (@updates_inv) { &{$_};} + &$_ foreach @updates_inv; $ignore = 0; }; }; @@ -139,7 +139,7 @@ sub ask_from_entries_refW { } comb_entry($entry,$val->[$i])->signal_connect(changed => $callback); comb_entry($entry,$val->[$i])->signal_connect(activate => sub { - ($ind == ($num_champs -1)) ? + ($ind == ($num_fields -1)) ? ($w->{ok}->grab_focus(), ) : (comb_entry($entries[$ind+1],$val->[$ind+1])->grab_focus(),$_[0]->signal_emit_stop("activate")) ; }); comb_entry($entry,$val->[$i])->set_text(${$val->[$i]{val}}) if ${$val->[$i]{val}}; diff --git a/perl-install/keyboard.pm b/perl-install/keyboard.pm index 3b53bf194..fad61f667 100644 --- a/perl-install/keyboard.pm +++ b/perl-install/keyboard.pm @@ -114,7 +114,7 @@ sub setup($) { log::l("loading keymap $o->[1]"); load(cat_($file)); } - eval { run_program::run('xmodmap', "/usr/share/xmodmap/xmodmap.$o->[2]") }; + eval { run_program::run('xmodmap', "/usr/share/xmodmap/xmodmap.$o->[2]") } unless $::testing; } sub write($$) { diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm index 4b07450a3..a8ac65d58 100644 --- a/perl-install/pkgs.pm +++ b/perl-install/pkgs.pm @@ -290,6 +290,12 @@ sub install { if (my @probs = c::rpmRunTransactions($trans, $callbackOpen, $callbackClose, $callbackStart, $callbackProgress, $force)) { + my %parts; + @probs = reverse grep { + if (s/(installing package) .* (needs (?:.*) on the (.*) filesystem)/$1 $2/) { + $parts{$3} ? 0 : ($parts{$3} = 1); + } else { 1; } + } reverse @probs; die "installation of rpms failed:\n ", join("\n ", @probs); } c::rpmtransFree($trans); -- cgit v1.2.1