chiark / gitweb /
Fix a badly open-coded copy of check_not_dirty. Closes: #720524.
[dgit.git] / dgit
diff --git a/dgit b/dgit
index 94adcb5fd856349b8a2ec52bb56d1de74738257a..693aa18267d30ab931e6d4ce5c25ca6ff02ba7f2 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -24,6 +24,7 @@ use Data::Dumper;
 use LWP::UserAgent;
 use Dpkg::Control::Hash;
 use File::Path;
+use File::Basename;
 use Dpkg::Version;
 use POSIX;
 
@@ -36,6 +37,7 @@ our $dryrun = 0;
 our $changesfile;
 our $new_package = 0;
 our $existing_package = 'dpkg';
+our $cleanmode = 'dpkg-source';
 
 our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
 
@@ -45,14 +47,19 @@ our (@dput) = qw(dput);
 our (@debsign) = qw(debsign);
 our (@sbuild) = qw(sbuild -A);
 our (@dpkgbuildpackage) = qw(dpkg-buildpackage -i\.git/ -I.git);
+our (@dpkgsource) = qw(dpkg-source -i\.git/ -I.git);
+our (@dpkggenchanges) = qw(dpkg-genchanges);
 our (@mergechanges) = qw(mergechanges -f);
-
+our (@changesopts) = ('');
 
 our %opts_opt_map = ('dget' => \@dget,
                     'dput' => \@dput,
                     'debsign' => \@debsign,
                      'sbuild' => \@sbuild,
+                     'dpkg-source' => \@dpkgsource,
                      'dpkg-buildpackage' => \@dpkgbuildpackage,
+                     'dpkg-genchanges' => \@dpkggenchanges,
+                     'ch' => \@changesopts,
                      'mergechanges' => \@mergechanges);
 
 our $keyid;
@@ -61,7 +68,7 @@ our $debug = 0;
 open DEBUG, ">/dev/null" or die $!;
 
 our $remotename = 'dgit';
-our $ourdscfield = 'Vcs-Dgit-Master';
+our @ourdscfield = qw(Dgit Vcs-Dgit-Master);
 our $branchprefix = 'dgit';
 our $csuite;
 
