chiark / gitweb /
Reuse already-downloaded .orig files after checking their hashes. Closes: #720526...
[dgit.git] / dgit
diff --git a/dgit b/dgit
index 693aa18267d30ab931e6d4ce5c25ca6ff02ba7f2..4550a86d897a8bb2e208e62b7630f2838f8a7401 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -36,6 +36,8 @@ our $sign = 1;
 our $dryrun = 0;
 our $changesfile;
 our $new_package = 0;
+our $ignoredirty = 0;
+our $noquilt = 0;
 our $existing_package = 'dpkg';
 our $cleanmode = 'dpkg-source';
 
@@ -83,7 +85,16 @@ sub debiantag ($) {
     return "debian/$v";
 }
 
-sub dscfn ($) { return "${package}_$_[0].dsc"; }
+sub stripepoch ($) {
+    my ($vsn) = @_;
+    $vsn =~ s/^\d+\://;
+    return $vsn;
+}
+
+sub dscfn ($) {
+    my ($vsn) = @_;
+    return "${package}_".(stripepoch $vsn).".dsc";
+}
 
 sub changesopts () { return @changesopts[1..$#changesopts]; }
 
@@ -399,7 +410,7 @@ sub madison_parse ($) {
        }
        $5 eq 'source' or die "$rmad ?";
        my $prefix = substr($package, 0, $package =~ m/^l/ ? 4 : 1);
-       my $subpath = "/pool/$component/$prefix/$package/${package}_$vsn.dsc";
+       my $subpath = "/pool/$component/$prefix/$package/".dscfn($vsn);
        push @out, [$vsn,$subpath,$newsuite];
     }
     return sort { -version_compare_string($a->[0],$b->[0]); } @out;
@@ -501,16 +512,35 @@ sub mktree_in_ud_from_only_subdir () {
     return ($tree,$dir);
 }
 
-sub dsc_files () {
-    my $field = $dsc->{'Checksums-Sha256'} || $dsc->{Files};
-    defined $field or
-       fail "missing both Checksums-Sha256 and Files in ".
+sub dsc_files_info () {
+    foreach my $csumi (['Checksums-Sha256','Digest::SHA', 'new(256)'],
+                      ['Checksums-Sha1',  'Digest::SHA', 'new(1)'],
+                      ['Files',           'Digest::MD5', 'new()']) {
+       my ($fname, $module, $method) = @$csumi;
+       my $field = $dsc->{$fname};
+       next unless defined $field;
+       eval "use $module; 1;" or die $@;
+       my @out;
+       foreach (split /\n/, $field) {
+           next unless m/\S/;
+           m/^(\w+) (\d+) (\S+)$/ or
+               fail "could not parse .dsc $fname line \`$_'";
+           my $digester = eval "$module"."->$method;" or die $@;
+           push @out, {
+               Hash => $1,
+               Bytes => $2,
+               Filename => $3,
+               Digester => $digester,
+           };
+       }
+       return @out;
+    }
+    fail "missing any supported Checksums-* or Files field in ".
        $dsc->get_option('name');
-    map {
-       m/^\w+ \d+ (\S+)$/ or
-           fail "could not parse .dsc Files/Checksums line \`$_'";
-       $1;
-    } grep m/\S/, split /\n/, $field;
+}
+
+sub dsc_files () {
+    map { $_->{Filename} } dsc_files_info();
 }
 
 sub is_orig_file ($) {
@@ -607,10 +637,20 @@ END
 }
 
 sub ensure_we_have_orig () {
-    foreach my $f (dsc_files()) {
+    foreach my $fi (dsc_files_info()) {
+       my $f = $fi->{Filename};
        next unless is_orig_file($f);
-       if (stat "../$f") {
-           die "$f ?" unless -f _;
+       if (open F, "<", "../$f") {
+           $fi->{Digester}->reset();
+           $fi->{Digester}->addfile(*F);
+           F->error and die $!;
+           my $got = $fi->{Digester}->hexdigest();
+           $got eq $fi->{Hash} or
+               fail "existing file $f has hash $got but .dsc".
+                   " demands hash $fi->{Hash}".
+                   " (perhaps you should delete this file?)";
+           print "using existing $f\n";
+           next;
        } else {
            die "$f $!" unless $!==&ENOENT;
        }
@@ -630,8 +670,14 @@ sub rev_parse ($) {
 
 sub is_fast_fwd ($$) {
     my ($ancestor,$child) = @_;
-    my $mb = cmdoutput @git, qw(merge-base), $ancestor, $child;
-    return rev_parse($mb) eq rev_parse($ancestor);
+    my @cmd = (@git, qw(merge-base), $ancestor, $child);
+    my $mb = cmdoutput_errok @cmd;
+    if (defined $mb) {
+       return rev_parse($mb) eq rev_parse($ancestor);
+    } else {
+       $?==256 or failedcmd @cmd;
+       return 0;
+    }
 }
 
 sub git_fetch_us () {
@@ -748,6 +794,7 @@ sub pull () {
 }
 
 sub check_not_dirty () {
+    return if $ignoredirty;
     my @cmd = (@git, qw(diff --quiet HEAD));
     printcmd(\*DEBUG,"+",@cmd) if $debug>0;
     $!=0; $?=0; system @cmd;
@@ -787,6 +834,10 @@ sub madformat ($) {
     my ($format) = @_;
     return 0 unless $format eq '3.0 (quilt)';
     print "Format \`$format', urgh\n";
+    if ($noquilt) {
+       print "Not doing any fixup of \`$format' due to --no-quilt-fixup";
+       return 0;
+    }
     return 1;
 }
 
@@ -837,12 +888,12 @@ sub dopush () {
     $dsc->{$ourdscfield[0]} = rev_parse('HEAD');
     $dsc->save("../$dscfn.tmp") or die $!;
     if (!$changesfile) {
-       my $multi = "../${package}_${cversion}_multi.changes";
+       my $multi = "../${package}_".(stripepoch $cversion)."_multi.changes";
        if (stat "$multi") {
            $changesfile = $multi;
        } else {
            $!==&ENOENT or die "$multi: $!";
-           my $pat = "${package}_${cversion}_*.changes";
+           my $pat = "${package}_".(stripepoch $cversion)."_*.changes";
            my @cs = glob "../$pat";
            fail "failed to find unique changes file".
                " (looked for $pat in .., or $multi);".
@@ -969,7 +1020,10 @@ sub cmd_push {
        git_fetch_us();
     }
     if (fetch_from_archive()) {
-       is_fast_fwd(lrref(), 'HEAD') or die;
+       is_fast_fwd(lrref(), 'HEAD') or
+           fail "dgit push: HEAD is not a descendant".
+               " of the archive's version.\n".
+               "$us: To overwrite it, use git-merge -s ours ".lrref().".";
     } else {
        $new_package or
            fail "package appears to be new in this suite;".
@@ -1052,19 +1106,32 @@ sub quilt_fixup_editor () {
     exit 0;
 }
 
-sub cmd_build {
-    # we pass further options and args to git-buildpackage
-    badusage "-p is not allowed with dgit build" if defined $package;
-    badusage "dgit build implies --clean=dpkg-source" if defined $package;
+sub build_prep () {
+    badusage "-p is not allowed when building" if defined $package;
+    check_not_dirty();
     my $clogp = parsechangelog();
     $isuite = getfield $clogp, 'Distribution';
     $package = getfield $clogp, 'Source';
     $version = getfield $clogp, 'Version';
     build_maybe_quilt_fixup();
+}
+
+sub cmd_build {
+    badusage "dgit build implies --clean=dpkg-source"
+       if $cleanmode ne 'dpkg-source';
+    build_prep();
+    runcmd_ordryrun @dpkgbuildpackage, qw(-us -uc), changesopts(), @ARGV;
+    printdone "build successful\n";
+}
+
+sub cmd_git_build {
+    badusage "dgit git-build implies --clean=dpkg-source"
+       if $cleanmode ne 'dpkg-source';
+    build_prep();
     my @cmd =
        (qw(git-buildpackage -us -uc --git-no-sign-tags),
         "--git-builder=@dpkgbuildpackage");
-    unless (grep { m/^--git-debian-branch/ } @ARGV) {
+    unless (grep { m/^--git-debian-branch|^--git-ignore-branch/ } @ARGV) {
        canonicalise_suite();
        push @cmd, "--git-debian-branch=".lbranch();
     }
@@ -1074,15 +1141,9 @@ sub cmd_build {
 }
 
 sub build_source {
-    badusage "-p is not allowed with this action" if defined $package;
-    check_not_dirty();
-    my $clogp = parsechangelog();
-    $package = getfield $clogp, 'Source';
-    $isuite = getfield $clogp, 'Distribution';
-    $version = getfield $clogp, 'Version';
-    $sourcechanges = "${package}_${version}_source.changes";
+    build_prep();
+    $sourcechanges = "${package}_".(stripepoch $version)."_source.changes";
     $dscfn = dscfn($version);
-    build_maybe_quilt_fixup();
     if ($cleanmode eq 'dpkg-source') {
        runcmd_ordryrun (@dpkgbuildpackage, qw(-us -uc -S)), changesopts();
     } else {
@@ -1113,7 +1174,7 @@ sub cmd_build_source {
 sub cmd_sbuild {
     build_source();
     chdir ".." or die $!;
-    my $pat = "${package}_${version}_*.changes";
+    my $pat = "${package}_".(stripepoch $version)."_*.changes";
     if (!$dryrun) {
        stat $dscfn or fail "$dscfn (in parent directory): $!";
        stat $sourcechanges or fail "$sourcechanges (in parent directory): $!";
@@ -1124,7 +1185,7 @@ sub cmd_sbuild {
     }
     runcmd_ordryrun @sbuild, @ARGV, qw(-d), $isuite, $dscfn;
     runcmd_ordryrun @mergechanges, glob $pat;
-    my $multichanges = "${package}_${version}_multi.changes";
+    my $multichanges = "${package}_".(stripepoch $version)."_multi.changes";
     if (!$dryrun) {
        stat $multichanges or fail "$multichanges: $!";
     }
@@ -1168,6 +1229,10 @@ sub parseopts () {
                $cleanmode = $1;
            } elsif (m/^--clean=(.*)$/s) {
                badusage "unknown cleaning mode \`$1'";
+           } elsif (m/^--ignore-dirty$/s) {
+               $ignoredirty = 1;
+           } elsif (m/^--no-quilt-fixup$/s) {
+               $noquilt = 1;
            } else {
                badusage "unknown long option \`$_'";
            }
@@ -1211,6 +1276,8 @@ if ($ENV{$fakeeditorenv}) {
     quilt_fixup_editor();
 }
 
+delete $ENV{'DGET_UNPACK'};
+
 parseopts();
 print STDERR "DRY RUN ONLY\n" if $dryrun;
 if (!@ARGV) {