From: Frank Lichtenheld Date: Sun, 29 Jan 2006 17:30:28 +0000 (+0000) Subject: * man/C/dpkg-scanpackages.1: Document new dpkg-scanpackages X-Git-Url: https://err.no/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=027e9bffc6d9b18446feb44b86fdad515e8db7bb;p=dpkg * man/C/dpkg-scanpackages.1: Document new dpkg-scanpackages -m option. * scripts/dpkg-scanpackages.pl: Rewrite the script to support multiple versions of packages in a single Packages file; use Getopt::Long instead of attempting to parse the command line ourselves and doing it badly; get rid of unecessary hashes and arrays that aren't used at all; output help when given the --help/-h/-? options Closes: #229589, #319541 --- diff --git a/ChangeLog b/ChangeLog index 185bcead..772f5bf6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,19 @@ +2006-01-29 Frank Lichtenheld + + * man/C/dpkg-scanpackages.1: Document new dpkg-scanpackages + -m option added by Don Armstrong. + * scripts/dpkg-scanpackages.pl: Fix some bugs introduced by + the rewrite. + +2006-01-29 Don Armstrong + + * scripts/dpkg-scanpackages.pl: Rewrite the script to support + multiple versions of packages in a single Packages file; + use Getopt::Long instead of attempting to parse the command line + ourselves and doing it badly; + get rid of unecessary hashes and arrays that aren't used at all; + output help when given the --help/-h/-? options + 2006-01-29 maximilian attems * scripts/dpkg-source.pl: Add files and diff --git a/debian/changelog b/debian/changelog index 6add50d7..53b37928 100644 --- a/debian/changelog +++ b/debian/changelog @@ -13,6 +13,11 @@ dpkg (1.13.14~) UNRELEASED; urgency=low more complex setups (Julian Gilbey). Closes: #163061 * Add files and dirs used by bzr to default dpkg-source -i regex (maximilian attems). Closes: #345164 + * dpkg-scanpackages can now output Packages files with multiple + versions of a single package (Don Armstrong). Closes: #229589. + * dpkg-scanpackages outputs help when given the --help or -h option + (Don Armstrong). Closes: #319541 + * Document dpkg-scanpackage -m in man page. -- Guillem Jover Sun, 29 Jan 2006 06:02:58 +0200 diff --git a/man/C/dpkg-scanpackages.1 b/man/C/dpkg-scanpackages.1 index fcc6960c..91a1615c 100644 --- a/man/C/dpkg-scanpackages.1 +++ b/man/C/dpkg-scanpackages.1 @@ -21,6 +21,7 @@ dpkg\-scanpackages - create Packages files .B dpkg\-scanpackages .RI [ \-u ] .RI [ \-a ] +.RI [ \-m ] .I binarydir .I overridefile .RI [ pathprefix ] @@ -59,6 +60,12 @@ is specified, then scan for *.udeb, instead of *.deb. .PP When \-a\fI\fP is specified, then instead of scanning for all debs, a pattern consisting of *_all.deb and *_arch.deb is used. +.PP +If more than one version of a package is found only the newest one +is included in the output. If they have the same version and only +differ in architecture only the first one found is used. You can override +this behaviour with the \fI\-m\fP switch. If given, all found packages +are included in the output. . .SH THE OVERRIDE FILE While most information about a package can be found in the control file, diff --git a/scripts/dpkg-scanpackages.pl b/scripts/dpkg-scanpackages.pl index 5c8e0029..b7031f44 100755 --- a/scripts/dpkg-scanpackages.pl +++ b/scripts/dpkg-scanpackages.pl @@ -1,241 +1,243 @@ #!/usr/bin/perl -$version= '1.2.6'; # This line modified by Makefile +use warnings; +use strict; -%kmap= ('optional','suggests', - 'recommended','recommends', - 'class','priority', - 'package_revision','revision'); +use IO::Handle; +use IO::File; -@fieldpri= ('Package', - 'Source', - 'Version', - 'Priority', - 'Section', - 'Essential', - 'Maintainer', - 'Pre-Depends', - 'Depends', - 'Recommends', - 'Suggests', - 'Conflicts', - 'Provides', - 'Replaces', - 'Architecture', - 'Filename', - 'Size', - 'Installed-Size', - 'MD5sum', - 'Description', - 'Origin', - 'Bugs'); +my $version= '1.2.6'; # This line modified by Makefile -$written=0; -$i=100; grep($pri{$_}=$i--,@fieldpri); +my %kmap= (optional => 'suggests', + recommended => 'recommends', + class => 'priority', + package_revision => 'revision', + ); -$udeb = 0; -$arch = ''; -while ($ARGV[0] =~ m/^-.*/) { - my $opt = shift @ARGV; - if ($opt eq '-u') { - $udeb = 1; - } elsif ($opt =~ m/-a(.*)/) { - if ($1) { - $arch = $1; - } else { - $arch = shift @ARGV; - } - } else { - print STDERR "Unknown option($opt)!\n"; - exit(1); - } -} -$ext = $udeb ? 'udeb' : 'deb'; -$pattern = $arch ? "'(' -name '*_all.$ext' -o -name '*_$arch.$ext' ')'" : "-name '*.$ext'"; -if ($ARGV[1] eq '-u') { - $udeb = 1; - shift @ARGV; -} +my @fieldpri= ('Package', + 'Source', + 'Version', + 'Priority', + 'Section', + 'Essential', + 'Maintainer', + 'Pre-Depends', + 'Depends', + 'Recommends', + 'Suggests', + 'Conflicts', + 'Provides', + 'Replaces', + 'Enhances', + 'Architecture', + 'Filename', + 'Size', + 'Installed-Size', + 'MD5sum', + 'Description', + 'Origin', + 'Bugs' + ); -$#ARGV == 1 || $#ARGV == 2 - or die "Usage: dpkg-scanpackages [-u] [-a] binarypath overridefile [pathprefix] > Packages\n"; -($binarydir, $override, $pathprefix) = @ARGV; --d $binarydir or die "Binary dir $binarydir not found\n"; --e $override or die "Override file $override not found\n"; +# This maps the fields into the proper case +my %field_case; +@field_case{map{lc($_)} @fieldpri} = @fieldpri; -sub vercmp { - ($a,$b)=@_; - return $vercache{$a,$b} if defined($vercache{$a,$b}); - system("dpkg --compare-versions $a le $b"); - $vercache{$a,$a}=$?; - return $?; -} +use Getopt::Long; -# The extra slash causes symlinks to be followed. -open(F,"find $binarydir/ -follow $pattern -print |") - or die "Couldn't open pipe to find: $!\n"; -while () { - chomp($fn=$_); - substr($fn,0,length($binarydir)) eq $binarydir - or die "$fn not in binary dir $binarydir\n"; - $t= `dpkg-deb -I $fn control`; - if ($t eq "") { - warn "Couldn't call dpkg-deb on $fn: $!, skipping package\n"; - next; - } - if ($?) { - warn "\`dpkg-deb -I $fn control' exited with $?, skipping package\n"; - next; - } +my %options = (help => 0, + udeb => 0, + arch => undef, + multiversion => 0, + ); - undef %tv; - $o= $t; - while ($t =~ s/^\n*(\S+):[ \t]*(.*(\n[ \t].*)*)\n//) { - $k= lc $1; $v= $2; - if (defined($kmap{$k})) { $k= $kmap{$k}; } - if (@kn= grep($k eq lc $_, @fieldpri)) { - @kn==1 || die $k; - $k= $kn[0]; - } - $v =~ s/\s+$//; - $tv{$k}= $v; - } - $t =~ /^\n*$/ - or die "Unprocessed text from $fn control file; info:\n$o / $t\n"; +my $result = GetOptions(\%options,'help|h|?','udeb|u!','arch|a=s','multiversion|m!'); - defined($tv{'Package'}) - or die "No Package field in control file of $fn\n"; - $p= $tv{'Package'}; delete $tv{'Package'}; +print <] [-m] binarypath overridefile [pathprefix] > Packages - if (defined($p1{$p})) { - if (&vercmp($tv{'Version'}, $pv{$p,'Version'})) { - print(STDERR " ! Package $p (filename $fn) is repeat but newer version;\n". - " used that one and ignored data from $pfilename{$p} !\n") - || die $!; - delete $p1{$p}; - for $k (keys %k1) { - delete $pv{$p,$k}; - } - } else { - print(STDERR " ! Package $p (filename $fn) is repeat;\n". - " ignored that one and using data from $pfilename{$p} !\n") - || die $!; - next; - } - } - print(STDERR " ! Package $p (filename $fn) has Filename field!\n") || die $! - if defined($tv{'Filename'}); - - $tv{'Filename'}= "$pathprefix$fn"; + Options: + --udeb, -u scan for udebs + --arch, -a architecture to scan for + --multiversion, -m allow multiple versions of a single package + --help, -h show this help - open(C,"md5sum <$fn |") || die "$fn $!"; - chop($_=); close(C); $? and die "\`md5sum < $fn' exited with $?\n"; - /^([0-9a-f]{32})\s*-?\s*$/ or die "Strange text from \`md5sum < $fn': \`$_'\n"; - $tv{'MD5sum'}= $1; +END - @stat= stat($fn) or die "Couldn't stat $fn: $!\n"; - $stat[7] or die "$fn is empty\n"; - $tv{'Size'}= $stat[7]; - if (length($tv{'Revision'})) { - $tv{'Version'}.= '-'.$tv{'Revision'}; - delete $tv{'Revision'}; - } +my $udeb = $options{udeb}; +my $arch = $options{arch}; - for $k (keys %tv) { - $pv{$p,$k}= $tv{$k}; - $k1{$k}= 1; - $p1{$p}= 1; - } +my $ext = $options{udeb} ? 'udeb' : 'deb'; +my @find_args; +if ($options{arch}) { + @find_args = ('(','-name',"*_all.$ext",'-o','-name',"_${arch}.$ext",')',); +} +else { + @find_args = ('-name',"*.$ext"); +} +my ($binarydir, $override, $pathprefix) = @ARGV; +-d $binarydir or die "Binary dir $binarydir not found\n"; +-e $override or die "Override file $override not found\n"; - $_= substr($fn,length($binarydir)); - s#/[^/]+$##; s#^/*##; - $psubdir{$p}= $_; - $pfilename{$p}= $fn; +$pathprefix = '' if not defined $pathprefix; + +our %vercache; +sub vercmp { + my ($a,$b)=@_; + return $vercache{$a}{$b} if exists $vercache{$a}{$b}; + system('dpkg','--compare-versions',$a,'le',$b); + $vercache{$a}{$b}=$?; + return $?; } -close(F); -$? and warn "find exited with $?\n"; + +my %packages; +my $find_h = new IO::Handle; +open($find_h,'-|','find',"$binarydir/",@find_args,'-print') + or die "Couldn't open $binarydir for reading: $!\n"; +FILE: + while (<$find_h>) { + chomp; + my $fn = $_; + my $control = `dpkg-deb -I $fn control`; + if ($control eq "") { + warn "Couldn't call dpkg-deb on $fn: $!, skipping package\n"; + next; + } + if ($?) { + warn "\`dpkg-deb -I $fn control' exited with $?, skipping package\n"; + next; + } + + my %tv = (); + my $temp = $control; + while ($temp =~ s/^\n*(\S+):[ \t]*(.*(\n[ \t].*)*)\n//) { + my ($key,$value)= (lc $1,$2); + if (defined($kmap{$key})) { $key= $kmap{$key}; } + if (defined($field_case{$key})) { $key= $field_case{$key}; } + $value =~ s/\s+$//; + $tv{$key}= $value; + } + $temp =~ /^\n*$/ + or die "Unprocessed text from $fn control file; info:\n$control / $temp\n"; + + defined($tv{'Package'}) + or die "No Package field in control file of $fn\n"; + my $p= $tv{'Package'}; delete $tv{'Package'}; + + if (defined($packages{$p}) and not $options{multiversion}) { + foreach (@{$packages{$p}}) { + if (&vercmp($tv{'Version'}, $_->{'Version'})) { + print(STDERR " ! Package $p (filename $fn) is repeat but newer version;\n". + " used that one and ignored data from $_->{Filename} !\n") + || die $!; + $packages{$p} = []; + } else { + print(STDERR " ! Package $p (filename $fn) is repeat;\n". + " ignored that one and using data from $_->{Filename} !\n") + or die $!; + next FILE; + } + } + } + print(STDERR " ! Package $p (filename $fn) has Filename field!\n") || die $! + if defined($tv{'Filename'}); + + $tv{'Filename'}= "$pathprefix$fn"; + + open(C,"md5sum <$fn |") || die "$fn $!"; + chop($_=); close(C); $? and die "\`md5sum < $fn' exited with $?\n"; + /^([0-9a-f]{32})\s*-?\s*$/ or die "Strange text from \`md5sum < $fn': \`$_'\n"; + $tv{'MD5sum'}= $1; + + my @stat= stat($fn) or die "Couldn't stat $fn: $!\n"; + $stat[7] or die "$fn is empty\n"; + $tv{'Size'}= $stat[7]; + + if (defined $tv{Revision} and length($tv{Revision})) { + $tv{Version}.= '-'.$tv{Revision}; + delete $tv{Revision}; + } + + push @{$packages{$p}}, {%tv}; + } +close($find_h); select(STDERR); $= = 1000; select(STDOUT); +sub writelist { + my $title= shift(@_); + return unless @_; + + print(STDERR " $title\n") || die $!; + my $packages= join(' ',sort @_); + format STDERR = ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< $packages . - -sub writelist { - $title= shift(@_); - return unless @_; - print(STDERR " $title\n") || die $!; - $packages= join(' ',sort @_); while (length($packages)) { write(STDERR) || die $!; } print(STDERR "\n") || die $!; } -@samemaint=(); +my (@samemaint,@changedmaint); + -open(O, $override) +my %overridden; +my $override_fh = new IO::File $override,'r' or die "Couldn't open override file $override: $!\n"; -while () { +while (<$override_fh>) { s/\#.*//; s/\s+$//; - ($p,$priority,$section,$maintainer)= split(/\s+/,$_,4); - next unless defined($p1{$p}); - if (length($maintainer)) { - if ($maintainer =~ m/\s*=\>\s*/) { - $oldmaint= $`; $newmaint= $'; $debmaint= $pv{$p,'Maintainer'}; - if (!grep($debmaint eq $_, split(m:\s*//\s*:, $oldmaint))) { - push(@changedmaint, - " $p (package says $pv{$p,'Maintainer'}, not $oldmaint)\n"); - } else { - $pv{$p,'Maintainer'}= $newmaint; - } - } elsif ($pv{$p,'Maintainer'} eq $maintainer) { - push(@samemaint," $p ($maintainer)\n"); - } else { - print(STDERR " * Unconditional maintainer override for $p *\n") || die $!; - $pv{$p,'Maintainer'}= $maintainer; - } + my ($p,$priority,$section,$maintainer)= split(/\s+/,$_,4); + next unless defined($packages{$p}); + for my $package (@{$packages{$p}}) { + if (defined $maintainer and length($maintainer)) { + if ($maintainer =~ m/(.+?)\s*=\>\s*(.+)/) { + my $oldmaint= $1; + my $newmaint= $2; + my $debmaint= $$package{Maintainer}; + if (!grep($debmaint eq $_, split(m:\s*//\s*:, $oldmaint))) { + push(@changedmaint, + " $p (package says $$package{Maintainer}, not $oldmaint)\n"); + } else { + $$package{Maintainer}= $newmaint; + } + } + } elsif ($$package{Maintainer} eq $maintainer) { + push(@samemaint," $p ($maintainer)\n"); + } else { + print(STDERR " * Unconditional maintainer override for $p *\n") || die $!; + $$package{Maintainer}= $maintainer; + } + $packages{$p}{Priority}= $priority; + $packages{$p}{Section}= $section; } - $pv{$p,'Priority'}= $priority; - $pv{$p,'Section'}= $section; - ($sectioncut = $section) =~ s:^[^/]*/::; - if (length($psubdir{$p}) && $section ne $psubdir{$p} && - $sectioncut ne $psubdir{$p}) { - if (length($psubdir{$p}) && $section ne $psubdir{$p}) { - print(STDERR " !! Package $p has \`Section: $section',". - " but file is in \`$psubdir{$p}' !!\n") || die $!; - $ouches++; - } - } - $o1{$p}= 1; + $overridden{$p} = 1; } -close(O); -print(STDERR "\n") || die $! if $ouches; - -$k1{'Maintainer'}= 1; -$k1{'Priority'}= 1; -$k1{'Section'}= 1; +close($override_fh); -@missingover=(); +my @missingover=(); -for $p (sort keys %p1) { - if (!defined($o1{$p})) { +my $records_written = 0; +for my $p (sort keys %packages) { + if (not defined($overridden{$p})) { push(@missingover,$p); } - $r= "Package: $p\n"; - for $k (sort { $pri{$b} <=> $pri{$a} } keys %k1) { - next unless length($pv{$p,$k}); - $r.= "$k: $pv{$p,$k}\n"; + for my $package (@{$packages{$p}}) { + my $record= "Package: $p\n"; + for my $key (@fieldpri) { + next unless defined $$package{$key}; + $record .= "$key: $$package{$key}\n"; + } + $record .= "\n"; + $records_written++; + print(STDOUT $record) or die "Failed when writing stdout: $!\n"; } - $r.= "\n"; - $written++; - $p1{$p}= 1; - print(STDOUT $r) or die "Failed when writing stdout: $!\n"; } close(STDOUT) or die "Couldn't close stdout: $!\n"; -@spuriousover= grep(!defined($p1{$_}),sort keys %o1); +my @spuriousover= grep(!defined($packages{$_}),sort keys %overridden); &writelist("** Packages in archive but missing from override file: **", @missingover); @@ -258,4 +260,4 @@ if (@spuriousover) { "\n") || die $!; } -print(STDERR " Wrote $written entries to output Packages file.\n") || die $!; +print(STDERR " Wrote $records_written entries to output Packages file.\n") || die $!;