@@ -78,6 +85,8 @@ sub debiantag ($) {
 
 sub dscfn ($) { return "${package}_$_[0].dsc"; }
 
+sub changesopts () { return @changesopts[1..$#changesopts]; }
+
 our $us = 'dgit';
 
 sub fail { die "$us: @_\n"; }
@@ -221,13 +230,13 @@ our %defcfg = ('dgit.default.distro' => 'debian',
               'dgit.default.ssh' => 'ssh',
               'dgit-distro.debian.git-host' => 'git.debian.org',
               'dgit-distro.debian.git-proto' => 'git+ssh://',
-              'dgit-distro.debian.git-path' => '/git/dgit-repos',
+              'dgit-distro.debian.git-path' => '/git/dgit-repos/repos',
               'dgit-distro.debian.git-check' => 'ssh-cmd',
               'dgit-distro.debian.git-create' => 'ssh-cmd',
               'dgit-distro.debian.sshdakls-host' => 'coccia.debian.org',
               'dgit-distro.debian.sshdakls-dir' =>
                   '/srv/ftp-master.debian.org/ftp/dists',
-              'dgit-distro.debian.mirror' => 'http://http.debian.net/debian/');
+              'dgit-distro.debian.mirror' => 'http://ftp.debian.org/debian/');
 
 sub cfg {
     foreach my $c (@_) {
@@ -406,6 +415,8 @@ sub canonicalise_suite_madison ($$) {
 }
 
 sub canonicalise_suite () {
+    return if defined $csuite;
+    fail "cannot operate on $isuite suite" if $isuite eq 'UNRELEASED';
     $csuite = archive_query('canonicalise_suite');
     if ($isuite ne $csuite) {
        # madison canonicalises for us
@@ -479,7 +490,7 @@ sub mktree_in_ud_from_only_subdir () {
     $dirs[0] =~ m#^([^/]+)/\.$# or die;
     my $dir = $1;
     chdir $dir or die "$dir $!";
-    die if stat '.git';
+    fail "source package contains .git directory" if stat '.git';
     die $! unless $!==&ENOENT;
     runcmd qw(git init -q);
     rmtree('.git/objects');
@@ -582,12 +593,9 @@ Last allegedly pushed/uploaded: $oversion (newer or same)
 $later_warning_msg
 END
             $outputhash = $upload_hash;
-       } elsif ($outputhash ne $upload_hash) {
-           fail "version in archive ($cversion)".
-               " is same as version in git".
-               " to-be-uploaded (upload/) branch ($oversion)".
-               " but archive version hash no commit hash?!";
-        }
+        } else {
+           $outputhash = $upload_hash;
+       }
     }
     chdir '../../../..' or die $!;
     runcmd @git, qw(update-ref -m),"dgit fetch import $cversion",
@@ -635,7 +643,10 @@ sub fetch_from_archive () {
     # ensures that lrref() is what is actually in the archive,
     #  one way or another
     get_archive_dsc() or return 0;
-    $dsc_hash = $dsc->{$ourdscfield};
+    foreach my $field (@ourdscfield) {
+       $dsc_hash = $dsc->{$field};
+       last if defined $dsc_hash;
+    }
     if (defined $dsc_hash) {
        $dsc_hash =~ m/\w+/ or fail "invalid hash in .dsc \`$dsc_hash'";
        $dsc_hash = $&;
@@ -659,11 +670,12 @@ sub fetch_from_archive () {
     if (defined $dsc_hash) {
        fail "missing git history even though dsc has hash -".
            " could not find commit $dsc_hash".
-           " (should be in ".access_giturl()."#".rref().")"
+           " (should be in ".access_giturl()."#".rrref().")"
            unless $upload_hash;
        $hash = $dsc_hash;
        ensure_we_have_orig();
-       if (is_fast_fwd($dsc_hash,$upload_hash)) {
+       if ($dsc_hash eq $upload_hash) {
+       } elsif (is_fast_fwd($dsc_hash,$upload_hash)) {
            print STDERR <<END or die $!;
 
 Git commit in archive is behind the last version allegedly pushed/uploaded.
@@ -672,6 +684,9 @@ Last allegedly pushed/uploaded: $upload_hash
 $later_warning_msg
 END
            $hash = $upload_hash;
+       } else {
+           fail "archive's .dsc refers to ".$dsc_hash.
+               " but this is an ancestor of ".$upload_hash;
        }
     } else {
        $hash = generate_commit_from_dsc();
@@ -744,24 +759,35 @@ sub check_not_dirty () {
     }
 }
 
-sub commit_quilty_patch ($) {
-    my ($vsn) = @_;
+sub commit_quilty_patch () {
     my $output = cmdoutput @git, qw(status --porcelain);
-    my %fixups = map {$_=>1}
-        (".pc/debian-changes-$vsn/","debian/patches/debian-changes-$vsn");
-    my @files;
+    my %adds;
+    my $bad=0;
     foreach my $l (split /\n/, $output) {
-       next unless $l =~ s/^\?\? //;
-       next unless $fixups{$l};
-       push @files, $l;
+       next unless $l =~ m/\S/;
+       if ($l =~ m{^(?:\?\?| M) (.pc|debian/patches)}) {
+           $adds{$1}++;
+       } else {
+           print STDERR "git status: $l\n";
+           $bad++;
+       }
     }
-    print DEBUG "checking for quilty\n", Dumper(\@files);
-    if (@files == 2) {
-       my $m = "Commit Debian 3.0 (quilt) metadata";
-       print "$m\n";
-       runcmd_ordryrun @git, qw(add), @files;
-       runcmd_ordryrun @git, qw(commit -m), $m;
+    fail "unexpected output from git status (is tree clean?)" if $bad;
+    if (!%adds) {
+       print "nothing quilty to commit, ok.\n";
+       return;
     }
+    runcmd_ordryrun @git, qw(add), sort keys %adds;
+    my $m = "Commit Debian 3.0 (quilt) metadata";
+    print "$m\n";
+    runcmd_ordryrun @git, qw(commit -m), $m;
+}
+
+sub madformat ($) {
+    my ($format) = @_;
+    return 0 unless $format eq '3.0 (quilt)';
+    print "Format \`$format', urgh\n";
+    return 1;
 }
 
 sub dopush () {
@@ -781,9 +807,8 @@ sub dopush () {
        fail "$dsc is for $dscpackage $dversion".
            " but debian/changelog is for $package $cversion";
     print DEBUG "format $format\n";
-    if ($format eq '3.0 (quilt)') {
-       print "Format \`$format', urgh\n";
-       commit_quilty_patch($dversion);
+    if (madformat($format)) {
+       commit_quilty_patch();
     }
     check_not_dirty();
     prep_ud();
@@ -809,7 +834,7 @@ sub dopush () {
 #    runcmd @git, qw(fetch -p ), "$alioth_git/$package.git",
 #        map { lref($_).":".rref($_) }
 #        (uploadbranch());
-    $dsc->{$ourdscfield} = rev_parse('HEAD');
+    $dsc->{$ourdscfield[0]} = rev_parse('HEAD');
     $dsc->save("../$dscfn.tmp") or die $!;
     if (!$changesfile) {
        my $multi = "../${package}_${cversion}_multi.changes";
@@ -826,6 +851,12 @@ sub dopush () {
            ($changesfile) = @cs;
        }
     }
+    my $changes = parsecontrol($changesfile,$changesfile);
+    foreach my $field (qw(Source Distribution Version)) {
+       $changes->{$field} eq $clogp->{$field} or
+           fail "changes field $field \`$changes->{$field}'".
+               " does not match changelog \`$clogp->{$field}'";
+    }
     my $tag = debiantag($dversion);
     if (!check_for_git()) {
        create_remote_git_repo();
@@ -922,7 +953,7 @@ sub cmd_pull {
 sub cmd_push {
     parseopts();
     badusage "-p is not allowed with dgit push" if defined $package;
-    runcmd @git, qw(diff --quiet HEAD);
+    check_not_dirty();
     my $clogp = parsechangelog();
     $package = getfield $clogp, 'Source';
     if (@ARGV==0) {
@@ -934,6 +965,9 @@ sub cmd_push {
     } else {
        badusage "incorrect arguments to dgit push";
     }
+    if (check_for_git()) {
+       git_fetch_us();
+    }
     if (fetch_from_archive()) {
        is_fast_fwd(lrref(), 'HEAD') or die;
     } else {
@@ -944,12 +978,89 @@ sub cmd_push {
     dopush();
 }
 
+our $version;
+our $sourcechanges;
+our $dscfn;
+
+our $fakeeditorenv = 'DGIT_FAKE_EDITOR_QUILT';
+
+sub build_maybe_quilt_fixup () {
+    if (!open F, "debian/source/format") {
+       die $! unless $!==&ENOENT;
+       return;
+    }
+    $_ = <F>;
+    F->error and die $!;
+    chomp;
+    return unless madformat($_);
+    # sigh
+    my $clogp = parsechangelog();
+    my $version = getfield $clogp, 'Version';
+    my $author = getfield $clogp, 'Maintainer';
+    my $headref = rev_parse('HEAD');
+    my $time = time;
+    my $ncommits = 3;
+    my $patchname = "auto-$version-$headref-$time";
+    my $msg = cmdoutput @git, qw(log), "-n$ncommits";
+    my $descfn = ".git/dgit/quilt-description.tmp";
+    open O, '>', $descfn or die "$descfn: $!";
+    $msg =~ s/\n/\n /g;
+    $msg =~ s/^\s+$/ ./mg;
+    print O <<END or die $!;
+Description: Automatically generated patch ($clogp->{Version})
+ Last (up to) $ncommits git changes, FYI:
+ .
+ $msg
+Author: $author
+
+---
+
+END
+    close O or die $!;
+    {
+       local $ENV{'EDITOR'} = cmdoutput qw(realpath --), $0;
+       local $ENV{'VISUAL'} = $ENV{'EDITOR'};
+       local $ENV{$fakeeditorenv} = cmdoutput qw(realpath --), $descfn;
+       runcmd_ordryrun @dpkgsource, qw(--commit .), $patchname;
+    }
+
+    if (!open P, '>>', ".pc/applied-patches") {
+       $!==&ENOENT or die $!;
+    } else {
+       close P;
+    }
+
+    commit_quilty_patch();
+}
+
+sub quilt_fixup_editor () {
+    my $descfn = $ENV{$fakeeditorenv};
+    my $editing = $ARGV[$#ARGV];
+    open I1, '<', $descfn or die "$descfn: $!";
+    open I2, '<', $editing or die "$editing: $!";
+    unlink $editing or die "$editing: $!";
+    open O, '>', $editing or die "$editing: $!";
+    while (<I1>) { print O or die $!; } I1->error and die $!;
+    my $copying = 0;
+    while (<I2>) {
+       $copying ||= m/^\-\-\- /;
+       next unless $copying;
+       print O or die $!;
+    }
+    I2->error and die $!;
+    close O or die $1;
+    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;
     my $clogp = parsechangelog();
     $isuite = getfield $clogp, 'Distribution';
     $package = getfield $clogp, 'Source';
+    $version = getfield $clogp, 'Version';
+    build_maybe_quilt_fixup();
     my @cmd =
        (qw(git-buildpackage -us -uc --git-no-sign-tags),
         "--git-builder=@dpkgbuildpackage");
@@ -957,21 +1068,51 @@ sub cmd_build {
        canonicalise_suite();
        push @cmd, "--git-debian-branch=".lbranch();
     }
+    push @cmd, changesopts();
     runcmd_ordryrun @cmd, @ARGV;
     printdone "build successful\n";
 }
 
-sub cmd_sbuild {
+sub build_source {
+    badusage "-p is not allowed with this action" if defined $package;
     check_not_dirty();
-    badusage "-p is not allowed with dgit sbuild" if defined $package;
     my $clogp = parsechangelog();
     $package = getfield $clogp, 'Source';
-    my $isuite = getfield $clogp, 'Distribution';
-    my $version = getfield $clogp, 'Version';
-    runcmd_ordryrun (@dpkgbuildpackage, qw(-us -uc -S));
+    $isuite = getfield $clogp, 'Distribution';
+    $version = getfield $clogp, 'Version';
+    $sourcechanges = "${package}_${version}_source.changes";
+    $dscfn = dscfn($version);
+    build_maybe_quilt_fixup();
+    if ($cleanmode eq 'dpkg-source') {
+       runcmd_ordryrun (@dpkgbuildpackage, qw(-us -uc -S)), changesopts();
+    } else {
+       if ($cleanmode eq 'git') {
+           runcmd_ordryrun @git, qw(clean -xdf);
+       } elsif ($cleanmode eq 'none') {
+       } else {
+           die "$cleanmode ?";
+       }
+       my $pwd = cmdoutput qw(env - pwd);
+       my $leafdir = basename $pwd;
+       chdir ".." or die $!;
+       runcmd_ordryrun @dpkgsource, qw(-b --), $leafdir;
+       chdir $pwd or die $!;
+       runcmd_ordryrun qw(sh -ec),
+           'exec >$1; shift; exec "$@"','x',
+           "../$sourcechanges",
+           @dpkggenchanges, qw(-S), changesopts();
+    }
+}
+
+sub cmd_build_source {
+    badusage "build-source takes no additional arguments" if @ARGV;
+    build_source();
+    printdone "source built, results in $dscfn and $sourcechanges";
+}
+
+sub cmd_sbuild {
+    build_source();
     chdir ".." or die $!;
-    my $sourcechanges = "${package}_${version}_source.changes";
-    my $dscfn = dscfn($version);
     my $pat = "${package}_${version}_*.changes";
     if (!$dryrun) {
        stat $dscfn or fail "$dscfn (in parent directory): $!";
@@ -991,9 +1132,10 @@ sub cmd_sbuild {
 }    
 
 sub cmd_quilt_fixup {
-    badusage "incorrect arguments to dgit quilt-fixup";
+    badusage "incorrect arguments to dgit quilt-fixup" if @ARGV;
     my $clogp = parsechangelog();
-    commit_quilty_patch((getfield $clogp, 'Version'));
+    $version = getfield $clogp, 'Version';
+    build_maybe_quilt_fixup();
 }
 
 sub parseopts () {
@@ -1011,14 +1153,21 @@ sub parseopts () {
                helponly();
            } elsif (m/^--new$/) {
                $new_package=1;
-           } elsif (m/^--(\w+)=(.*)/s && ($om = $opts_opt_map{$1})) {
+           } elsif (m/^--(\w+)=(.*)/s &&
+                    ($om = $opts_opt_map{$1}) &&
+                    length $om->[0]) {
                $om->[0] = $2;
-           } elsif (m/^--(\w+):(.*)/s && ($om = $opts_opt_map{$1})) {
+           } elsif (m/^--(\w+):(.*)/s &&
+                    ($om = $opts_opt_map{$1})) {
                push @$om, $2;
            } elsif (m/^--existing-package=(.*)/s) {
                $existing_package = $1;
            } elsif (m/^--distro=(.*)/s) {
                $idistro = $1;
+           } elsif (m/^--clean=(dpkg-source|git|none)$/s) {
+               $cleanmode = $1;
+           } elsif (m/^--clean=(.*)$/s) {
+               badusage "unknown cleaning mode \`$1'";
            } else {
                badusage "unknown long option \`$_'";
            }
@@ -1033,6 +1182,9 @@ sub parseopts () {
                    $debug++;
                } elsif (s/^-N/-/) {
                    $new_package=1;
+               } elsif (m/^-[vm]/) {
+                   push @changesopts, $_;
+                   $_ = '';
                } elsif (s/^-c(.*=.*)//s) {
                    push @git, '-c', $1;
                } elsif (s/^-d(.*)//s) {
@@ -1041,6 +1193,12 @@ sub parseopts () {
                    $changesfile = $1;
                } elsif (s/^-k(.*)//s) {
                    $keyid=$1;
+               } elsif (s/^-wn//s) {
+                   $cleanmode = 'none';
+               } elsif (s/^-wg//s) {
+                   $cleanmode = 'git';
+               } elsif (s/^-wd//s) {
+                   $cleanmode = 'dpkg-source';
                } else {
                    badusage "unknown short option \`$_'";
                }
@@ -1049,6 +1207,10 @@ sub parseopts () {
     }
 }
 
+if ($ENV{$fakeeditorenv}) {
+    quilt_fixup_editor();
+}
+
 parseopts();
 print STDERR "DRY RUN ONLY\n" if $dryrun;
 if (!@ARGV) {