diff options
Diffstat (limited to 't')
| -rwxr-xr-x | t/gendistrib | 407 | ||||
| -rwxr-xr-x | t/genhdlist2 | 701 | ||||
| -rw-r--r-- | t/helper.pm | 4 | ||||
| -rw-r--r-- | t/superuser--addmedia.t | 1 | ||||
| -rw-r--r-- | t/superuser--media_info_dir.t | 1 |
5 files changed, 1114 insertions, 0 deletions
diff --git a/t/gendistrib b/t/gendistrib new file mode 100755 index 00000000..e0457505 --- /dev/null +++ b/t/gendistrib @@ -0,0 +1,407 @@ +#!/usr/bin/perl + +(our $VERSION) = q(Id: gendistrib 20724 2006-11-30 13:13:27Z rafael ) =~ /(\d+)/; + +use strict; +use Cwd; +use MDV::Distribconf::Build; +use Getopt::Long; + +sub usage () { + require Pod::Usage; + Pod::Usage::pod2usage({ '-verbose' => 1 }); + exit 0; +} + +my %urpmfiles; +my %old; + +GetOptions( + 'blind' => \my $blind, + 'clean' => \my $clean, + 'hdlists=s' => \$urpmfiles{hdlists}, + 'help|h' => \&usage, + 'mediacfg=s' => \$urpmfiles{mediacfg}, + 'nobadrpm' => \my $nobadrpm, + 'noemptymedia' => \my $noemptymedia, + 'nomd5sum' => \my $nomd5sum, + 'skipmissingdir' => \my $skipmissingdir, + 's' => \my $nooutput, + 'v|version' => sub { warn "$0 version $VERSION\n"; exit 0 }, + +# old stuff + 'chkdep' => \$old{chkdep}, + 'compss=s' => \$old{compss}, + 'depslist=s' => \$old{depslist}, + 'noclean' => \$old{noclean}, + 'provides=s' => \$old{provides}, + 'headersdir=s' => \$old{headersdir}, + 'nomediainfo' => \$old{nomediainfo}, +); + +foreach (qw(chkdep compss depslist noclean headersdir provides nomediainfo)) { + $old{$_} and warn "--$_ is obsolete (not used anymore)\n"; +} + +@ARGV == 1 or usage(); +my ($root) = @ARGV; + +my $distrib = MDV::Distribconf::Build->new($root); + +$distrib->loadtree or die "$root does not seem to be a distribution tree\n"; + +if (defined($urpmfiles{mediacfg})) { + $distrib->parse_mediacfg($urpmfiles{mediacfg}) or die "Can't read $urpmfiles{mediacfg}\n"; +} elsif (defined($urpmfiles{hdlists})) { + $distrib->parse_hdlists($urpmfiles{hdlists}) or die "Can't read $urpmfiles{hdlists}\n"; +} else { + $distrib->parse_mediacfg || $distrib->parse_hdlists or die "Can't read the distrib config\n"; +} + +my $destinfodir = $distrib->getfullpath(undef, "infodir"); +$urpmfiles{version} = $distrib->getfullpath(undef, "VERSION"), + +# Error which are fatale +my @fatal = qw(SAME_INDEX); +push @fatal, 'MISSING_MEDIADIR' if !$skipmissingdir; +my @IGNORE = qw(MISSING_INDEX); +my @fatalerrors; # fatales error show at the end +$distrib->check(sub { + my %info = @_; + grep { $_ eq $info{errcode} } @IGNORE and next; + if (grep { $_ eq $info{errcode} } @fatal) { + push(@fatalerrors, "$info{level}: $info{message}"); + } else { + printf STDERR "$info{level}: $info{message}\n" unless $nooutput; + } + } +); + +if (@fatalerrors) { + printf STDERR <<EOF; + +A fatal error has been detected, continueing is likely to produce an invalid +tree. (Missing directories can be ignored with --skipmissingdir.) +Fix the error in media.cfg and retry: + +EOF + print STDERR "$_\n" foreach @fatalerrors; + print STDERR "\n"; + exit(1); +} + +my @hdlists; +foreach my $m ($distrib->listmedia) { + my $path = $distrib->getfullpath($m, 'path'); + -d $path or next; # this has been checked earlier + + push @hdlists, { + media => $m, + dir => $distrib->getpath($m, 'path'), + path => $path, + descr => $distrib->getvalue($m, 'name'), + hdlist2 => $distrib->getfullpath($m, 'hdlist'), + synthesis2 => $distrib->getfullpath($m, 'synthesis'), + pubkey2 => $distrib->getfullpath($m, 'pubkey'), + hdlist => "$path/media_info/hdlist.cz", + synthesis => "$path/media_info/synthesis.hdlist" . $distrib->getvalue($m, 'synthesis-suffix'), + pubkey => "$path/media_info/pubkey", + noneedrebuild => $blind || $clean ? 0 : $distrib->check_index_sync($m, 'formedia'), + }; +} + +if (!-d $destinfodir) { + mkdir $destinfodir, 0755 + or die qq(Can't create directory "$destinfodir": $!\n); +} + +my $infodir = $distrib->getfullpath(undef, 'infodir'); + +foreach my $d ($infodir, map { "$_->{path}/media_info" } @hdlists) { + if (! -d $d) { + mkdir $d, 0755 or die qq(Can't create directory "$d": $!\n); + } +} + +foreach my $e (@hdlists) { + if ($e->{dir} =~ /%\{ARCH\}/) { + die "sorry, %{ARCH} not supported anymore\n"; + } + @{$e->{files}} = glob("$root/$e->{dir}/*.rpm") or do { + print STDERR "unable to find rpm files in $e->{dir}\n" unless $nooutput; + next; + }; +} + +if ($noemptymedia) { + if (grep { @{$_->{files}} == 0 } @hdlists) { + die "Empty media were found, stopping\n"; + } +} + +my $synthesis_filter = $distrib->getvalue(undef, 'synthesis-filter'); +my $xml_info_filter = $distrib->getvalue(undef, 'xml-info-filter'); +foreach my $e (grep { !$_->{noneedrebuild} } @hdlists) { + print STDERR qq(building hdlist & synthesis for medium "$e->{descr}"\n) unless $nooutput; + my $file_deps = "$destinfodir/file-deps"; + my $options = join(' ', + '--allow-empty-media', + $nooutput ? '--quiet' : (), + $clean ? '--clean' : (), + $nobadrpm ? '--no-bad-rpm' : (), + $nomd5sum ? "--no-md5sum" : (), + $distrib->getvalue($e->{media}, 'xml-info') ? '--xml-info' : (), + $synthesis_filter ? "--synthesis-filter '$synthesis_filter'" : (), + $xml_info_filter ? "--xml-info-filter '$xml_info_filter'" : (), + -e $file_deps ? "--file-deps $file_deps" : (), + ); + my $cmd = "genhdlist2 $options $e->{path}"; + print "running $cmd\n" unless $nooutput; + system($cmd) == 0 or die "$cmd failed\n"; +} + +foreach my $e (@hdlists) { + hdlist_alternate_location($e->{hdlist2}, $e->{hdlist}); + hdlist_alternate_location($e->{synthesis2}, $e->{synthesis}); + $e->{pubkey2} =~ s/ /_/g; # workaround MDV::Distribconf issue + hdlist_alternate_location($e->{pubkey2}, $e->{pubkey}); +} + +if (grep { ! $_->{noneedrebuild} } @hdlists) { + + if (-f $destinfodir . '/media.cfg') { + if (! -f "$destinfodir/hdlists" || + (stat($distrib->getfullpath(undef, 'infodir') . '/media.cfg'))[9] > + (stat($destinfodir . '/hdlists'))[9]) { + print STDERR "Write hdlists file\n" unless $nooutput; + $distrib->write_hdlists($destinfodir . '/hdlists') + or print STDERR "Can't write $destinfodir/hdlists file\n"; + } + } +} +if (grep { !$_->{noneedrebuild} } @hdlists) { + unlink "$destinfodir/MD5SUM"; #- safety cleaning + unless ($nomd5sum) { + # this MD5SUM is mostly obsolete, but is still needed up to 2007.1 + # (and even on cooker for existing urpmi.cfg) + require File::Glob; + require Digest::MD5; + my $md5sum; + my $cwd = getcwd(); + chdir($destinfodir); + foreach my $fn (glob("hdlist_*"), glob("synthesis*")) { + open(my $fh, '<', $fn) or die "Can't open '$fn': $!"; + binmode($fh); + $md5sum .= Digest::MD5->new->addfile($fh)->hexdigest . " $fn\n"; + } + chdir($cwd); + open my $md5sumfh, '>', "$destinfodir/MD5SUM" or die "Can't create $destinfodir/MD5SUM: $!\n"; + print $md5sumfh $md5sum if $md5sum; + } + + print STDERR "Calculating size of medias\n" unless $nooutput; + foreach my $e (@hdlists) { + my $size = 0; + foreach (@{$e->{files} || []}) { + $size += (stat($_))[7]; + } + my $blk = 1; + my $showsize = $size; + my @unit = (' ', qw(k m g)); + while (@unit) { + my $u = shift(@unit); + if ($size / $blk < 1) { + last; + } + $showsize = sprintf('%d%s', $size / $blk, $u); + $blk *= 1024; + } + $distrib->setvalue($e->{media}, 'size', $showsize); + } + + print STDERR "Rewriting media.cfg file\n" unless $nooutput; + $distrib->write_mediacfg($urpmfiles{mediacfg}); + + print STDERR "Building version file\n" unless $nooutput; + $distrib->write_version($urpmfiles{version}); +} + +sub hdlist_alternate_location { + my ($alternate, $main) = @_; + + if (! -e $main) { + print STDERR "missing $main, not creating alternate location $alternate\n"; + } elsif (inode($alternate) == inode($main)) { + # ok + } else { + if (-l $alternate) { + print STDERR "bad alternate location " . readlink($alternate) . ", replacing it\n"; + unlink $alternate; + } elsif (-e $alternate) { + print STDERR "replacing existing plain file $alternate with a symlink\n"; + unlink $alternate; + } + print STDERR qq(link alternate location $alternate\n) unless $nooutput; + relative_symlink($main, $alternate); + } +} + +sub inode { + my ($f) = @_; + (stat($f))[1]; +} + +sub relative_symlink { + my ($src, $dest) = @_; + + # cleanup + foreach ($src, $dest) { + s!//!/!g; + s!/\./!/!g; + } + + my @src = split('/', $src); + my @dest = split('/', $dest); + pop @dest; + + while (@src && @dest && $src[0] eq $dest[0]) { + shift @src; + shift @dest; + } + symlink join('/', ('..') x @dest, @src), $dest; +} + +__END__ + +=head1 NAME + +gendistrib - generates a mirror tree for a distribution + +=head1 SYNOPSIS + + gendistrib [options] directory + +=head1 OPTIONS + +=over 4 + +=item --blind + +Always rebuild indexes, without checking whether it's needed. + +=item --clean + +Force rebuild of indexes from scratch. + +=item --hdlists file + +Path of the F<hdlists> file (defaults to F<media/media_info/hdlists>). This is +deprecated; if gendistrib finds a F<media.cfg> file, it will use it and ignore +the F<hdlists> file unless this option is given. + +=item --mediacfg file + +Use the specified F<media.cfg> file (defaults to F<media/media_info/media.cfg>). + +=item --nobadrpm + +Don't abort when encountering bad rpms. + +=item --noemptymedia + +Stop and abort if an empty media is found. + +=item --nomd5sum + +Don't generate MD5SUM files. + +=item --skipmissingdir + +If a media dir is missing, ignore it instead of aborting. + +=item -s + +Silent mode. + +=back + +=head1 DESCRIPTION + +F<gendistrib> is a tool that helps to generate the structure of a Mandriva +RPM repository, compatible with Mandriva tools (F<urpmi>, F<rpmdrake>, +etc.) + +=head2 General Structure of a Repository + +A typical repository, under a root directory F</ROOT/>, has the following +structure: + + ROOT/ - media/ + |- contrib/ + | `- media_info/ + |- main/ + | `- media_info/ + `- media_info/ + +In this example, we have two media, called I<main> and I<contrib>. The +RPMs packages are placed in the F<main> and F<contrib> subdirectories. +Repository metadata is contained in the top-level F<media_info> directory. +Per-media metadata are contained in the F<main/media_info> and +F<contrib/media_info> subdirectories. + +=head2 Configuration of the distribution tree + +Before using F<gendistrib>, you must create a file F<media_info/media.cfg> +to describe your repository. (An empty file will work, but this isn't +recommended.) The syntax of this file is reminiscent of F<.ini> files. + +A first section C<[media_info]> contains global information about the +repository: + + [media_info] + version=2006.0 + branch=Cooker + arch=i586 + +Then, supply one section per media. + + [main] + hdlist=hdlist_main.cz + name=Main + +Here, the C<hdlist> parameter specifies what will be the name of the +hdlist file in the top-level F<media_info> directory. C<name> is a human +readable label for the media. + +=head2 Operation + +F<gendistrib> should be passed the F<ROOT> directory as parameter. It will +then generate the hdlist and synthesis files and all other files needed +for proper repository operation. + +=head1 SEE ALSO + +genhdlist2(1), and MDV::Distribconf(3) for description of the format of the +F<media.cfg> file. + +=head1 COPYRIGHT + +Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005 MandrakeSoft SA + +Copyright (C) 2005, 2006 Mandriva SA + +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. + +=cut diff --git a/t/genhdlist2 b/t/genhdlist2 new file mode 100755 index 00000000..e7ea961e --- /dev/null +++ b/t/genhdlist2 @@ -0,0 +1,701 @@ +#!/usr/bin/perl + +our ($VERSION) = q(Id: genhdlist2 20460 2006-11-23 13:19:11Z pixel ) =~ /(\d+\.\d+)/; + +use Cwd; +use URPM; +use List::Util 'any'; +use MDV::Packdrakeng; +use Getopt::Long; +use strict; + +main(); + +sub usage () { + require Pod::Usage; + Pod::Usage::pod2usage({ '-verbose' => 1 }); +} + +sub main() { + my %options = ( + synthesis_filter => '.cz:xz -7', + xml_info => 'auto', + xml_info_filter => '.lzma:xz -7', + versioned => 'auto' + ); + + GetOptions( + 'clean' => \$options{no_incremental}, + 'no-bad-rpm' => \$options{no_bad_rpm}, + 'no-md5sum' => \$options{no_md5sum}, + 'no-clean-old-rpms' => \$options{no_clean_old_rpms}, + 'only-clean-old-rpms' => \$options{only_clean_old_rpms}, + 'nolock' => \$options{nolock}, + 'no-hdlist' => \$options{no_hdlist}, + 'allow-empty-media' => \$options{allow_empty_media}, + 'file-deps=s' => \$options{file_deps}, + 'synthesis-filter=s' => \$options{synthesis_filter}, + 'xml-info!' => \$options{xml_info}, + 'xml-info-filter=s' => \$options{xml_info_filter}, + 'versioned!' => \$options{versioned}, + 'media_info-dir=s' => \$options{media_info_dir}, + 'h|help' => sub { usage(); exit 0 }, + 'q|quiet' => sub { $options{verbose} = -1 }, + 'v|verbose' => sub { $options{verbose}++ }, + 'version' => sub { warn "$0 version $VERSION\n"; exit 0 }, + ); + + @ARGV == 1 or usage(); + my $rpms_dir = $ARGV[0]; + + $options{no_incremental} ||= $options{no_hdlist}; + + # Force locale to be C + # We don't translate anything but we would get translated package info and + # wrongly put it in hdlists + # https://bugs.mageia.org/show_bug.cgi?id=95 + $ENV{LC_ALL} = 'C'; + + do_it($rpms_dir, %options); +} + +# global vars +my ($no_bad_rpm, $verbose); +my $tmp_header; + +sub do_we_use_recommends { + my ($rpms_dir) = @_; + my @files = glob("$rpms_dir/../../core/release/mageia-release-common*"); + if (@files) { + # fast path: + return !any { /mga[1-4]/ } @files; + } else { + # slow path: + return glob("$rpms_dir/*mga[5-9].*.rpm") ? 1 : 0; + } +} + +sub do_it { + my ($rpms_dir, %options) = @_; + + $verbose = $options{verbose}; + $no_bad_rpm = $options{no_bad_rpm}; + + my @rpms = grep { /\.rpm$/ } all($rpms_dir); + @rpms || $options{allow_empty_media} or die "no *.rpm found in $rpms_dir (use --allow-empty-media?)\n"; + + my $media_info_dir = $options{media_info_dir} || "$rpms_dir/media_info"; + -e $media_info_dir || mkdir $media_info_dir or die "Can't mkdir $media_info_dir: $!\n"; + -d $media_info_dir && -w _ && -x _ or die "$media_info_dir isn't a writable directory, bailing out\n"; + + my ($synthesis_suffix, $synthesis_filter) = split(":", $options{synthesis_filter}); + my ($xml_info_suffix, $xml_info_filter) = split(":", $options{xml_info_filter}); + + my $synthesis = "$media_info_dir/synthesis.hdlist$synthesis_suffix"; + my $lock_file = "$media_info_dir/UPDATING"; + $tmp_header = "$media_info_dir/.tmp-header"; + + my $lock = !$options{nolock} && global_lock($lock_file); + + $SIG{INT} = sub { + unlink "$media_info_dir/hdlist.cz.tmp", "$synthesis.tmp", $tmp_header; + unlink $lock_file if $lock; + exit 1; + }; + END { unlink $lock_file if $lock } + + + #- handle old-rpms.lst + my $old_rpms_file = "$media_info_dir/old-rpms.lst"; + my $old_rpms = read_old_rpms_lst($old_rpms_file, $options{nolock}); + if ($old_rpms) { + filter_out_old_rpms($rpms_dir, $old_rpms, \@rpms); + if (!$options{no_clean_old_rpms}) { + clean_old_rpms($rpms_dir, $old_rpms); + write_old_rpms_lst($old_rpms, $old_rpms_file); + } + } + $options{only_clean_old_rpms} and return; + + + my %rpms_todo = map { /(.*)\.rpm/ => 1 } @rpms; + + my $urpm = new URPM; + + read_file_deps($urpm, $options{file_deps}) if $options{file_deps}; + + if ($options{xml_info} eq 'auto') { + $options{xml_info} = -e "$media_info_dir/info.xml$xml_info_suffix"; + } + my @xml_media_info = $options{xml_info} ? ('info', 'files', 'changelog') : @{[]}; + # default to "@suggests@" lines on older distros, "@recommends@" lines on newer: + my $output_recommends = do_we_use_recommends($rpms_dir); + + build($urpm, \%rpms_todo, $media_info_dir, $rpms_dir, \@xml_media_info, $options{no_incremental}, $options{no_hdlist}, $xml_info_suffix, $xml_info_filter, $synthesis); + build_synthesis($urpm, "$synthesis.tmp", $synthesis_filter, $output_recommends); + + if (1) { + my @media_info_files = ($options{no_hdlist} ? @{[]} : 'hdlist.cz', + "synthesis.hdlist$synthesis_suffix", map { "$_.xml$xml_info_suffix" } @xml_media_info); + foreach my $name (@media_info_files) { + print "replacing $media_info_dir/$name with $name.tmp\n" if $verbose >= 0; + rename "$media_info_dir/$name.tmp", "$media_info_dir/$name" or die "rename $media_info_dir/$name failed: $!\n"; + } + my $existed = remove_versioned_media_info($media_info_dir); + if ($options{versioned} && ($options{versioned} ne 'auto' || $existed)) { + push @media_info_files, generate_versioned_media_info($media_info_dir, \@media_info_files); + } + generate_md5sum($media_info_dir, \@media_info_files) if !$options{no_md5sum}; + } +} + +sub lock_file { + my ($file) = @_; + #- avoid putting a require on Fcntl ':flock' (which is perl and not perl-base). + my ($LOCK_EX, $LOCK_NB) = (2, 4); + + print "locking $file\n" if $verbose > 0; + open(my $lock, '>', $file) or die "lock_file $file failed\n"; + flock $lock, $LOCK_EX|$LOCK_NB or return; + $lock; +} +sub global_lock { + my ($file) = @_; + my $lock = lock_file($file) or die "another genhdlist2 already running\n"; + $lock; +} + +sub read_file_deps { + my ($urpm, $file_deps) = @_; + + -r $file_deps or die "can't read $file_deps: $?\n"; + + foreach (cat_($file_deps)) { + chomp; + # mark that this "file provide" is required: + $urpm->{provides}{$_} = undef; + } +} + +sub build { + my ($urpm, $rpms_todo, $media_info_dir, $rpms_dir, $xml_media_info, $b_no_incremental, $b_no_hdlist, $xml_info_suffix, $xml_info_filter, $synthesis) = @_; + + my $hdlist = "$media_info_dir/hdlist.cz"; + + my $out_hdlist; + if (!$b_no_hdlist) { + $out_hdlist = MDV::Packdrakeng->new( + archive => "$hdlist.tmp", + compress => "zstd", + uncompress => "zstd -d", + extern => 1, + comp_level => 11, + ) or die "Can't create archive"; + } + + my $out = { + hdlist => $out_hdlist, + map { $_ => open_xml_filter("$media_info_dir/$_.xml${xml_info_suffix}.tmp", $xml_info_filter) } @$xml_media_info + }; + + if (-e $hdlist && !$b_no_incremental) { + print "filtering $hdlist into hdlist.cz.tmp\n" if $verbose >= 0; + + # keep real filesizes from synthesis since hdlist no more have filesizes since 2008 + # else URPM will put a bogus estimation: + my $sizes = get_filesize_from_synthesis($urpm, $rpms_todo, $synthesis); + + filter_existing_hdlist($urpm, $rpms_todo, $hdlist, $out, $sizes); + } + + add_new_rpms_to_hdlist($urpm, $rpms_todo, $out, $rpms_dir); + + close_xml($out->{$_}) foreach @$xml_media_info; +} + +sub get_filesize_from_synthesis { + my ($urpm, $rpms_todo, $synthesis) = @_; + + return {} if !-r $synthesis; + + my %sizes; + $urpm->parse_synthesis($synthesis, packing => 1, callback => sub { + my (undef, $pkg) = @_; + my $fullname = $pkg->fullname; + $sizes{$fullname} = $pkg->filesize if $rpms_todo->{$fullname}; + 0; # don't keep in memory + }); + \%sizes; +} + +sub filter_existing_hdlist { + my ($urpm, $rpms_todo, $in_hdlist, $out, $sizes) = @_; + + if ($urpm->parse_hdlist($in_hdlist, packing => 1, callback => sub { + my (undef, $pkg) = @_; + my $fullname = $pkg->fullname; + if (delete $rpms_todo->{$fullname}) { + print "keeping $fullname\n" if $verbose > 1; + add_pkg($out, $pkg); + # readd back real filesize from synthesis since hdlist no more have filesizes since 2008 + # else URPM will put a bogus estimation: + $pkg->set_filesize($sizes->{$fullname}) if $sizes->{$fullname}; + 1; # do keep in memory + } else { + print "removing $fullname\n" if $verbose > 0; + 0; # don't keep in memory + } + })) { + # ok + } else { + my $nb = @{$urpm->{depslist}}; + print STDERR "parse_hdlist has failed, keeping $nb headers successfully parsed\n" if $verbose >= 0; + } +} + +sub add_new_rpms_to_hdlist { + my ($urpm, $rpms_todo, $out, $rpms_dir) = @_; + + my @rpms = keys %$rpms_todo or return; + if ($verbose >= 0) { + if (@rpms > 100 || $verbose == 0) { + print "adding ", int(@rpms), " new rpms not available in existing hdlist\n"; + } else { + print "adding ", join(' ', @rpms), "\n"; + } + } + + foreach (@rpms) { + print "adding $_\n" if $verbose > 1; + + my $rpm = "$rpms_dir/$_.rpm"; + my ($id, undef) = $urpm->parse_rpm($rpm); + if (!defined $id) { + if ($no_bad_rpm) { + print STDERR "bad rpm $rpm\n"; + next; + } else { + die "bad rpm $rpm\n"; + } + } + my $pkg = $urpm->{depslist}[$id]; + add_pkg($out, $pkg); + + $pkg->pack_header; # for synthesis + } +} + +sub open_xml_filter { + my ($file, $xml_info_filter) = @_; + + open(my $F, "| $xml_info_filter > $file") or die "can't open $file\n"; + binmode $F, ':utf8'; + print $F qq(<?xml version="1.0" encoding="utf-8"?>\n); + print $F "<media_info>"; + $F; +} + +sub close_xml { + my ($F) = @_; + print $F "</media_info>\n"; +} + +sub ensure_utf8 { + if (utf8::is_utf8($_[0])) { + utf8::valid($_[0]) and return; + + utf8::encode($_[0]); #- disable utf8 flag + utf8::upgrade($_[0]); + } else { + utf8::decode($_[0]); #- try to set utf8 flag + utf8::valid($_[0]) and return; + warn "do not know what to with $_[0]\n"; + } +} + +sub encode_xml { + my ($s) = @_; + $s =~ s/&/&/g; + $s =~ s/</</g; + $s =~ s/>/>/g; + ensure_utf8($s); + $s; +} +sub encode_xml_attribute { + my ($s) = @_; + + $s = encode_xml($s); + + $s =~ /'/ or return qq('$s'); + $s =~ /"/ or return qq("$s"); + + # argh!! hum replacing " with '' :-D + $s =~ s/"/''/g; + print STDERR qq(encoding xml attribute: replacing " with '' for $s\n); + + qq("$s"); +} + +sub add_pkg { + my ($out, $pkg) = @_; + my $fullname = $pkg->fullname; + + if ($out->{hdlist}) { + add_pkg_header($out->{hdlist}, $pkg, $fullname); + } + + if ($out->{files}) { + my $F = $out->{files}; + print $F qq(<files fn="$fullname">\n); + print $F encode_xml($_), "\n" foreach $pkg->files; + print $F qq(</files>); + } + + if ($out->{info}) { + my $F = $out->{info}; + print $F qq(<info fn="$fullname"); + printf $F qq(\n $_=%s), encode_xml_attribute($pkg->$_) foreach qw(sourcerpm url license); + print $F qq(>\n); + print $F encode_xml($pkg->description), "\n"; + print $F qq(</info>); + } + + if ($out->{changelog} && $pkg->changelog_name) { + my $F = $out->{changelog}; + my @ti = $pkg->changelog_time; + my @na = $pkg->changelog_name; + my @te = $pkg->changelog_text; + + print $F qq(<changelogs fn="$fullname">\n); + foreach (0 .. $#ti) { + print $F qq(<log time="$ti[$_]">\n); + print $F qq(<log_name>), encode_xml($na[$_]), qq(</log_name>\n); + print $F qq(<log_text>), encode_xml($te[$_]), qq(</log_text>\n); + print $F qq(</log>); + } + print $F qq(</changelogs>); + } +} + +sub add_pkg_header { + my ($out, $pkg, $fullname) = @_; + { + open(my $fh, ">", $tmp_header); + $pkg->build_header(fileno $fh); + } + { + open(my $fh, "<", $tmp_header); + $out->add_virtual('f', $fullname, $fh); + } + unlink $tmp_header; +} + +sub build_synthesis { + my ($urpm, $synthesis, $synthesis_filter, $output_recommends) = @_; + $urpm->build_synthesis( + start => 0, + end => $#{$urpm->{depslist}}, + synthesis => $synthesis, + filter => $synthesis_filter, + recommends => $output_recommends, + ) or die "build_synthesis failed (disk full?)\n"; +} + +sub remove_versioned_media_info { + my ($media_info_dir) = @_; + + my @l = grep { /^\d{8}-\d{6}-/ && -l "$media_info_dir/$_" } all($media_info_dir) or return; + + foreach (@l) { + print "removing previous versioned $_\n" if $verbose > 0; + unlink "$media_info_dir/$_"; + } + 1; +} + +sub generate_versioned_media_info { + my ($media_info_dir, $media_info_files) = @_; + + require POSIX; + my $version = POSIX::strftime("%Y%m%d-%H%M%S", gmtime()); + + map { + print "creating versioned media_info $_: $version-$_\n" if $verbose > 0; + symlink $_, "$media_info_dir/$version-$_"; + "$version-$_"; + } @$media_info_files; +} + +sub generate_md5sum { + my ($media_info_dir, $media_info_files) = @_; + require Digest::MD5; + print "updating $media_info_dir/MD5SUM\n" if $verbose >= 0; + my $cwd = getcwd(); + chdir($media_info_dir); + my $m; + foreach my $fn (@$media_info_files) { + open(my $fh, '<', $fn) or die "Can't open '$fn': $!"; + binmode($fh); + $m .= Digest::MD5->new->addfile($fh)->hexdigest . " $fn\n"; + } + chdir($cwd); + unlink "$media_info_dir/MD5SUM"; # ensure no hard link is used + open(my $f, '>', "$media_info_dir/MD5SUM") or die "Can't write MD5SUM: $!\n"; + print $f $m; +} + + +################################################################################ +sub read_old_rpms_lst { + my ($file, $nolock) = @_; + + -e $file or return; + + my $lock = !$nolock && lock_file("$file.lock") + or $verbose >= 0 && print "lock failed, we simply won't write the modified file\n"; + + require Config::IniFiles; + my $lst = Config::IniFiles->new('-file' => $file) or die "invalid $file\n"; + { lst => $lst, lock => $lock }; +} + +sub write_old_rpms_lst { + my ($old_rpms, $file) = @_; + + if ($old_rpms->{lock}) { + sleep 10; + $old_rpms->{lst}->WriteConfig($file); # no need to use a temp file + rename since WriteConfig is doing so + + print "unlocking $file.lock\n" if $verbose > 0; + close(delete $old_rpms->{lock}); + unlink "$file.lock"; + } else { + # we don't have the lock, so don't write + } +} + +sub clean_old_rpms { + my ($rpms_dir, $old_rpms) = @_; + + my $lst = $old_rpms->{lst}; + foreach my $pkg ($lst->Parameters('Remove')) { + my $keep; + if (-e "$rpms_dir/$pkg") { + my $date = $lst->val('Remove', $pkg); + if ($date >= time()) { + $keep = 1; + print "[OLD-RPMS] keeping $pkg (it is scheduled for " . $lst->GetParameterComment('Remove', $pkg) . "# )\n" if $verbose > 0; + } else { + print "[OLD-RPMS] removing rpm file $pkg (was scheduled for " . $lst->GetParameterComment('Remove', $pkg) . "# )\n" if $verbose >= 0; + unlink "$rpms_dir/$pkg"; + } + } else { + print "[OLD-RPMS] $pkg already removed\n" if $verbose >= 0; + } + $keep or $old_rpms->{lst}->delval('Remove', $pkg); + } +} + +# 'Remove' + +sub clean_old_rpms { + my ($rpms_dir, $old_rpms) = @_; + + _apply_date_old_rpms($rpms_dir, $old_rpms, 'Remove', 'OLD-RPMS', sub { + my ($pkg, $date) = @_; + print "[OLD-RPMS] removing rpm file $pkg (was scheduled for $date)\n" if $verbose >= 0; + unlink "$rpms_dir/$pkg"; + }); +} + +sub _apply_date_old_rpms { + my ($rpms_dir, $old_rpms, $section, $section_tag, $do_it) = @_; + + my $lst = $old_rpms->{lst}; + foreach my $pkg ($lst->Parameters($section)) { + my $keep; + if (-e "$rpms_dir/$pkg") { + my $date = $lst->val($section, $pkg); + if ($date >= time()) { + $keep = 1; + print "[$section_tag] keeping $pkg (it is scheduled for " . $lst->GetParameterComment($section, $pkg) . "# )\n" if $verbose > 0; + } else { + $do_it->($pkg, $verbose >= 0 && $lst->GetParameterComment($section, $pkg)); + } + } else { + print "[$section_tag] $pkg already removed\n" if $verbose >= 0; + } + $keep or $old_rpms->{lst}->delval($section, $pkg); + } +} + +sub filter_out_old_rpms { + my ($rpms_dir, $old_rpms, $rpms_list) = @_; + + _apply_date_old_rpms($rpms_dir, $old_rpms, 'Keep-in-hdlist', 'KEEP-IN-HDLIST', sub { + my ($pkg, $date) = @_; + print "[KEEP-IN-HDLIST] removing $pkg from hdlist (was scheduled for $date)\n" if $verbose >= 0; + }); + + my %old = map { $_ => 1 } $old_rpms->{lst}->Parameters('Remove'); + delete $old{$_} foreach $old_rpms->{lst}->Parameters('Keep-in-hdlist'); + + @$rpms_list = grep { !$old{$_} } @$rpms_list; +} +################################################################################ + + +sub cat_ { my @l = map { my $F; open($F, '<', $_) ? <$F> : () } @_; wantarray() ? @l : join '', @l } + +sub all { + my $d = shift; + + local *F; + opendir F, $d or return; + my @l = grep { $_ ne '.' && $_ ne '..' } readdir F; + closedir F; + + @l; +} + +__END__ + +=head1 NAME + +genhdlist2 - generates an hdlist and a synthesis file + +=head1 SYNOPSIS + + genhdlist2 [options] dir + +=head1 OPTIONS + +=over 4 + +=item B<--clean> + +Do not use existing hdlist.cz, build hdlist from scratch. + +=item B<--file-deps> + +Use the given file to know which file dependencies are used by other media. +Here is an example of use: + + package foo in medium contrib requires /bin/bar + package bar in medium main has file /bin/bar + + % echo /bin/bar > media/media_info/file-deps + % genhdlist2 --file-deps media/media_info/file-deps media/main/release + + without file-deps, media/main/release/media_info/synthesis.hdlist.cz would not provide /bin/bar. + +This option is not needed for file-deps inside a same medium. + +=item B<--no-md5sum> + +Do not generate MD5SUM file. + +=item B<--no-bad-rpm> + +Do not abort on bad rpms. + +=item B<--no-clean-old-rpms> + +Take into account old-rpms.lst, but don't remove rpms from repository + +=item B<--only-clean-old-rpms> + +F<genhdlist2> will only clean old rpms from repository, it will not update +hdlist/synthesis. + +=item B<--nolock> + +Don't lock the media (can be useful when locks fail, eg NFS). Since the lock +is used to verify no other genhdlist2 process is running on the same media, it +is a dangerous option. + +=item B<--allow-empty-media> + +By default if no *.rpm files are found, F<genhdlist2> will exit on error. +To allow building empty media, use this option. + +=item B<--media_info-dir> I<directory> + +Write hdlist/synthesis in this directory instead of <dir>/media_info +(mostly useful for debugging) + +=item B<--synthesis-filter SUFFIX:FILTER> + +Use SUFFIX for filename suffix and filter through FILTER for compression. +By default genhdlist2 will use '.cz:xz -7'. + +=item B<--xml-info> + +Force to generate xml info. By default genhdlist2 will only regenerate xml info files already there in media_info/ + +=item B<--xml-info-filter SUFFIX:FILTER> + +Use SUFFIX for filename suffix and filter through FILTER for compression. +By default genhdlist2 will use '.lzma:xz -7'. + +=item B<--versioned> + +Force to generate versioned media info. + +=item B<--no-hdlist> + +Disable generation of hdlist.cz. + +=item B<-v> + +Be verbose. Use one more B<-v> to get even more verbose. + +=item B<--quiet> + +Quiet mode. + +=back + +=head1 DESCRIPTION + +F<genhdlist2> is used to generate an hdlist and an associated synthesis file +from a set of RPM packages found in the directory passed on the command-line. +It will put the hdlist and synthesis files in media_info/ sub-directory. + +Without B<--clean>, F<genhdlist2> is incremental, ie it will use existing +media_info/hdlist.cz: it will first remove package headers for packages that +are no more in the directory. It will then add new packages. This makes an +important assumption: name-version-release-arch is enough to uniquely +indentify a package. So if foo-1-1 is in hdlist, genhdlist2 will keep it and +not bother verifying if it really is the same package. + +Contrary to F<gendistrib>, F<genhdlist2> doesn't have to be work on all media +at once. For this, it assumes no inter media file dependencies are used. If +you still have inter media file dependencies, you can use option +B<--file-deps>. + +=head1 SEE ALSO + +gendistrib(1), parsehdlist(1) + +=head1 COPYRIGHT + +Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005 MandrakeSoft SA + +Copyright (C) 2005, 2006, 2007 Mandriva SA + +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. + +=cut diff --git a/t/helper.pm b/t/helper.pm index c06d1202..950c3c65 100644 --- a/t/helper.pm +++ b/t/helper.pm @@ -1,6 +1,7 @@ package helper; use Test::More; +use Cwd 'getcwd'; use Config; use urpm::select; use urpm::util; @@ -25,6 +26,9 @@ sub set_path() { my $blib_script = dirname($_) . "/script"; -d $blib_script ? $blib_script : (); } split(':', $ENV{PERL5LIB}))); + + # Fallback to bundled genhdlist2/gendistrib if not installed: + $ENV{PATH} .= ':' . getcwd(); } my $using_root; diff --git a/t/superuser--addmedia.t b/t/superuser--addmedia.t index 51bd4cb5..5f843a82 100644 --- a/t/superuser--addmedia.t +++ b/t/superuser--addmedia.t @@ -6,6 +6,7 @@ use helper; use Test::More 'no_plan'; BEGIN { use_ok 'urpm::cfg' } +set_path(); need_root_and_prepare(); my $name = 'various'; diff --git a/t/superuser--media_info_dir.t b/t/superuser--media_info_dir.t index a71fc277..d2575b0a 100644 --- a/t/superuser--media_info_dir.t +++ b/t/superuser--media_info_dir.t @@ -6,6 +6,7 @@ use helper; use Test::More 'no_plan'; +set_path(); need_root_and_prepare(); various(); urpmq_various(); |