scripts/chdist.pl

   1 #!/usr/bin/perl
   2
   3 # Debian GNU/Linux chdist.  Copyright (C) 2007 Lucas Nussbaum and Luk Claes.
   4 #
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 2 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program. If not, see <http://www.gnu.org/licenses/>.
  17
  18 =head1 NAME
  19
  20 chdist - script to easily play with several distributions
  21
  22 =head1 SYNOPSIS
  23
  24 B<chdist> [options] [command] [command parameters]
  25
  26 =head1 DESCRIPTION
  27
  28 B<chdist> is a rewrite of what used to be known as 'MultiDistroTools'
  29 (or mdt). Its use is to create 'APT trees' for several distributions,
  30 making it easy to query the status of packages in other distribution
  31 without using chroots, for instance.
  32
  33 =head1 OPTIONS
  34
  35 =over 4
  36
  37 =item -h, --help
  38
  39 Provide a usage message.
  40
  41 =item -d, --data-dir DIR
  42
  43 Choose data directory (default: $HOME/.chdist/).
  44
  45 =item -a, --arch ARCH
  46
  47 Choose architecture (default: `dpkg --print-architecture`)
  48
  49 =item --version
  50
  51 Display version information.
  52
  53 =back
  54
  55 =head1 COMMANDS
  56
  57 =over 4
  58
  59 =item create DIST : prepare a new tree named DIST
  60
  61 =item apt-get DIST (update|source|...) : run apt-get inside DIST
  62
  63 =item apt-cache DIST (show|showsrc|...) : run apt-cache inside DIST
  64
  65 =item apt-rdepends DIST [...] : run apt-rdepends inside DIST
  66
  67 =item src2bin DIST PKG : get binary packages for a source package in DIST
  68
  69 =item bin2src DIST PKG : get source package for a binary package in DIST
  70
  71 =item compare-packages DIST1 DIST2 [DIST3, ...] : list versions of packages in several DISTributions
  72
  73 =item compare-bin-packages DIST1 DIST2 [DIST3, ...]
  74
  75 =item compare-versions DIST1 DIST2 : same as compare-packages, but also run dpkg --compare-versions and display where the package is newer.
  76
  77 =item compare-bin-versions DIST1 DIST2
  78
  79 =item compare-src-bin-packages DIST : compare sources and binaries for DIST
  80
  81 =item compare-src-bin-versions DIST : same as compare-src-bin-versions, but also run dpkg --compare-versions and display where the package is newer
  82
  83 =item grep-dctrl-packages DIST [...] : run grep-dctrl on *_Packages inside DIST
  84
  85 =item grep-dctrl-sources DIST [...] : run grep-dctrl on *_Sources inside DIST
  86
  87 =item list : list available DISTs
  88
  89 =back
  90
  91 =head1 COPYRIGHT
  92
  93 This program is copyright 2007 by Lucas Nussbaum and Luk Claes. This
  94 program comes with ABSOLUTELY NO WARRANTY.
  95
  96 It is licensed under the terms of the GPL, either version 2 of the
  97 License, or (at your option) any later version.
  98
  99 =cut
 100
 101 use strict;
 102 use warnings;
 103 use File::Basename;
 104 use Getopt::Long qw(:config require_order);
 105 use Cwd qw(abs_path cwd);
 106 use Dpkg::Version;
 107
 108 my $progname = basename($0);
 109
 110 sub usage {
 111   return <<EOF;
 112 Usage: chdist [options] [command] [command parameters]
 113
 114 Options:
 115     -h, --help                       Show this help
 116     -d, --data-dir DIR               Choose data directory (default: \$HOME/.chdist/)
 117     -a, --arch ARCH                  Choose architecture (default: `dpkg --print-architecture`)
 118     -v, --version                    Display version and copyright information
 119
 120 Commands:
 121   create DIST : prepare a new tree named DIST
 122   apt-get DIST (update|source|...) : run apt-get inside DIST
 123   apt-cache DIST (show|showsrc|...) : run apt-cache inside DIST
 124   apt-rdepends DIST [...] : run apt-rdepends inside DIST
 125   src2bin DIST PKG : get binary packages for a source package in DIST
 126   bin2src DIST PKG : get source package for a binary package in DIST
 127   compare-packages DIST1 DIST2 [DIST3, ...] : list versions of packages in
 128       several DISTributions
 129   compare-bin-packages DIST1 DIST2 [DIST3, ...]
 130   compare-versions DIST1 DIST2 : same as compare-packages, but also run
 131       dpkg --compare-versions and display where the package is newer
 132   compare-bin-versions DIST1 DIST2
 133   compare-src-bin-packages DIST : compare sources and binaries for DIST
 134   compare-src-bin-versions DIST : same as compare-src-bin-versions, but also
 135       run dpkg --compare-versions and display where the package is newer
 136   grep-dctrl-packages DIST [...] : run grep-dctrl on *_Packages inside DIST
 137   grep-dctrl-sources DIST [...] : run grep-dctrl on *_Sources inside DIST
 138   list : list available DISTs
 139 EOF
 140 }
 141
 142 # specify the options we accept and initialize
 143 # the option parser
 144 my $help     = '';
 145
 146 my $version = '';
 147 my $versioninfo = <<"EOF";
 148 This is $progname, from the Debian devscripts package, version
 149 ###VERSION### This code is copyright 2007 by Lucas Nussbaum and Luk
 150 Claes. This program comes with ABSOLUTELY NO WARRANTY. You are free
 151 to redistribute this code under the terms of the GNU General Public
 152 License, version 2 or (at your option) any later version.
 153 EOF
 154
 155 my $arch;
 156 my $datadir = $ENV{'HOME'} . '/.chdist';
 157
 158 GetOptions(
 159   "help"       => \$help,
 160   "data-dir=s" => \$datadir,
 161   "arch=s"     => \$arch,
 162   "version"    => \$version,
 163 );
 164
 165 # Fix-up relative paths
 166 $datadir = cwd() . "/$datadir" unless $datadir =~ m!^/!;
 167 $datadir = abs_path($datadir);
 168
 169 if ($help) {
 170   print usage(0);
 171   exit;
 172 }
 173
 174 if ($version) {
 175   print $versioninfo;
 176   exit;
 177 }
 178
 179
 180 ########################################################
 181 ### Functions
 182 ########################################################
 183
 184 sub uniq (@) {
 185         my %hash;
 186         map { $hash{$_}++ == 0 ? $_ : () } @_;
 187 }
 188
 189 sub dist_check {
 190   # Check that dist exists in $datadir
 191   my ($dist) = @_;
 192   if ($dist) {
 193      my $dir  = $datadir . '/' . $dist;
 194      return 0 if (-d $dir);
 195      die "E: Could not find $dist in $datadir. Run `$0 create $dist` first. Exiting.\n";
 196   } else {
 197      die "E: No dist provided. Exiting. \n";
 198   }
 199 }
 200
 201 sub type_check {
 202    my ($type) = @_;
 203    if ( ($type ne 'Sources') && ($type ne 'Packages') ) {
 204       die "E: Unknown type $type. Exiting.\n";
 205    }
 206 }
 207
 208 sub aptopts {
 209   # Build apt options
 210   my ($dist) = @_;
 211   my $opts = "";
 212   if ($arch) {
 213      print "W: Forcing arch $arch for this command only.\n";
 214      $opts .= " -o Apt::Architecture=$arch";
 215   }
 216   return $opts;
 217 }
 218
 219 sub aptconfig {
 220   # Build APT_CONFIG override
 221   my ($dist) = @_;
 222   return "APT_CONFIG=$datadir/$dist/etc/apt/apt.conf";
 223 }
 224
 225 ###
 226
 227 sub aptcache {
 228   # Run apt-cache cmd
 229   my ($dist, @args) = @_;
 230   dist_check($dist);
 231   my $args = aptopts($dist) . " @args";
 232   my $aptconfig = aptconfig($dist);
 233   system("$aptconfig /usr/bin/apt-cache $args");
 234 }
 235
 236 sub aptget {
 237   # Run apt-get cmd
 238   my ($dist, @args) = @_;
 239   dist_check($dist);
 240   my $args = aptopts($dist) . " @args";
 241   my $aptconfig = aptconfig($dist);
 242   system("$aptconfig /usr/bin/apt-get $args");
 243 }
 244
 245 sub aptrdepends {
 246   # Run apt-rdepends cmd
 247   my ($dist, @args) = @_;
 248   dist_check($dist);
 249   my $args = aptopts($dist) . " @args";
 250   my $aptconfig = aptconfig($dist);
 251   system("$aptconfig /usr/bin/apt-rdepends $args");
 252 }
 253
 254 sub bin2src {
 255   my ($dist, $pkg) = @_;
 256   dist_check($dist);
 257   if (!$pkg) {
 258      die "E: no package name provided. Exiting.\n";
 259   }
 260   my $args = aptopts($dist) . " show $pkg";
 261   my $aptconfig = aptconfig($dist);
 262   my $source = `$aptconfig /usr/bin/apt-cache $args|grep '^Source:'`;
 263   exit($?) if($? != 0);
 264   $source =~ s/Source: (.*)/$1/;
 265   print $pkg if($source eq '');
 266   print $source if($source ne '');
 267 }
 268
 269 sub src2bin {
 270   my ($dist, $pkg) = @_;
 271   dist_check($dist);
 272   if (!$pkg) {
 273      die "E: no package name provided. Exiting.\n";
 274   }
 275   my $args = aptopts($dist) . " showsrc $pkg";
 276   my $bins = `/usr/bin/apt-cache $args|sed -n '/^Package: $pkg/{N;p}' | sed -n 's/^Binary: \\(.*\\)/\\1/p'`;
 277   exit($?) if ($? != 0);
 278   my @bins = split /, /, $bins;
 279   print join "\n", @bins;
 280 }
 281
 282
 283 sub recurs_mkdir {
 284   my ($dir) = @_;
 285   my @temp = split /\//, $dir;
 286   my $createdir = "";
 287   foreach my $piece (@temp) {
 288      $createdir .= "/$piece";
 289      if (! -d $createdir) {
 290         mkdir($createdir);
 291      }
 292   }
 293 }
 294
 295 sub dist_create {
 296   my ($dist, $method, $version, @sections) = @_;
 297   my $dir  = $datadir . '/' . $dist;
 298   if ( ! $dist ) {
 299      die "E: you must provide a dist name.\n";
 300   }
 301   if (-d $dir) {
 302     die "E: $dir already exists, exiting.\n";
 303   }
 304   if (! -d $datadir) {
 305     mkdir($datadir);
 306   }
 307   mkdir($dir);
 308   foreach my $d (('/etc/apt', '/var/lib/apt/lists/partial', '/var/lib/dpkg', '/var/cache/apt/archives/partial')) {
 309      recurs_mkdir("$dir/$d");
 310   }
 311
 312   # Create sources.list
 313   open(FH, ">$dir/etc/apt/sources.list");
 314   if ($version) {
 315      # Use provided method, version and sections
 316      my $sections_str = join(' ', @sections);
 317      print FH <<EOF;
 318 deb $method $version $sections_str
 319 deb-src $method $version $sections_str
 320 EOF
 321   } else {
 322      if ($method) {
 323         warn "W: method provided without a section. Using default content for sources.list\n";
 324      }
 325      # Fill in sources.list with example contents
 326      print FH <<EOF;
 327 #deb http://ftp.debian.org/debian/ unstable main contrib non-free
 328 #deb-src http://ftp.debian.org/debian/ unstable main contrib non-free
 329
 330 #deb http://archive.ubuntu.com/ubuntu dapper main restricted
 331 #deb http://archive.ubuntu.com/ubuntu dapper universe multiverse
 332 #deb-src http://archive.ubuntu.com/ubuntu dapper main restricted
 333 #deb-src http://archive.ubuntu.com/ubuntu dapper universe multiverse
 334 EOF
 335   }
 336   close FH;
 337   # Create dpkg status
 338   open(FH, ">$dir/var/lib/dpkg/status");
 339   close FH; #empty file
 340   # Create apt.conf
 341   $arch ||= `dpkg --print-architecture`;
 342   chomp $arch;
 343   open(FH, ">$dir/etc/apt/apt.conf");
 344   print FH <<EOF;
 345 Apt {
 346    Architecture "$arch";
 347 }
 348
 349 Dir "$dir";
 350 Dir::State::status "$dir/var/lib/dpkg/status";
 351 EOF
 352   close FH;
 353   print "Now edit $dir/etc/apt/sources.list\n";
 354   print "Then run chdist apt-get $dist update\n";
 355   print "And enjoy.\n";
 356 }
 357
 358
 359
 360 sub get_distfiles {
 361   # Retrieve files to be read
 362   # Takes a dist and a type
 363   my ($dist, $type) = @_;
 364
 365   # Let the above function check the type
 366   #type_check($type);
 367
 368   my @files;
 369
 370   foreach my $file ( glob($datadir . '/' . $dist . "/var/lib/apt/lists/*_$type") ) {
 371      if ( -f $file ) {
 372         push @files, $file;
 373      }
 374   }
 375
 376   return \@files;
 377 }
 378
 379
 380 sub dist_compare(\@;$;$) {
 381   # Takes a list of dists, a type of comparison and a do_compare flag
 382   my ($dists, $do_compare, $type) = @_;
 383   # Type is 'Sources' by default
 384   $type ||= 'Sources';
 385   type_check($type);
 386
 387   $do_compare = 0 if $do_compare eq 'false';
 388
 389   # Get the list of dists from the referrence
 390   my @dists = @$dists;
 391   map { dist_check($_) } @dists;
 392
 393   # Get all packages
 394   my %packages;
 395
 396   foreach my $dist (@dists) {
 397      my $files = get_distfiles($dist,$type);
 398      my @files = @$files;
 399      foreach my $file ( @files ) {
 400         my $parsed_file = parseFile($file);
 401         foreach my $package ( keys(%{$parsed_file}) ) {
 402            if ( $packages{$dist}{$package} ) {
 403               warn "W: Package $package is already listed for $dist. Not overriding.\n";
 404            } else {
 405               $packages{$dist}{$package} = $parsed_file->{$package};
 406            }
 407         }
 408      }
 409   }
 410
 411   # Get entire list of packages
 412   my @all_packages = uniq sort ( map { keys(%{$packages{$_}}) } @dists );
 413
 414   foreach my $package (@all_packages) {
 415      my $line = "$package ";
 416      my $status = "";
 417      my $details;
 418
 419      foreach my $dist (@dists) {
 420         if ( $packages{$dist}{$package} ) {
 421            $line .= "$packages{$dist}{$package}{'Version'} ";
 422         } else {
 423            $line .= "UNAVAIL ";
 424            $status = "not_in_$dist";
 425         }
 426      }
 427
 428      my @versions = map { $packages{$_}{$package}{'Version'} } @dists;
 429      # Escaped versions
 430      my @esc_vers = @versions;
 431      foreach my $vers (@esc_vers) {
 432         $vers =~ s|\+|\\\+|;
 433      }
 434
 435      # Do compare
 436      if ($do_compare) {
 437         if ($#dists != 1) {
 438            die "E: Can only compare versions if there are two distros.\n";
 439         }
 440         if (!$status) {
 441           my $cmp = version_compare($versions[0], $versions[1]);
 442           if (!$cmp) {
 443             $status = "same_version";
 444           } elsif ($cmp < 0) {
 445             $status = "newer_in_$dists[1]";
 446             if ( $versions[1] =~ m|^$esc_vers[0]| ) {
 447                $details = " local_changes_in_$dists[1]";
 448             }
 449           } else {
 450              $status = "newer_in_$dists[0]";
 451              if ( $versions[0] =~ m|^$esc_vers[1]| ) {
 452                 $details = " local_changes_in_$dists[0]";
 453              }
 454           }
 455         }
 456         $line .= " $status $details";
 457      }
 458
 459      print "$line\n";
 460   }
 461 }
 462
 463
 464 sub compare_src_bin {
 465    my ($dist, $do_compare) = @_;
 466
 467    $do_compare = 0 if $do_compare eq 'false';
 468
 469    dist_check($dist);
 470
 471
 472    # Get all packages
 473    my %packages;
 474    my @parse_types = ('Sources', 'Packages');
 475    my @comp_types  = ('Sources_Bin', 'Packages');
 476
 477    foreach my $type (@parse_types) {
 478       my $files = get_distfiles($dist, $type);
 479       my @files = @$files;
 480       foreach my $file ( @files ) {
 481          my $parsed_file = parseFile($file);
 482          foreach my $package ( keys(%{$parsed_file}) ) {
 483             if ( $packages{$dist}{$package} ) {
 484                warn "W: Package $package is already listed for $dist. Not overriding.\n";
 485             } else {
 486                $packages{$type}{$package} = $parsed_file->{$package};
 487             }
 488          }
 489       }
 490    }
 491
 492    # Build 'Sources_Bin' hash
 493    foreach my $package ( keys( %{$packages{Sources}} ) ) {
 494       my $package_h = \%{$packages{Sources}{$package}};
 495       if ( $package_h->{'Binary'} ) {
 496          my @binaries = split(", ", $package_h->{'Binary'});
 497          my $version  = $package_h->{'Version'};
 498          foreach my $binary (@binaries) {
 499             if ( $packages{Sources_Bin}{$binary} ) {
 500                # TODO: replace if new version is newer (use dpkg --compare-version?)
 501                warn "There is already a version for binary $binary. Not replacing.\n";
 502             } else {
 503                $packages{Sources_Bin}{$binary}{Version} = $version;
 504             }
 505          }
 506       } else {
 507          warn "Source $package has no binaries!\n";
 508       }
 509    }
 510
 511    # Get entire list of packages
 512    my @all_packages = uniq sort ( map { keys(%{$packages{$_}}) } @comp_types );
 513
 514   foreach my $package (@all_packages) {
 515      my $line = "$package ";
 516      my $status = "";
 517      my $details;
 518
 519      foreach my $type (@comp_types) {
 520         if ( $packages{$type}{$package} ) {
 521            $line .= "$packages{$type}{$package}{'Version'} ";
 522         } else {
 523            $line .= "UNAVAIL ";
 524            $status = "not_in_$type";
 525         }
 526      }
 527
 528      my @versions = map { $packages{$_}{$package}{'Version'} } @comp_types;
 529      # Escaped versions
 530      my @esc_vers = @versions;
 531      foreach my $vers (@esc_vers) {
 532         $vers =~ s|\+|\\\+|;
 533      }
 534
 535      # Do compare
 536      if ($do_compare) {
 537         if ($#comp_types != 1) {
 538            die "E: Can only compare versions if there are two types.\n";
 539         }
 540         if (!$status) {
 541           my $cmp = version_compare($versions[0], $versions[1]);
 542           if (!$cmp) {
 543             $status = "same_version";
 544           } elsif ($cmp < 0) {
 545             $status = "newer_in_$comp_types[1]";
 546             if ( $versions[1] =~ m|^$esc_vers[0]| ) {
 547                $details = " local_changes_in_$comp_types[1]";
 548             }
 549           } else {
 550              $status = "newer_in_$comp_types[0]";
 551              if ( $versions[0] =~ m|^$esc_vers[1]| ) {
 552                 $details = " local_changes_in_$comp_types[0]";
 553              }
 554           }
 555         }
 556         $line .= " $status $details";
 557      }
 558
 559      print "$line\n";
 560   }
 561 }
 562
 563 sub grep_file {
 564   my (@argv, $file) = @_;
 565   my $dist = shift @argv;
 566   dist_check($dist);
 567   my $f = glob($datadir . '/' . $dist . "/var/lib/apt/lists/*_$file");
 568   # FIXME avoid shell invoc, potential quoting problems here
 569   system("cat $f | grep-dctrl @argv");
 570 }
 571
 572 sub list {
 573   opendir(DIR, $datadir) or die "can't open dir $datadir: $!";
 574   while (my $file = readdir(DIR)) {
 575      if ( (-d "$datadir/$file") && ($file =~ m|^\w+|) ) {
 576         print "$file\n";
 577      }
 578   }
 579   closedir(DIR);
 580 }
 581
 582
 583
 584 sub parseFile {
 585    my ($file) = @_;
 586
 587    # Parse a source file and returns results as a hash
 588
 589    open(FILE, "$file") || die("Could not open $file : $!\n");
 590
 591    # Use %tmp hash to store tmp data
 592    my %tmp;
 593    my %result;
 594
 595    while (my $line = <FILE>) {
 596       if ( $line =~ m|^$| ) {
 597          # Commit data if empty line
 598          if ( $tmp{'Package'} ) {
 599             #print "Committing data for $tmp{'Package'}\n";
 600             while ( my ($field, $data) = each(%tmp) ) {
 601                if ( $field ne "Package" ) {
 602                   $result{$tmp{'Package'}}{$field} = $data;
 603                }
 604             }
 605             # Reset %tmp
 606             %tmp = ();
 607          } else {
 608             warn "W: No Package field found. Not committing data.\n";
 609          }
 610       } elsif ( $line =~ m|^[a-zA-Z]| ) {
 611          # Gather data
 612          my ($field, $data) = $line =~ m|([a-zA-z-]+): (.*)$|;
 613          if ($data) {
 614             $tmp{$field} = $data;
 615          }
 616       }
 617    }
 618    close(FILE);
 619
 620    return \%result;
 621 }
 622
 623
 624
 625
 626 ########################################################
 627 ### Command parsing
 628 ########################################################
 629
 630 my $command = shift @ARGV;
 631 if ($command eq 'create') {
 632   dist_create(@ARGV);
 633 }
 634 elsif ($command eq 'apt-get') {
 635   aptget(@ARGV);
 636 }
 637 elsif ($command eq 'apt-cache') {
 638   aptcache(@ARGV);
 639 }
 640 elsif ($command eq 'apt-rdepends') {
 641   aptrdepends(@ARGV);
 642 }
 643 elsif ($command eq 'bin2src') {
 644   bin2src(@ARGV);
 645 }
 646 elsif ($command eq 'src2bin') {
 647   src2bin(@ARGV);
 648 }
 649 elsif ($command eq 'compare-packages') {
 650   dist_compare(@ARGV, 0, 'Sources');
 651 }
 652 elsif ($command eq 'compare-bin-packages') {
 653   dist_compare(@ARGV, 0, 'Packages');
 654 }
 655 elsif ($command eq 'compare-versions') {
 656   dist_compare(@ARGV, 1, 'Sources');
 657 }
 658 elsif ($command eq 'compare-bin-versions') {
 659   dist_compare(@ARGV, 1, 'Packages');
 660 }
 661 elsif ($command eq 'grep-dctrl-packages') {
 662   grep_file(@ARGV, 'Packages');
 663 }
 664 elsif ($command eq 'grep-dctrl-sources') {
 665   grep_file(@ARGV, 'Sources');
 666 }
 667 elsif ($command eq 'compare-src-bin-packages') {
 668   compare_src_bin(@ARGV, 0);
 669 }
 670 elsif ($command eq 'compare-src-bin-versions') {
 671   compare_src_bin(@ARGV, 1);
 672 }
 673 elsif ($command eq 'list') {
 674   list;
 675 }
 676 else {
 677   die "Command unknown. Try $0 -h\n";
 678 }