pristine-tar

   1 #!/usr/bin/perl
   2
   3 =head1 NAME
   4
   5 pristine-tar - regenerate pristine tarballs
   6
   7 =head1 SYNOPSIS
   8
   9 B<pristine-tar> [-vdk] gendelta I<tarball> I<delta>
  10
  11 B<pristine-tar> [-vdk] gentar I<delta> I<tarball>
  12
  13 B<pristine-tar> [-vdk] [-m message] commit I<tarball> [I<upstream>]
  14
  15 B<pristine-tar> [-vdk] checkout I<tarball>
  16
  17 B<pristine-tar> [-vdk] list
  18
  19 =head1 DESCRIPTION
  20
  21 pristine-tar can regenerate an exact copy of a pristine upstream tarball
  22 using only a small binary I<delta> file and the contents of the tarball,
  23 which are typically kept in an I<upstream> branch in version control.
  24
  25 The I<delta> file is designed to be checked into version control along-side
  26 the I<upstream> branch, thus allowing Debian packages to be built entirely
  27 using sources in version control, without the need to keep copies of
  28 upstream tarballs.
  29
  30 pristine-tar supports compressed tarballs, calling out to pristine-gz(1),
  31 pristine-bz2(1), and pristine-xz(1) to produce the pristine gzip, bzip2,
  32 and xz files.
  33
  34 =head1 COMMANDS
  35
  36 =over 4
  37
  38 =item pristine-tar gendelta I<tarball> I<delta>
  39
  40 This takes the specified upstream I<tarball>, and generates a small binary
  41 delta file that can later be used by pristine-tar gentar to recreate the
  42 tarball.
  43
  44 If the delta filename is "-", it is written to standard output.
  45
  46 =item pristine-tar gentar I<delta> I<tarball>
  47
  48 This takes the specified I<delta> file, and the files in the current
  49 directory, which must have identical content to those in the upstream
  50 tarball, and uses these to regenerate the pristine upstream I<tarball>.
  51
  52 If the delta filename is "-", it is read from standard input.
  53
  54 =item pristine-tar commit I<tarball> [I<upstream>]
  55
  56 B<pristine-tar commit> generates a pristine-tar delta file for the specified
  57 I<tarball>, and commits it to version control. The B<pristine-tar checkout>
  58 command can later be used to recreate the original tarball based only
  59 on the information stored in version control.
  60
  61 The I<upstream> parameter specifies the tag or branch that contains the
  62 same content that is present in the tarball. This defaults to
  63 "refs/heads/upstream", or if there's no such branch, any
  64 branch matching "upstream". The name of the tree it points to will be
  65 recorded for later use by B<pristine-tar checkout>. Note that the content
  66 does not need to be 100% identical to the content of the tarball, but
  67 if it is not, additional space will be used in the delta file.
  68
  69 The delta files are stored in a branch named "pristine-tar", with filenames
  70 corresponding to the input tarball, with ".delta" appended. This
  71 branch is created or updated as needed to add each new delta.
  72
  73 =item pristine-tar checkout I<tarball>
  74
  75 This regenerates a copy of the specified I<tarball> using information
  76 previously saved in version control by B<pristine-tar commit>.
  77
  78 =item pristine-tar list
  79
  80 This lists tarballs that pristine-tar is able to checkout from version
  81 control.
  82
  83 =back
  84
  85 =head1 OPTIONS
  86
  87 =over 4
  88
  89 =item -v
  90
  91 =item --verbose
  92
  93 Verbose mode, show each command that is run.
  94
  95 =item -d
  96
  97 =item --debug
  98
  99 Debug mode.
 100
 101 =item -k
 102
 103 =item --keep
 104
 105 Don't clean up the temporary directory on exit.
 106
 107 =item -m message
 108
 109 =item --message=message
 110
 111 Use this option to specify a custom commit message to pristine-tar commit.
 112
 113 =back
 114
 115 =head1 EXAMPLES
 116
 117 Suppose you maintain the hello package, in a git repository. You have
 118 just created a tarball of the release, I<hello-1.0.tar.gz>, which you
 119 will upload to a "forge" site.
 120
 121 You want to ensure that, if the "forge" loses the tarball, you can always
 122 recreate exactly that same tarball. And you'd prefer not to keep copies
 123 of tarballs for every release, as that could use a lot of disk space
 124 when hello gets the background mp3s and user-contributed levels you
 125 are planning for version 2.0.
 126
 127 The solution is to use pristine-tar to commit a delta file that efficiently
 128 stores enough information to reproduce the tarball later.
 129
 130         cd hello
 131         git tag -s 1.0
 132         pristine-tar commit ../hello-1.0.tar.gz 1.0
 133
 134 Remember to tell git to push both the pristine-tar branch, and your tag:
 135
 136         git push --all --tags
 137
 138 Now it is a year later. The worst has come to pass; the "forge" lost
 139 all its data, you deleted the tarballs to make room for bug report emails,
 140 and you want to regenerate them. Happily, the git repository is still
 141 available.
 142
 143         git clone git://github.com/joeyh/hello.git
 144         cd hello
 145         pristine-tar checkout ../hello-1.0.tar.gz
 146
 147 =head1 LIMITATIONS
 148
 149 Only tarballs, gzipped tarballs, bzip2ed tarballs, and xzed tarballs
 150 are currently supported.
 151
 152 Currently only the git revision control system is supported by the
 153 "checkout" and "commit" commands. It's ok if the working copy
 154 is not clean or has uncommitted changes, or has changes staged in the
 155 index; none of that will be touched by "checkout" or "commit".
 156
 157 =head1 ENVIRONMENT
 158
 159 =over 4
 160
 161 =item B<TMPDIR>
 162
 163 Specifies a location to place temporary files, other than the default.
 164
 165 =back
 166
 167 =head1 AUTHOR
 168
 169 Joey Hess <joeyh@debian.org>
 170
 171 Licensed under the GPL, version 2 or above.
 172
 173 =cut
 174
 175 use warnings;
 176 use strict;
 177 use Pristine::Tar;
 178 use Pristine::Tar::Delta;
 179 use Pristine::Tar::Formats;
 180 use File::Path;
 181 use File::Basename;
 182 use Cwd qw{getcwd abs_path};
 183
 184 # Force locale to C since tar may output utf-8 filenames differently
 185 # depending on the locale.
 186 $ENV{LANG}='C';
 187
 188 # Don't let environment change tar's behavior.
 189 delete $ENV{TAR_OPTIONS};
 190 delete $ENV{TAPE};
 191
 192 # Ask tar to please be compatable with version 1.26.
 193 # In version 1.27, it changed some fields used in longlink entries.
 194 $ENV{PRISTINE_TAR_COMPAT}=1;
 195
 196 # The following two assignments are potentially munged during the
 197 # build process to hold the values of TAR_PROGRAM and XDELTA_PROGRAM
 198 # parameters as given to Makefile.PL.
 199 my $tar_program = "tar";
 200 my $xdelta_program = "xdelta";
 201
 202 my $message;
 203
 204 dispatch(
 205         commands => {
 206                 usage => [\&usage],
 207                 gentar => [\&gentar, 2],
 208                 gendelta => [\&gendelta, 2],
 209                 commit => [\&commit],
 210                 ci => [\&commit, 1],
 211                 checkout => [\&checkout, 1],
 212                 co => [\&checkout, 1],
 213                 list => [\&list, 0],
 214         },
 215         options => {
 216                 "m|message=s" => \$message,
 217         },
 218 );
 219
 220 sub usage {
 221         print STDERR "Usage: pristine-tar [-vdk] gendelta tarball delta\n";
 222         print STDERR "       pristine-tar [-vdk] gentar delta tarball\n";
 223         print STDERR "       pristine-tar [-vdk] [-m message] commit tarball [upstream]\n";
 224         print STDERR "       pristine-tar [-vdk] checkout tarball\n";
 225         print STDERR "       pristine-tar        list\n";
 226         exit 1;
 227 }
 228
 229 sub unquote_filename {
 230         my $filename = shift;
 231
 232         $filename =~ s/\\a/\a/g;
 233         $filename =~ s/\\b/\b/g;
 234         $filename =~ s/\\f/\f/g;
 235         $filename =~ s/\\n/\n/g;
 236         $filename =~ s/\\r/\r/g;
 237         $filename =~ s/\\t/\t/g;
 238         $filename =~ s/\\v/\x11/g;
 239         $filename =~ s/\\\\/\\/g;
 240
 241         return $filename;
 242 }
 243
 244 my $recreatetarball_tempdir;
 245 sub recreatetarball {
 246         my $manifestfile=shift;
 247         my $source=shift;
 248         my %options=@_;
 249
 250         my $tempdir=tempdir();
 251
 252         my @manifest;
 253         open (IN, "<", $manifestfile) || die "$manifestfile: $!";
 254         while (<IN>) {
 255                 chomp;
 256                 push @manifest, $_;
 257         }
 258         close IN;
 259         link($manifestfile, "$tempdir/manifest") || die "link $tempdir/manifest: $!";
 260
 261         # The manifest and source should have the same filenames,
 262         # but the manifest probably has all the files under a common
 263         # subdirectory. Check if it does.
 264         my $subdir="";
 265         foreach my $file (@manifest) {
 266                 #debug("file: $file");
 267                 if ($file=~m!^(/?[^/]+)(/|$)!) {
 268                         if (length $subdir && $subdir ne $1) {
 269                                 debug("found file not in subdir $subdir: $file");
 270                                 $subdir="";
 271                                 last;
 272                         }
 273                         elsif (! length $subdir) {
 274                                 $subdir=$1;
 275                                 debug("set subdir to $subdir");
 276                         }
 277                 }
 278                 else {
 279                         debug("found file not in subdir: $file");
 280                         $subdir="";
 281                         last;
 282                 }
 283         }
 284
 285         if (length $subdir) {
 286                 debug("subdir is $subdir");
 287                 doit("mkdir", "$tempdir/workdir");
 288                 $subdir="/$subdir";
 289         }
 290
 291         if (! $options{clobber_source}) {
 292                 doit("cp", "-a", $source, "$tempdir/workdir$subdir");
 293         }
 294         else {
 295                 doit("mv", $source, "$tempdir/workdir$subdir");
 296         }
 297
 298         # It's important that this create an identical tarball each time
 299         # for a given set of input files. So don't include file metadata
 300         # in the tarball, since it can easily vary.
 301         my $full_sweep=0;
 302         foreach my $file (@manifest) {
 303                 my $unquoted_file = unquote_filename($file);
 304
 305                 if (-l "$tempdir/workdir/$unquoted_file") {
 306                         # Can't set timestamp of a symlink, so
 307                         # replace the symlink with an empty file.
 308                         unlink("$tempdir/workdir/$unquoted_file") || die "unlink: $!";
 309                         open(OUT, ">", "$tempdir/workdir/$unquoted_file") || die "open: $!";
 310                         close OUT;
 311                 }
 312                 elsif (! -e "$tempdir/workdir/$unquoted_file") {
 313                         debug("$file is listed in the manifest but may not be present in the source directory");
 314                         $full_sweep=1;
 315
 316                         if ($options{create_missing}) {
 317                                 # Avoid tar failing on the nonexistent item by
 318                                 # creating a dummy directory.
 319                                 debug("creating missing $unquoted_file");
 320                                 mkpath "$tempdir/workdir/$unquoted_file";
 321                         }
 322                 }
 323
 324                 if (-d "$tempdir/workdir/$unquoted_file" && (-u _ || -g _ || -k _)) {
 325                         # tar behaves weirdly for some special modes
 326                         # and ignores --mode, so clear them.
 327                         debug("chmod $file");
 328                         chmod(0755, "$tempdir/workdir/$unquoted_file") ||
 329                                 die "chmod: $!";
 330                 }
 331         }
 332
 333         # Set file times only after modifying of the directory content is
 334         # done.
 335         foreach my $file (@manifest) {
 336                 my $unquoted_file = unquote_filename($file);
 337                 if (-e "$tempdir/workdir/$unquoted_file") {
 338                         utime(0, 0, "$tempdir/workdir/$unquoted_file") || die "utime: $file: $!";
 339                 }
 340         }
 341
 342         # If some files couldn't be matched up with the manifest,
 343         # it's possible they do exist, but just with names that make sense
 344         # to tar, but not to this program. Work around this and make sure
 345         # such files have their metadata tweaked, by doing a full sweep of
 346         # the tree.
 347         if ($full_sweep) {
 348                 debug("doing full tree sweep to catch missing files");
 349                 use File::Find;
 350                 find(sub {
 351                         if (-l $_) {
 352                                 unlink($_) || die "unlink: $!";
 353                                 open(OUT, ">", $_) || die "open: $!";
 354                                 close OUT;
 355                         }
 356                         if (-d $_ && (-u _ || -g _ || -k _)) {
 357                                 chmod(0755, $_) ||
 358                                         die "chmod: $!";
 359                         }
 360                 }, "$tempdir/workdir");
 361                 find(sub {
 362                         utime(0, 0, $_) || die "utime: $_: $!";
 363                 }, "$tempdir/workdir");
 364         }
 365
 366         $recreatetarball_tempdir=$tempdir;
 367         return recreatetarball_helper(%options);
 368 }
 369
 370 sub recreatetarball_helper {
 371         my %options=@_;
 372         my $tempdir=$recreatetarball_tempdir;
 373
 374         my $ret="$tempdir/recreatetarball";
 375         my @cmd=($tar_program, "cf", $ret, "--owner", 0, "--group", 0,
 376                         "--numeric-owner", "-C", "$tempdir/workdir",
 377                         "--no-recursion", "--mode", "0644",
 378             "--files-from", "$tempdir/manifest");
 379         if (exists $options{tar_format}) {
 380                 push @cmd, ("-H", $options{tar_format});
 381         }
 382
 383         doit(@cmd);
 384
 385         return $ret;
 386 }
 387
 388 sub recreatetarball_longlink_100 {
 389         # For a long time, Debian's tar had a patch that made it output
 390         # larger tar files if a filename was exactly 100 bytes. Now that
 391         # Debian's tar has been fixed, in order to recreate the tarball
 392         # created by that version of tar, we reply on on an environment
 393         # variable to turn back on the old behavior.
 394         #
 395         # This variable is currently only available in Debian's tar,
 396         # so users of non-debian tar who want to recreate tarballs from
 397         # deltas created using the old version of Debian's tar are SOL.
 398
 399         $ENV{TAR_LONGLINK_100}=1;
 400         my $ret=recreatetarball_helper();
 401         delete $ENV{TAR_LONGLINK_100};
 402         return $ret;
 403 }
 404
 405 sub gentar {
 406         my $deltafile=shift;
 407         my $tarball=shift;
 408         my %opts=@_;
 409
 410         my $delta=Pristine::Tar::Delta::read(Tarball => $deltafile);
 411         Pristine::Tar::Delta::assert($delta, type => "tar", maxversion => 2,
 412                 minversion => 2, fields => [qw{manifest delta}]);
 413
 414         my $out=(defined $delta->{wrapper}
 415                 ? tempdir()."/".basename($tarball).".tmp"
 416                 : $tarball);
 417
 418         my @try;
 419         push @try, sub { recreatetarball($delta->{manifest}, getcwd,
 420                         clobber_source => 0, %opts) };
 421         push @try, \&recreatetarball_longlink_100;
 422         push @try, sub { recreatetarball($delta->{manifest}, getcwd,
 423                         clobber_source => 0, tar_format => "gnu", %opts) };
 424         push @try, sub { recreatetarball($delta->{manifest}, getcwd,
 425                         clobber_source => 0, tar_format => "posix", %opts) };
 426
 427         my $ok;
 428         foreach my $variant (@try) {
 429                 my $recreatetarball=$variant->();
 430                 my $ret=try_doit($xdelta_program, "patch", $delta->{delta}, $recreatetarball, $out);
 431                 if ($ret == 0) {
 432                         $ok=1;
 433                         last;
 434                 }
 435         }
 436         if (! $ok) {
 437                 error "Failed to reproduce original tarball. Please file a bug report.";
 438         }
 439
 440         if (defined $delta->{wrapper}) {
 441                 my $delta_wrapper=Pristine::Tar::Delta::read(Tarball => $delta->{wrapper});
 442                 if (grep { $_ eq $delta_wrapper->{type} } qw{gz bz2 xz}) {
 443                         doit("pristine-".$delta_wrapper->{type},
 444                                 ($verbose ? "-v" : "--no-verbose"),
 445                                 ($debug ? "-d" : "--no-debug"),
 446                                 ($keep ? "-k" : "--no-keep"),
 447                                 "gen".$delta_wrapper->{type},
 448                                 $delta->{wrapper}, $out);
 449                         doit("mv", "-f", $out.".".$delta_wrapper->{type}, $tarball);
 450                 }
 451                 else {
 452                         error "unknown wrapper file type: ".
 453                                 $delta_wrapper->{type};
 454                 }
 455         }
 456 }
 457
 458 sub genmanifest {
 459         my $tarball=shift;
 460         my $manifest=shift;
 461
 462         open(IN, "tar --quoting-style=escape -tf $tarball |") || die "tar tf: $!";
 463         open(OUT, ">", $manifest) || die "$!";
 464         while (<IN>) {
 465                 chomp;
 466                 # ./ or / in the manifest just confuses tar
 467                 s/^\.?\/+//;
 468                 print OUT "$_\n" if length $_;
 469         }
 470         close IN;
 471         close OUT;
 472 }
 473
 474 sub gendelta {
 475         my $tarball=shift;
 476         my $deltafile=shift;
 477         my %opts=@_;
 478
 479         my $tempdir=tempdir();
 480         my %delta;
 481
 482         # Check to see if it's compressed, and get uncompressed tarball.
 483         my $compression=undef;
 484         if (is_gz($tarball)) {
 485                 $compression='gz';
 486                 open(IN, "-|", "zcat", $tarball) || die "zcat: $!";
 487                 open(OUT, ">", "$tempdir/origtarball") || die "$tempdir/origtarball: $!";
 488                 print OUT $_ while <IN>;
 489                 close IN || die "zcat: $!";
 490                 close OUT || die "$tempdir/origtarball: $!";
 491         }
 492         elsif (is_bz2($tarball)) {
 493                 $compression='bz2';
 494                 open(IN, "-|", "bzcat", $tarball) || die "bzcat: $!";
 495                 open(OUT, ">", "$tempdir/origtarball") || die "$tempdir/origtarball: $!";
 496                 print OUT $_ while <IN>;
 497                 close IN || die "bzcat: $!";
 498                 close OUT || die "$tempdir/origtarball: $!";
 499         }
 500         elsif (is_xz($tarball)) {
 501                 $compression='xz';
 502                 open(IN, "-|", "xzcat", $tarball) || die "xzcat: $!";
 503                 open(OUT, ">", "$tempdir/origtarball") || die "$tempdir/origtarball: $!";
 504                 print OUT $_ while <IN>;
 505                 close IN || die "xzcat: $!";
 506                 close OUT || die "$tempdir/origtarball: $!";
 507         }
 508         close IN;
 509
 510         # Generate a wrapper file to recreate the compressed file.
 511         if (defined $compression) {
 512                 $delta{wrapper}="$tempdir/wrapper";
 513                 doit("pristine-$compression",
 514                         ($verbose ? "-v" : "--no-verbose"),
 515                         ($debug ? "-d" : "--no-debug"),
 516                         ($keep ? "-k" : "--no-keep"),
 517                         "gendelta", $tarball, $delta{wrapper});
 518                 $tarball="$tempdir/origtarball";
 519         }
 520
 521         $delta{manifest}="$tempdir/manifest";
 522         genmanifest($tarball, $delta{manifest});
 523
 524         my $recreatetarball;
 525         if (! exists $opts{recreatetarball}) {
 526                 my $sourcedir="$tempdir/tmp";
 527                 doit("mkdir", $sourcedir);
 528                 doit($tar_program, "xf", File::Spec->rel2abs($tarball), "-C", $sourcedir);
 529                 # if all files were in a subdir, use the subdir as the sourcedir
 530                 my @out=grep { $_ ne "$sourcedir/.." && $_ ne "$sourcedir/." }
 531                         (glob("$sourcedir/*"), glob("$sourcedir/.*"));
 532                 if ($#out == 0 && -d $out[0]) {
 533                         $sourcedir=$out[0];
 534                 }
 535                 $recreatetarball=recreatetarball("$tempdir/manifest", $sourcedir, clobber_source => 1);
 536         }
 537         else {
 538                 $recreatetarball=$opts{recreatetarball};
 539         }
 540
 541         $delta{delta}="$tempdir/delta";
 542         my $ret=system("$xdelta_program delta -0 --pristine $recreatetarball $tarball $delta{delta}") >> 8;
 543         # xdelta exits 1 on success if there were differences
 544         if ($ret != 1 && $ret != 0) {
 545                 error "xdelta failed with return code $ret";
 546         }
 547
 548         if (-s $delta{delta} >= -s $tarball) {
 549                 print STDERR "error: excessively large binary delta for $tarball\n";
 550                 if (! defined $compression) {
 551                         print STDERR "(Probably the tarball is compressed with an unsupported form of compression.)\n";
 552                 }
 553                 else {
 554                         print STDERR "(Please consider filing a bug report.)\n";
 555                 }
 556                 exit 1;
 557         }
 558
 559         Pristine::Tar::Delta::write(Tarball => $deltafile, {
 560                 version => 2,
 561                 type => 'tar',
 562                 %delta,
 563         });
 564 }
 565
 566 sub vcstype {
 567         if (-e ".git" ||
 568             (exists $ENV{GIT_DIR} && length $ENV{GIT_DIR})) {
 569                 return 'git';
 570         }
 571         else {
 572                 error("cannot determine type of vcs used for the current directory");
 573         }
 574 }
 575
 576 sub export {
 577         my $upstream=shift;
 578
 579         my $dest=tempdir();
 580         my $id;
 581
 582         my $vcs=vcstype();
 583         if ($vcs eq "git") {
 584                 if (defined $upstream && $upstream =~ /[A-Za-z0-9]{40}/) {
 585                         $id=$upstream;
 586                 }
 587                 else {
 588                         if (! defined $upstream) {
 589                                 $upstream='upstream';
 590                         }
 591
 592                         my @reflines=map { chomp; $_ } `git show-ref \Q$upstream\E`;
 593                         if (! @reflines) {
 594                                 error "failed to find ref using: git show-ref $upstream";
 595                         }
 596
 597                         # if one line's ref matches exactly, use it
 598                         foreach my $line (@reflines) {
 599                                 my ($b)=$line=~/^[A-Za-z0-9]+\s(.*)/;
 600                                 if ($b eq $upstream || $b eq "refs/heads/$upstream") {
 601                                         ($id)=$line=~/^([A-Za-z0-9]+)\s/;
 602                                         last;
 603                                 }
 604                         }
 605
 606                         if (! defined $id) {
 607                                 if (@reflines == 1) {
 608                                         ($id)=$reflines[0]=~/^([A-Za-z0-9]+)\s/;
 609                                 }
 610                                 else {
 611                                         error "more than one ref matches \"$upstream\":\n".
 612                                                 join("\n", @reflines);
 613                                 }
 614                         }
 615                 }
 616
 617                 # We have an id that is probably a commit. Let's get to the
 618                 # id of the actual tree instead. This makes us more robust
 619                 # against any later changes to the commit.
 620                 my $treeid=`git rev-parse '$id^{tree}'`;
 621                 chomp $treeid;
 622                 $id = $treeid if length $treeid;
 623
 624                 doit("git archive --format=tar \Q$id\E | (cd '$dest' && tar x)");
 625         }
 626         else {
 627                 die "unsupported vcs $vcs";
 628         }
 629
 630         return ($dest, $id);
 631 }
 632
 633 sub git_findbranch {
 634         # Looks for a branch with the given name. If a local branch exists,
 635         # returns it. Otherwise, looks for a remote branch, and if exactly
 636         # one exists, returns that. If there's no such branch at all, returns
 637         # undef. Finally, if there are multiple remote branches and no
 638         # local branch, fails with an error.
 639         my $branch=shift;
 640
 641         my @reflines=split(/\n/, `git show-ref \Q$branch\E`);
 642         my @remotes=grep { ! m/ refs\/heads\/\Q$branch\E$/ } @reflines;
 643         if ($#reflines != $#remotes) {
 644                 return $branch;
 645         }
 646         else {
 647                 if (@reflines == 0) {
 648                         return undef;
 649                 }
 650                 elsif (@remotes == 1) {
 651                         my ($remote_branch)=$remotes[0]=~/^[A-Za-z0-9]+\s(.*)/;
 652                         return $remote_branch;
 653                 }
 654                 else {
 655                         error "There's no local $branch branch. Several remote $branch branches exist.\n".
 656                                 "Run \"git branch --track $branch <remote>\" to create a local $branch branch\n".
 657                                 join("\n", @remotes);
 658                 }
 659         }
 660 }
 661
 662 sub checkoutdelta {
 663         my $tarball=shift;
 664
 665         my $branch="pristine-tar";
 666         my $deltafile=basename($tarball).".delta";
 667         my $idfile=basename($tarball).".id";
 668
 669         my ($delta, $id);
 670
 671         my $vcs=vcstype();
 672         if ($vcs eq "git") {
 673                 my $b=git_findbranch($branch);
 674                 if (! defined $b) {
 675                         error "no $branch branch found, use \"pristine-tar commit\" first";
 676                 }
 677                 elsif ($b eq $branch) {
 678                         $branch="refs/heads/$branch";
 679                 }
 680                 else {
 681                         # use remote branch
 682                         $branch=$b;
 683                 }
 684
 685                 $delta=`git show $branch:\Q$deltafile\E`;
 686                 if ($?) {
 687                         error "git show $branch:$deltafile failed";
 688                 }
 689                 if (! length $delta) {
 690                         error "git show $branch:$deltafile returned no content";
 691                 }
 692                 $id=`git show $branch:\Q$idfile\E`;
 693                 if ($?) {
 694                         error "git show $branch:$idfile failed";
 695                 }
 696                 chomp $id;
 697                 if (! length $id) {
 698                         error "git show $branch:$idfile returned no id";
 699                 }
 700         }
 701         else {
 702                 die "unsupported vcs $vcs";
 703         }
 704
 705         return ($delta, $id);
 706 }
 707
 708 sub commitdelta {
 709         my $delta=shift;
 710         my $id=shift;
 711         my $tarball=shift;
 712
 713         my $branch="pristine-tar";
 714         my $deltafile=basename($tarball).".delta";
 715         my $idfile=basename($tarball).".id";
 716         my $commit_message=defined $message ? $message :
 717                 "pristine-tar data for ".basename($tarball);
 718
 719         my $vcs=vcstype();
 720         if ($vcs eq "git") {
 721                 my $tempdir=tempdir();
 722                 open(OUT, ">$tempdir/$deltafile") || die "$tempdir/$deltafile: $!";
 723                 print OUT $delta;
 724                 close OUT;
 725                 open(OUT, ">$tempdir/$idfile") || die "$tempdir/$idfile: $!";
 726                 print OUT "$id\n";
 727                 close OUT;
 728
 729                 # Commit the delta to a branch in git without affecting the
 730                 # index, and without touching the working tree. Aka deep
 731                 # git magick.
 732                 $ENV{GIT_INDEX_FILE}="$tempdir/index";
 733                 $ENV{GIT_WORK_TREE}="$tempdir";
 734                 if (! exists $ENV{GIT_DIR} || ! length $ENV{GIT_DIR}) {
 735                         $ENV{GIT_DIR}=getcwd."/.git";
 736                 }
 737                 else {
 738                         $ENV{GIT_DIR}=abs_path($ENV{GIT_DIR});
 739                 }
 740                 chdir($tempdir) || die "chdir: $!";
 741
 742                 # If there's no local branch, branch from a remote branch
 743                 # if one exists. If there's no remote branch either, the
 744                 # code below will create the local branch.
 745                 my $b=git_findbranch($branch);
 746                 if (defined $b && $b ne $branch) {
 747                         doit("git branch --track \Q$branch\E \Q$b\E");
 748                 }
 749
 750                 my $branch_exists=(system("git show-ref --quiet --verify refs/heads/$branch") == 0);
 751                 if ($branch_exists) {
 752                         doit("git ls-tree -r --full-name $branch | git update-index --index-info");
 753                 }
 754                 doit("git", "update-index", "--add", $deltafile, $idfile);
 755                 my $sha=`git write-tree`;
 756                 if ($?) {
 757                         error("git write-tree failed");
 758                 }
 759                 $sha=~s/\n//sg;
 760                 if (! length $sha) {
 761                         error("git write-tree did not return a sha");
 762                 }
 763                 my $pid = open(COMMIT, "|-");
 764                 if (! $pid) {
 765                         # child
 766                         my $commitopts=$branch_exists ? "-p $branch" : "";
 767                         my $commitsha=`git commit-tree $sha $commitopts`;
 768                         if ($?) {
 769                                 error("git commit-tree failed");
 770                         }
 771                         $commitsha=~s/\n//sg;
 772                         if (! length $commitsha) {
 773                                 error("git commit-tree did not return a sha");
 774                         }
 775                         doit("git", "update-ref", "refs/heads/$branch", $commitsha);
 776                         exit 0;
 777                 }
 778                 else {
 779                         # parent
 780                         print COMMIT $commit_message."\n";
 781                         close COMMIT || error("git commit-tree failed");
 782                 }
 783
 784                 message("committed $deltafile to branch $branch");
 785         }
 786         else {
 787                 die "unsupported vcs $vcs";
 788         }
 789 }
 790
 791 sub commit {
 792         my $tarball=shift;
 793         my $upstream=shift; # optional
 794
 795         if (! defined $tarball || @_) {
 796                 usage();
 797         }
 798
 799         my $tempdir=tempdir();
 800         my ($sourcedir, $id)=export($upstream);
 801         genmanifest($tarball, "$tempdir/manifest");
 802         my $recreatetarball=recreatetarball("$tempdir/manifest", $sourcedir,
 803                 clobber_source => 1, create_missing => 1);
 804         my $pid = open(GENDELTA, "-|");
 805         if (! $pid) {
 806                 # child
 807                 gendelta($tarball, "-", recreatetarball => $recreatetarball);
 808                 exit 0;
 809         }
 810         local $/=undef;
 811         my $delta=<GENDELTA>;
 812         close GENDELTA || error "failed to generate delta";
 813         commitdelta($delta, $id, $tarball);
 814 }
 815
 816 sub checkout {
 817         my $tarball=shift;
 818
 819         my ($delta, $id)=checkoutdelta($tarball);
 820         my ($sourcedir, undef)=export($id);
 821         my $pid = open(GENTAR, "|-");
 822         if (! $pid) {
 823                 # child
 824                 $tarball=abs_path($tarball);
 825                 chdir($sourcedir) || die "chdir $sourcedir: $!";
 826                 gentar("-", $tarball, clobber_source => 1, create_missing => 1);
 827                 exit 0;
 828         }
 829         print GENTAR $delta;
 830         close GENTAR || error "failed to generate tarball";
 831
 832         message("successfully generated $tarball");
 833 }
 834
 835 sub list {
 836         my $branch="pristine-tar";
 837         my $vcs=vcstype();
 838         if ($vcs eq "git") {
 839                 my $b=git_findbranch($branch);
 840                 if (defined $b) {
 841                         open (LIST, "git ls-tree $b --name-only |");
 842                         while (<LIST>) {
 843                                 chomp;
 844                                 next unless s/\.delta$//;
 845                                 print $_."\n";
 846                         }
 847                 }
 848         }
 849         else {
 850                 die "unsupported vcs $vcs";
 851         }
 852 }