summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/ChangeLog43
-rw-r--r--perl-install/any.pm24
-rw-r--r--perl-install/detect_devices.pm13
-rw-r--r--perl-install/fs.pm3
-rw-r--r--perl-install/fsedit.pm3
-rw-r--r--perl-install/install2.pm7
-rw-r--r--perl-install/install_steps.pm6
-rw-r--r--perl-install/install_steps_gtk.pm7
-rw-r--r--perl-install/install_steps_interactive.pm11
-rw-r--r--perl-install/lang.pm10
-rw-r--r--perl-install/modules.pm16
-rw-r--r--perl-install/partition_table_raw.pm2
-rw-r--r--perl-install/services.pm2
-rw-r--r--perl-install/share/diskdrake.rc4
-rw-r--r--perl-install/share/install.rc7
-rw-r--r--perl-install/share/po/Makefile2
-rwxr-xr-xperl-install/standalone/adduserdrake8
17 files changed, 122 insertions, 46 deletions
diff --git a/perl-install/ChangeLog b/perl-install/ChangeLog
index 5d5816e0c..a9339b7c5 100644
--- a/perl-install/ChangeLog
+++ b/perl-install/ChangeLog
@@ -1,3 +1,46 @@
+2000-03-01 Pixel <pixel@mandrakesoft.com>
+
+ * install_steps_gtk.pm (new): more intelligent SIGCHLD handler
+
+2000-02-29 Pixel <pixel@mandrakesoft.com>
+
+ * modules.pm: moved common network stuff from "net" to "network"
+ (modules like nfs lockd...)
+
+ * fs.pm (write_fstab): moved the sort to the right place
+
+ * services.pm (drakxservices): chkconfig --list is i18n'ed :(
+ set LANGUAGE=C before
+
+ * partition_table_raw.pm (get_geometry): geom{cylinders} must not
+ be a decimal value :)
+
+ * install_steps_gtk.pm (create_logo_window): set_name logo for
+ logo window
+ * share/install.rc: force disabling of background image theme
+
+ * install_steps_gtk.pm (enteringStep): add step information for
+ console 1
+
+ * any.pm (addKdmIcon): new function
+ * install_steps.pm (addUser): handle field icon
+ * install_steps_interactive.pm (addUser): add choice of kdm icon
+ * standalone/adduserdrake: add choice of kdm icon
+
+ * diskdrake.pm (ask_all_data...): change for easier i18n
+
+ * install_steps.pm (miscellaneous): add CLEAN_TMP handling
+ (need cleaning?)
+ * install_steps_interactive.pm (miscellaneous): add CLEAN_TMP
+ option in expert
+ * install2.pm (miscellaneous): add CLEAN_TMP option for
+ /etc/sysconfig/system
+
+ * install_steps_interactive.pm (miscellaneous): forbidden
+ useSupermount if high security.
+
+ * mouse.pm (detect): fix bug (ttyS instead of ttyS0)
+
2000-02-28 Pixel <pixel@mandrakesoft.com>
* install_steps_gtk.pm (createXconf): do not use "Generic VGA" for
diff --git a/perl-install/any.pm b/perl-install/any.pm
index 04276b919..b932c4831 100644
--- a/perl-install/any.pm
+++ b/perl-install/any.pm
@@ -2,27 +2,41 @@ package any;
use diagnostics;
use strict;
+use vars qw(@users);
#-######################################################################################
#- misc imports
#-######################################################################################
-use common qw(:system :file);
+use common qw(:common :system :file);
use commands;
use run_program;
+#-PO: names (tie, curly...) have corresponding icons for kdm
+my @users_male = (__("tie"), __("default"), __("curly")); #- don't change the names, files correspond to them
+my @users_female = (__("brunette"), __("girl"), __("woman-blond"));
+@users = (@users_male, @users_female);
+
+sub addKdmIcon {
+ my ($prefix, $user, $icon, $force) = @_;
+ my $dest = "$prefix/usr/share/apps/kdm/pics/users/$user.xpm";
+ unlink $dest if $force;
+ eval { commands::cp("$prefix/usr/share/icons/user-$icon-mdk.xpm", $dest) } if $icon;
+}
+
sub addKdmUsers {
my ($prefix, @users) = @_;
require timezone;
- my @u1 = my @users_male = qw(tie default curly);
- my @u2 = my @users_female = qw(brunette girl woman-blond);
+ my @u1 = @users_male;
+ my @u2 = @users_female;
foreach (@users) {
my $l = rand() < timezone::sexProb($_) ? \@u2 : \@u1;
my $u = splice(@$l, rand(@$l), 1); #- known biased (see cookbook for better)
+ addKdmIcon($prefix, $_, $u);
eval { commands::cp "$prefix/usr/share/icons/user-$u-mdk.xpm", "$prefix/usr/share/apps/kdm/pics/users/$_.xpm" };
@u1 = @users_male unless @u1;
@u2 = @users_female unless @u2;
}
- eval { commands::cp "-f", "$prefix/usr/share/icons/user-hat-mdk.xpm", "$prefix/usr/share/apps/kdm/pics/users/root.xpm" } unless $::isStandalone;
+ addKdmIcon($prefix, 'root', 'hat', 'force');
}
sub addUsers {
@@ -32,8 +46,6 @@ sub addUsers {
substInFile { s/^$u\n//; $_ .= "$u\n" if eof } "$msec/user.conf" if -d $msec;
}
run_program::rooted($prefix, "/etc/security/msec/init-sh/grpuser.sh --refresh");
-
- addKdmUsers($prefix, @users);
}
1;
diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm
index 1384ed74d..ba0765fb5 100644
--- a/perl-install/detect_devices.pm
+++ b/perl-install/detect_devices.pm
@@ -38,11 +38,14 @@ sub zips() { grep { $_->{type} eq 'hd' && isZipDrive($_) } get(); }
#-sub jazzs() { grep { $_->{type} eq 'hd' && isJazDrive($_) } get(); }
sub cdroms() {
my @l = grep { $_->{type} eq 'cdrom' } get();
- my $nb = $modules::scsi; #- this is gross!
- foreach my $b (getIDEBurners()) {
- log::l("getIDEBurners: $b");
- my ($e) = grep { $_->{device} eq $b } @l or next;
- $e->{device} = "scd" . $nb++;
+ if (getIDEBurners()) {
+ require modules;
+ my $nb = modules::add_alias('scsi_hostadapter', 'ide-scsi') =~ /(\d+)/;
+ foreach my $b (getIDEBurners()) {
+ log::l("getIDEBurners: $b");
+ my ($e) = grep { $_->{device} eq $b } @l or next;
+ $e->{device} = "scd" . $nb++;
+ }
}
@l;
}
diff --git a/perl-install/fs.pm b/perl-install/fs.pm
index e6dc4ef38..27c177a25 100644
--- a/perl-install/fs.pm
+++ b/perl-install/fs.pm
@@ -293,14 +293,13 @@ sub write_fstab($;$$) {
! exists $new{"/dev/$_->{device}"} } @$fstab;
push @to_add,
- sort { $a->[1] cmp $b->[1] }
grep { !exists $new{$_->[0]} && !exists $new{$_->[1]} }
map { [ split ] } cat_("$prefix/etc/fstab");
log::l("writing $prefix/etc/fstab");
local *F;
open F, "> $prefix/etc/fstab" or die "error writing $prefix/etc/fstab";
- print F join(" ", @$_), "\n" foreach @to_add;
+ print F join(" ", @$_), "\n" foreach sort { $a->[1] cmp $b->[1] } @to_add;
}
sub check_mount_all_fstab($;$) {
diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm
index 8f23f1795..c05a1b27b 100644
--- a/perl-install/fsedit.pm
+++ b/perl-install/fsedit.pm
@@ -262,9 +262,12 @@ sub allocatePartitions($$) {
while (suggest_part($hd,
$part = { start => $start, size => 0, maxsize => $size },
$hds, $to_add)) {
+ log::l("partsize " . ($part->{size}+ $part->{start}));
+ log::l("size " . ($size+ $start));
add($hd, $part, $hds);
$size -= $part->{size} + $part->{start} - $start;
$start = $part->{start} + $part->{size};
+ log::l("size " . ($size+ $start));
}
}
}
diff --git a/perl-install/install2.pm b/perl-install/install2.pm
index a9e22535b..18698608b 100644
--- a/perl-install/install2.pm
+++ b/perl-install/install2.pm
@@ -382,6 +382,7 @@ sub miscellaneous {
addToBeDone {
setVarsInSh("$o->{prefix}/etc/sysconfig/system", {
HDPARM => $o->{miscellaneous}{HDPARM},
+ CLEAN_TMP => $o->{miscellaneous}{CLEAN_TMP},
CLASS => $::expert && "expert" || $::beginner && "beginner" || "medium",
TYPE => $o->{installClass},
SECURITY => $o->{security},
@@ -448,7 +449,7 @@ sub addUser {
#------------------------------------------------------------------------------
#-PADTODO
sub createBootdisk {
- modules::write_conf("$o->{prefix}/etc/conf.modules", 'append');
+ modules::write_conf("$o->{prefix}/etc/conf.modules");
return if $o->{lnx4win};
$o->createBootdisk($_[1] == 1);
@@ -467,7 +468,7 @@ sub configureX {
#- done here and also at the end of install2.pm, just in case...
fs::write($o->{prefix}, $o->{fstab}, $o->{manualFstab}, $o->{useSupermount});
- modules::write_conf("$o->{prefix}/etc/conf.modules", 'append');
+ modules::write_conf("$o->{prefix}/etc/conf.modules");
$o->setupXfree if $o->{packages}{XFree86}{installed} || $clicked;
}
@@ -657,7 +658,7 @@ sub main {
install_any::ejectCdrom();
fs::write($o->{prefix}, $o->{fstab}, $o->{manualFstab}, $o->{useSupermount});
- modules::write_conf("$o->{prefix}/etc/conf.modules", 'append');
+ modules::write_conf("$o->{prefix}/etc/conf.modules");
install_any::lnx4win_postinstall($o->{prefix}) if $o->{lnx4win};
install_any::killCardServices();
diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm
index 38b21a60f..1d277745a 100644
--- a/perl-install/install_steps.pm
+++ b/perl-install/install_steps.pm
@@ -19,6 +19,7 @@ use log;
use fsedit;
use commands;
use network;
+use any;
use fs;
my @filesToSaveForUpgrade = qw(
@@ -418,7 +419,7 @@ sub installCrypto {
my $u = $o->{crypto} or return; $u->{mirror} or return;
my ($packages, %done);
my $dir = "$o->{prefix}/tmp";
- modules::write_conf("$o->{prefix}/etc/conf.modules", 'append');
+ modules::write_conf("$o->{prefix}/etc/conf.modules");
network::up_it($o->{prefix}, $o->{intf}) if $o->{intf};
local *install_any::getFile = sub {
@@ -550,7 +551,7 @@ sub addUser($) {
}
eval { commands::chown_("-r", "$u->{uid}.$u->{gid}", "$p$u->{home}") }
if $u->{uid} != $u->{oldu} || $u->{gid} != $u->{oldg};
-
+ any::addKdmIcon($p, $u->{name}, $u->{icon});
}
require any;
any::addUsers($o->{prefix}, map { $_->{name} } @l);
@@ -715,6 +716,7 @@ sub miscellaneous {
my %s = getVarsFromSh("$o->{prefix}/etc/sysconfig/system");
$o->{miscellaneous}{HDPARM} ||= $s{HDPARM} if exists $s{HDPARM};
+ $o->{miscellaneous}{CLEAN_TMP} ||= $s{HDPARM} if exists $s{CLEAN_TMP};
$o->{security} ||= $s{SECURITY} if exists $s{SECURITY};
$ENV{SECURE_LEVEL} = $o->{security};
diff --git a/perl-install/install_steps_gtk.pm b/perl-install/install_steps_gtk.pm
index 94e9845ff..42b94ac7e 100644
--- a/perl-install/install_steps_gtk.pm
+++ b/perl-install/install_steps_gtk.pm
@@ -174,13 +174,13 @@ sub new($$) {
if ($ENV{DISPLAY} eq ":0") {
my $launchX = sub {
my $ok = 1;
- local $SIG{CHLD} = sub { $ok = 0 };
+ local $SIG{CHLD} = sub { $ok = 0 if waitpid(-1, c::WNOHANG()) > 0 };
unless (fork) {
exec $_[0], "-dpms","-s" ,"240", "-allowMouseOpenFail", "-xf86config", $f or exit 1;
}
foreach (1..60) {
sleep 1;
- return 0 if !$ok;
+ log::l("Server died"), return 0 if !$ok;
return 1 if c::Xtest($ENV{DISPLAY});
}
log::l("Timeout!!");
@@ -235,6 +235,7 @@ sub new($$) {
sub enteringStep {
my ($o, $step) = @_;
+ print _("Entering step `%s'\n", $o->{steps}{$step}{text});
$o->SUPER::enteringStep($step);
create_steps_window($o);
create_help_window($o);
@@ -778,7 +779,7 @@ sub create_logo_window() {
$w->{rwindow} = $w->{window} = new Gtk::Window;
$w->{rwindow}->set_uposition($::stepswidth, 0);
$w->{rwindow}->set_usize($::logowidth, $::logoheight);
- $w->{rwindow}->set_name("background");
+ $w->{rwindow}->set_name("logo");
$w->show;
my $file = "logo-mandrake.xpm";
-r $file or $file = "/usr/share/$file";
diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm
index f7aa39acf..e4ecb4b7e 100644
--- a/perl-install/install_steps_interactive.pm
+++ b/perl-install/install_steps_interactive.pm
@@ -26,6 +26,7 @@ use modules;
use lang;
use services;
use keyboard;
+use any;
use fs;
use log;
@@ -620,6 +621,7 @@ sub addUser($) {
my $u = $o->{user} ||= $o->{security} < 1 ? { name => "mandrake", realname => "default" } : {};
$u->{password2} ||= $u->{password} ||= "";
$u->{shell} ||= "/bin/bash";
+ $u->{icon} ||= translate('default');
my @fields = qw(realname name password password2);
my @shells = install_any::shells($o);
@@ -634,6 +636,8 @@ sub addUser($) {
_("Password (again)") => {val => \$u->{password2}, hidden => 1},
), $::beginner ? () : (
_("Shell") => {val => \$u->{shell}, list => \@shells, not_edit => !$::expert}
+ ), $o->{security} > 3 || $::beginner ? () : (
+ _("Icon") => {val => \$u->{icon}, list => [ map { translate($_) } @any::users ], not_edit => 1 },
),
],
focus_out => sub {
@@ -647,6 +651,7 @@ sub addUser($) {
$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);
member($u->{name}, map { $_->{name} } @{$o->{users}}) and $o->ask_warn('', _("This user name is already added")), return (1,0);
+ $u->{icon} = untranslate($u->{icon}, @any::users);
return 0;
},
)) {
@@ -1002,15 +1007,19 @@ _("Use hard drive optimisations?") => { val => \$u->{HDPARM}, type => 'bool', te
_("Choose security level") => { val => \$s, list => [ map { $l{$_} } ikeys %l ], not_edit => 1 },
_("Precise RAM size if needed (found %d MB)", availableRam / 1024 + 3) => \$u->{memsize}, #- add three for correction.
_("Removable media automounting") => { val => \$o->{useSupermount}, type => 'bool', text => 'supermount' },
+ $::expert ? (
+_("Clean /tmp at each boot") => { val => \$u->{CLEAN_TMP}, type => 'bool' },
+ ) : (),
$u->{numlock} ? (
_("Enable num lock at startup") => { val => \$u->{numlock}, type => 'bool' },
) : (),
], complete => sub {
!$u->{memsize} || $u->{memsize} =~ s/^(\d+)M?$/$1M/i or $o->ask_warn('', _("Give the ram size in Mb")), return 1;
+ my %m = reverse %l; $ENV{SECURE_LEVEL} = $o->{security} = $m{$s};
+ $o->{useSupermount} && $o->{security} > 3 and $o->ask_warn('', _("Can't use supermount in high security level")), return 1;
0;
}
) || return;
- my %m = reverse %l; $ENV{SECURE_LEVEL} = $o->{security} = $m{$s};
}
#------------------------------------------------------------------------------
diff --git a/perl-install/lang.pm b/perl-install/lang.pm
index b75ea5c01..96c5de80f 100644
--- a/perl-install/lang.pm
+++ b/perl-install/lang.pm
@@ -114,9 +114,9 @@ my %xim = (
}
);
-sub std2 { "-mdk-helvetica-medium-r-normal-*-*-$_[1]-*-*-*-*-$_[0]" }
-sub std_ { std2($_[0], 100), std2($_[0], 100) }
-sub std { std2($_[0], 100), std2($_[0], 80) }
+sub std2 { "-*-*-medium-r-normal-*-$_[1]-*-*-*-*-*-$_[0]" }
+sub std_ { std2($_[0], 10), std2($_[0], 10) }
+sub std { std2($_[0], 10), std2($_[0], 8) }
#- [0]: console font name; [1]: unicode map for console font
#- [2]: acm file for console font; [3]: X11 fontset
@@ -174,9 +174,9 @@ my %charsets = (
"-*-*-*-*-*-*-*-*-*-*-*-*-ksc5601.1987-*" ],
#- I have no console font for Thai...
"tis620" => [ undef, undef, "trivial.trans",
- std2("tis620.2533-1",120) ],
+ std2("tis620.2533-1",12) ],
"tcvn" => [ "tcvn8x16", "tcvn", "trivial.trans",
- std2("tcvn-5712", 130), std2("tcvn-5712", 100) ],
+ std2("tcvn-5712", 13), std2("tcvn-5712", 10) ],
"viscii" => [ "viscii10-8x16", "viscii.uni", "viscii1.0_to_viscii1.1.trans",
"-*-*-*-*-*-*-*-*-*-*-*-*-viscii1.1-1" ],
#- Farsi (iranian) needs special console driver for text mode [patching acon ?]
diff --git a/perl-install/modules.pm b/perl-install/modules.pm
index 734523fcb..d66b3172b 100644
--- a/perl-install/modules.pm
+++ b/perl-install/modules.pm
@@ -1,6 +1,6 @@
package modules;
-use vars qw(%loaded %drivers $scsi);
+use vars qw(%loaded %drivers);
use common qw(:common :file :system);
use detect_devices;
@@ -10,7 +10,7 @@ use log;
my %conf;
my %loaded; #- array of loaded modules for each types (scsi/net/...)
-$scsi = 0;
+my $scsi = 0;
my %deps = ();
my @drivers_by_category = (
@@ -86,9 +86,9 @@ arch() =~ /^sparc/ ? (
"3c59x" => "3com 3c59x (Vortex)",
"de4x5" => "Digital 425,434,435,450,500",
"rtl8139" => "RealTek RTL8129/8139",
-
+}],
+[ 'network', {
"8390" => "8390",
- "dummy" => "dummy",
"af_packet" => "packet socket",
"nfs" => "Network File System (nfs)",
"lockd" => "lockd",
@@ -340,11 +340,11 @@ sub text2driver($) {
sub add_alias($$) {
my ($alias, $name) = @_;
- /\Q$alias/ && $conf{$_}{alias} && $conf{$_}{alias} eq $name and return foreach keys %conf;
+ /\Q$alias/ && $conf{$_}{alias} && $conf{$_}{alias} eq $name and return $_ foreach keys %conf;
$alias .= $scsi++ || '' if $alias eq 'scsi_hostadapter';
log::l("adding alias $alias to $name");
$conf{$alias}{alias} ||= $name;
- 1;
+ $alias;
}
sub remove_alias($) {
@@ -464,15 +464,13 @@ sub write_conf {
my ($file) = @_;
#- remove the post-install supermount stuff. We may have to add some more
- substInFile { $_ = '' if /post-install supermount/ } $file;
+ substInFile { $_ = '' if /^post-install supermount/ } $file;
my $written = read_conf($file);
my %net = detect_devices::net2module();
while (my ($k, $v) = each %net) { add_alias($k, $v) }
- add_alias('scsi_hostadapter', 'ide-scsi') if detect_devices::getIDEBurners();
-
if (my @scsis = sort grep { $conf{$_}{alias} && /scsi_hostadapter/ } keys %conf) {
log::l("has scsis ", join " ; ", map { "modprobe $_" } @scsis);
$conf{supermount}{"post-install"} = join " ; ", map { "modprobe $_" } @scsis;
diff --git a/perl-install/partition_table_raw.pm b/perl-install/partition_table_raw.pm
index af73da1d1..b8c30fb86 100644
--- a/perl-install/partition_table_raw.pm
+++ b/perl-install/partition_table_raw.pm
@@ -77,7 +77,7 @@ sub get_geometry($) {
#- $geom{cylinders} is no good (only a ushort, that means less than 2^16 => at best 512MB)
if (my $total = c::total_sectors(fileno F)) {
- $geom{cylinders} = $total / $geom{heads} / $geom{sectors};
+ $geom{cylinders} = int $total / $geom{heads} / $geom{sectors};
}
{ geom => \%geom, totalsectors => $geom{heads} * $geom{sectors} * $geom{cylinders} };
diff --git a/perl-install/services.pm b/perl-install/services.pm
index 57a78a9df..819528033 100644
--- a/perl-install/services.pm
+++ b/perl-install/services.pm
@@ -72,7 +72,7 @@ xfs => __("Starts and stops the X Font Server at boot time and shutdown."),
sub drakxservices {
my ($in, $prefix) = @_;
my $cmd = $prefix ? "chroot $prefix" : "";
- my @services = map { [/(\S+)/, /:on/ ] } sort `$cmd chkconfig --list`;
+ my @services = map { log::l ("services: $_"); [/(\S+)/, /:on/ ] } sort `LANGUAGE=C $cmd chkconfig --list`;
my @l = map { $_->[0] } @services;
my @before = map { $_->[1] } @services;
my @descr = map {
diff --git a/perl-install/share/diskdrake.rc b/perl-install/share/diskdrake.rc
index 814c0f924..198aa9f05 100644
--- a/perl-install/share/diskdrake.rc
+++ b/perl-install/share/diskdrake.rc
@@ -1,8 +1,6 @@
style "font"
{
- # to be sure
- font = "-*-helvetica-medium-r-normal-*-*-80-*-*-*-*-*-*"
- fontset = "-*-helvetica-medium-r-normal-*-*-80-*-*-*-*-*-*"
+ fontset = "-*-*-medium-r-normal-*-8-*-*-*-*-*-iso8859-1,*-r-*"
}
style "red" = "font"
diff --git a/perl-install/share/install.rc b/perl-install/share/install.rc
index b7201ca94..84c264a4b 100644
--- a/perl-install/share/install.rc
+++ b/perl-install/share/install.rc
@@ -1,16 +1,19 @@
style "default-font"
{
- fontset = "-mdk-helvetica-medium-r-normal-*-*-100-*-*-*-*-iso8859-15"
+ fontset = "-*-*-medium-r-normal-*-10-*-*-*-*-*-iso8859-15"
}
style "steps"
{
- fontset = "-mdk-helvetica-medium-r-normal-*-*-80-*-*-*-*-iso8859-15"
+ fontset = "-*-*-medium-r-normal-*-8-*-*-*-*-*-iso8859-15"
}
style "logo"
{
bg[NORMAL] = { 1.0, 1.0, 1.0 }
+
+ # no background image
+ engine "pixmap" { image { function = FLAT_BOX } }
}
style "stepsReachable"
diff --git a/perl-install/share/po/Makefile b/perl-install/share/po/Makefile
index fce441bca..0fa58cc84 100644
--- a/perl-install/share/po/Makefile
+++ b/perl-install/share/po/Makefile
@@ -20,7 +20,7 @@ $(POFILES): DrakX.pot
DrakX.pot: $(PMSFILES)
$(MAKE) $(PMSCFILES);
- xgettext -F -n --keyword=_ --keyword=__ -o $@ $(PMSCFILES)
+ xgettext -F -n --add-comments='-PO' --keyword=_ --keyword=__ -o $@ $(PMSCFILES)
rm $(PMSCFILES)
$(PMSCFILES): %_.c: %
diff --git a/perl-install/standalone/adduserdrake b/perl-install/standalone/adduserdrake
index 87384e06b..7ead7679b 100755
--- a/perl-install/standalone/adduserdrake
+++ b/perl-install/standalone/adduserdrake
@@ -1,6 +1,6 @@
#!/usr/bin/perl
-use lib qw(/usr/lib/libDrakX);
+use lib qw(.); #/usr/lib/libDrakX);
use common qw(:common :functional :system :file);
use interactive;
@@ -28,8 +28,10 @@ if (my @l = grep { ! /^-/ } @ARGV) {
}
my $in = vnew interactive('su');
+my @users;
new:
+$u = { icon => translate('default') };
if ($in->ask_from_entries_refH(
[ _("Add user"), _("Accept user"), _("Done") ],
_("Enter a user\n%s", $users ? _("(already added %s)", join(", ", map { $_->{realname} || $_->{name} } @users)) : ''),
@@ -41,6 +43,8 @@ if ($in->ask_from_entries_refH(
_("Password (again)") => {val => \$u->{password2}, hidden => 1},
), $::beginner ? () : (
_("Shell") => {val => \$u->{shell}, list => \@shells, not_edit => !$::expert}
+ ), $security > 3 ? () : (
+ _("Icon") => {val => \$u->{icon}, list => [ map { translate($_) } @any::users ], not_edit => 1 },
),
],
focus_out => sub {
@@ -54,11 +58,11 @@ if ($in->ask_from_entries_refH(
$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);
member($u->{name}, map { $_->{name} } @users) and $o->ask_warn('', _("This user name is already added")), return (1,0);
+ $u->{icon} = untranslate($u->{icon}, @any::users);
return 0;
},
)) {
push @users, $u;
- $u = {};
goto new;
}