← Back to branch summary

~ubuntu-branches/ubuntu/precise/pristine-tar/precise

« back to all changes in this revision

Viewing changes to pristine-tar

  • Committer: Bazaar Package Importer
  • Author(s): Joey Hess
  • Date: 2010-08-19 16:36:25 UTC
  • Revision ID: james.westby@ubuntu.com-20100819163625-y78g4vegbjm1n7mw
Tags: 1.10
http://bugs.debian.org/498760
* pristine-gz gengz: Bugfix: Always remove uncompressed input file.
* Large refactoring and modularization. (Thanks Gabriel de Perthuis
  for inspiration for this.))
* Remove environment variables used by tar, gz, and bzip2, to avoid
  local environment settings possibly breaking things.
  Closes: #498760 (probably; thanks Ralph Lange for analysis)
* Lintian fixes.

Show diffs side-by-side

added added

removed removed

Lines of Context:
pristine-tar
165
165
 
166
166
use warnings;
167
167
use strict;
168
 
use File::Temp;
 
168
use Pristine::Tar;
 
169
use Pristine::Tar::Delta;
 
170
use Pristine::Tar::Formats;
169
171
use File::Path;
170
172
use File::Basename;
171
 
use Getopt::Long;
172
173
use Cwd qw{getcwd abs_path};
173
174
 
174
 
# magic identification
175
 
use constant GZIP_ID1            => 0x1F;
176
 
use constant GZIP_ID2            => 0x8B;
177
 
use constant BZIP2_ID1           => 0x42;
178
 
use constant BZIP2_ID2           => 0x5a;
179
 
 
180
 
# compression methods, 0x00-0x07 are reserved
181
 
use constant GZIP_METHOD_DEFLATE => 0x08;
182
 
 
183
 
# compression methods, 'h' for Bzip2 ('H'uffman coding), '0' for Bzip1 (deprecated)
184
 
use constant BZIP2_METHOD_HUFFMAN => 0x68;
185
 
 
186
 
my $verbose=0;
187
 
my $debug=0;
188
 
my $keep=0;
189
 
my $message;
190
 
        
191
175
# Force locale to C since tar may output utf-8 filenames differently
192
176
# depending on the locale.
193
177
$ENV{LANG}='C';
194
178
 
 
179
# Don't let environment change tar's behavior.
 
180
delete $ENV{TAR_OPTIONS};
 
181
delete $ENV{TAPE};
 
182
 
 
183
my $message;
 
184
 
 
185
dispatch(
 
186
        commands => {
 
187
                usage => [\&usage],
 
188
                gentar => [\&gentar, 2],
 
189
                gendelta => [\&gendelta, 2],
 
190
                commit => [\&commit],
 
191
                ci => [\&commit, 1],
 
192
                checkout => [\&checkout, 1],
 
193
                co => [\&checkout, 1],
 
194
        },
 
195
        options => {
 
196
                "m|message=s" => \$message,
 
197
        },
 
198
);
 
199
 
195
200
sub usage {
196
201
        print STDERR "Usage: pristine-tar [-vdk] gendelta tarball delta\n";
197
202
        print STDERR "       pristine-tar [-vdk] gentar delta tarball\n";
200
205
        exit 1;
201
206
}
202
207
 
203
 
sub error {
204
 
        die "pristine-tar: @_\n";
205
 
}
206
 
 
207
 
sub message {
208
 
        print STDERR "pristine-tar: @_\n";
209
 
}
210
 
 
211
 
sub debug {
212
 
        message(@_) if $debug;
213
 
}
214
 
 
215
 
sub vprint {
216
 
        message(@_) if $verbose;
217
 
}
218
 
 
219
 
sub doit {
220
 
        vprint(@_);
221
 
        if (system(@_) != 0) {
222
 
                error "command failed: @_";
223
 
        }
224
 
}
225
 
 
226
 
sub tempdir {
227
 
        return File::Temp::tempdir("pristine-tar.XXXXXXXXXX",
228
 
                TMPDIR => 1, CLEANUP => !$keep);
229
 
}
230
 
 
231
 
# Workaround for bug #479317 in perl 5.10.
232
 
