diff options
Diffstat (limited to 'perl-install')
| -rw-r--r-- | perl-install/Makefile | 18 | ||||
| -rw-r--r-- | perl-install/c/Makefile.PL | 2 | ||||
| -rw-r--r-- | perl-install/common.pm | 7 | ||||
| -rw-r--r-- | perl-install/fsedit.pm | 56 | ||||
| -rwxr-xr-x | perl-install/getpkgs_deps | 10 | ||||
| -rwxr-xr-x | perl-install/install2 | 3 | ||||
| -rw-r--r-- | perl-install/install2.pm | 12 | ||||
| -rw-r--r-- | perl-install/install_any.pm | 2 | ||||
| -rw-r--r-- | perl-install/lang.pm | 12 | ||||
| -rw-r--r-- | perl-install/my_gtk.pm | 18 | ||||
| -rw-r--r-- | perl-install/partition_table.pm | 3 | ||||
| -rw-r--r-- | perl-install/pkgs.pm | 125 |
12 files changed, 175 insertions, 93 deletions
diff --git a/perl-install/Makefile b/perl-install/Makefile index 3b401fa1e..d4aec1cdb 100644 --- a/perl-install/Makefile +++ b/perl-install/Makefile @@ -1,6 +1,7 @@ SO_FILES = c/blib/arch/auto/c/c.so PMS = *.pm c/*.pm resize_fat/*.pm po/*.pm commands install2 diskdrake -DEST = /tmp/t/Mandrake/instimage +ROOTDEST = /tmp/t +DEST = $(ROOTDEST)/Mandrake/instimage DESTREP4PMS = $(DEST)/usr/bin/perl-install PERL = perl LOCALFILES = $(PERL) mouseconfig @@ -50,6 +51,9 @@ test_pms: verify_c verify_c: ./verify_c $(PMS) +depslist: + ./gendepslist > $(ROOTDEST)/Mandrake/base/depslist + install_pms: all for i in `perl -ne 's/sub (\w+?)_? {.*/$$1/ and print' commands.pm`; do ln -sf commands $(DEST)/usr/bin/$$i; done @@ -110,8 +114,9 @@ get_needed_files: $(SO_FILES) cp -a keymaps $(DEST)/usr/share cp -a consolefonts $(DEST)/usr/share - echo -e "#!/usr/bin/perl\n\nsymlink '/tmp/rhimage/usr/lib/perl5', '/usr/lib/perl5';\nexec '/usr/bin/sh'" > $(DEST)/usr/bin/runinstall2 - chmod a+x $(DEST)/usr/bin/runinstall2 + ln -s install2 $(DEST)/usr/bin/runinstall2 +# echo -e "#!/bin/sh\n\nexec '/usr/bin/sh'" > $(DEST)/usr/bin/runinstall2 +# chmod a+x $(DEST)/usr/bin/runinstall2 as_root: /bin/dd if=/dev/zero of=/tmp/initrd bs=1k count=4000 @@ -128,17 +133,16 @@ full_stage2: stage2: $(MAKE) install_pms - cd /tmp/t ; tar cfz /tmp/instimage-full.tgz Mandrake - cd /tmp/t ; tar cfz /tmp/instimage-light.tgz Mandrake/instimage/usr/[bl]* + cd $(ROOTDEST) ; tar cfz /tmp/instimage-full.tgz Mandrake + cd $(ROOTDEST) ; tar cfz /tmp/instimage-light.tgz Mandrake/instimage/usr/[bl]* @#rm -rf /mnt/initrd/* @#cp -a $(DEST)/* /mnt/initrd @#sync @#dd if=/dev/loop0 | gzip -9 > /tmp/t/Mandrake/base/stage2.img - # function f() { grep "$*" /usr/include/*.h /usr/include/*/*.h; } -# dd if=/dev/zero of=/tmp/initrd bs=1k count=2000 ; echo y | mke2fs /tmp/initrd ; mount /tmp/initrd /mnt/disk/ -o loop ; cp -a /tmp/disk/* /mnt/disk/ ; umount /mnt/disk ; gzip -c /tmp/initrd > /tmp/initrd.img ; mcopy -o /tmp/initrd.img a: +# dd if=/dev/zero of=/tmp/initrd bs=1k count=2000 ; echo y | mke2fs /tmp/initrd ; mount /tmp/initrd /mnt/disk/ -o loop ; cd ~pixel/gi/perl-install ; install -s install/local-install install1/bin/install ; cp -a install1/* /mnt/disk/ ; umount /mnt/disk ; gzip -c /tmp/initrd > /tmp/initrd.img ; mcopy -o /tmp/initrd.img a: # mount /tmp/initrd /mnt/disk/ -o loop ; ; umount /mnt/disk ; gzip -c /tmp/initrd > /tmp/initrd.img ; mcopy -o /tmp/initrd.img a: diff --git a/perl-install/c/Makefile.PL b/perl-install/c/Makefile.PL index f9d2309f8..4ed352603 100644 --- a/perl-install/c/Makefile.PL +++ b/perl-install/c/Makefile.PL @@ -6,5 +6,5 @@ WriteMakefile( 'VERSION_FROM' => 'c.pm', # finds $VERSION 'LIBS' => ['-lrpm -ldb1 -lz -L/usr/X11R6/lib -lX11 -lgdk'], # e.g., '-lm' 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' - 'INC' => '-Wall `gtk-config --cflags`', # e.g., '-I/usr/include/other' + 'INC' => '-I/usr/include/rpm -Wall `gtk-config --cflags`', # e.g., '-I/usr/include/other' ); diff --git a/perl-install/common.pm b/perl-install/common.pm index c15aafdae..feec2e844 100644 --- a/perl-install/common.pm +++ b/perl-install/common.pm @@ -6,7 +6,7 @@ use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK $printable_chars $sizeof_int $bitof_int @ISA = qw(Exporter); %EXPORT_TAGS = ( - common => [ qw(_ __ min max bool member divide is_empty_array_ref round_up round_down first top translate) ], + common => [ qw(_ __ min max bool member divide is_empty_array_ref set_new set_add round_up round_down first second top uniq translate) ], file => [ qw(dirname basename all glob_ cat_ chop_ mode) ], system => [ qw(sync makedev unmakedev psizeof strcpy gettimeofday syscall_ crypt_) ], constant => [ qw($printable_chars $sizeof_int $bitof_int $SECTORSIZE) ], @@ -25,7 +25,9 @@ sub __ { $_[0] } sub min { my $min = shift; grep { $_ < $min and $min = $_; } @_; $min } sub max { my $max = shift; grep { $_ > $max and $max = $_; } @_; $max } sub first { $_[0] } +sub second { $_[1] } sub top { $_[$#_] } +sub uniq { my %l; @l{@_} = (); keys %l } sub member { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 } sub dirname { @_ == 1 or die "usage: dirname <name>\n"; local $_ = shift; s|[^/]*/*\s*$||; s|(.)/*$|$1|; $_ || '.' } sub basename { @_ == 1 or die "usage: basename <name>\n"; local $_ = shift; s|/*\s*$||; s|.*/||; $_ } @@ -38,6 +40,9 @@ sub round_up { my ($i, $r) = @_; $i += $r - ($i + $r - 1) % $r - 1; } sub round_down { my ($i, $r) = @_; $i -= $i % $r; } sub is_empty_array_ref { my $a = shift; !defined $a || @$a == 0 } +sub set_new(@) { my %l; @l{@_} = undef; { list => [ @_ ], hash => \%l } } +sub set_add($@) { my $o = shift; foreach (@_) { exists $o->{hash}->{$_} and next; push @{$o->{list}}, $_; $o->{hash}->{$_} = undef } } + sub sync { syscall_('sync') } sub gettimeofday { my $t = pack "LL"; syscall_('gettimeofday', $t, 0) or die "gettimeofday failed: $!\n"; unpack("LL", $t) } diff --git a/perl-install/fsedit.pm b/perl-install/fsedit.pm index 8e511c8b9..7406211e7 100644 --- a/perl-install/fsedit.pm +++ b/perl-install/fsedit.pm @@ -25,6 +25,11 @@ my @suggestions = ( 1; +sub suggestions_mntpoint($) { + my ($hds) = @_; + grep { !/swap/ && !has_mntpoint($_, $hds) } map { $_->{mntpoint} } @suggestions; +} + sub hds($$) { my ($drives, $flags) = @_; my @hds; @@ -58,13 +63,11 @@ sub suggest_part($$$;$) { $suggestions ||= \@suggestions; foreach (@$suggestions) { $_->{minsize} ||= $_->{size} } - my $has_swap; - my @mntpoints = map { $has_swap ||= isSwap($_); $_->{mntpoint} } get_fstab(@$hds); - my %mntpoints; @mntpoints{@mntpoints} = undef; + my $has_swap = grep { isSwap($_) } get_fstab(@$hds); my ($best, $second) = grep { $part->{size} >= $_->{minsize} } - grep { !exists $mntpoints{$_->{mntpoint}} || isSwap($_) && !$has_swap } + grep { ! has_mntpoint($_->{mntpoint}, $hds) || isSwap($_) && !$has_swap } @$suggestions or return; $best = $second if @@ -100,27 +103,31 @@ sub suggest_part($$$;$) { #} +sub has_mntpoint($$) { + my ($mntpoint, $hds) = @_; + scalar grep { $mntpoint eq $_->{mntpoint} } get_fstab(@$hds); +} -sub checkMountPoint($$) { -# my $type = shift; -# local $_ = shift; -# -# m|^/| or die "The mount point $_ is illegal.\nMount points must begin with a leading /"; +sub check_mntpoint($$) { + my ($mntpoint, $hds) = @_; + + $mntpoint eq '' and return; + + local $_ = $mntpoint; + m|^/| or die _("Mount points must begin with a leading /"); # m|(.)/$| and die "The mount point $_ is illegal.\nMount points may not end with a /"; -# c::isprint($_) or die "The mount point $_ is illegal.\nMount points must be made of printable characters (no accents...)"; -# -# foreach my $dev (qw(/dev /bin /sbin /etc /lib)) { -# /^$dev/ and die "The $_ directory must be on the root filesystem.", -# } -# -# if ($type eq 'linux_native') { -# $_ eq '/'; and return 1; -# foreach my $r (qw(/var /tmp /boot /root)) { -# /^$r/ and return 1; -# } -# die "The mount point $_ is illegal.\nSystem partitions must be on Linux Native partitions"; -# } -# 1; + + has_mntpoint($mntpoint, $hds) and die _("There is already a partition with mount point %s", $mntpoint); +} + +sub add($$$) { + my ($hd, $part, $hds) = @_; + + isSwap($part) ? + ($part->{mntpoint} = 'swap') : + check_mntpoint($part->{mntpoint}, $hds); + + partition_table::add($hd, $part); } sub removeFromList($$$) { @@ -183,9 +190,8 @@ sub allocatePartitions($$) { sub auto_allocate($;$) { my ($hds, $suggestions) = @_; - my %mntpoints; map { $mntpoints{$_->{mntpoint}} = 1 } get_fstab(@$hds); allocatePartitions($hds, [ - grep { ! $mntpoints{$_->{mntpoint}} } + grep { ! has_mntpoint($_->{mntpoint}, $hds) } @{ $suggestions || \@suggestions } ]); map { partition_table::assign_device_numbers($_) } @$hds; diff --git a/perl-install/getpkgs_deps b/perl-install/getpkgs_deps new file mode 100755 index 000000000..bc2d5e0e8 --- /dev/null +++ b/perl-install/getpkgs_deps @@ -0,0 +1,10 @@ +#!/usr/bin/perl + +use diagnostics; +use strict; + +use lib qw(/usr/bin/perl-install . c c/blib/arch); +use pkgs_deps; +use pkgs; + +pkgs_deps::main(pkgs::psUsingDirectory()); diff --git a/perl-install/install2 b/perl-install/install2 index c8ae2ce9b..016bafabc 100755 --- a/perl-install/install2 +++ b/perl-install/install2 @@ -3,7 +3,8 @@ use diagnostics; use strict; -use lib qw(. c c/blib/arch); +use lib qw(/usr/bin/perl-install . c c/blib/arch); use install2; install2::main(@ARGV); + diff --git a/perl-install/install2.pm b/perl-install/install2.pm index 442ad4cf0..049331533 100644 --- a/perl-install/install2.pm +++ b/perl-install/install2.pm @@ -24,7 +24,7 @@ $INSTALL_VERSION = 0; my @installStepsFields = qw(text help skipOnCancel skipOnLocal prev next); my @installSteps = ( - selectLanguage => [ "Choose your language", "help", 0, 0 ], + selectLanguage => [ __("Choose your language"), "help", 0, 0 ], selectPath => [ __("Choose install or upgrade"), __("help"), 0, 0 ], selectInstallClass => [ __("Select installation class"), __("help"), 0, 0 ], setupSCSI => [ __("Setup SCSI"), __("help"), 0, 1 ], @@ -98,10 +98,10 @@ my $default = { installClass => 'Server', bootloader => { onmbr => 1, linear => 0 }, mkbootdisk => 0, - base => [ qw(basesystem mkbootdisk linuxconf anacron linux_logo rhs-hwdiag utempter ldconfig chkconfig ntsysv mktemp setup setuptool filesystem MAKEDEV SysVinit ash at authconfig bash bdflush binutils console-tools cpio crontabs dev diffutils e2fsprogs ed eject etcskel file fileutils findutils getty_ps gpm grep groff gzip hdparm info initscripts isapnptools kbdconfig kernel less ldconfig lilo logrotate losetup mailcap mailx man mkinitrd mingetty modutils mount mouseconfig net-tools passwd kernel-pcmcia-cs procmail procps psmisc pump mandrake-release rootfiles rpm sash sed setconsole setserial shadow-utils sh-utils slocate stat sysklogd tar termcap textutils time timeconfig tmpwatch util-linux vim-minimal vixie-cron which) ], + base => [ qw(basesystem console-tools mkbootdisk linuxconf anacron linux_logo rhs-hwdiag utempter ldconfig chkconfig ntsysv mktemp setup setuptool filesystem MAKEDEV SysVinit ash at authconfig bash bdflush binutils console-tools crontabs dev e2fsprogs ed etcskel file fileutils findutils getty_ps gpm grep groff gzip hdparm info initscripts isapnptools kbdconfig kernel less ldconfig lilo logrotate losetup man mkinitrd mingetty modutils mount net-tools passwd procmail procps psmisc mandrake-release rootfiles rpm sash sed setconsole setserial shadow-utils sh-utils slocate stat sysklogd tar termcap textutils time timeconfig tmpwatch util-linux vim-minimal vixie-cron which) ], comps => [ - [ 1, __('X Window System') => qw(XFree86 XFree86-xfs XFree86-75dpi-fonts) ], - [ 1, __('KDE') => qw(kdeadmin kdebase kthememgr kdegames kjumpingcube kdegraphics kdelibs kdemultimedia kdenetwork kdesupport kdeutils kBeroFTPD kdesu kdetoys kpilot kcmlaptop kdpms kpppload kmpg) ], + [ 0, __('X Window System') => qw(XFree86 XFree86-xfs XFree86-75dpi-fonts) ], + [ 0, __('KDE') => qw(kdeadmin kdebase kthememgr kdegames kjumpingcube kdegraphics kdelibs kdemultimedia kdenetwork kdesupport kdeutils kBeroFTPD kdesu kdetoys kpilot kcmlaptop kdpms kpppload kmpg) ], [ 0, __('Console Multimedia') => qw(aumix audiofile esound sndconfig awesfx rhsound cdp mpg123 svgalib playmidi sox mikmod) ], [ 0, __('CD-R burning and utilities') => qw(mkisofs cdrecord cdrecord-cdda2wav cdparanoia xcdroast) ], [ 0, __('Games') => qw(xbill xboard xboing xfishtank xgammon xjewel xpat2 xpilot xpuzzles xtrojka xkobo freeciv) ], @@ -197,10 +197,12 @@ sub findInstallFiles { c::rpmReadConfigFiles() or die "can't read rpm config files"; log::l("\tdone"); - $o->{packages} = pkgs::psFromHeaderListFile(install_any::imageGetFile("hdlist")); + $o->{packages} = pkgs::psUsingDirectory(); + pkgs::getDeps($o->{packages}); } sub choosePackages { + foreach (@{$o->{default}->{base}}) { pkgs::select($o->{packages}, $_) } $o->choosePackages($o->{packages}, $o->{comps}); my @p = @{$o->{default}->{base}}, grep { $_->{selected} } @{$o->{comps}}; diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm index f7bac3580..74e6b2a01 100644 --- a/perl-install/install_any.pm +++ b/perl-install/install_any.pm @@ -15,7 +15,7 @@ use log; 1; -sub fileInBase { member($_[0], qw(hdlist comps)); } +sub fileInBase { member($_[0], qw(hdlist comps depslist)); } sub imageGetFile { fileInBase($_[0]) and return "/tmp/rhimage/Mandrake/base/$_[0]"; diff --git a/perl-install/lang.pm b/perl-install/lang.pm index 54e75bcd8..3385248d6 100644 --- a/perl-install/lang.pm +++ b/perl-install/lang.pm @@ -8,6 +8,7 @@ use commands; use cpio; use log; +my @fields = my %languages = ( "en" => [ "English", undef, undef, "en_US" ], "fr" => [ "French", "lat0-sun16", "iso15", "fr_FR" ], @@ -60,14 +61,15 @@ sub write { &$f("LANG", $lang); &$f("LINGUAS", $lang); if (my $l = $languages{$lang}) { - &$f("LC_ALL", $l->{lc_all}); - &$f("SYSFONT", $l->{font}); - &$f("SYSFONTACM", $l->{map}); + &$f("LC_ALL", $l->[3]); + $l->[1] or return; + &$f("SYSFONT", $l->[1]); + &$f("SYSFONTACM", $l->[2]); my $p = "$prefix/usr/lib/kbd"; commands::cp("-f", - "$p/consolefonts/$l->{font}.psf.gz", - glob_("$p/consoletrans/$l->{map}*"), + "$p/consolefonts/$l->[1].psf.gz", + glob_("$p/consoletrans/$l->[2]*"), "$prefix/etc/sysconfig/console"); } } diff --git a/perl-install/my_gtk.pm b/perl-install/my_gtk.pm index b7a3405f5..c2f0166bf 100644 --- a/perl-install/my_gtk.pm +++ b/perl-install/my_gtk.pm @@ -127,8 +127,8 @@ sub create_okcancel($;$$) { my ($w, $ok, $cancel) = @_; gtkadd(create_hbox(), - gtksignal_connect($w->{ok} = new Gtk::Button($ok || "Ok"), "clicked" => sub { $w->{retval} = 1; Gtk->main_quit }), - gtksignal_connect(new Gtk::Button($cancel || "Cancel"), "clicked" => sub { $w->{retval} = 0; Gtk->main_quit }), + gtksignal_connect($w->{ok} = new Gtk::Button($ok || _("Ok")), "clicked" => $w->{ok_clicked} || sub { $w->{retval} = 1; Gtk->main_quit }), + gtksignal_connect(new Gtk::Button($cancel || _("Cancel")), "clicked" => $w->{cancel_clicked} || sub { $w->{retval} = 0; Gtk->main_quit }), ); } @@ -221,8 +221,8 @@ sub _create_window($$) { ################################################################################ sub ask_warn { my $w = my_gtk->new(shift @_); $w->_ask_warn(@_); main($w); } -sub ask_yesorno { my $w = my_gtk->new(shift @_); $w->_ask_okcancel(@_, "Yes", "No"); main($w); } -sub ask_okcancel { my $w = my_gtk->new(shift @_); $w->_ask_okcancel(@_, "Is it ok?", "Ok", "Cancel"); main($w); } +sub ask_yesorno { my $w = my_gtk->new(shift @_); $w->_ask_okcancel(@_, _("Yes"), _("No")); main($w); } +sub ask_okcancel { my $w = my_gtk->new(shift @_); $w->_ask_okcancel(@_, _("Is it ok?"), _("Ok"), _("Cancel")); main($w); } sub ask_from_entry { my $w = my_gtk->new(shift @_); $w->_ask_from_entry(@_); main($w); } sub ask_from_list { my $w = my_gtk->new(shift @_); $w->_ask_from_list(pop @_, @_); main($w); } @@ -230,15 +230,13 @@ sub _ask_from_entry($$@) { my ($o, @msgs) = @_; my $entry = new Gtk::Entry; my $f = sub { $o->{retval} = $entry->get_text; Gtk->main_quit }; + $o->{ok_clicked} = $f; + $o->{cancel_clicked} = sub { $o->{retval} = undef; Gtk->main_quit }; gtkadd($o->{window}, gtkpack($o->create_box_with_title(@msgs), gtksignal_connect($entry, 'activate' => $f), - ($o->{hide_buttons} ? () : gtkpack(new Gtk::HBox(0,0), - gtksignal_connect(new Gtk::Button('Ok'), 'clicked' => $f), - gtksignal_connect(new Gtk::Button('Cancel'), 'clicked' => sub { $o->{retval} = undef; Gtk->main_quit }), - )), - ), + ($o->{hide_buttons} ? () : create_okcancel($o))), ); $entry->grab_focus(); } @@ -295,7 +293,7 @@ sub _ask_warn($@) { my ($o, @msgs) = @_; gtkadd($o->{window}, gtkpack($o->create_box_with_title(@msgs), - gtksignal_connect(my $w = new Gtk::Button("Ok"), "clicked" => sub { Gtk->main_quit }), + gtksignal_connect(my $w = new Gtk::Button(_("Ok")), "clicked" => sub { Gtk->main_quit }), ), ); $w->grab_focus(); diff --git a/perl-install/partition_table.pm b/perl-install/partition_table.pm index 3ebd47122..3f46e7ea7 100644 --- a/perl-install/partition_table.pm +++ b/perl-install/partition_table.pm @@ -286,6 +286,9 @@ sub add($$) { raw_add($hd->{primary}->{raw}, $part); @{$hd->{primary}->{normal}} = $part; } else { + $hd->{primary}->{extended} && !verifyInside($part, $hd->{primary}->{extended}) + and die "sorry, can't add outside the main extended partition"; + foreach (@{$hd->{extended}}) { $_->{normal} and next; raw_add($_->{raw}, $part); diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm index 34a5774c9..9d9894031 100644 --- a/perl-install/pkgs.pm +++ b/perl-install/pkgs.pm @@ -19,59 +19,108 @@ my @skipThesesPackages = qw(XFree86-8514 XFree86-AGX XFree86-Mach32 XFree86-Mach sub skipThisPackage { member($_[0], @skipThesesPackages) } -sub addInfosFromHeader($$) { - my ($packages, $header) = @_; + +sub Package { + my ($packages, $name) = @_; + $packages->{$name} or die "unknown package $name"; +} +sub select($$) { + my ($packages, $name) = @_; + my $p = Package($packages, $name); + $p->{selected} = -1; # selected by user + my @l = @{$p->{deps}}; + while (@l) { + my $n = shift @l; + my $i = Package($packages, $n); + push @l, @{$i->{deps}} unless $i->{selected}; + $i->{selected}++ unless $i->{selected} == -1; + } +} +sub unselect($$) { + my ($packages, $name) = @_; + my $p = Package($packages, $name); + my $set = set_new($name); + my $l = $set->{list}; + + # get the list of provided packages + foreach my $q (@$l) { + my $i = Package($packages, $q); + $i->{selected} or next; + $i->{selected} = 1; # that way, its counter will be zero the first time + set_add($set, @{$i->{provides} || []}); + } + + while (@$l) { + my $n = shift @$l; + my $i = Package($packages, $n); + + $i->{selected} <= 0 and next; + if (--$i->{selected} == 0) { + push @$l, @{$i->{deps}}; + } + } + + # garbage collect for circular dependencies + my $changed = 1; + while ($changed) { + $changed = 0; + NEXT: foreach my $p (grep { $_->{selected} > 0 } values %$packages) { + my $set = set_new(@{$p->{provides}}); + foreach (@{$set->{list}}) { + my $q = Package($packages, $_); + $q->{selected} == -1 and next NEXT; + set_add($set, @{$q->{provides}}) if $q->{selected}; + } + $p->{selected} = 0; + $changed = 1; + } + } +} +sub toggle($$) { + my ($packages, $name) = @_; + Package($packages, $name)->{selected} ? unselect($packages, $name) : &select($packages, $name); +} +sub set($$$) { + my ($packages, $name, $val) = @_; + $val ? &select($packages, $name) : unselect($packages, $name); +} + +sub addInfosFromHeader($$;$) { + my ($packages, $header, $file) = @_; my $name = c::headerGetEntry($header, 'name'); $packages->{$name} = { - name => $name, + name => $name, file => $file, selected => 0, deps => [], header => $header, size => c::headerGetEntry($header, 'size'), - group => c::headerGetEntry($header, 'group') || "(unknown group)", }; } -sub psUsingDirectory { +sub psUsingDirectory(;$) { my ($dirname) = @_; my %packages; + $dirname ||= install_any::imageGetFile(''); log::l("scanning $dirname for packages"); foreach (glob_("$dirname/*.rpm")) { - my $basename = basename($_); local *F; open F, $_ or log::l("failed to open package $_: $!"); - my $header = c::rpmReadPackageHeader($_) or log::l("failed to rpmReadPackageHeader $basename: $!"); + my $header = c::rpmReadPackageHeader(fileno F) or log::l("failed to rpmReadPackageHeader $_: $!"); my $name = c::headerGetEntry($header, 'name'); - addInfosFromHeader(\%packages, $header); + addInfosFromHeader(\%packages, $header, $_); } \%packages; } -sub psVerifyDependencies { -# my ($packages, $fixup) = @_; -# -# -r "/mnt/var/lib/rpm/packages.rpm" or die "can't find packages.rpm"; -# -# my $db = rpmdbOpenRWCreate("/mnt"); -# my $rpmdeps = rpmtransCreateSet($db, undef); -# -# foreach (values %$packages) { -# $_->{selected} ? -# c::rpmtransAddPackage($rpmdeps, $_->{header}, undef, $_, 0, undef) : -# c::rpmtransAvailablePackage($rpmdeps, $_->{header}, $_); -# } -# my @conflicts = c::rpmdepCheck($rpmdeps); -# -# rpmtransFree($rpmdeps); -# rpmdbClose($db); -# -# if ($fixup) { -# foreach (@conflicts) { -# $_->{suggestedPackage}->{selected} = 1; -# } -# rpmdepFreeConflicts(@conflicts); -# } -# -# 1; +sub getDeps($) { + my ($packages) = @_; + + local *F; + open F, install_any::imageGetFile("depslist"); # or die "can't find dependencies list"; + foreach (<F>) { + my ($name, @deps) = split; + Package($packages, $name)->{deps} = \@deps; + map { push @{Package($packages, $_)->{provides}}, $name } @deps; + } } sub psFromHeaderListDesc { @@ -130,9 +179,11 @@ sub install { my ($total, $nb); foreach my $p (@$toInstall) { - my $fullname = sprintf "%s-%s-%s.%s.rpm", - map { c::headerGetEntry($p->{header}, $_) } qw(name version release arch); - c::rpmtransAddPackage($trans, $p->{header}, install_any::imageGetFile($fullname) , $isUpgrade); + $p->{file} ||= + install_any::imageGetFile(sprintf "%s-%s-%s.%s.rpm", + map { c::headerGetEntry($p->{header}, $_) } + qw(name version release arch)); + c::rpmtransAddPackage($trans, $p->{header}, $p->{file}, $isUpgrade); $nb++; $total += $p->{size}; } |