diff options
author | Pascal Rigaux <pixel@mandriva.com> | 2000-08-17 00:39:01 +0000 |
---|---|---|
committer | Pascal Rigaux <pixel@mandriva.com> | 2000-08-17 00:39:01 +0000 |
commit | 11b0b944ddde76b4982fa2f9e2118dcee5035f80 (patch) | |
tree | a873f848dcf1eda96b89a0319f8923e10bbc5b4a | |
parent | d77799bb5ce63ecac4de72e1b27f56d7d22fd048 (diff) | |
download | drakx-backup-do-not-use-11b0b944ddde76b4982fa2f9e2118dcee5035f80.tar drakx-backup-do-not-use-11b0b944ddde76b4982fa2f9e2118dcee5035f80.tar.gz drakx-backup-do-not-use-11b0b944ddde76b4982fa2f9e2118dcee5035f80.tar.bz2 drakx-backup-do-not-use-11b0b944ddde76b4982fa2f9e2118dcee5035f80.tar.xz drakx-backup-do-not-use-11b0b944ddde76b4982fa2f9e2118dcee5035f80.zip |
no_comment
-rw-r--r-- | docs/HACKING | 4 | ||||
-rw-r--r-- | perl-install/ChangeLog | 5 | ||||
-rw-r--r-- | perl-install/any.pm | 42 | ||||
-rw-r--r-- | perl-install/common.pm | 58 | ||||
-rw-r--r-- | perl-install/detect_devices.pm | 6 | ||||
-rw-r--r-- | perl-install/install2.pm | 7 | ||||
-rw-r--r-- | perl-install/install_any.pm | 653 | ||||
-rw-r--r-- | perl-install/install_steps.pm | 20 | ||||
-rw-r--r-- | perl-install/install_steps_interactive.pm | 8 | ||||
-rw-r--r-- | perl-install/lang.pm | 11 | ||||
-rw-r--r-- | perl-install/modules.pm | 5 | ||||
-rwxr-xr-x | perl-install/standalone/adduserdrake | 2 |
12 files changed, 245 insertions, 576 deletions
diff --git a/docs/HACKING b/docs/HACKING index c33dcaf4d..8ff13e003 100644 --- a/docs/HACKING +++ b/docs/HACKING @@ -35,6 +35,10 @@ make --------------------------------------------------------------------------- +The comments are written with #- +You should use #+ instead of #- if the code is i18n'ed + +--------------------------------------------------------------------------- testing all: go to the perl-install directory and execute ./g_auto_install --test diff --git a/perl-install/ChangeLog b/perl-install/ChangeLog index ba877445a..68517d30a 100644 --- a/perl-install/ChangeLog +++ b/perl-install/ChangeLog @@ -1,3 +1,8 @@ +2000-08-17 Pixel <pixel@mandrakesoft.com> + + * install_any.pm: many cleanup. moved some functions to common, + any or install_interactive (newly created) + 2000-08-16 dam's <damien@mandrakesoft.com> * install_steps_interactive.pm(configureNetwork): added call to diff --git a/perl-install/any.pm b/perl-install/any.pm index 7e50c1dbc..1c0d9c368 100644 --- a/perl-install/any.pm +++ b/perl-install/any.pm @@ -12,6 +12,7 @@ use commands; use detect_devices; use fsedit; use run_program; +use log; #-PO: names (tie, curly...) have corresponding icons for kdm my @users_male = (__("tie"), __("default"), __("curly")); #- don't change the names, files correspond to them @@ -51,6 +52,28 @@ sub addUsers { addKdmIcon($prefix, 'root', 'hat', 'force'); } +sub crypt { + my ($password, $md5) = @_; + $md5 ? + c::crypt_md5($password, salt(8)) : + crypt ($password, salt(2)); +} +sub enableShadow { + my ($prefix) = @_; + run_program::rooted($prefix, "pwconv") or log::l("pwconv failed"); + run_program::rooted($prefix, "grpconv") or log::l("grpconv failed"); +} +sub enableMD5Shadow { + my ($prefix, $shadow, $md5) = @_; + substInFile { + if (/^password.*pam_pwdb.so/) { + s/\s*shadow//; s/\s*md5//; + s/$/ shadow/ if $shadow; + s/$/ md5/ if $md5; + } + } grep { -r $_ } map { "$prefix/etc/pam.d/$_" } qw(login rlogin passwd); +} + sub setupBootloader { my ($in, $b, $hds, $fstab, $security, $prefix, $more) = @_; @@ -213,4 +236,23 @@ sub setAutologin { # (dam's) : a patch for gdm is being done. } + +sub writeandclean_ldsoconf { + my ($prefix) = @_; + my $file = "$prefix/etc/ld.so.conf"; + + log::l("before: ", cat_($file)); + output $file, + grep { !m|^(/usr)?/lib$| } #- no need to have /lib and /usr/lib in ld.so.conf + uniq cat_($file), "/usr/X11R6/lib\n"; + log::l("after: ", cat_($file)); +} + +sub shells { + my ($prefix) = @_; + grep { -x "$prefix$_" } map { chomp; $_ } cat_("$prefix/etc/shells"); +} + + + 1; diff --git a/perl-install/common.pm b/perl-install/common.pm index 3afcfc371..779cec099 100644 --- a/perl-install/common.pm +++ b/perl-install/common.pm @@ -9,7 +9,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int common => [ qw(__ even odd arch better_arch compat_arch min max sqr sum and_ or_ sign product bool invbool listlength bool2text bool2yesno text2bool to_int to_float ikeys member divide is_empty_array_ref is_empty_hash_ref add2hash add2hash_ set_new set_add round round_up round_down first second top uniq translate untranslate warp_text formatAlaTeX formatLines deref) ], functional => [ qw(fold_left compose mapgrep map_index grep_index find_index map_each grep_each list2kv map_tab_hash mapn mapn_ difference2 before_leaving catch_cdie cdie combine) ], file => [ qw(dirname basename touch all glob_ cat_ output symlinkf chop_ mode typeFromMagic expand_symlinks) ], - system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ salt getVarsFromSh setVarsInSh setVarsInCsh substInFile availableRam availableMemory removeXiBSuffix template2file formatTime unix2dos setVirtual) ], + system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ salt getVarsFromSh setVarsInSh setVarsInCsh substInFile availableRam availableMemory removeXiBSuffix template2file template2userfile update_userkderc list_skels formatTime unix2dos setVirtual) ], constant => [ qw($printable_chars $sizeof_int $bitof_int $SECTORSIZE %compat_arch) ], ); @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; @@ -325,6 +325,20 @@ sub salt($) { sub makedev { ($_[0] << 8) | $_[1] } sub unmakedev { $_[0] >> 8, $_[0] & 0xff } +sub list_passwd() { + my (@l, @e); + setpwent(); + while (@e = getpwent()) { push @l, [ @e ] } + endpwent(); + @l; +} +sub list_home() { + map { $_->[7] } grep { $_->[2] >= 500 } list_passwd(); +} +sub list_skels { + my ($prefix, $suffix) = @_; + map { "$prefix$_$suffix" } '/etc/skel', '/root', list_home() } + sub translate { my ($s) = @_; my ($lang) = $ENV{LANGUAGE} || $ENV{LC_MESSAGES} || $ENV{LC_ALL} || $ENV{LANG} || 'en'; @@ -428,14 +442,42 @@ sub setVarsInCsh { $l->{$_} and print F "setenv $_ $l->{$_}\n" foreach @fields; } -sub template2file($$%) { - my ($inputfile, $outputfile, %toreplace) = @_; - local *OUT; local *IN; +sub template2file { + my ($in, $out, %toreplace) = @_; + output $out, map { s/@@@(.*?)@@@/$toreplace{$1}/g; $_ } cat_($in); +} +sub template2userfile { + my ($prefix, $in, $out_rel, $force, %toreplace) = @_; - open IN, $inputfile or die "Can't open $inputfile $!"; - open OUT, ">$outputfile" or die "Can't open $outputfile $!"; + foreach (list_skels($prefix, $out_rel)) { + -d dirname($_) or !-e $_ or $force or next; - map { s/@@@(.*?)@@@/$toreplace{$1}/g; print OUT; } <IN>; + template2file($in, $_, %toreplace); + m|/home/(.+?)/| and chown(getpwnam($1), getgrnam($1), $_); + } +} +sub update_userkderc { + my ($prefix, $category, %subst) = @_; + + foreach my $file (list_skels($prefix, '.kderc')) { + output $file, + (map { + my $l = $_; + s/^\s*//; + if (my $i = /^\[$category\]/i ... /^\[/) { + if ($i =~ /E/) { #- for last line of category + $l = join('', values %subst) . $l; + %subst = (); + } elsif (/^(\w*?)=/) { + if (my $e = delete $subst{lc($1)}) { + $l = "$1=$e\n"; + } + } + } + $l; + } cat_($file)), + (%subst && "[$category]\n", values %subst); #- if category has not been found above. + } } sub substInFile(&@) { @@ -557,6 +599,8 @@ sub df { map { $_ * ($blocksize / 1024) } $size, $free; } + + #-###################################################################################### #- Wonderful perl :( #-###################################################################################### diff --git a/perl-install/detect_devices.pm b/perl-install/detect_devices.pm index a55a8b38f..5aa50aeeb 100644 --- a/perl-install/detect_devices.pm +++ b/perl-install/detect_devices.pm @@ -189,8 +189,10 @@ sub hasEthernet() { hasNetDevice("eth0"); } sub hasTokenRing() { hasNetDevice("tr0"); } sub hasNetDevice($) { c::hasNetDevice($_[0]) } -# probe_type true means detect the type of hardware, this is unsafe for pci! (bug in kernel&hardware) +# pci_probing::main::probe with $probe_type is unsafe for pci! (bug in kernel&hardware) # get_pcmcia_devices provides field "device", used in network.pm +# => probeall with $probe_type is unsafe +# => matching_type is unsafe sub probeall { my ($probe_type, $pcic) = @_; require pci_probing::main; @@ -243,7 +245,7 @@ sub hasUltra66 { # #- disable hasUltra66 (now included in kernel) # return; - my @l = map { $_->{verbatim} } matching_desc('(HPT|Ultra66)') or return; + my @l = map { $_->{verbatim} } matching_desc('HPT|Ultra66') or return; my $ide = sprintf "ide2=0x%x,0x%x ide3=0x%x,0x%x", @l == 2 ? diff --git a/perl-install/install2.pm b/perl-install/install2.pm index 737a0b2db..41824979c 100644 --- a/perl-install/install2.pm +++ b/perl-install/install2.pm @@ -159,7 +159,6 @@ $o = $::o = { #- { mntpoint => "swap", size => 64 << 11, type => 0x82 }, #- { mntpoint => "/usr", size => 400 << 11, type => 0x83, growable => 1 }, #- ], - shells => [ map { "/bin/$_" } qw(bash tcsh zsh ash ksh) ], authentication => { md5 => 1, shadow => 1 }, lang => 'en_US', isUpgrade => 0, @@ -281,7 +280,7 @@ sub selectInstallClass { if ($o->{steps}{choosePackages}{entered} >= 1 && !$o->{steps}{installPackages}{done}) { $o->setPackages(\@install_classes); - $o->selectPackagesToUpgrade() if $o->{isUpgrade}; + $o->selectPackagesToUpgrade if $o->{isUpgrade}; } if ($o->{isUpgrade}) { @{$o->{orderedSteps}} = map { /setupSCSI/ ? ($_, "doPartitionDisks") : $_ } @@ -295,7 +294,7 @@ sub selectInstallClass { #------------------------------------------------------------------------------ sub doPartitionDisks { - return install_any::searchAndMount4Upgrade($o) if $o->{isUpgrade}; + return $o->searchAndMount4Upgrade if $o->{isUpgrade}; $o->{steps}{formatPartitions}{done} = 0; $o->doPartitionDisksBefore; @@ -340,7 +339,7 @@ sub choosePackages { #- for the first time, select package to upgrade. #- TOCHECK this may not be the best place for that as package are selected at some other point. if ($_[1] == 1) { - $o->selectPackagesToUpgrade($o) if $o->{isUpgrade}; + $o->selectPackagesToUpgrade if $o->{isUpgrade}; $o->{compssUsersChoice}{$_} = 1 foreach @{$o->{compssUsersSorted}}, 'Miscellaneous'; # $o->{compssUsersChoice}{KDE} = 0 if $o->{lang} =~ /ja|el|ko|th|vi|zh/; #- gnome handles much this fonts much better diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm index 6e9984f2a..25fbdbf79 100644 --- a/perl-install/install_any.pm +++ b/perl-install/install_any.pm @@ -2,7 +2,6 @@ package install_any; use diagnostics; use strict; -use Config; use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @needToCopy); @@ -26,6 +25,7 @@ use network; use modules; use detect_devices; use fs; +use any; use log; #- package that have to be copied for proper installation (just to avoid changing cdrom) @@ -220,10 +220,10 @@ sub spawnShell { exec {"/bin/sh"} "-/bin/sh" or log::l("exec of /bin/sh failed: $!"); } -sub shells($) { +sub fsck_option() { my ($o) = @_; - my @l = grep { -x "$o->{prefix}$_" } @{$o->{shells}}; - @l ? @l : "/bin/bash"; + my $y = $o->{security} < 3 && $::beginner ? "-y " : ""; + substInFile { s/^(\s*fsckoptions="?)(-y )?/$1$y/ } "$o->{prefix}/etc/rc.d/rc.sysinit"; } sub getAvailableSpace { @@ -307,13 +307,6 @@ sub setPackages($) { } } -sub selectPackagesToUpgrade($) { - my ($o) = @_; - - require pkgs; - pkgs::selectPackagesToUpgrade($o->{packages}, $o->{prefix}, $o->{base}, $o->{toRemove}, $o->{toSave}); -} - sub addToBeDone(&$) { my ($f, $step) = @_; @@ -322,134 +315,12 @@ sub addToBeDone(&$) { push @{$::o->{steps}{$step}{toBeDone}}, $f; } -sub getHds { - my ($o) = @_; - my ($ok, $ok2) = (1, 1); - my $flags = $o->{partitioning}; - - my @drives = detect_devices::hds(); -# add2hash_($o->{partitioning}, { readonly => 1 }) if partition_table_raw::typeOfMBR($drives[0]{device}) eq 'system_commander'; - - getHds: - $o->{hds} = catch_cdie { fsedit::hds(\@drives, $flags) } - sub { - log::l("error reading partition table: $@"); - my ($err) = $@ =~ /(.*) at /; - $@ =~ /overlapping/ and $o->ask_warn('', $@), return 1; - $o->ask_okcancel(_("Error"), -[_("I can't read your partition table, it's too corrupted for me :( -I'll try to go on blanking bad partitions"), $err]) unless $flags->{readonly}; - $ok = 0; 1 - }; - - if (is_empty_array_ref($o->{hds}) && $o->{autoSCSI}) { - $o->setupSCSI; #- ask for an unautodetected scsi card - goto getHds; - } - - $ok2 = fsedit::verifyHds($o->{hds}, $flags->{readonly}, $ok) - unless $flags->{clearall} || $flags->{clear}; - - $o->{fstab} = [ fsedit::get_fstab(@{$o->{hds}}) ]; - fs::check_mounted($o->{fstab}); - fs::merge_fstabs($o->{fstab}, $o->{manualFstab}); - - $o->ask_warn('', -_("DiskDrake failed to read correctly the partition table. -Continue at your own risk!")) if !$ok2 && $ok && !$flags->{readonly}; - - my @win = grep { isFat($_) && isFat({ type => fsedit::typeOfPart($_->{device}) }) } @{$o->{fstab}}; - log::l("win parts: ", join ",", map { $_->{device} } @win) if @win; - if (@win == 1) { - $win[0]{mntpoint} = "/mnt/windows"; - } else { - my %w; foreach (@win) { - my $v = $w{$_->{device_windobe}}++; - $_->{mntpoint} = "/mnt/win_" . lc($_->{device_windobe}) . ($v ? $v+1 : ''); #- lc cuz of StartOffice(!) cf dadou - } - } - - my @sunos = grep { isSunOS($_) && type2name($_->{type}) =~ /root/i } @{$o->{fstab}}; #- take only into account root partitions. - if (@sunos) { - my $v = ''; - map { $_->{mntpoint} = "/mnt/sunos" . ($v && ++$v) } @sunos; - } - #- a good job is to mount SunOS root partition, and to use mount point described here in /etc/vfstab. - - $ok2; -} - -sub searchAndMount4Upgrade { - my ($o) = @_; - my ($root, $found); - - my $w = !$::expert && $o->wait_message('', _("Searching root partition.")); - - #- try to find the partition where the system is installed if beginner - #- else ask the user the right partition, and test it after. - getHds($o); - - #- get all ext2 partition that may be root partition. - my %Parts = my %parts = map { $_->{device} => $_ } grep { isTrueFS($_) } @{$o->{fstab}}; - while (keys(%parts) > 0) { - $root = $::beginner ? first(%parts) : $o->selectRootPartition(keys %parts); - $root = delete $parts{$root}; - - my $r; unless ($r = $root->{realMntpoint}) { - $r = $o->{prefix}; - $root->{mntpoint} = "/"; - log::l("trying to mount partition $root->{device}"); - eval { fs::mount_part($root, $o->{prefix}, 'readonly') }; - $r = "/*ERROR*" if $@; - } - $found = -d "$r/etc/sysconfig" && [ fs::read_fstab("$r/etc/fstab") ]; - - unless ($root->{realMntpoint}) { - log::l("umounting partition $root->{device}"); - eval { fs::umount_part($root, $o->{prefix}) }; - } - - last if !is_empty_array_ref($found); - - delete $root->{mntpoint}; - $o->ask_warn(_("Information"), - _("%s: This is not a root partition, please select another one.", $root->{device})) unless $::beginner; - } - is_empty_array_ref($found) and die _("No root partition found"); - - log::l("found root partition : $root->{device}"); - - #- test if the partition has to be fsck'ed and remounted rw. - if ($root->{realMntpoint}) { - ($o->{prefix}, $root->{mntpoint}) = ($root->{realMntpoint}, '/'); - } else { - delete $root->{mntpoint}; - ($Parts{$_->{device}} || {})->{mntpoint} = $_->{mntpoint} foreach @$found; - map { $_->{mntpoint} = 'swap_upgrade' } grep { isSwap($_) } @{$o->{fstab}}; #- use all available swap. - - #- TODO fsck, create check_mount_all ? - fs::mount_all([ grep { isTrueFS($_) || isSwap($_) } @{$o->{fstab}} ], $o->{prefix}); - } -} - -sub write_ldsoconf { - my ($prefix) = @_; - my $file = "$prefix/etc/ld.so.conf"; - - #- write a minimal ld.so.conf file unless it already exists. - unless (-s "$file") { - local *F; - open F, ">$file" or die "unable to open for writing $file"; - print F "/usr/lib\n"; - } -} - sub setAuthentication { my ($o) = @_; my ($shadow, $md5, $nis) = @{$o->{authentication} || {}}{qw(shadow md5 NIS)}; my $p = $o->{prefix}; - enableMD5Shadow($p, $shadow, $md5); - enableShadow() if $shadow; + any::enableMD5Shadow($p, $shadow, $md5); + any::enableShadow($p) if $shadow; if ($nis) { $o->pkg_install("ypbind"); my $domain = $o->{netc}{NISDOMAIN}; @@ -464,42 +335,6 @@ sub setAuthentication { } } -sub enableShadow() { - my $p = $::o->{prefix}; - run_program::rooted($p, "pwconv") or log::l("pwconv failed"); - run_program::rooted($p, "grpconv") or log::l("grpconv failed"); - -#- my $chpasswd = sub { -#- my ($name, $password) = @_; -#- $password =~ s/"/\\"/; -#- -#- local *log::l = sub {}; #- disable the logging (otherwise password visible in the log) -#- run_program::rooted($p, qq((echo "$password" ; sleep 1 ; echo "$password") | passwd $name)); -#-#- run_program::rooted($p, "echo $name:$password | chpasswd"); -#- }; -#- &$chpasswd("root", $::o->{superuser}{password}); -#- &$chpasswd($_->{name}, $_->{password}) foreach @{$::o->{users} || []}; -} - -sub enableMD5Shadow($$$) { - my ($prefix, $shadow, $md5) = @_; - substInFile { - if (/^password.*pam_pwdb.so/) { - s/\s*shadow//; s/\s*md5//; - s/$/ shadow/ if $shadow; - s/$/ md5/ if $md5; - } - } grep { -r $_ } map { "$prefix/etc/pam.d/$_" } qw(login rlogin passwd); -} - -sub crypt($) { - my ($password) = @_; - - $::o->{authentication}{md5} ? - c::crypt_md5($password, salt(8)) : - crypt ($password, salt(2)); -} - sub killCardServices { my $pid = chop_(cat_("/tmp/cardmgr.pid")); $pid and kill(15, $pid); #- send SIGTERM @@ -546,8 +381,7 @@ sub setupFB { #- nothing done, fall through linux-fb. } else { $e->{vga} = $vga; - bootloader::install($o->{prefix}, $o->{bootloader}, $o->{fstab}, $o->{hds}); - return 1; + goto ok; } } } @@ -558,14 +392,122 @@ sub setupFB { vga => $vga, })) { $o->{bootloader}{default} = 'linux-fb'; - bootloader::install($o->{prefix}, $o->{bootloader}, $o->{fstab}, $o->{hds}); } else { log::l("unable to install kernel with frame buffer support, disabling"); return 0; } + ok: + bootloader::install($o->{prefix}, $o->{bootloader}, $o->{fstab}, $o->{hds}); 1; } +sub install_urpmi { + my ($prefix, $method, $mediums) = @_; + + my @cfg = map_index { + my $name = $_->{fakemedium}; + + local *LIST; + open LIST, ">$prefix/var/lib/urpmi/list.$name" or log::l("failed to write list.$name"), return; + + my $dir = ${{ nfs => "file://mnt/nfs", + hd => "file:/" . hdInstallPath(), + ftp => $ENV{URLPREFIX}, + http => $ENV{URLPREFIX}, + cdrom => "removable_cdrom_$::i://mnt/cdrom" }}{$method} . "/$_->{rpmsdir}"; + + local *FILES; open FILES, "bzip2 -dc /tmp/$_->{hdlist} 2>/dev/null | hdlist2names - |"; + chop, print LIST "$dir/$_\n" foreach <FILES>; + close FILES or log::l("hdlist2names failed"), return; + close LIST; + + $dir .= " with ../base/$_->{hdlist}" if $method =~ /ftp|http/; + "$name $dir\n"; + } values %$mediums; + eval { output "$prefix/etc/urpmi/urpmi.cfg", @cfg }; +} + + +#-############################################################################### +#- kde stuff +#-############################################################################### +sub kderc_largedisplay { + my ($prefix) = @_; + + update_userkderc($prefix, 'KDE', + Contrast => 7, + kfmIconStyle => "Large", + kpanelIconStyle => "Normal", #- to change to Large when icons looks better + KDEIconStyle => "Large"); + substInFile { + s/^(GridWidth)=85/$1=100/; + s/^(GridHeight)=70/$1=75/; + } $_ foreach list_skels($prefix, '.kde/share/config/kfmrc'); +} + +sub kdeicons_postinstall { + my ($prefix) = @_; + + #- parse etc/fstab file to search for dos/win, floppy, zip, cdroms icons. + #- handle both supermount and fsdev usage. + my %l = ( + 'cdrom' => [ 'cdrom', 'Cd-Rom' ], + 'zip' => [ 'zip', 'Zip' ], + 'floppy-ls' => [ 'floppy', 'LS-120' ], + 'floppy' => [ 'floppy', 'Floppy' ], + ); + foreach (fs::read_fstab("$prefix/etc/fstab")) { + + my ($name_, $nb) = $_->{mntpoint} =~ m|.*/(\S+?)(\d*)$/|; + my ($name, $text) = @{$l{$name_} || []}; + + my $f = ${{ + supermount => sub { $name .= '.fsdev' if $name }, + vfat => sub { $name = 'Dos_'; $text = $name_ }, + }}{$_->{type}}; + &$f if $f; + + template2userfile($prefix, + "$ENV{SHARE_PATH}/$name.kdelnk.in", + "Desktop/$text" . ($nb && " $nb"). ".kdelnk", + 1, %$_) if $name; + } + + my @l = list_skels($prefix, 'Desktop/Doc.kdelnk'); + if (my ($lang) = eval { all("$prefix/usr/doc/mandrake") }) { + substInFile { s|^(URL=.*?)/?$|$1/$lang/index.html| } @l; + substInFile { s|^(url=/usr/doc/mandrake/)$|$1$lang/index.html| } "$prefix/usr/lib/desktop-links/mandrake.links"; + } else { + unlink @l; + substInFile { $_ = '' if /^\[MDKsupport\]$/ .. /^\s*$/ } "$prefix/usr/lib/desktop-links/mandrake.links"; + } + + # rename the .kdelnk to the name found in the .kdelnk as kde doesn't use it + # for displaying + foreach my $dir (grep { -d $_ } list_skels($prefix, 'Desktop')) { + foreach (grep { /\.kdelnk$/ } all($dir)) { + cat_("$dir/$_") =~ /^Name\[\Q$ENV{LANG}\E\]=(.{2,14})$/m + and rename "$dir/$_", "$dir/$1.kdelnk"; + } + } +} + +sub kdemove_desktop_file { + my ($prefix) = @_; + my @toMove = qw(doc.kdelnk news.kdelnk updates.kdelnk home.kdelnk printer.kdelnk floppy.kdelnk cdrom.kdelnk FLOPPY.kdelnk CDROM.kdelnk); + + #- remove any existing save in Trash of each user and + #- move appropriate file there after an upgrade. + foreach my $dir (grep { -d $_ } list_skels($prefix, 'Desktop')) { + unlink("$dir/Trash/$_") && rename("$dir/$_", "$dir/Trash/$_") + foreach grep { -e "$dir/$_" } @toMove, grep { /\.rpmorig$/ } all($dir) + } +} + + +#-############################################################################### +#- auto_install stuff +#-############################################################################### sub auto_inst_file() { ($::g_auto_install ? "/tmp" : "$::o->{prefix}/root") . "/auto_inst.cfg.pl" } sub g_auto_install(;$) { @@ -608,7 +550,7 @@ sub loadO { fs::mount(devices::make("fd0"), "/mnt", (arch() =~ /sparc/ ? "romfs" : "vfat"), 'readonly'); $f = "/mnt/$f"; } - -e $f or $f .= ".pl"; + -e $f or $f .= '.pl'; my $b = before_leaving { fs::umount("/mnt") unless $::testing; @@ -631,223 +573,6 @@ sub loadO { bless $o, ref $O; } -sub fsck_option() { - my $y = $::o->{security} < 3 && $::beginner ? "-y " : ""; - substInFile { s/^(\s*fsckoptions="?)(-y )?/$1$y/ } "$::o->{prefix}/etc/rc.d/rc.sysinit"; -} - -sub install_urpmi { - my ($prefix, $method, $mediums) = @_; - - my @cfg = map_index { - my $name = $_->{fakemedium}; - - local *LIST; - open LIST, ">$prefix/var/lib/urpmi/list.$name" or log::l("failed to write list.$name"), return; - - my $dir = ${{ nfs => "file://mnt/nfs", - hd => "file:/" . hdInstallPath(), - ftp => $ENV{URLPREFIX}, - http => $ENV{URLPREFIX}, - cdrom => "removable_cdrom_$::i://mnt/cdrom" }}{$method} . "/$_->{rpmsdir}"; - - local *FILES; open FILES, "bzip2 -dc /tmp/$_->{hdlist} 2>/dev/null | hdlist2names - |"; - chop, print LIST "$dir/$_\n" foreach <FILES>; - close FILES or log::l("hdlist2names failed"), return; - close LIST; - - $dir .= " with ../base/$_->{hdlist}" if $method =~ /ftp|http/; - "$name $dir\n"; - } values %$mediums; - eval { output "$prefix/etc/urpmi/urpmi.cfg", @cfg }; -} - -sub list_passwd() { - my ($e, @l); - - setpwent(); - while (@{$e = [ getpwent() ]}) { push @l, $e } - endpwent(); - - @l; -} - -sub list_home() { - map { $_->[7] } grep { $_->[2] >= 500 } list_passwd(); -} -sub list_skels() { "/etc/skel", "/root", list_home() } - -sub template2userfile($$$$%) { - my ($prefix, $inputfile, $outputrelfile, $force, %toreplace) = @_; - - foreach (list_skels()) { - my $outputfile = "$prefix/$_/$outputrelfile"; - if (-d dirname($outputfile) && ($force || ! -e $outputfile)) { - log::l("generating $outputfile from template $inputfile"); - template2file($inputfile, $outputfile, %toreplace); - m|/home/(.*)| and commands::chown_($1, $outputfile); - } - } -} - -sub update_userkderc($$$) { - my ($prefix, $cat, $subst) = @_; - - foreach (list_skels()) { - my ($inputfile, $outputfile) = ("$prefix$_/.kderc", "$prefix$_/.kderc.new"); - my %tosubst = (%$subst); - local *INFILE; local *OUTFILE; - open INFILE, $inputfile or return; - open OUTFILE, ">$outputfile" or return; - - print OUTFILE map { - if (my $i = /^\s*\[$cat\]/i ... /^\s*\[/) { - if (/^\s*(\w*)=/ && $tosubst{lc($1)}) { - delete $tosubst{lc($1)}; - } else { - ($i > 1 && /^\s*\[/ && join '', map { delete $tosubst{$_} } keys %tosubst). $_; - } - } else { - $_; - } - } <INFILE>; - print OUTFILE "[$cat]\n", values %tosubst if values %tosubst; #- if categorie has not been found above. - - my @l = (stat $inputfile)[4, 5]; - unlink $inputfile; - rename $outputfile, $inputfile; - chown @l, $inputfile; - } -} - -sub kderc_largedisplay($) { - my ($prefix) = @_; - - update_userkderc($prefix, 'KDE', { - contrast => "Contrast=7\n", - kfmiconstyle => "kfmIconStyle=Large\n", - kpaneliconstyle => "kpanelIconStyle=Normal\n", #- to change to Large when icons looks better - kdeiconstyle => "KDEIconStyle=Large\n", - }); - foreach (list_skels()) { - substInFile { - s/^(GridWidth)=85/$1=100/; - s/^(GridHeight)=70/$1=75/; - } "$prefix$_/.kde/share/config/kfmrc" - } -} - -sub kdelang_postinstall($) { - my ($prefix) = @_; - my %i18n = getVarsFromSh("$prefix/etc/sysconfig/i18n"); - - #- remove existing reference to $lang. - update_userkderc($prefix, 'Locale', { language => "Language=\n" }); -} - -sub kdeicons_postinstall($) { - my ($prefix) = @_; - - #- parse etc/fstab file to search for dos/win, floppy, zip, cdroms icons. - #- handle both supermount and fsdev usage. - local *F; - open F, "$prefix/etc/fstab" or log::l("failed to read $prefix/etc/fstab"), return; - - foreach (<F>) { - if (m|^/dev/(\S+)\s+/mnt/cdrom(\d*)\s+|) { - my %toreplace = ( device => $1, id => $2 ); - template2userfile($prefix, "$ENV{SHARE_PATH}/cdrom.fsdev.kdelnk.in", "Desktop/Cd-Rom". ($2 && " $2") .".kdelnk", - 1, %toreplace); - } elsif (m|^/dev/(\S+)\s+/mnt/zip(\d*)\s+|) { - my %toreplace = ( device => $1, id => $2 ); - template2userfile($prefix, "$ENV{SHARE_PATH}/zip.fsdev.kdelnk.in", "Desktop/Zip". ($2 && " $2") .".kdelnk", - 1, %toreplace); - } elsif (m|^/dev/(\S+)\s+/mnt/floppy-ls(\d*)\s+|) { - my %toreplace = ( device => $1, id => $2 ); - template2userfile($prefix, "$ENV{SHARE_PATH}/floppy.fsdev.kdelnk.in", "Desktop/LS-120". ($2 && " $2") .".kdelnk", - 1, %toreplace); - } elsif (m|^/dev/(\S+)\s+/mnt/floppy(\d*)\s+|) { - my %toreplace = ( device => $1, id => $2 ); - template2userfile($prefix, "$ENV{SHARE_PATH}/floppy.fsdev.kdelnk.in", "Desktop/Floppy". ($2 && " $2") .".kdelnk", - 1, %toreplace); - } elsif (m|^/mnt/cdrom(\d*)\s+/mnt/cdrom\d*\s+supermount|) { - my %toreplace = ( id => $1 ); - template2userfile($prefix, "$ENV{SHARE_PATH}/cdrom.kdelnk.in", "Desktop/Cd-Rom". ($1 && " $1") .".kdelnk", - 1, %toreplace); - } elsif (m|^/mnt/zip(\d*)\s+/mnt/zip\d*\s+supermount|) { - my %toreplace = ( id => $1 ); - template2userfile($prefix, "$ENV{SHARE_PATH}/zip.kdelnk.in", "Desktop/Zip". ($1 && " $1") .".kdelnk", - 1, %toreplace); - } elsif (m|^/mnt/floppy-ls(\d*)\s+/mnt/floppy-ls\d*\s+supermount|) { - my %toreplace = ( id => $1 ); - template2userfile($prefix, "$ENV{SHARE_PATH}/floppy.kdelnk.in", "Desktop/LS-120". ($1 && " $1") .".kdelnk", - 1, %toreplace); - } elsif (m|^/mnt/floppy(\d*)\s+/mnt/floppy\d*\s+supermount|) { - my %toreplace = ( id => $1 ); - template2userfile($prefix, "$ENV{SHARE_PATH}/floppy.kdelnk.in", "Desktop/Floppy". ($1 && " $1") .".kdelnk", - 1, %toreplace); - } elsif (m|^/dev/(\S+)\s+(/mnt/DOS_\S*)\s+|) { - my %toreplace = ( device => $1, id => $1, mntpoint => $2 ); - template2userfile($prefix, "$ENV{SHARE_PATH}/Dos_.kdelnk.in", "Desktop/Dos_$1.kdelnk", 1, %toreplace); - symlink "hd_umount.xpm", "$prefix/usr/share/icons/hd_unmount.xpm"; - symlink "hd_umount.xpm", "$prefix/usr/share/icons/large/hd_unmount.xpm"; - } elsif (m|^/dev/(\S+)\s+/mnt/([^\/]*)\s+vfat\s+|) { - my %toreplace = ( device => $1, id => $1, mntpoint => "/mnt/$2" ); - template2userfile($prefix, "$ENV{SHARE_PATH}/Dos_.kdelnk.in", "Desktop/$2.kdelnk", 1, %toreplace); - symlink "hd_umount.xpm", "$prefix/usr/share/icons/hd_unmount.xpm"; - symlink "hd_umount.xpm", "$prefix/usr/share/icons/large/hd_unmount.xpm"; - } elsif (m|^/dev/(\S+)\s+(\S*)\s+vfat\s+|) { - my %toreplace = ( device => $1, id => $1, mntpoint => $2 ); - template2userfile($prefix, "$ENV{SHARE_PATH}/Dos_.kdelnk.in", "Desktop/Dos_$1.kdelnk", 1, %toreplace); - symlink "hd_umount.xpm", "$prefix/usr/share/icons/hd_unmount.xpm"; - symlink "hd_umount.xpm", "$prefix/usr/share/icons/large/hd_unmount.xpm"; - } - } - - my @l = map { "$prefix$_/Desktop/Doc.kdelnk" } list_skels(); - if (my ($lang) = eval { all("$prefix/usr/doc/mandrake") }) { - substInFile { s|^(URL=.*?)/?$|$1/$lang/index.html| } @l; - substInFile { s|^(url=/usr/doc/mandrake/)$|$1$lang/index.html| } "$prefix/usr/lib/desktop-links/mandrake.links"; - } else { - unlink @l; - substInFile { $_ = '' if /^\[MDKsupport\]$/ .. /^\s*$/ } "$prefix/usr/lib/desktop-links/mandrake.links"; - } - - my $lang = quotemeta $ENV{LANG}; - foreach my $dir (map { "$prefix$_/Desktop" } list_skels()) { - -d $dir or next; - foreach (grep { /\.kdelnk$/ } all($dir)) { - cat_("$dir/$_") =~ /^Name\[$lang\]=(.{2,14})$/m - and rename "$dir/$_", "$dir/$1.kdelnk"; - } - } -} - -sub move_desktop_file($) { - my ($prefix) = @_; - my @toMove = qw(doc.kdelnk news.kdelnk updates.kdelnk home.kdelnk printer.kdelnk floppy.kdelnk cdrom.kdelnk FLOPPY.kdelnk CDROM.kdelnk); - - foreach (list_skels()) { - my $dir = "$prefix$_"; - if (-d "$dir/Desktop") { - my @toSubst = glob_("$dir/Desktop/*rpmorig"); - - push @toSubst, "$dir/Desktop/$_" foreach @toMove; - - #- remove any existing save in Trash of each user and - #- move appropriate file there after an upgrade. - foreach (@toSubst) { - if (-e $_) { - my $basename = basename($_); - - unlink "$dir/Desktop/Trash/$basename"; - rename $_, "$dir/Desktop/Trash/$basename"; - } - } - } - } -} - sub generate_ks_cfg { my ($o) = @_; @@ -872,148 +597,4 @@ sub generate_ks_cfg { $ks; } -sub partitionWizard { - my ($o, $hds, $fstab, $readonly) = @_; - my @wizlog; - my (@solutions, %solutions); - - my $min_linux = 500 << 11; - my $max_linux = 2500 << 11; - my $min_swap = 50 << 11; - my $max_swap = 300 << 11; - my $min_freewin = 100 << 11; - - # each solution is a [ score, text, function ], where the function retunrs true if succeeded - - if (fsedit::free_space(@$hds) > $min_linux and !$readonly) { - $solutions{free_space} = [ 20, _("Use free space"), sub { fsedit::auto_allocate($hds, $o->{partitions}); 1 } ] - } else { - push @wizlog, _("Not enough free space to allocate new partitions"); - } - - if (@$fstab) { - my $truefs = grep { isTrueFS($_) } @$fstab; - #- value twice the ext2 partitions - $solutions{existing_part} = [ 6 + $truefs + @$fstab, _("Use existing partition"), sub { $o->ask_mntpoint_s($fstab) } ] - } else { - push @wizlog, _("There is no existing partition to use"); - } - - my @fats = grep { isFat($_) } @$fstab; - fs::df($_) foreach @fats; - if (my @ok_forloopback = sort { $b->{free} <=> $a->{free} } grep { $_->{free} > $min_linux + $min_freewin } @fats) { - $solutions{loopback} = - [ 5 - @fats, _("Use the FAT partition for loopback"), - sub { - my ($s_root, $s_swap); - my $part = $o->ask_from_listf('', _("Which partition do you want to use to put Linux4Win?"), \&partition_table_raw::description, \@ok_forloopback) or return; - $o->ask_from_entries_refH('', _("Choose the sizes"), [ - _("Root partition size in MB: ") => { val => \$s_root, min => 1 + ($min_linux >> 11), max => min($part->{free} - 2 * $max_swap - $min_freewin, $max_linux) >> 11, type => 'range' }, - _("Swap partition size in MB: ") => { val => \$s_swap, min => 1 + ($min_swap >> 11), max => 2 * $max_swap >> 11, type => 'range' }, - ]) or return; - push @{$part->{loopback}}, - { type => 0x83, loopback_file => '/lnx4win/linuxsys.img', mntpoint => '/', size => $s_root << 11, device => $part, notFormatted => 1 }, - { type => 0x82, loopback_file => '/lnx4win/swapfile', mntpoint => 'swap', size => $s_swap << 11, device => $part, notFormatted => 1 }; - 1; - } ]; - $solutions{resize_fat} = - [ 6 - @fats, _("Use the free space on the FAT partition"), - sub { - my $part = $o->ask_from_listf('', _("Which partition do you want to resize?"), \&partition_table_raw::description, \@ok_forloopback) or return; - my $w = $o->wait_message(_("Resizing"), _("Computing FAT filesystem bounds")); - my $resize_fat = eval { resize_fat::main->new($part->{device}, devices::make($part->{device})) }; - $@ and die _("The FAT resizer is unable to handle your partition, -the following error occured: %s", $@); - my $min_win = $resize_fat->min_size; - $part->{size} > $min_linux + $min_freewin + $min_win or die _("Your windows partition is too fragmented, please run ``defrag'' first"); - $o->ask_okcancel('', _("WARNING! - -DrakX will now resize your Windows partition. Be careful: this operation is -dangerous. If you have not already done so, you should first exit the -installation, run scandisk under Windows (and optionally run defrag), then -restart the installation. You should also backup your data. -When sure, press Ok.")) or return; - - my $size = $part->{size}; - $o->ask_from_entries_refH('', _("Which size do you want to keep for windows on"), [ - _("partition %s", partition_table_raw::description($part)) => { val => \$size, min => 1 + ($min_win >> 11), max => ($part->{size} - $min_linux) >> 11, type => 'range' }, - ]) or return; - $size <<= 11; - - local *log::l = sub { $w->set(join(' ', @_)) }; - eval { $resize_fat->resize($size) }; - $@ and die _("FAT resizing failed: %s", $@); - - $part->{size} = $size; - $part->{isFormatted} = 1; - - my ($hd) = grep { $_->{device} eq $part->{rootDevice} } @$hds; - $hd->{isDirty} = $hd->{needKernelReread} = 1; - $hd->adjustEnd($part); - partition_table::adjust_local_extended($hd, $part); - partition_table::adjust_main_extended($hd); - - fsedit::auto_allocate($hds, $o->{partitions}); - 1; - } ] if !$readonly; - } else { - push @wizlog, _("There is no FAT partitions to resize or to use as loopback (or not enough space left)"); - } - - if (@$fstab && !$readonly) { - require diskdrake; - $solutions{wipe_drive} = - [ 10, fsedit::is_one_big_fat($hds) ? _("Remove Windows(TM)") : _("Take over the hard drive"), - sub { - my $hd = $o->ask_from_listf('', _("You have more than one hard drive, which one do you install linux on?"), - \&partition_table_raw::description, $hds) or return; - $o->ask_okcancel('', _("All existing partitions and their data will be lost on drive %s", $hd->{device})) or return; - partition_table_raw::zero_MBR($hd); - fsedit::auto_allocate($hds, $o->{partitions}); - 1; - } ]; - } - - if (!$readonly && ref($o) =~ /gtk/) { #- diskdrake only available in gtk for now - $solutions{diskdrake} = - [ 0, _("Use diskdrake"), sub { - my $ok = 1; - do { - diskdrake::main($hds, $o->{raid}, interactive_gtk->new, $o->{partitions}); - my @fstab = fsedit::get_fstab(@$hds); - - unless (fsedit::get_root(\@fstab)) { - $ok = 0; - $o->ask_okcancel('', _("You must have a root partition. -For this, create a partition (or click on an existing one). -Then choose action ``Mount point'' and set it to `/'"), 1) or return; - } - if (!grep { isSwap($_) } @fstab) { - $o->ask_warn('', _("You must have a swap partition")), $ok=0 if $::beginner; - $ok &&= $::expert || $o->ask_okcancel('', _("You don't have a swap partition\n\nContinue anyway?")); - } - } until $ok; - 1; - } ]; - } - - if (!$readonly) { #- diskdrake only available in gtk for now - $solutions{fdisk} = - [ -10, _("Use fdisk"), sub { - $o->suspend; - foreach (@$hds) { - print "\n" x 10, _("You can now partition %s. -When you are done, don't forget to save using `w'", partition_table_raw::description($_)); - print "\n\n"; - my $pid = fork or exec "fdisk", devices::make($_->{device}); - waitpid($pid, 0); - } - $o->resume; - 0; - } ]; - } - log::l("partitioning wizard log:\n", (map { ">>wizlog>>$_\n" } @wizlog)); - %solutions; -} - 1; diff --git a/perl-install/install_steps.pm b/perl-install/install_steps.pm index 72734f5b3..709764a1e 100644 --- a/perl-install/install_steps.pm +++ b/perl-install/install_steps.pm @@ -9,6 +9,7 @@ use vars qw(@filesToSaveForUpgrade); #-###################################################################################### use common qw(:file :system :common :functional); use install_any qw(:all); +use install_interactive; use partition_table qw(:types); use detect_devices; use modules; @@ -134,7 +135,7 @@ sub doPartitionDisksBefore { eval { fs::umount_all($o->{fstab}, $o->{prefix}) } if $o->{fstab} && !$::testing; $o->{raid} ||= {}; - install_any::getHds($o); + install_interactive::getHds($o); } #------------------------------------------------------------------------------ @@ -223,7 +224,7 @@ sub setPackages { } sub selectPackagesToUpgrade { my ($o) = @_; - install_any::selectPackagesToUpgrade($o); + pkgs::selectPackagesToUpgrade($o->{packages}, $o->{prefix}, $o->{base}, $o->{toRemove}, $o->{toSave}); } sub choosePackages { @@ -269,7 +270,7 @@ sub beforeInstallPackages { } #- some packages need such files for proper installation. - install_any::write_ldsoconf($o->{prefix}); + any::writeandclean_ldsoconf($o->{prefix}); fs::write($o->{prefix}, $o->{fstab}, $o->{manualFstab}, $o->{useSupermount}); network::add2hosts("$o->{prefix}/etc/hosts", "localhost.localdomain", "127.0.0.1"); @@ -391,8 +392,7 @@ Consoles 1,3,4,7 may also contain interesting information"; } #- update language and icons for KDE. - log::l("updating language for kde"); - install_any::kdelang_postinstall($o->{prefix}); + update_userkderc($o->{prefix}, 'Locale', Language => ""); log::l("updating kde icons according to available devices"); install_any::kdeicons_postinstall($o->{prefix}); @@ -431,7 +431,7 @@ Consoles 1,3,4,7 may also contain interesting information"; #- run_program::rooted($o->{prefix}, "chkfontpath", "--add", $dest); #- } - foreach (install_any::list_skels()) { + foreach (list_skels($o->{prefix}, '.kde/share/config/kfmrc')) { my $found; substInFile { $found ||= /KFM Misc Defaults/; @@ -440,14 +440,14 @@ Consoles 1,3,4,7 may also contain interesting information"; GridWidth=85 GridHeight=70 " if eof && !$found; - } "$o->{prefix}$_/.kde/share/config/kfmrc" + } $_ } #- move some file after an upgrade that may be seriously annoying. #- and rename saved files to .mdkgiorig. if ($o->{isUpgrade}) { log::l("moving previous desktop files that have been updated to Trash of each user"); - install_any::move_desktop_file($o->{prefix}); + install_any::kdemove_desktop_file($o->{prefix}); foreach (@filesToSaveForUpgrade) { if (-e "$o->{prefix}$_.mdkgisave") { @@ -675,7 +675,7 @@ sub setRootPassword($) { my $p = $o->{prefix}; my $u = $o->{superuser} ||= {}; - $u->{pw} ||= $u->{password} && install_any::crypt($u->{password}); + $u->{pw} ||= $u->{password} && any::crypt($u->{password}, $o->{authentication}{md5}); my @lines = cat_(my $f = "$p/etc/passwd") or log::l("missing passwd file"), return; @@ -716,7 +716,7 @@ sub addUser($) { $_->{uid} = $u; $uids{$u} = 1; $_->{gid} = $g; $gids{$g} = 1; - $_->{pw} ||= $_->{password} && install_any::crypt($_->{password}); + $_->{pw} ||= $_->{password} && any::crypt($_->{password}, $o->{authentication}{md5}); $_->{shell} ||= "/bin/bash"; $done{$_->{name}} = 1; } diff --git a/perl-install/install_steps_interactive.pm b/perl-install/install_steps_interactive.pm index 18ad53a87..5664b4d0c 100644 --- a/perl-install/install_steps_interactive.pm +++ b/perl-install/install_steps_interactive.pm @@ -14,6 +14,7 @@ use common qw(:common :file :functional :system); use partition_table qw(:types); use partition_table_raw; use install_steps; +use install_interactive; use install_any; use detect_devices; use run_program; @@ -22,6 +23,7 @@ use devices; use fsedit; use network; use raid; +use Netconnect; use mouse; use modules; use lang; @@ -214,7 +216,7 @@ sub ask_mntpoint_s { #------------------------------------------------------------------------------ sub doPartitionDisks { my ($o) = @_; - my %solutions = install_any::partitionWizard($o, $o->{hds}, $o->{fstab}, $o->{partitioning}{readonly}); + my %solutions = install_interactive::partitionWizard($o, $o->{hds}, $o->{fstab}, $o->{partitioning}{readonly}); my @solutions = sort { $b->[0] <=> $a->[0] } values %solutions; my $level = $::beginner ? 2 : -9999; @@ -741,7 +743,7 @@ sub addUser { $u->{password2} ||= $u->{password} ||= ""; $u->{shell} ||= "/bin/bash"; my @fields = qw(realname name password password2); - my @shells = install_any::shells($o); + my @shells = map { chomp; $_ } cat_("$o->{prefix}/etc/shells"); if (($o->{security} >= 1 || $clicked)) { $u->{icon} = translate($u->{icon}); @@ -755,7 +757,7 @@ sub addUser { _("Password") => {val => \$u->{password}, hidden => 1}, _("Password (again)") => {val => \$u->{password2}, hidden => 1}, ), $::beginner ? () : ( - _("Shell") => {val => \$u->{shell}, list => \@shells, not_edit => !$::expert} + _("Shell") => {val => \$u->{shell}, list => [ any::shells($o->{prefix}) ], not_edit => !$::expert} ), $o->{security} > 3 || $::beginner ? () : ( _("Icon") => {val => \$u->{icon}, list => [ map { translate($_) } @any::users ], not_edit => 1 }, ), diff --git a/perl-install/lang.pm b/perl-install/lang.pm index e12fc789a..490cdee57 100644 --- a/perl-install/lang.pm +++ b/perl-install/lang.pm @@ -211,16 +211,7 @@ my %charsets = ( sub list { sort { $a cmp $b } keys %languages } sub lang2text { $languages{$_[0]} && $languages{$_[0]}[0] } -sub text2lang { - my ($t) = @_; - foreach (keys %languages) { - lc($languages{$_}[0]) eq lc($t) and return $_; - } - die "unknown language $t"; -} - -sub lang2charset { - $languages{$_[0]} } +sub lang2charset { $languages{$_[0]} && $languages{$_[0]}[1] } sub set { my ($lang) = @_; diff --git a/perl-install/modules.pm b/perl-install/modules.pm index 24e4e1291..366fbabff 100644 --- a/perl-install/modules.pm +++ b/perl-install/modules.pm @@ -311,9 +311,8 @@ my @drivers_fields = qw(text type); %drivers = (); foreach (@drivers_by_category) { - my @l = @$_; - my $l = pop @l; - foreach (keys %$l) { $drivers{$_} = [ $l->{$_}, @l ]; } + my ($text, $l) = @$_; + foreach (keys %$l) { $drivers{$_} = [ $l->{$_}, $type ]; } } while (my ($k, $v) = each %drivers) { my %l; @l{@drivers_fields} = @$v; diff --git a/perl-install/standalone/adduserdrake b/perl-install/standalone/adduserdrake index be03ed9f3..6cd88bf32 100755 --- a/perl-install/standalone/adduserdrake +++ b/perl-install/standalone/adduserdrake @@ -72,7 +72,7 @@ sub addusers { my @u = map { $_->{name} } my @users = @_; foreach (@users) { - $_->{pw} = $isMD5 ? c::crypt_md5($_->{password}, salt(8)) : crypt($_->{password}, salt(2)); + $_->{pw} = any::crypt($_->{password}, $isMD5); $_->{shell} ||= "/bin/bash"; } |