diff options
-rw-r--r-- | perl-install/ChangeLog | 16 | ||||
-rw-r--r-- | perl-install/install_any.pm | 1 | ||||
-rw-r--r-- | perl-install/pkgs.pm | 8 | ||||
-rwxr-xr-x | tools/closurepkgs | 52 | ||||
-rwxr-xr-x | tools/syncrpms | 200 |
5 files changed, 272 insertions, 5 deletions
diff --git a/perl-install/ChangeLog b/perl-install/ChangeLog index 06f1f5a71..7237ea35d 100644 --- a/perl-install/ChangeLog +++ b/perl-install/ChangeLog @@ -1,3 +1,14 @@ +2000-03-13 Fran�ois Pons <fpons@mandrakesoft.com> + + * pkgs.pm, install_any.pm: small correction for multiple media + installation. + * tools/syncrpms: added for handling synchronisation of multiple source + rpm directories (and multiple target), include cleaning. + * tools/closurepkgs: tools to get rpm that may be installed by DrakX + after normal packages installation (printer, network, X11...), may + be used to duplicate on other CD some important stuff of the first + one. + 2000-03-11 Pixel <pixel@mandrakesoft.com> * devices.pm (set_loop): created, searches for an available @@ -9,6 +20,11 @@ message, otherwise silly gtk won't do anything and we'll wait forever :( +2000-03-10 Fran�ois Pons <fpons@mandrakesoft.com> + + * *.pm: heavy modification to take into account multiple media + installation. + 2000-03-10 Pixel <pixel@mandrakesoft.com> * install2.pm (@install_classes): cleanup, no more i18n (is now in diff --git a/perl-install/install_any.pm b/perl-install/install_any.pm index 41a46f93b..1b908e062 100644 --- a/perl-install/install_any.pm +++ b/perl-install/install_any.pm @@ -35,7 +35,6 @@ use log; $current_medium = ''; $asked_medium = ''; %refused_media = (); -sub medium() { $current_medium } sub useMedium($) { $asked_medium eq $_[0] or log::l("selecting new medium $_[0]"); $asked_medium = $_[0] } sub changeMedium($$) { my ($method, $medium) = @_; diff --git a/perl-install/pkgs.pm b/perl-install/pkgs.pm index c6d7f402e..43dca813c 100644 --- a/perl-install/pkgs.pm +++ b/perl-install/pkgs.pm @@ -86,9 +86,9 @@ $PKGS_UNSKIP = 0x10000000; #- size and deps are grouped to save memory too and make a much #- simpler and faster depslist reader, this gets (sizeDeps). sub packageHeaderFile { my ($pkg) = @_; $pkg->{file} } -sub packageName { my ($pkg) = @_; $pkg->{file} =~ /(.*)-[^-]+-[^-]+/ && $1 or die "invalid file `$pkg->{file}'" } -sub packageVersion { my ($pkg) = @_; $pkg->{file} =~ /.*-([^-]+)-[^-]+/ && $1 or die "invalid file `$pkg->{file}'" } -sub packageRelease { my ($pkg) = @_; $pkg->{file} =~ /.*-[^-]+-([^-]+)/ && $1 or die "invalid file `$pkg->{file}'" } +sub packageName { my ($pkg) = @_; $pkg->{file} =~ /(.*)-[^-]+-[^-]+/ ? $1 : die "invalid file `$pkg->{file}'" } +sub packageVersion { my ($pkg) = @_; $pkg->{file} =~ /.*-([^-]+)-[^-]+/ ? $1 : die "invalid file `$pkg->{file}'" } +sub packageRelease { my ($pkg) = @_; $pkg->{file} =~ /.*-[^-]+-([^-]+)/ ? $1 : die "invalid file `$pkg->{file}'" } sub packageSize { my ($pkg) = @_; to_int($pkg->{sizeDeps}) } sub packageDepsId { my ($pkg) = @_; split ' ', ($pkg->{sizeDeps} =~ /^\d*\s+(.*)/)[0] } @@ -752,7 +752,7 @@ sub install($$$;$$) { #- place (install_steps_gtk.pm,...). installCallback("Starting installation", $nb, $total); - my ($i, $min, $medium) = (0, 0, install_any::medium()); + my ($i, $min, $medium) = (0, 0); do { my @transToInstall; diff --git a/tools/closurepkgs b/tools/closurepkgs new file mode 100755 index 000000000..dccd41977 --- /dev/null +++ b/tools/closurepkgs @@ -0,0 +1,52 @@ +#!/usr/bin/perl + +use strict; + +sub chop_version($) { + ($_[0] =~ /(.*)-[^-]+-[^-]+/)[0] || $_[0]; +} + +sub read_depslist { + my ($file) = @_; + my $depslist = { 'ordered' => [], 'packages' => {} }; + + local *F; + open F, $file or die "closurepkgs: unable to open ordered dependencies list file $file\n"; + foreach (<F>) { + my ($name, $size, @deps) = split; + push @{$depslist->{ordered}}, { name => $name, size => $size, deps => \@deps }; + } + close F; + + foreach (@{$depslist->{ordered}}) { + $depslist->{packages}{chop_version($_->{name})} = $_; + } + + print STDERR "closurepkgs: read " . scalar(@{$depslist->{ordered}}) . " package dependancies\n"; + + $depslist; +} + +sub main { + my ($file) = @_; + my $depslist = read_depslist($file); + + my @pkgs = qw(XFree86 dhcpcd pump ppp ypbind rhs-printfilters samba ncpfs kernel-fb); + push @pkgs, "XFree86-$_" foreach qw(3DLabs 3dfx 8514 AGX FBDev I128 Mach8 Mach32 Mach64 Mono P9000 Rage128 S3 S3V SVGA VGA16 W32); + + my %closure; + foreach (@pkgs) { + $closure{$_} = 1; + map { $closure{chop_version($_->{name})} = 1 } map { ($depslist->{ordered}[$_]) } @{$depslist->{packages}{$_}{deps}}; + } + + #- remove base package, which are already installed. + foreach (qw(basesystem sed initscripts console-tools utempter ldconfig chkconfig ntsysv setup filesystem SysVinit bdflush crontabs dev e2fsprogs etcskel fileutils findutils getty_ps grep gzip hdparm info kernel less ldconfig logrotate losetup man mingetty modutils mount net-tools passwd procmail procps psmisc mandrake-release rootfiles rpm sash ash setserial shadow-utils sh-utils stat sysklogd tar termcap textutils time tmpwatch util-linux vim-minimal vixie-cron which perl-base msec)) { + delete $closure{$_}; + map { delete $closure{chop_version($_->{name})} } map { ($depslist->{ordered}[$_]) } @{$depslist->{packages}{$_}{deps}}; + } + + map { print $depslist->{packages}{$_}{name}, "\n" } grep { $closure{$_} } keys %closure; +} + +main(@ARGV); diff --git a/tools/syncrpms b/tools/syncrpms new file mode 100755 index 000000000..1c7eea761 --- /dev/null +++ b/tools/syncrpms @@ -0,0 +1,200 @@ +#!/usr/bin/perl + +#- Synchronize mulitple RPMS/SRPMS directories. +#- Copyright (C) 1999 MandrakeSoft (fpons@mandrakesoft.com) +#- +#- This program is free software; you can redistribute it and/or modify +#- it under the terms of the GNU General Public License as published by +#- the Free Software Foundation; either version 2, or (at your option) +#- any later version. +#- +#- This program is distributed in the hope that it will be useful, +#- but WITHOUT ANY WARRANTY; without even the implied warranty of +#- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +#- GNU General Public License for more details. +#- +#- You should have received a copy of the GNU General Public License +#- along with this program; if not, write to the Free Software +#- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + + +use strict qw(subs vars refs); + +#- get basename for a file. +sub basename { $_[0] =~ /([^\/]*)$/ ? $1 : $_[0]; } + +#- compare a version string. +sub version_compare { + my ($a, $b) = @_; + local $_; + + while ($a && $b) { + my ($sb, $sa) = map { $1 if $a =~ /^\W*\d/ ? s/^\W*0*(\d+)// : s/^\W*(\D+)// } ($b, $a); + $_ = length($sa) cmp length($sb) || $sa cmp $sb and return $_; + } +} + +#- system functions. +sub cp { + my $pid; + if ($pid = fork()) { + waitpid($pid, 0); + } else { + exec '/bin/cp', @_; + } +} +sub rm { + my $pid; + if ($pid = fork()) { + waitpid($pid, 0); + } else { + exec '/bin/rm', '-f', @_; + } +} + +#- get a hash on name of srpms/rpms in a directory. +sub get_rpms { + my ($dir, $rpms, $flag) = @_; + + opendir D, $dir or die "cannot open directory $dir\n"; + map { + if (/([^\/]*?)-([^-]*)-([^-]*)\.([^-]*)(?:\.src)?\.rpm$/) { + if ($rpms->{$1}) { + if (version_compare($rpms->{$1}{version}, $2) > 0 || + version_compare($rpms->{$1}{version}, $2) == 0 && version_compare($rpms->{$1}{release}, $3) > 0) { + if ($flag->{clean}) { + print "removing obseleted $rpms->{$1}{file} by $_ in $rpms->{$1}{dir}\n" if $flag->{verbose}; + rm("$rpms->{$1}{dir}/$rpms->{$1}{file}"); + } + $rpms->{$1} = { name => $1, + version => $2, + release => $3, + arch => $4, + dir => $dir, + file => $_, + }; + } else { + if ($flag->{clean}) { + print "removing older or equal $_ by $rpms->{$1}{file} in $dir\n" if $flag->{verbose}; + rm("$dir/$_"); + } + } + } else { + $rpms->{$1} = { name => $1, + version => $2, + release => $3, + arch => $4, + dir => $dir, + file => $_, + }; + } + } else { + print STDERR "unable to parse filename $_\n"; + } + } grep { /\.rpm$/ } readdir D; + closedir D; +} + +#- sync two hashes of rpms, update rpms and printer newer version that are not taken into account. +sub sync_rpms { + my ($source, $target, $flag) = @_; + + #- search in source part. + foreach (keys %$source) { + unless ($target->{$_}) { + if ($flag->{verbose}) { + print "adding $source->{$_}{file}" . (-d $flag->{add} ? " to $flag->{add}\n" : " is neccessary!\n"); + } + if (-d $flag->{add}) { + cp("$source->{$_}{dir}/$source->{$_}{file}", $flag->{add}); + } + } + } + + #- search in both part. + foreach (keys %$source) { + if ($target->{$_}) { + if (version_compare($source->{$_}{version}, $target->{$_}{version}) > 0 || + version_compare($source->{$_}{version}, $target->{$_}{version}) == 0 && + version_compare($source->{$_}{release}, $target->{$_}{release}) > 0) { + if ($flag->{verbose}) { + print "updating $target->{$_}{dir}/$target->{$_}{file} with newer version $source->{$_}{file}\n"; + } + if ($flag->{update}) { + cp("$source->{$_}{dir}/$source->{$_}{file}", $target->{$_}{dir}); + unless (-e "$target->{$_}{dir}/$source->{$_}{file}") { + die "unable to copy $source->{$_}{file} from $source->{$_}{dir} into $target->{$_}{dir}\n"; + } + rm("$target->{$_}{dir}/$target->{$_}{file}"); + } + } elsif (version_compare($source->{$_}{version}, $target->{$_}{version}) != 0 || + version_compare($source->{$_}{release}, $target->{$_}{release}) != 0) { + if ($flag->{verbose}) { + print STDERR "keeping more up-to-date version $target->{$_}{dir}/$source->{$_}{file} against $source->{$_}{dir}/$source->{$_}{file}, check your repository !\n"; + } + } #- say nothing if source is equal to target. + } + } + + #- search in target part. + foreach (keys %$target) { + unless ($source->{$_}) { + if ($flag->{verbose}) { + print "removing $target->{$_}{file}" . ($flag->{remove} ? " from $target->{$_}{dir}\n" : " is neccessary!\n") + } + if ($flag->{remove}) { + rm("$target->{$_}{dir}/$target->{$_}{file}"); + } + } + } +} + +#- main program. +sub main { + my @from_rpms; + my @to_rpms; + my $target_rpms; + my %flag; + my %source; + my %target; + + foreach (@_) { + if (/^--(\w*)$/) { + if ($1 eq 'verbose' || $1 eq 'update' || $1 eq 'remove' || $1 eq 'clean') { + $flag{$1} = 1; + } elsif ($1 eq 'add') { + $flag{add} = undef; + } elsif ($1 eq 'from') { + $target_rpms = \@from_rpms; + } elsif ($1 eq 'to') { + $target_rpms = \@to_rpms; + } else { + die "unknown option: $1\n"; + } + } else { + if (exists $flag{add} && ! $flag{add}) { + $flag{add} = $_; + die "cannot add to non-directory: $_\n" unless -d $flag{add}; + } else { + die "unknown parameter: $_\n" unless $target_rpms; + push @$target_rpms, $_; + } + } + } + + die "usage: syncrpms [--update] [--remove] [--clean] [--add <dir>] --from <dir_sources> --to <dir_target>\n" + unless scalar(@from_rpms) > 0 && scalar(@to_rpms) > 0; + + #- parse directory structures. + get_rpms($_, \%source, \%flag) foreach @from_rpms; + get_rpms($_, \%target, \%flag) foreach @to_rpms; + + print STDERR "reading " . scalar(keys %source) . " packages as source rpms from\n"; + print STDERR " $_\n" foreach @from_rpms; + print STDERR "reading " . scalar(keys %target) . " packages as target rpms from\n"; + print STDERR " $_\n" foreach @to_rpms; + + sync_rpms(\%source, \%target, \%flag); +} + +main(@ARGV); |