Package: devscripts
Version: 2.9.26
Severity: wishlist
Tags: patch
Hi,
I've been debugging a few things in chdist, porting some
functionalities from multidistrotools (RIP) and adding some more.
The main changes are :
* Added -a / --arch option to override architecture ;
* Modified dist-create to add an apt.conf with the architecture
override ;
* Modified aptopts to allow one-shot architecture overrides ;
* Improved argument management in most functions ;
* Fixed error in dist_check when no dist is given ;
* Added command "list" to list available dists ;
* Added aptconfig to override the APT_CONFIG env variable and allow the
use of apt.conf files in dists ;
* Rewrote parsing algorithm for *_Sources and *_Packages files to fix
error due to undertermined field order ;
* Added commands to compare binary packages : "compare-bin-packages"
and "compare-bin-versions" ;
* Rewrote dist_compare to use new parsing algorithm and add a new
output column with "local_changes_in_X" details the way it was in
mdt ;
* Fixed bug in dist_compare to allow comparing more than 2 dists ;
* Added arguments to the "create" command to specify the main method,
version and sections the way mdt did it ;
* Improved error management.
-- System Information:
Debian Release: 4.0
Architecture: amd64 (x86_64)
Shell: /bin/sh linked to /bin/bash
Kernel: Linux 2.6.22.5
Locale: LANG=C, LC_CTYPE=C (charmap=ANSI_X3.4-1968)
Versions of packages devscripts depends on:
ii debianutils 2.17 Miscellaneous utilities specific t
ii dpkg-dev 1.13.25 package building tools for Debian
ii libc6 2.3.6.ds1-13etch2 GNU C Library: Shared libraries
ii perl 5.8.8-7etch1 Larry Wall's Practical Extraction
ii sed 4.1.5-1 The GNU sed stream editor
Versions of packages devscripts recommends:
ii fakeroot 1.5.10 Gives a fake root environment
-- no debconf information
--- chdist.orig 2007-12-24 15:16:33.000000000 +0100
+++ chdist 2007-12-26 14:16:47.000000000 +0100
@@ -17,6 +17,7 @@
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
use Getopt::Long;
+use List::MoreUtils qw(uniq);
my $datadir = $ENV{'HOME'} . '/.chdist';
@@ -27,6 +28,7 @@
Options:
-h, --help Show this help
-d, --data-dir DIR Choose data directory (default:
\$HOME/.chdist/
+ -a, --arch ARCH Choose architecture (default: `dpkg
--print-architecture`)
Commands:
create DIST : prepare a new tree named DIST
@@ -37,10 +39,13 @@
bin2src DIST PKG : get source package for a binary package in DIST
compare-packages DIST1 DIST2 [DIST3, ...] : list versions of packages in
several DISTributions
+ compare-bin-packages DIST1 DIST2 [DIST3, ...]
compare-versions DIST1 DIST2 : same as compare-packages, but also run
dpkg --compare-versions and display where the package is newer
+ compare-bin-versions DIST1 DIST2
grep-dctrl-packages DIST [...] : run grep-dctrl on *_Packages inside DIST
grep-dctrl-sources DIST [...] : run grep-dctrl on *_Sources inside DIST
+ list : list available DISTs
EOF
}
@@ -50,6 +55,7 @@
GetOptions(
"help" => \$help,
"data-dir=s" => \$datadir,
+ "arch=s" => \$arch,
);
if ($help) {
@@ -57,82 +63,125 @@
exit;
}
+
+########################################################
+### Functions
########################################################
+
sub dist_check {
- my $dist = $_;
- my $dir = $datadir . '/' . $dist;
- return 0 if (-d $dir);
- print "Could not find $dist in $datadir. Exiting.\n";
- exit(1);
+ # Check that dist exists in $datadir
+ my ($dist) = @_;
+ if ($dist) {
+ my $dir = $datadir . '/' . $dist;
+ return 0 if (-d $dir);
+ die "E: Could not find $dist in $datadir. Run `$0 create $dist` first.
Exiting.\n";
+ } else {
+ die "E: No dist provided. Exiting. \n";
+ }
+}
+
+sub type_check {
+ my ($type) = @_;
+ if ( ($type ne 'Sources') && ($type ne 'Packages') ) {
+ die "E: Unknown type $type. Exiting.\n";
+ }
}
sub aptopts {
- my $dist = @_[0];
- return "-o Dir=$datadir/$dist -o
Dir::State::status=$datadir/$dist/var/lib/dpkg/status";
+ # Build apt options
+ my ($dist) = @_;
+ my $opts = "-o Dir=$datadir/$dist -o
Dir::State::status=$datadir/$dist/var/lib/dpkg/status";
+ if ($arch) {
+ print "W: Forcing arch $arch for this command only.\n";
+ $opts .= " -o Apt::Architecture=$arch";
+ }
+ return $opts;
+}
+
+sub aptconfig {
+ # Build APT_CONFIG override
+ my ($dist) = @_;
+ return "APT_CONFIG=$datadir/$dist/etc/apt/apt.conf";
}
sub compare_versions {
- my $va = $_[0];
- my $vb = $_[1];
- return `dpkg --compare-versions $va lt $vb; echo $?`;
+ # Compare two versions
+ my ($va, $vb) = @_;
+ if (!vb) {
+ die "E: Must provide two versions\n";
+ }
+
+ my $test = `/usr/bin/dpkg --compare-versions $va lt $vb && echo 'true' ||
echo 'false'`;
+ chomp $test;
+ return $test;
}
###
sub aptcache {
- my @args = @_;
- my $dist = shift @args;
+ # Run apt-cache cmd
+ my ($dist, @args) = @_;
dist_check($dist);
my $args = aptopts($dist) . " @args";
- system("/usr/bin/apt-cache $args");
+ my $aptconfig = aptconfig($dist);
+ system("$aptconfig /usr/bin/apt-cache $args");
}
sub aptget {
- my @args = @_;
- my $dist = shift @args;
+ # Run apt-get cmd
+ my ($dist, @args) = @_;
dist_check($dist);
my $args = aptopts($dist) . " @args";
- system("/usr/bin/apt-get $args");
+ my $aptconfig = aptconfig($dist);
+ system("$aptconfig /usr/bin/apt-get $args");
}
sub aptrdepends {
- my @args = @_;
- my $dist = shift @args;
+ # Run apt-rdepends cmd
+ my ($dist, @args) = @_;
dist_check($dist);
my $args = aptopts($dist) . " @args";
- system("/usr/bin/apt-rdepends $args");
+ my $aptconfig = aptconfig($dist);
+ system("$aptconfig /usr/bin/apt-rdepends $args");
}
sub bin2src {
- my @args = @_;
- my $dist = $args[0];
+ my ($dist, $pkg) = @_;
dist_check($dist);
- my $args = aptopts($dist) . " show $args[1]";
- my $source = `/usr/bin/apt-cache $args|grep '^Source:'`;
+ if (!$pkg) {
+ die "E: no package name provided. Exiting.\n";
+ }
+ my $args = aptopts($dist) . " show $pkg";
+ my $aptconfig = aptconfig($dist);
+ my $source = `$aptconfig /usr/bin/apt-cache $args|grep '^Source:'`;
exit($?) if($? != 0);
$source =~ s/Source: (.*)/$1/;
- print $args[1] if($source eq '');
+ print $pkg if($source eq '');
print $source if($source ne '');
}
sub src2bin {
- my @argv = @_;
- my $dist = $argv[0];
+ my ($dist, $pkg) = @_;
dist_check($dist);
- my $args = aptopts($dist) . " showsrc $argv[1]";
- my $bins = `/usr/bin/apt-cache $args|sed 's/\(Package: .*\)\n/\(Binary:
.*\)/\1\t\2/'|grep "Package: $argv[1]"|sed 's/.*Binary: \(.*\)\n/\1/'`;
+ if (!$pkg) {
+ die "E: no package name provided. Exiting.\n";
+ }
+ my $args = aptopts($dist) . " showsrc $pkg";
+ my $bins = `/usr/bin/apt-cache $args|sed 's/\(Package: .*\)\n/\(Binary:
.*\)/\1\t\2/'|grep "Package: $pkg"|sed 's/.*Binary: \(.*\)\n/\1/'`;
exit($?) if ($? != 0);
my @bins = split /, /, $bins;
print join "\n", @bins;
}
+
sub dist_create {
- my @argv = @_;
- my $dist = $argv[0];
+ my ($dist, $method, $version, @sections) = @_;
my $dir = $datadir . '/' . $dist;
+ if ( ! $dist ) {
+ die "E: you must provide a dist name.\n";
+ }
if (-d $dir) {
- print "$dir already exists, exiting.\n";
- exit(1);
+ die "E: $dir already exists, exiting.\n";
}
if (! -d $datadir) {
mkdir($datadir);
@@ -146,8 +195,22 @@
mkdir($tres);
}
}
+
+ # Create sources.list
open(FH, ">$dir/etc/apt/sources.list");
- print FH <<EOF;
+ if ($version) {
+ # Use provided method, version and sections
+ my $sections_str = join(' ', @sections);
+ print FH <<EOF;
+deb $method $version $sections_str
+deb-src $method $version $sections_str
+EOF
+ } else {
+ if ($method) {
+ warn "W: method provided without a section. Using default content for
sources.list\n";
+ }
+ # Fill in sources.list with example contents
+ print FH <<EOF;
#deb http://ftp.debian.org/debian/ unstable main contrib non-free
#deb-src http://ftp.debian.org/debian/ unstable main contrib non-free
@@ -156,89 +219,134 @@
#deb-src http://archive.ubuntu.com/ubuntu dapper main restricted
#deb-src http://archive.ubuntu.com/ubuntu dapper universe multiverse
EOF
+ }
close FH;
+ # Create dpkg status
open(FH, ">$dir/var/lib/dpkg/status");
close FH; #empty file
+ if ($arch) {
+ # Create apt.conf if arch option given
+ open(FH, ">$dir/etc/apt/apt.conf");
+ print FH <<EOF;
+Apt {
+ Architecture "$arch";
+}
+EOF
+ close FH;
+ }
print "Now edit $dir/etc/apt/sources.list\n";
print "Then run chdist apt-get $dist update\n";
print "And enjoy.\n";
}
-sub dist_compare(\@;$) {
- my ($argv, $do_compare) = @_;
- $do_compare = 0 if $do_compare eq 'false';
- my @dists;
- my $n = 0;
- my @argv = @$argv;
- # read params
- foreach my $a (@argv) {
- $dists[$n] = $a;
- dist_check($dists[$n]);
- $n += 1;
- }
- if ($do_compare && $n != 2) {
- print "Can only compare if there are two distros.\n";
- exit(1);
+
+
+sub get_distfiles {
+ # Retrieve files to be read
+ # Takes a dist and a type
+ my ($dist, $type) = @_;
+
+ # Let the above function check the type
+ #type_check($type);
+
+ my @files;
+
+ foreach my $file ( glob($datadir . '/' . $dist .
"/var/lib/apt/lists/*_$type") ) {
+ if ( -f $file ) {
+ push @files, $file;
+ }
}
- # read Sources
- my @tot = ();
+
+ return [EMAIL PROTECTED];
+}
+
+
+sub dist_compare(\@;$;$) {
+ # Takes a list of dists, a type of comparison and a do_compare flag
+ my ($dists, $do_compare, $type) = @_;
+ # Type is 'Sources' by default
+ $type ||= Sources;
+ type_check($type);
+
+ $do_compare = 0 if $do_compare eq 'false';
+
+ # Get the list of dists from the referrence
+ my @dists = @$dists;
+ map { dist_check($_) } @dists;
+
+ # Get all packages
my %packages;
+
foreach my $dist (@dists) {
- foreach $f (glob($datadir . '/' . $dist . "/var/lib/apt/lists/*_Sources"))
{
- my $pkg;
- open FILE, $f;
- foreach my $l (<FILE>) {
- chomp $l;
- if ($l =~ /^Package: /) {
- (my $ign, $pkg) = split /: /, $l;
- push @tot, $pkg;
- }
- elsif ($l =~ /^Version: /) {
- (my $ign, $packages{$dist}{$pkg}) = split /: /, $l;
+ my $files = get_distfiles($dist,$type);
+ my @files = @$files;
+ foreach my $file ( @files ) {
+ my $parsed_file = parseFile($file);
+ foreach my $package ( keys(%{$parsed_file}) ) {
+ if ( $packages{$dist}{$package} ) {
+ warn "Package $package is alread listed for $dist. Not
overriding.\n";
+ } else {
+ $packages{$dist}{$package} = $parsed_file->{$package};
+ }
}
- }
- }
+ }
}
- # @out contains the uniq elements of @tot
- my %saw;
- @[EMAIL PROTECTED] = ();
- my @out = keys %saw;
- foreach my $pkg (@out) {
- my $str = "$pkg";
- foreach $dist (@dists) {
- if ($packages{$dist}{$pkg}) {
- $str .= " $packages{$dist}{$pkg}";
- }
- else {
- $str .= " UNAVAIL";
- }
- }
- if ($do_compare) {
- # compare versions if run as compare-versions
- if (! $packages{$dists[0]}{$pkg}) {
- $dist = $dists[0];
- $str .= " not_in_$dist";
- }
- elsif (! $packages{$dists[1]}{$pkg}) {
- $dist = $dists[1];
- $str .= " not_in_$dist";
- }
- elsif ($packages{$dists[0]}{$pkg} eq $packages{$dists[1]}{$pkg}) {
- $str .= " same_version";
- }
- elsif (compare_versions($packages{$dists[0]}{$pkg},
$packages{$dists[1]}{$pkg})) {
- $dist = $dists[0];
- $str .= " newer_in_$dist";
- }
- else {
- $dist = $dists[1];
- $str .= " newer_in_$dist";
- }
- }
- print "$str\n";
+
+ # Get entire list of packages
+ my @all_packages = uniq sort ( map { keys(%{$packages{$_}}) } @dists );
+
+ foreach my $package (@all_packages) {
+ my $line = "$package ";
+ my $status = "";
+ my $details;
+
+ foreach my $dist (@dists) {
+ if ( $packages{$dist}{$package} ) {
+ $line .= "$packages{$dist}{$package}{'Version'} ";
+ } else {
+ $line .= "UNAVAIL ";
+ $status = "not_in_$dist";
+ }
+ }
+
+ my @versions = map { $packages{$_}{$package}{'Version'} } @dists;
+ # Escaped versions
+ my @esc_vers = @versions;
+ foreach my $vers (@esc_vers) {
+ $vers =~ s|\+|\\\+|;
+ }
+
+ # Do compare
+ if ($do_compare) {
+ if ($#dists != 1) {
+ die "E: Can only compare versions if there are two distros.\n";
+ }
+ if (!$status) {
+ if ($versions[0] eq $versions[1]) {
+ $status = "same_version";
+ } else {
+ $test = compare_versions($versions[0], $versions[1]);
+ if ($test eq 'true') {
+ $status = "newer_in_$dists[1]";
+ if ( $versions[1] =~ m|^$esc_vers[0]| ) {
+ $details = " local_changes_in_$dists[1]";
+ }
+ } else {
+ $status = "newer_in_$dists[0]";
+ if ( $versions[0] =~ m|^$esc_vers[1]| ) {
+ $details = " local_changes_in_$dists[0]";
+ }
+ }
+ }
+ }
+ $line .= " $status $details";
+ }
+
+ print "$line\n";
}
}
+
sub grep_file {
my (@argv, $file) = @_;
$dist = shift @argv;
@@ -248,8 +356,63 @@
system("cat $f | grep-dctrl @argv");
}
+sub list {
+ opendir(DIR, $datadir) or die "can't open dir $datadir: $!";
+ while (defined($file = readdir(DIR))) {
+ if ( (-d "$datadir/$file") && ($file =~ m|^\w+$|) ) {
+ print "$file\n";
+ }
+ }
+ closedir(DIR);
+}
+
+
+
+sub parseFile {
+ my ($file) = @_;
+
+ # Parse a source file and returns results as a hash
+
+ open(FILE, "$file") || die("Could not open $file : $!\n");
+
+ # Use %tmp hash to store tmp data
+ my %tmp;
+ my %result;
+
+ while (my $line = <FILE>) {
+ if ( $line =~ m|^$| ) {
+ # Commit data if empty line
+ if ( $tmp{'Package'} ) {
+ #print "Committing data for $tmp{'Package'}\n";
+ while ( my ($field, $data) = each(%tmp) ) {
+ if ( $field ne "Package" ) {
+ $result{$tmp{'Package'}}{$field} = $data;
+ }
+ }
+ # Reset %tmp
+ %tmp = ();
+ } else {
+ warn "No Package field found. Not committing data.\n";
+ }
+ } elsif ( $line =~ m|^[a-zA-Z]| ) {
+ # Gather data
+ my ($field, $data) = $line =~ m|([a-zA-z-]+): (.*)$|;
+ if ($data) {
+ $tmp{$field} = $data;
+ }
+ }
+ }
+ close(FILE);
+
+ return \%result;
+}
+
+
+
+
+########################################################
+### Command parsing
########################################################
-# Command parsing
my $command = shift @ARGV;
if ($command eq 'create') {
@@ -271,10 +434,16 @@
src2bin(@ARGV);
}
elsif ($command eq 'compare-packages') {
- dist_compare(@ARGV);
+ dist_compare(@ARGV, 0, 'Sources');
+}
+elsif ($command eq 'compare-bin-packages') {
+ dist_compare(@ARGV, 0, 'Packages');
}
elsif ($command eq 'compare-versions') {
- dist_compare(@ARGV, 1);
+ dist_compare(@ARGV, 1, 'Sources');
+}
+elsif ($command eq 'compare-bin-versions') {
+ dist_compare(@ARGV, 1, 'Packages');
}
elsif ($command eq 'grep-dctrl-packages') {
grep_file(@ARGV, 'Packages');
@@ -282,7 +451,9 @@
elsif ($command eq 'grep-dctrl-sources') {
grep_file(@ARGV, 'Sources');
}
+elsif ($command eq 'list') {
+ list;
+}
else {
- print "Command unknown. Try $0 -h\n";
- exit(1);
+ die "Command unknown. Try $0 -h\n";
}