sub END {
233
 
        chdir("/");
234
 
}
235
 
 
236
208
sub recreatetarball {
237
 
        my $tempdir=shift;
 
209
        my $manifestfile=shift;
238
210
        my $source=shift;
239
211
        my %options=@_;
240
212
        
 
213
        my $tempdir=tempdir();
 
214
 
241
215
        my @manifest;
242
 
        open (IN, "$tempdir/manifest") || die "$tempdir/manifest: $!";
 
216
        open (IN, "<", $manifestfile) || die "$manifestfile: $!";
243
217
        while (<IN>) {
244
218
                chomp;
245
219
                push @manifest, $_;
246
220
        }
247
221
        close IN;
 
222
        link($manifestfile, "$tempdir/manifest") || die "link $tempdir/manifest: $!";
248
223
 
249
224
        # The manifest and source should have the same filenames,
250
225
        # but the manifest probably has all the files under a common
353
328
}
354
329
 
355
330
sub gentar {
356
 
        my $delta=shift;
 
331
        my $deltafile=shift;
357
332
        my $tarball=shift;
358
333
        my %opts=@_;
359
334
 
360
 
        my $tempdir=tempdir();
361
 
        
362
 
        if ($delta eq "-") {
363
 
                $delta="$tempdir/in";
364
 
                open (OUT, ">", $delta) || die "$delta: $!";
365
 
                while (<STDIN>) {
366
 
                        print OUT $_;
367
 
                }
368
 
                close OUT;
369
 
        }
370
 
 
371
 
        doit("tar", "xf", File::Spec->rel2abs($delta), "-C", $tempdir);
372
 
        if (! -e "$tempdir/type") {
373
 
                error "failed to gentar delta $delta";
374
 
        }
375
 
 
376
 
        open (IN, "$tempdir/version") || error "delta lacks version number ($!)";
377
 
        my $version=<IN>;
378
 
        if ($version >= 3 || $version < 2) {
379
 
                error "delta is version $version, not supported";
380
 
        }
381
 
        close IN;
382
 
        if (open (IN, "$tempdir/type")) {
383
 
                my $type=<IN>;
384
 
                chomp $type;
385
 
                if ($type ne "tar") {
386
 
                        error "delta is for a $type, not a tar";
387
 
                }
388
 
                close IN;
389
 
        }
390
 
 
391
 
        my $recreatetarball=recreatetarball($tempdir, getcwd, clobber_source => 0, %opts);
392
 
        my $out=(-e "$tempdir/wrapper")
393
 
                ? $tempdir."/".basename($tarball).".tmp"
394
 
                : $tarball;
395
 
        doit("xdelta", "patch", "$tempdir/delta", $recreatetarball, $out);
396
 
 
397
 
        if (-e "$tempdir/wrapper") {
398
 
                my $type=`tar xOzf $tempdir/wrapper type`;
399
 
                chomp $type;
400
 
                if ($type eq 'gz') {
 
335
        my $delta=Pristine::Tar::Delta::read(Tarball => $deltafile);
 
336
        Pristine::Tar::Delta::assert($delta, type => "tar", maxversion => 2,
 
337
                minversion => 2, fields => [qw{manifest delta}]);
 
338
 
 
339
        my $recreatetarball=recreatetarball($delta->{manifest}, getcwd, clobber_source => 0, %opts);
 
340
        my $out=(defined $delta->{wrapper}
 
341
                ? tempdir()."/".basename($tarball).".tmp"
 
342
                : $tarball);
 
343
        doit("xdelta", "patch", $delta->{delta}, $recreatetarball, $out);
 
344
 
 
345
        if (defined $delta->{wrapper}) {
 
346
                my $delta_wrapper=Pristine::Tar::Delta::read(Tarball => $delta->{wrapper});
 
347
                if ($delta_wrapper->{type} eq 'gz') {
401
348
                        doit("pristine-gz", 
402
349
                                ($verbose ? "-v" : "--no-verbose"),
403
350
                                ($debug ? "-d" : "--no-debug"),
404
351
                                ($keep ? "-k" : "--no-keep"),
405
 
                                "gengz", "$tempdir/wrapper", $out);
 
352
                                "gengz", $delta->{wrapper}, $out);
406
353
                        doit("mv", "-f", $out.".gz", $tarball);
407
354
                }
408
 
                elsif ($type eq 'bz2') {
 
355
                elsif ($delta_wrapper->{type} eq 'bz2') {
409
356
                        doit("pristine-bz2",
410
357
                                ($verbose ? "-v" : "--no-verbose"),
411
358
                                ($debug ? "-d" : "--no-debug"),
412
359
                                ($keep ? "-k" : "--no-keep"),
413
 
                                "genbz2", "$tempdir/wrapper", $out);
 
360
                                "genbz2", $delta->{wrapper}, $out);
414
361
                        doit("mv", "-f", $out.".bz2", $tarball);
415
362
                }
416
363
                else {
417
 
                        error "unknown wrapper file type: $type";
 
364
                        error "unknown wrapper file type: ".
 
365
                                $delta_wrapper->{type};
418
366
                }
419
367
        }
420
368
}
437
385
 
438
386
sub gendelta {
439
387
        my $tarball=shift;
440
 
        my $delta=shift;
 
388
        my $deltafile=shift;
441
389
        my %opts=@_;
442
390
 
443
391
        my $tempdir=tempdir();
444
 
        
445
 
        my $stdout=0;
446
 
        if ($delta eq "-") {
447
 
                $stdout=1;
448
 
                $delta="$tempdir/out";
449
 
        }
450
 
 
451
 
        my @files=qw(delta manifest version type);
452
 
 
453
 
        # Check to see if it's compressed.
 
392
        my %delta;
 
393
 
 
394
        # Check to see if it's compressed, and get uncompressed tarball.
454
395
        my $compression=undef;
455
 
        open (IN, "<", $tarball) || error "Cannot read $tarball: $!\n";
456
 
        my ($chars, $id1, $id2, $method);
457
 
        if (read(IN, $chars, 10) == 10 &&
458
 
            (($id1, $id2, $method) = unpack("CCC", $chars)) &&
459
 
            $id1 == GZIP_ID1 && $id2 == GZIP_ID2 &&
460
 
            $method == GZIP_METHOD_DEFLATE) {
 
396
        if (is_gz($tarball)) {
461
397
                $compression='gz';
462
398
                open(IN, "-|", "zcat", $tarball) || die "zcat: $!";
463
399
                open(OUT, ">", "$tempdir/origtarball") || die "$tempdir/origtarball: $!";
465
401
                close IN || die "zcat: $!";
466
402
                close OUT || die "$tempdir/origtarball: $!";
467
403
        }
468
 
        else {
469
 
                seek(IN, 0, 0) || die "seek: $!";
470
 
                if (read(IN, $chars, 3) == 3 &&
471
 
                    (($id1, $id2, $method) = unpack("CCC", $chars)) &&
472
 
                    $id1 == BZIP2_ID1 && $id2 == BZIP2_ID2 &&
473
 
                    $method == BZIP2_METHOD_HUFFMAN) {
474
 
                        $compression='bz2';
475
 
                        open(IN, "-|", "bzcat", $tarball) || die "bzcat: $!";
476
 
                        open(OUT, ">", "$tempdir/origtarball") || die "$tempdir/origtarball: $!";
477
 
                        print OUT $_ while <IN>;
478
 
                        close IN || die "bzcat: $!";
479
 
                        close OUT || die "$tempdir/origtarball: $!";
480
 
                }
 
404
        elsif (is_bz2($tarball)) {
 
405
                $compression='bz2';
 
406
                open(IN, "-|", "bzcat", $tarball) || die "bzcat: $!";
 
407
                open(OUT, ">", "$tempdir/origtarball") || die "$tempdir/origtarball: $!";
 
408
                print OUT $_ while <IN>;
 
409
                close IN || die "bzcat: $!";
 
410
                close OUT || die "$tempdir/origtarball: $!";
481
411
        }
482
412
        close IN;
483
413
        
484
414
        # Generate a wrapper file to recreate the compressed file.
485
415
        if (defined $compression) {
 
416
                $delta{wrapper}="$tempdir/wrapper";
486
417
                doit("pristine-$compression",
487
418
                        ($verbose ? "-v" : "--no-verbose"),
488
419
                        ($debug ? "-d" : "--no-debug"),
489
420
                        ($keep ? "-k" : "--no-keep"),
490
 
                        "gendelta", $tarball, "$tempdir/wrapper");
491
 
                push @files, "wrapper";
 
421
                        "gendelta", $tarball, $delta{wrapper});
492
422
                $tarball="$tempdir/origtarball";
493
423
        }
494
424
 
495
 
        genmanifest($tarball, "$tempdir/manifest");
 
425
        $delta{manifest}="$tempdir/manifest";
 
426
        genmanifest($tarball, $delta{manifest});
 
427
 
496
428
        my $recreatetarball;
497
429
        if (! exists $opts{recreatetarball}) {
498
430
                my $sourcedir="$tempdir/tmp";
504
436
                if ($#out == 0 && -d $out[0]) {
505
437
                        $sourcedir=$out[0];
506
438
                }
507
 
                $recreatetarball=recreatetarball($tempdir, $sourcedir, clobber_source => 1);
 
439
                $recreatetarball=recreatetarball("$tempdir/manifest", $sourcedir, clobber_source => 1);
508
440
        }
509
441
        else {
510
442
                $recreatetarball=$opts{recreatetarball};
511
443
        }
512
444
 
513
 
        my $ret=system("xdelta delta -0 --pristine $recreatetarball $tarball $tempdir/delta") >> 8;
 
445
        $delta{delta}="$tempdir/delta";
 
446
        my $ret=system("xdelta delta -0 --pristine $recreatetarball $tarball $delta{delta}") >> 8;
514
447
        # xdelta exits 1 on success if there were differences
515
448
        if ($ret != 1 && $ret != 0) {
516
449
                error "xdelta failed with return code $ret";
517
450
        }
518
451
 
519
 
        open(OUT, ">", "$tempdir/version") || die "$!";
520
 
        print OUT "2.0\n";
521
 
        close OUT;
522
 
        open(OUT, ">", "$tempdir/type") || die "$!";
523
 
        print OUT "tar\n";
524
 
        close OUT;
525
 
 
526
 
        doit("tar", "czf", $delta, "-C", $tempdir, @files);
527
 
 
528
 
        if ($stdout) {
529
 
                doit("cat", $delta);
530
 
        }
 
452
        Pristine::Tar::Delta::write(Tarball => $deltafile, {
 
453
                version => 2,
 
454
                type => 'tar',
 
455
                %delta,
 
456
        });
531
457
}
532
458
 
533
459
sub vcstype {
669
595
        my $delta=shift;
670
596
        my $id=shift;
671
597
        my $tarball=shift;
672
 
        
 
598
 
673
599
        my $branch="pristine-tar";
674
600
        my $deltafile=basename($tarball).".delta";
675
601
        my $idfile=basename($tarball).".id";
749
675
 
750
676
sub commit {
751
677
        my $tarball=shift;
752
 
        my $upstream=shift;
 
678
        my $upstream=shift; # optional
 
679
        
 
680
        if (! defined $tarball || @_) {
 
681
                usage();
 
682
        }
753
683
 
754
684
        my $tempdir=tempdir();
755
685
        my ($sourcedir, $id)=export($upstream);
756
686
        genmanifest($tarball, "$tempdir/manifest");
757
 
        my $recreatetarball=recreatetarball($tempdir, $sourcedir,
 
687
        my $recreatetarball=recreatetarball("$tempdir/manifest", $sourcedir,
758
688
                clobber_source => 1, create_missing => 1);
759
689
        my $pid = open(GENDELTA, "-|");
760
690
        if (! $pid) {
786
716
 
787
717
        message("successfully generated $tarball");
788
718
}
789
 
 
790
 
Getopt::Long::Configure("bundling");
791
 
if (! GetOptions(
792
 
        "m|message=s" => \$message,
793
 
        "v|verbose!" => \$verbose,
794
 
        "d|debug!" => \$debug,
795
 
        "k|keep!" => \$keep)) {
796
 
        usage();
797
 
}
798
 
 
799
 
usage unless @ARGV;
800
 
my $command=shift;
801
 
 
802
 
if ($command eq 'gentar') {
803
 
        usage unless @ARGV == 2;
804
 
        gentar(@ARGV);
805
 
}
806
 
elsif ($command eq 'gendelta') {
807
 
        usage unless @ARGV == 2;
808
 
        gendelta(@ARGV);
809
 
}
810
 
elsif ($command eq 'commit' || $command eq 'ci') {
811
 
        usage unless @ARGV >= 1;
812
 
        commit(@ARGV);
813
 
}
814
 
elsif ($command eq 'checkout' || $command eq 'co') {
815
 
        usage unless @ARGV == 1;
816
 
        checkout(@ARGV);
817
 
}
818
 
else {
819
 
        print STDERR "Unknown subcommand \"$command\"\n";
820
 
        usage();
821
 
}