chiark / gitweb /
Introduce --rm-old-changes to delete previous builds' changes files.
[dgit.git] / dgit
diff --git a/dgit b/dgit
index eaba82b4143d2babd6157f89c746184e55ee9a6d..38c1497f808cd9ec990a02a4b230ccad74c643df 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -59,6 +59,7 @@ our %previously;
 our $existing_package = 'dpkg';
 our $cleanmode;
 our $changes_since_version;
+our $rmchanges;
 our $quilt_mode;
 our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck';
 our $we_are_responder;
@@ -75,7 +76,7 @@ our (@curl) = qw(curl -f);
 our (@dput) = qw(dput);
 our (@debsign) = qw(debsign);
 our (@gpg) = qw(gpg);
-our (@sbuild) = qw(sbuild -A);
+our (@sbuild) = qw(sbuild);
 our (@ssh) = 'ssh';
 our (@dgit) = qw(dgit);
 our (@dpkgbuildpackage) = qw(dpkg-buildpackage -i\.git/ -I.git);
@@ -147,6 +148,11 @@ sub dscfn ($) {
     return srcfn($vsn,".dsc");
 }
 
+sub changespat ($;$) {
+    my ($vsn, $arch) = @_;
+    return "${package}_".(stripepoch $vsn)."_".($arch//'*').".changes";
+}
+
 our $us = 'dgit';
 initdebug('');
 
@@ -155,7 +161,7 @@ END {
     local ($?);
     foreach my $f (@end) {
        eval { $f->(); };
-       warn "$us: cleanup: $@" if length $@;
+       print STDERR "$us: cleanup: $@" if length $@;
     }
 };
 
@@ -1706,7 +1712,7 @@ sub clone ($) {
     canonicalise_suite();
     badusage "dry run makes no sense with clone" unless act_local();
     my $hasgit = check_for_git();
-    mkdir $dstdir or die "$dstdir $!";
+    mkdir $dstdir or fail "create \`$dstdir': $!";
     changedir $dstdir;
     runcmd @git, qw(init -q);
     my $giturl = access_giturl(1);
@@ -1751,7 +1757,14 @@ sub pull () {
 }
 
 sub check_not_dirty () {
+    foreach my $f (qw(local-options local-patch-header)) {
+       if (stat_exists "debian/source/$f") {
+           fail "git tree contains debian/source/$f";
+       }
+    }
+
     return if $ignoredirty;
+
     my @cmd = (@git, qw(diff --quiet HEAD));
     debugcmd "+",@cmd;
     $!=0; $?=0; system @cmd;
@@ -1761,10 +1774,6 @@ sub check_not_dirty () {
     } else {
        failedcmd @cmd;
     }
-
-    if (stat_exists "debian/source/local-options") {
-       fail "git tree contains debian/source/local-options";
-    }
 }
 
 sub commit_admin ($) {
@@ -1994,12 +2003,11 @@ END
     }
     my $head = git_rev_parse('HEAD');
     if (!$changesfile) {
-       my $multi = "$buildproductsdir/".
-           "${package}_".(stripepoch $cversion)."_multi.changes";
+       my $multi = "$buildproductsdir/".changespat $cversion,'multi';
        if (stat_exists "$multi") {
            $changesfile = $multi;
        } else {
-           my $pat = "${package}_".(stripepoch $cversion)."_*.changes";
+           my $pat = changespat $cversion;
            my @cs = glob "$buildproductsdir/$pat";
            fail "failed to find unique changes file".
                " (looked for $pat in $buildproductsdir, or $multi);".
@@ -2080,7 +2088,7 @@ END
        sign_changes $changesfile;
     }
 
-    supplementary_message(<<'END');
+    supplementary_message(<<END);
 Push failed, while uploading package(s) to the archive server.
 You can retry the upload of exactly these same files with dput of:
   $changesfile
@@ -2128,7 +2136,13 @@ sub cmd_clone {
                return if $!==&ENOENT;
                die "chdir $cwd_remove: $!";
            }
-           rmtree($dstdir) or die "remove $dstdir: $!\n";
+           if (stat $dstdir) {
+               rmtree($dstdir) or die "remove $dstdir: $!\n";
+           } elsif (!grep { $! == $_ }
+                    (ENOENT, ENOTDIR, EACCES, EPERM, ELOOP)) {
+           } else {
+               print STDERR "check whether to remove $dstdir: $!\n";
+           }
        };
     }
 
@@ -2779,7 +2793,12 @@ sub quilt_fixup_linkorigs ($$) {
 
     foreach my $f (<../../../../*>) { #/){
        my $b=$f; $b =~ s{.*/}{};
+       {
+           local ($debuglevel) = $debuglevel-1;
+           printdebug "QF linkorigs $b, $f ?\n";
+       }
        next unless is_orig_file $b, srcfn $upstreamversion,'';
+       printdebug "QF linkorigs $b, $f Y\n";
        link_ltarget $f, $b or die "$b $!";
         $fn->($b);
     }
@@ -2793,6 +2812,8 @@ sub quilt_fixup_delete_pc () {
 sub quilt_fixup_singlepatch ($$$) {
     my ($clogp, $headref, $upstreamversion) = @_;
 
+    progress "starting quiltify (single-debian-patch)";
+
     # dpkg-source --commit generates new patches even if
     # single-debian-patch is in debian/source/options.  In order to
     # get it to generate debian/patches/debian-changes, it is
@@ -2818,6 +2839,8 @@ sub quilt_fixup_singlepatch ($$$) {
 sub quilt_fixup_multipatch ($$$) {
     my ($clogp, $headref, $upstreamversion) = @_;
 
+    progress "starting quiltify (multiple patches, $quilt_mode mode)";
+
     # Our objective is:
     #  - honour any existing .pc in case it has any strangeness
     #  - determine the git commit corresponding to the tip of
@@ -2991,6 +3014,16 @@ sub build_prep () {
     $package = getfield $clogp, 'Source';
     $version = getfield $clogp, 'Version';
     build_maybe_quilt_fixup();
+    if ($rmchanges) {
+       my $pat = changespat $version;
+       foreach my $f (glob "$buildproductsdir/$pat") {
+           if (act_local()) {
+               unlink $f or fail "remove old changes file $f: $!";
+           } else {
+               progress "would remove $f";
+           }
+       }
+    }
 }
 
 sub changesopts_initial () {
@@ -3040,7 +3073,7 @@ sub massage_dbp_args ($;$) {
     push @newcmd, '-nc';
     # and some combinations of -S, -b, et al, are errors, rather than
     # later simply overriding earlier
-    push @newcmd, '-F' unless grep { m/^-[bBASF]$/ } (@$cmd, @$xargs);
+    push @newcmd, '-F' unless grep { m/^-[bBASFgG]$/ } (@$cmd, @$xargs);
     push @newcmd, @$cmd;
     @$cmd = @newcmd;
 }
@@ -3088,14 +3121,14 @@ sub build_source {
        $suppress_clean = 1;
     }
     build_prep();
-    $sourcechanges = "${package}_".(stripepoch $version)."_source.changes";
+    $sourcechanges = changespat $version,'source';
     $dscfn = dscfn($version);
     if ($cleanmode eq 'dpkg-source') {
-       runcmd_ordryrun_local (@dpkgbuildpackage, qw(-us -uc -S)),
-           changesopts();
+       runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc -S),
+                              changesopts();
     } elsif ($cleanmode eq 'dpkg-source-d') {
-       runcmd_ordryrun_local (@dpkgbuildpackage, qw(-us -uc -S -d)),
-           changesopts();
+       runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc -S -d),
+                              changesopts();
     } else {
        my $pwd = must_getcwd();
        my $leafdir = basename $pwd;
@@ -3118,7 +3151,7 @@ sub cmd_build_source {
 sub cmd_sbuild {
     build_source();
     changedir "..";
-    my $pat = "${package}_".(stripepoch $version)."_*.changes";
+    my $pat = changespat $version;
     if (act_local()) {
        stat_exists $dscfn or fail "$dscfn (in parent directory): $!";
        stat_exists $sourcechanges
@@ -3128,18 +3161,27 @@ sub cmd_sbuild {
            unlink $cf or fail "remove $cf: $!";
        }
     }
-    runcmd_ordryrun_local @sbuild, @ARGV, qw(-d), $isuite, $dscfn;
+    runcmd_ordryrun_local @sbuild, qw(-d), $isuite, @ARGV, $dscfn;
     my @changesfiles = glob $pat;
     @changesfiles = sort {
        ($b =~ m/_source\.changes$/ <=> $a =~ m/_source\.changes$/)
            or $a cmp $b
     } @changesfiles;
     fail "wrong number of different changes files (@changesfiles)"
-       unless @changesfiles;
+       unless @changesfiles==2;
+    my $binchanges = parsecontrol($changesfiles[1], "binary changes file");
+    foreach my $l (split /\n/, getfield $binchanges, 'Files') {
+       fail "$l found in binaries changes file $binchanges"
+           if $l =~ m/\.dsc$/;
+    }
     runcmd_ordryrun_local @mergechanges, @changesfiles;
-    my $multichanges = "${package}_".(stripepoch $version)."_multi.changes";
+    my $multichanges = changespat $version,'multi';
     if (act_local()) {
        stat_exists $multichanges or fail "$multichanges: $!";
+       foreach my $cf (glob $pat) {
+           next if $cf eq $multichanges;
+           rename "$cf", "$cf.inmulti" or fail "$cf\{,.inmulti}: $!";
+       }
     }
     printdone "build successful, results in $multichanges\n" or die $!;
 }    
@@ -3149,6 +3191,8 @@ sub cmd_quilt_fixup {
     my $clogp = parsechangelog();
     $version = getfield $clogp, 'Version';
     $package = getfield $clogp, 'Source';
+    check_not_dirty();
+    clean_tree();
     build_maybe_quilt_fixup();
 }
 
@@ -3299,6 +3343,9 @@ sub parseopts () {
            } elsif (m/^--no-rm-on-error$/s) {
                push @ropts, $_;
                $rmonerror = 0;
+           } elsif (m/^--(no-)?rm-old-changes$/s) {
+               push @ropts, $_;
+               $rmchanges = !$1;
            } elsif (m/^--deliberately-($deliberately_re)$/s) {
                push @ropts, $_;
                push @deliberatelies, $&;
@@ -3405,6 +3452,11 @@ if (!@ARGV) {
 my $cmd = shift @ARGV;
 $cmd =~ y/-/_/;
 
+if (!defined $rmchanges) {
+    local $access_forpush;
+    $rmchanges = access_cfg_bool(0, 'rm-old-changes');
+}
+
 if (!defined $quilt_mode) {
     local $access_forpush;
     $quilt_mode = cfg('dgit.force.quilt-mode', 'RETURN-UNDEF')