home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-2 / Inter.Net 55-2.iso / Mandrake / mdkinst / usr / bin / perl-install / install_any.pm < prev    next >
Encoding:
Perl POD Document  |  2000-01-12  |  20.2 KB  |  706 lines
  1. package install_any;
  2.  
  3.  
  4.  
  5.  
  6.  
  7. @ISA = qw(Exporter);
  8. %EXPORT_TAGS = (
  9.     all => [ qw(getNextStep spawnShell addToBeDone) ],
  10. );
  11. @EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
  12.  
  13.  
  14.  
  15.  
  16. use common qw(:common :system :functional :file);
  17. use commands;
  18. use run_program;
  19. use partition_table qw(:types);
  20. use partition_table_raw;
  21. use devices;
  22. use fsedit;
  23. use network;
  24. use modules;
  25. use detect_devices;
  26. use fs;
  27. use log;
  28.  
  29.  
  30.  
  31.  
  32.  
  33. sub relGetFile($) {
  34.     local $_ = $_[0];
  35.     /\.img$/ and return "images/$_";
  36.     my $dir = m|/| ? "mdkinst" :
  37.       member($_, qw(compss compssList compssUsers depslist hdlist)) ? "base" : "RPMS";
  38.     $_ = "Mandrake/$dir/$_";
  39.     s/i386/i586/;
  40.     $_;
  41. }
  42. sub getFile($) {
  43.     local $^W = 0;
  44.     if ($::o->{method} && $::o->{method} eq "ftp") {
  45.     require ftp;
  46.     *install_any::getFile = \&ftp::getFile;
  47.     } elsif ($::o->{method} && $::o->{method} eq "http") {
  48.     require http;
  49.     *install_any::getFile = \&http::getFile;
  50.     } else {
  51.     *install_any::getFile = sub($) {
  52.         open getFile, "/tmp/rhimage/" . relGetFile($_[0]) or return;
  53.         *getFile;
  54.     };
  55.     }
  56.     goto &getFile;
  57. }
  58. sub rewindGetFile() {
  59.     if ($::o->{method} && $::o->{method} eq "ftp") {
  60.     require ftp;
  61.     ftp::rewindGetFile(); 
  62.     }
  63. }
  64.  
  65. sub kernelVersion {
  66.     local $_ = readlink("$::o->{prefix}/boot/vmlinuz") || $::testing && "vmlinuz-2.2.testversion" or die "I couldn't find the kernel package!";
  67.     first(/vmlinuz-(.*)/);
  68. }
  69.  
  70.  
  71. sub getNextStep {
  72.     my ($s) = $::o->{steps}{first};
  73.     $s = $::o->{steps}{$s}{next} while $::o->{steps}{$s}{done} || !$::o->{steps}{$s}{reachable};
  74.     $s;
  75. }
  76.  
  77. sub spawnShell {
  78.     return if $::o->{localInstall} || $::testing;
  79.  
  80.     -x "/bin/sh" or die "cannot open shell - /usr/bin/sh doesn't exist";
  81.  
  82.     fork and return;
  83.  
  84.     local *F;
  85.     sysopen F, "/dev/tty2", 2 or die "cannot open /dev/tty2 -- no shell will be provided";
  86.  
  87.     open STDIN, "<&F" or die '';
  88.     open STDOUT, ">&F" or die '';
  89.     open STDERR, ">&F" or die '';
  90.     close F;
  91.  
  92.     c::setsid();
  93.  
  94.     ioctl(STDIN, c::TIOCSCTTY(), 0) or warn "could not set new controlling tty: $!";
  95.  
  96.     exec {"/bin/sh"} "-/bin/sh" or log::l("exec of /bin/sh failed: $!");
  97. }
  98.  
  99. sub shells($) {
  100.     my ($o) = @_;
  101.     my @l = grep { -x "$o->{prefix}$_" } @{$o->{shells}};
  102.     @l ? @l : "/bin/bash";
  103. }
  104.  
  105. sub getAvailableSpace {
  106.     my ($o) = @_;
  107.  
  108.     do { $_->{mntpoint} eq '/usr' and return int($_->{size} * 512 / 1.07) } foreach @{$o->{fstab}};
  109.     do { $_->{mntpoint} eq '/'    and return int($_->{size} * 512 / 1.07) } foreach @{$o->{fstab}};
  110.  
  111.     if ($::testing) {
  112.     my $nb = 1350;
  113.     log::l("taking ${nb}MB for testing");
  114.     return $nb << 20;
  115.     }
  116.     die "missing root partition";
  117. }
  118.  
  119. sub setPackages($) {
  120.     my ($o) = @_;
  121.  
  122.     require pkgs;
  123.     if (is_empty_hash_ref($o->{packages})) {
  124.     my $useHdlist = $o->{method} !~ /nfs|hd/ || $o->{isUpgrade};
  125.     eval { $o->{packages} = pkgs::psUsingHdlist() }  if $useHdlist;
  126.     $o->{packages} = pkgs::psUsingDirectory() if !$useHdlist || $@;
  127.  
  128.     push @{$o->{default_packages}}, "nfs-utils-clients" if $o->{method} eq "nfs";
  129.     push @{$o->{default_packages}}, "numlock" if $o->{miscellaneous}{numlock};
  130.     push @{$o->{default_packages}}, "kernel-secure" if $o->{security} > 3;
  131.     push @{$o->{default_packages}}, "kernel-smp" if $o->{security} <= 3 && detect_devices::hasSMP(); 
  132.     push @{$o->{default_packages}}, "kernel-pcmcia-cs" if $o->{pcmcia};
  133.     push @{$o->{default_packages}}, "apmd" if $o->{pcmcia};
  134.     push @{$o->{default_packages}}, "raidtools" if $o->{raid} && !is_empty_array_ref($o->{raid}{raid});
  135.     push @{$o->{default_packages}}, "cdrecord" if detect_devices::getIDEBurners();
  136.  
  137.     pkgs::getDeps($o->{packages});
  138.  
  139.     my $c; ($o->{compss}, $c) = pkgs::readCompss($o->{packages});
  140.     $o->{compssListLevels} = pkgs::readCompssList($o->{packages}, $c);
  141.     ($o->{compssUsers}, $o->{compssUsersSorted}) = pkgs::readCompssUsers($o->{packages}, $o->{compss});
  142.  
  143.     my @l = ();
  144.     push @l, "kapm" if $o->{pcmcia};
  145.     $_->{values} = [ map { $_ + 50 } @{$_->{values}} ] foreach grep {$_} map { $o->{packages}{$_} } @l;
  146.  
  147.     grep { !$o->{packages}{$_} && log::l("missing base package $_") } @{$o->{base}} and die "missing some base packages";
  148.     } else {
  149.     pkgs::unselect_all($o->{packages});
  150.     }
  151.  
  152.     
  153.     
  154.     unless ($o->{isUpgrade}) {
  155.     do {
  156.         my $p = $o->{packages}{$_} or log::l("missing base package $_"), next;
  157.         pkgs::select($o->{packages}, $p, 1);
  158.     } foreach @{$o->{base}};
  159.     do {
  160.         my $p = $o->{packages}{$_} or log::l("missing add-on package $_"), next;
  161.         pkgs::select($o->{packages}, $p);
  162.     } foreach @{$o->{default_packages}};
  163.     }
  164. }
  165.  
  166. sub selectPackagesToUpgrade($) {
  167.     my ($o) = @_;
  168.  
  169.     require pkgs;
  170.     pkgs::selectPackagesToUpgrade($o->{packages}, $o->{prefix}, $o->{base}, $o->{toRemove}, $o->{toSave});
  171. }
  172.  
  173. sub addToBeDone(&$) {
  174.     my ($f, $step) = @_;
  175.  
  176.     return &$f() if $::o->{steps}{$step}{done};
  177.  
  178.     push @{$::o->{steps}{$step}{toBeDone}}, $f;
  179. }
  180.  
  181. sub getHds {
  182.     my ($o) = @_;
  183.     my ($ok, $ok2) = 1;
  184.  
  185.     my @drives = detect_devices::hds();
  186. #    add2hash_($o->{partitioning}, { readonly => 1 }) if partition_table_raw::typeOfMBR($drives[0]{device}) eq 'system_commander';
  187.  
  188.   getHds: 
  189.     $o->{hds} = catch_cdie { fsedit::hds(\@drives, $o->{partitioning}) }
  190.       sub {
  191.     my ($err) = $@ =~ /(.*) at /;
  192.     $@ =~ /overlapping/ and $o->ask_warn('', $@), return 1;
  193.     $o->ask_okcancel(_("Error"),
  194. [_("I can't read your partition table, it's too corrupted for me :(
  195. I'll try to go on blanking bad partitions"), $err]) unless $o->{partitioning}{readonly};
  196.     $ok = 0; 1 
  197.     };
  198.  
  199.     if (is_empty_array_ref($o->{hds}) && $o->{autoSCSI}) {
  200.     $o->setupSCSI; 
  201.     goto getHds;
  202.     }
  203.  
  204.     ($o->{hds}, $o->{fstab}, $ok2) = fsedit::verifyHds($o->{hds}, $o->{partitioning}{readonly}, $ok);
  205.  
  206.     fs::check_mounted($o->{fstab});
  207.  
  208.     $o->{partitioning}{clearall} and return 1;
  209.     $o->ask_warn('', 
  210. _("DiskDrake failed to read correctly the partition table.
  211. Continue at your own risk!")) if !$ok2 && $ok && !$o->{partitioning}{readonly};
  212.  
  213.     $ok2;
  214. }
  215.  
  216. sub searchAndMount4Upgrade {
  217.     my ($o) = @_;
  218.     my ($root, $found);
  219.  
  220.     my $w = $::beginner && $o->wait_message('', _("Searching root partition."));
  221.  
  222.     
  223.     
  224.     getHds($o);
  225.  
  226.     
  227.     my %Parts = my %parts = map { $_->{device} => $_ } grep { isExt2($_) } @{$o->{fstab}};
  228.     while (keys(%parts) > 0) {
  229.     $root = $::beginner ? first(%parts) : $o->selectRootPartition(keys %parts);
  230.     $root = delete $parts{$root};
  231.  
  232.     my $r; unless ($r = $root->{realMntpoint}) {
  233.         $r = $o->{prefix};
  234.         $root->{mntpoint} = "/"; 
  235.         log::l("trying to mount partition $root->{device}");
  236.         eval { fs::mount_part($root, $o->{prefix}, 'readonly') };
  237.         $r = "/*ERROR*" if $@;
  238.     }
  239.     $found = -d "$r/etc/sysconfig" && [ fs::read_fstab("$r/etc/fstab") ];
  240.  
  241.     unless ($root->{realMntpoint}) {
  242.         log::l("umounting partition $root->{device}");
  243.         eval { fs::umount_part($root, $o->{prefix}) };
  244.     }
  245.  
  246.     last if !is_empty_array_ref($found);
  247.  
  248.     delete $root->{mntpoint};
  249.     $o->ask_warn(_("Information"), 
  250.              _("%s: This is not a root partition, please select another one.", $root->{device})) unless $::beginner;
  251.     }
  252.     is_empty_array_ref($found) and die _("No root partition found");
  253.     
  254.     log::l("found root partition : $root->{device}");
  255.  
  256.     
  257.     if ($root->{realMntpoint}) {
  258.     ($o->{prefix}, $root->{mntpoint}) = ($root->{realMntpoint}, '/');
  259.     } else {
  260.     delete $root->{mntpoint};
  261.     ($Parts{$_->{device}} || {})->{mntpoint} = $_->{mntpoint} foreach @$found;
  262.     map { $_->{mntpoint} = 'swap_upgrade' } grep { isSwap($_) } @{$o->{fstab}}; 
  263.  
  264.     
  265.     fs::mount_all([ grep { isExt2($_) || isSwap($_) } @{$o->{fstab}} ], $o->{prefix});
  266.     }
  267. }
  268.  
  269. sub write_ldsoconf {
  270.     my ($prefix) = @_;
  271.     my $file = "$prefix/etc/ld.so.conf";
  272.  
  273.     
  274.     unless (-s "$file") {
  275.     local *F;
  276.     open F, ">$file" or die "unable to open for writing $file";
  277.     print F "/usr/lib\n";
  278.     }
  279. }
  280.  
  281. sub setAuthentication() {
  282.     my ($shadow, $md5, $nis, $nis_server) = @{$::o->{authentication} || {}}{qw(shadow md5 NIS NIS_server)};
  283.     my $p = $::o->{prefix};
  284.     enableMD5Shadow($p, $shadow, $md5);
  285.     enableShadow() if $shadow;
  286.     if ($nis) {
  287.     pkg_install($::o, "ypbind");
  288.     my $domain = $::o->{netc}{NISDOMAIN};
  289.     $domain || $nis_server ne "broadcast" or die _("Can't use broadcast with no NIS domain");
  290.     my $t = $domain ? "domain $domain" . ($nis_server ne "broadcast" && " server")
  291.                     : "ypserver";
  292.     substInFile {
  293.         $_ = "#~$_" unless /^#/;
  294.         $_ .= "$t $nis_server\n" if eof;
  295.     } "$p/etc/yp.conf";
  296.     network::write_conf("$p/etc/sysconfig/network", $::o->{netc});
  297.     }
  298. }
  299.  
  300. sub enableShadow() {
  301.     my $p = $::o->{prefix};
  302.     run_program::rooted($p, "pwconv")  or log::l("pwconv failed");
  303.     run_program::rooted($p, "grpconv") or log::l("grpconv failed");
  304.  
  305.  
  306.  
  307.  
  308.  
  309.  
  310.  
  311.  
  312.  
  313.  
  314.  
  315. }
  316.  
  317. sub enableMD5Shadow($$$) {
  318.     my ($prefix, $shadow, $md5) = @_;
  319.     substInFile {
  320.     if (/^password.*pam_pwdb.so/) {
  321.         s/\s*shadow//; s/\s*md5//;
  322.         s/$/ shadow/ if $shadow;
  323.         s/$/ md5/ if $md5;
  324.     }
  325.     } grep { -r $_ } map { "$prefix/etc/pam.d/$_" } qw(login rlogin passwd);
  326. }
  327.  
  328. sub crypt($) {
  329.     my ($password) = @_;
  330.  
  331.     $::o->{authentication}{md5} ?
  332.       c::crypt_md5($password, salt(8)) :
  333.          crypt    ($password, salt(2));
  334. }
  335.  
  336. sub lnx4win_preinstall {
  337.     require swap;
  338.     swap::swapon("/dos/lnx4win/swapfile"); 
  339. }
  340. sub lnx4win_postinstall {
  341.     my ($prefix) = @_;
  342.     my $dir = "/dos/lnx4win";
  343.     my $kernel = "$dir/vmlinuz";
  344.     rename $kernel, "$kernel.old";
  345.     commands::dd("if=$prefix/boot/vmlinuz", "of=$kernel");
  346.     run_program::run("rdev", $kernel, "/dev/loop7");
  347.  
  348.     unlink "$dir/size.txt";
  349.     unlink "$dir/swapsize.txt";
  350.  
  351.     mkdir "$prefix/initrd", 0755;
  352.     symlinkf "/initrd/dos", "$prefix/mnt/dos";
  353. }
  354.  
  355. sub killCardServices {
  356.     my $pid = chop_(cat_("/tmp/cardmgr.pid"));
  357.     $pid and kill(15, $pid); 
  358. }
  359.  
  360. sub hdInstallPath() {
  361.     cat_("/proc/mounts") =~ m|/tmp/(\S+)\s+/tmp/hdimage| or return;
  362.     my ($part) = grep { $_->{device} eq $1 } @{$::o->{fstab}};    
  363.     $part->{mntpoint} or grep { $_->{mntpoint} eq "/mnt/hd" } @{$::o->{fstab}} and return;
  364.     $part->{mntpoint} ||= "/mnt/hd";
  365.     $part->{mntpoint} . first(readlink("/tmp/rhimage") =~ m|^/tmp/hdimage/(.*)|);
  366. }
  367.  
  368. sub unlockCdrom() {
  369.     cat_("/proc/mounts") =~ m|/tmp/(\S+)\s+/tmp/rhimage| or return;
  370.     eval { ioctl detect_devices::tryOpen($1), c::CDROM_LOCKDOOR(), 0 };
  371. }
  372. sub ejectCdrom() {
  373.     cat_("/proc/mounts") =~ m|/tmp/(\S+)\s+/tmp/rhimage| or return;
  374.     my $f = eval { detect_devices::tryOpen($1) } or return;
  375.     getFile("XXX"); 
  376.     eval { fs::umount("/tmp/rhimage") };
  377.     ioctl $f, c::CDROMEJECT(), 1;
  378. }
  379.  
  380. sub setupFB {
  381.     my ($o, $vga) = @_;
  382.  
  383.     
  384.     require pkgs;
  385.     pkgs::select($o->{packages}, $o->{packages}{'kernel-fb'});
  386.     pkgs::select($o->{packages}, $o->{packages}{'XFree86-FBDev'});
  387.     $o->installPackages($o->{packages});
  388.  
  389.     $vga ||= 785; 
  390.  
  391.     require lilo;
  392.     
  393.     
  394.     
  395.     foreach (qw(secure smp)) {
  396.     if ($o->{bootloader}{entries}{"/boot/vmlinuz-$_"}) {
  397.         if ($_ eq 'secure') {
  398.         log::l("warning: kernel-secure is not fb, using a kernel-fb instead");
  399.         
  400.         } else {
  401.         $o->{bootloader}{entries}{"/boot/vmlinuz-$_"}{vga} = $vga;
  402.         lilo::install($o->{prefix}, $o->{bootloader});
  403.         return 1;
  404.         }
  405.     }
  406.     }
  407.     my $root = $o->{bootloader}{entries}{'/boot/vmlinuz'}{root};
  408.     if (lilo::add_kernel($o->{prefix}, $o->{bootloader}, kernelVersion(), 'fb',
  409.              {
  410.               label => 'linux-fb',
  411.               root => $root,
  412.               vga => $vga,
  413.              })) {
  414.     $o->{bootloader}{default} = 'linux-fb';
  415.     lilo::install($o->{prefix}, $o->{bootloader});
  416.     } else {
  417.     log::l("unable to install kernel with frame buffer support, disabling");
  418.     return 0;
  419.     }
  420.     1;
  421. }
  422.  
  423. sub auto_inst_file() { ($::g_auto_install ? "/tmp" : "$::o->{prefix}/root") . "/auto_inst.cfg.pl" }
  424.  
  425. sub g_auto_install(;$) {
  426.     my ($f) = @_; $f ||= auto_inst_file;
  427.     my $o = {};
  428.  
  429.     $o->{default_packages} = [ map { $_->{name} } grep { $_->{selected} && !$_->{base} } values %{$::o->{packages}} ];
  430.  
  431.     my @fields = qw(mntpoint type size);
  432.     $o->{partitions} = [ map { my %l; @l{@fields} = @$_{@fields}; \%l } grep { $_->{mntpoint} } @{$::o->{fstab}} ];
  433.     
  434.     exists $::o->{$_} and $o->{$_} = $::o->{$_} foreach qw(lang autoSCSI authentication printer mouse wacom netc timezone superuser intf keyboard mkbootdisk base users installClass partitioning isUpgrade manualFstab nomouseprobe crypto modem useSupermount auto_probe_pci); 
  435.  
  436.     if (my $card = $::o->{X}{card}) {
  437.     $o->{X}{card}{$_} = $card->{$_} foreach qw(default_depth);
  438.     if ($card->{default_depth} and my $depth = $card->{depth}{$card->{default_depth}}) {
  439.         $depth ||= [];
  440.         $o->{X}{card}{resolution_wanted} ||= join "x", @{$depth->[0]} unless is_empty_array_ref($depth->[0]);
  441.     }
  442.     }
  443.  
  444.  
  445.  
  446.     $_ = { %{$_ || {}} }, delete @$_{qw(oldu oldg password password2)} foreach $o->{superuser}, @{$o->{users} || []};
  447.     
  448.     local *F;
  449.     open F, ">$f" or log::l("can't output the auto_install script in $f"), return;
  450.     print F Data::Dumper->Dump([$o], ['$o']), "\0";
  451. }
  452.  
  453. sub loadO {
  454.     my ($O, $f) = @_; $f ||= auto_inst_file;
  455.     my $o;
  456.     if ($f =~ /^(floppy|patch)$/) {
  457.     my $f = $f eq "floppy" ? "auto_inst.cfg" : "patch";
  458.     unless ($::testing) {
  459.         fs::mount(devices::make("fd0"), "/mnt", "vfat", 0);
  460.         $f = "/mnt/$f";
  461.     }
  462.     -e $f or $f .= ".pl";
  463.  
  464.     my $b = before_leaving {
  465.         fs::umount("/mnt") unless $::testing;
  466.         modules::unload($_) foreach qw(vfat fat);
  467.     };
  468.     $o = loadO($O, $f);
  469.     } else {
  470.     -e $f or $f .= ".pl";
  471.     {
  472.         local *F;
  473.         open F, $f or die _("Error reading file $f");
  474.  
  475.         local $/ = "\0";
  476.         no strict;
  477.         eval <F>;
  478.     }
  479.     $@ and log::l _("Bad kickstart file %s (failed %s)", $f, $@);
  480.     add2hash_($o ||= {}, $O);
  481.     }
  482.     bless $o, ref $O;
  483. }
  484.  
  485. sub pkg_install {
  486.     my ($o, $name) = @_;
  487.     require pkgs;
  488.     pkgs::select($o->{packages}, $o->{packages}{$name} || die "$name rpm not found");
  489.     install_steps::installPackages ($o, $o->{packages});
  490. }
  491.  
  492. sub fsck_option() {
  493.     my $y = $::o->{security} < 3 && $::beginner ? "-y " : "";
  494.     substInFile { s/^(\s*fsckoptions="?)(-y )?/$1$y/ } "$::o->{prefix}/etc/rc.d/rc.sysinit";
  495. }
  496.  
  497. sub install_urpmi {
  498.     my ($prefix, $method) = @_;
  499.  
  500.     (my $name = _("installation")) =~ s/\s/_/g; 
  501.  
  502.     my $f = "$prefix/var/lib/urpmi/hdlist.$name";
  503.     {
  504.     my $fd = getFile("hdlist") or return;
  505.     local *OUT;
  506.     open OUT, ">$f" or log::l("failed to write $f"), return;
  507.     local $/ = \ (16 * 1024);
  508.     print OUT foreach <$fd>;
  509.     }
  510.     {
  511.     local *F = getFile("depslist");
  512.     output("$prefix/var/lib/urpmi/depslist", <F>);
  513.     }
  514.     {
  515.     local *LIST;
  516.     open LIST, ">$prefix/var/lib/urpmi/list.$name" or log::l("failed to write list.$name"), return;
  517.  
  518.     my $dir = ${{ nfs => "file://mnt/nfs", 
  519.                       hd => "file:/" . hdInstallPath,
  520.               ftp => $ENV{URLPREFIX},
  521.               http => $ENV{URLPREFIX},
  522.               cdrom => "removable_cdrom_1://mnt/cdrom" }}{$method};
  523.     local *FILES; open FILES, "hdlist2names $f|";
  524.     chop, print LIST "$dir/Mandrake/RPMS/$_\n" foreach <FILES>;
  525.     close FILES or log::l("hdlist2names failed"), return;
  526.  
  527.     run_program::run("gzip", "-9", $f);
  528.  
  529.     $dir .= "/Mandrake/RPMS with ../base/hdlist" if $method =~ /ftp|http/;
  530.     eval { output "$prefix/etc/urpmi/urpmi.cfg", "$name $dir\n" };
  531.     }
  532. }
  533.  
  534. sub list_passwd() {
  535.     my ($e, @l);
  536.  
  537.     setpwent();
  538.     while (@{$e = [ getpwent() ]}) { push @l, $e }
  539.     endpwent();
  540.  
  541.     @l;
  542. }
  543.  
  544. sub list_home() {
  545.     map { $_->[7] } grep { $_->[2] >= 500 } list_passwd();
  546. }
  547. sub list_skels() { "/etc/skel", "/root", list_home() }
  548.  
  549. sub template2userfile($$$$%) {
  550.     my ($prefix, $inputfile, $outputrelfile, $force, %toreplace) = @_;
  551.  
  552.     foreach (list_skels()) {
  553.     my $outputfile = "$prefix/$_/$outputrelfile";
  554.     if (-d dirname($outputfile) && ($force || ! -e $outputfile)) {
  555.         log::l("generating $outputfile from template $inputfile");
  556.         template2file($inputfile, $outputfile, %toreplace);
  557.         m|/home/(.*)| and commands::chown_($1, $outputfile);
  558.     }
  559.     }
  560. }
  561.  
  562. sub update_userkderc($$$) {
  563.     my ($prefix, $cat, $subst) = @_;
  564.  
  565.     foreach (list_skels()) {
  566.     my ($inputfile, $outputfile) = ("$prefix$_/.kderc", "$prefix$_/.kderc.new");
  567.     my %tosubst = (%$subst);
  568.     local *INFILE; local *OUTFILE;
  569.     open INFILE, $inputfile or return;
  570.     open OUTFILE, ">$outputfile" or return;
  571.  
  572.     print OUTFILE map {
  573.         if (my $i = /^\s*\[$cat\]/i ... /^\s*\[/) {
  574.         if (/^\s*(\w*)=/ && $tosubst{lc($1)}) {
  575.             delete $tosubst{lc($1)};
  576.         } else {
  577.             ($i > 1 && /^\s*\[/ && join '', map { delete $tosubst{$_} } keys %tosubst). $_;
  578.         }
  579.         } else {
  580.         $_;
  581.         }
  582.     } <INFILE>;
  583.     print OUTFILE "[$cat]\n", values %tosubst if values %tosubst; 
  584.  
  585.     unlink $inputfile;
  586.     rename $outputfile, $inputfile;
  587.     }
  588. }
  589.  
  590. sub kderc_largedisplay($) {
  591.     my ($prefix) = @_;
  592.  
  593.     update_userkderc($prefix, 'KDE', {
  594.                       contrast => "Contrast=7\n",
  595.                       kfmiconstyle => "kfmIconStyle=Large\n",
  596.                       kpaneliconstyle => "kpanelIconStyle=Normal\n", 
  597.                       kdeiconstyle => "KDEIconStyle=Large\n",
  598.                      });
  599.     foreach (list_skels()) {
  600.     substInFile {
  601.         s/^(GridWidth)=85/$1=100/;
  602.         s/^(GridHeight)=70/$1=75/;
  603.     } "$prefix$_/.kde/share/config/kfmrc" 
  604.     }
  605. }
  606.  
  607. sub kdelang_postinstall($) {
  608.     my ($prefix) = @_;
  609.     my %i18n = getVarsFromSh("$prefix/etc/sysconfig/i18n");
  610.  
  611.     
  612.     update_userkderc($prefix, 'Locale', { language => "Language=\n" });
  613. }
  614.  
  615. sub kdeicons_postinstall($) {
  616.     my ($prefix) = @_;
  617.  
  618.     
  619.     
  620.     local *F;
  621.     open F, "$prefix/etc/fstab" or log::l("failed to read $prefix/etc/fstab"), return;
  622.  
  623.     foreach (<F>) {
  624.     if (m|^/dev/(\S+)\s+/mnt/cdrom(\d*)\s+|) {
  625.         my %toreplace = ( device => $1, id => $2 );
  626.         template2userfile($prefix, "/usr/share/cdrom.fsdev.kdelnk.in", "Desktop/Cd-Rom". ($2 && " $2") .".kdelnk",
  627.                   1, %toreplace);
  628.     } elsif (m|^/dev/(\S+)\s+/mnt/zip(\d*)\s+|) {
  629.         my %toreplace = ( device => $1, id => $2 );
  630.         template2userfile($prefix, "/usr/share/zip.fsdev.kdelnk.in", "Desktop/Zip". ($2 && " $2") .".kdelnk",
  631.                   1, %toreplace);
  632.     } elsif (m|^/dev/(\S+)\s+/mnt/floppy(\d*)\s+|) {
  633.         my %toreplace = ( device => $1, id => $2 );
  634.         template2userfile($prefix, "/usr/share/floppy.fsdev.kdelnk.in", "Desktop/Floppy". ($2 && " $2") .".kdelnk",
  635.                   1, %toreplace);
  636.     } elsif (m|^/mnt/cdrom(\d*)\s+/mnt/cdrom\d*\s+supermount|) {
  637.         my %toreplace = ( id => $1 );
  638.         template2userfile($prefix, "/usr/share/cdrom.kdelnk.in", "Desktop/Cd-Rom". ($1 && " $1") .".kdelnk",
  639.                   1, %toreplace);
  640.     } elsif (m|^/mnt/zip(\d*)\s+/mnt/zip\d*\s+supermount|) {
  641.         my %toreplace = ( id => $1 );
  642.         template2userfile($prefix, "/usr/share/zip.kdelnk.in", "Desktop/Zip". ($1 && " $1") .".kdelnk",
  643.                   1, %toreplace);
  644.     } elsif (m|^/mnt/floppy(\d*)\s+/mnt/floppy\d*\s+supermount|) {
  645.         my %toreplace = ( id => $1 );
  646.         template2userfile($prefix, "/usr/share/floppy.kdelnk.in", "Desktop/Floppy". ($1 && " $1") .".kdelnk",
  647.                   1, %toreplace);
  648.     } elsif (m|^/dev/(\S+)\s+(/mnt/DOS_\S*)\s+|) {
  649.         my %toreplace = ( device => $1, id => $1, mntpoint => $2 );
  650.         template2userfile($prefix, "/usr/share/Dos_.kdelnk.in", "Desktop/Dos_$1.kdelnk", 1, %toreplace);
  651.         symlink "hd_umount.xpm", "$prefix/usr/share/icons/hd_unmount.xpm";
  652.         symlink "hd_umount.xpm", "$prefix/usr/share/icons/large/hd_unmount.xpm";
  653.     } elsif (m|^/dev/(\S+)\s+(\S*)\s+vfat\s+|) {
  654.         my %toreplace = ( device => $1, id => $1, mntpoint => $2 );
  655.         template2userfile($prefix, "/usr/share/Dos_.kdelnk.in", "Desktop/Dos_$1.kdelnk", 1, %toreplace);
  656.         symlink "hd_umount.xpm", "$prefix/usr/share/icons/hd_unmount.xpm";
  657.         symlink "hd_umount.xpm", "$prefix/usr/share/icons/large/hd_unmount.xpm";
  658.     }
  659.     }
  660.  
  661.     my @l = map { "$prefix$_/Desktop/Doc.kdelnk" } list_skels();
  662.     if (my ($lang) = eval { all("$prefix/usr/doc/mandrake") }) {
  663.     substInFile { s|^(URL=.*?)/?$|$1/$lang| } @l;
  664.     substInFile { s|^(url=/usr/doc/mandrake/)$|$1$lang/index.html| } "$prefix/usr/lib/desktop-links/mandrake.links";
  665.     } else {
  666.     unlink @l;
  667.     substInFile { $_ = '' if /^\[MDKsupport\]$/ .. /^\s*$/ } "$prefix/usr/lib/desktop-links/mandrake.links";
  668.     }
  669.  
  670.     my $lang = quotemeta $ENV{LANG};
  671.     foreach my $dir (map { "$prefix$_/Desktop" } list_skels()) {
  672.     -d $dir or next;
  673.     foreach (grep { /\.kdelnk$/ } all($dir)) {
  674.         cat_("$dir/$_") =~ /^Name\[$lang\]=(.{2,14})$/m
  675.           and rename "$dir/$_", "$dir/$1.kdelnk";
  676.     }
  677.     }
  678. }
  679.  
  680. sub move_desktop_file($) {
  681.     my ($prefix) = @_;
  682.     my @toMove = qw(doc.kdelnk news.kdelnk updates.kdelnk home.kdelnk printer.kdelnk floppy.kdelnk cdrom.kdelnk FLOPPY.kdelnk CDROM.kdelnk);
  683.  
  684.     foreach (list_skels()) {
  685.     my $dir = "$prefix$_";
  686.     if (-d "$dir/Desktop") {
  687.         my @toSubst = glob_("$dir/Desktop/*rpmorig");
  688.  
  689.         push @toSubst, "$dir/Desktop/$_" foreach @toMove;
  690.  
  691.         
  692.         
  693.         foreach (@toSubst) {
  694.         if (-e $_) {
  695.             my $basename = basename($_);
  696.  
  697.             unlink "$dir/Desktop/Trash/$basename";
  698.             rename $_, "$dir/Desktop/Trash/$basename";
  699.         }
  700.         }
  701.     }
  702.     }
  703. }
  704.  
  705. 1;
  706.