chiark / gitweb /
Reject `dgit pull' in split view quilt modes
[dgit.git] / dgit
diff --git a/dgit b/dgit
index 426aef2eebba1c24abb8a8e2b2522507c1fab6e8..e4eba536122933c2d6528d8803d2c1d6b46a1cc6 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -67,6 +67,7 @@ our $rmchanges;
 our $overwrite_version; # undef: not specified; '': check changelog
 our $quilt_mode;
 our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck|gbp|dpm|unapplied';
+our $split_brain_save;
 our $we_are_responder;
 our $initiator_tempdir;
 our $patches_applied_dirtily = 00;
@@ -78,7 +79,8 @@ our %forceopts = map { $_=>0 }
     qw(unrepresentable unsupported-source-format
        dsc-changes-mismatch changes-origs-exactly
        import-gitapply-absurd
-       import-gitapply-no-absurd);
+       import-gitapply-no-absurd
+       import-dsc-with-dgit-field);
 
 our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
 
@@ -220,6 +222,12 @@ sub changespat ($;$) {
     return "${package}_".(stripepoch $vsn)."_".($arch//'*').".changes";
 }
 
+sub upstreamversion ($) {
+    my ($vsn) = @_;
+    $vsn =~ s/-[^-]+$//;
+    return $vsn;
+}
+
 our $us = 'dgit';
 initdebug('');
 
@@ -1828,10 +1836,15 @@ sub generate_commits_from_dsc () {
        my $f = $fi->{Filename};
        die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#;
 
-       link_ltarget "../../../$f", $f
+       printdebug "considering linking $f: ";
+
+       link_ltarget "../../../../$f", $f
+           or ((printdebug "($!) "), 0)
            or $!==&ENOENT
            or die "$f $!";
 
+       printdebug "linked.\n";
+
        complete_file_from_dsc('.', $fi)
            or next;
 
@@ -1848,8 +1861,7 @@ sub generate_commits_from_dsc () {
     # from the debian/changelog, so we record the tree objects now and
     # make them into commits later.
     my @tartrees;
-    my $upstreamv = $dsc->{version};
-    $upstreamv =~ s/-[^-]+$//;
+    my $upstreamv = upstreamversion $dsc->{version};
     my $orig_f_base = srcfn $upstreamv, '';
 
     foreach my $fi (@dfi) {
@@ -2210,6 +2222,7 @@ sub complete_file_from_dsc ($$) {
     if (stat_exists $tf) {
        progress "using existing $f";
     } else {
+       printdebug "$tf does not exist, need to fetch\n";
        my $furl = $dscurl;
        $furl =~ s{/[^/]+$}{};
        $furl .= "/$f";
@@ -2861,6 +2874,11 @@ sub clone ($) {
     }
     setup_new_tree();
     runcmd @git, qw(reset --hard), lrref();
+    runcmd qw(bash -ec), <<'END';
+        set -o pipefail
+        git ls-tree -r --name-only -z HEAD | \
+        xargs -0r touch -r . --
+END
     printdone "ready for work in $dstdir";
 }
 
@@ -2974,6 +2992,18 @@ sub madformat_wantfixup ($) {
     return 1;
 }
 
+sub maybe_split_brain_save ($$$) {
+    my ($headref, $dgitview, $msg) = @_;
+    # => message fragment "$saved" describing disposition of $dgitview
+    return "commit id $dgitview" unless defined $split_brain_save;
+    my @cmd = (shell_cmd "cd ../../../..",
+              @git, qw(update-ref -m),
+              "dgit --dgit-view-save $msg HEAD=$headref",
+              $split_brain_save, $dgitview);
+    runcmd @cmd;
+    return "and left in $split_brain_save";
+}
+
 # An "infopair" is a tuple [ $thing, $what ]
 # (often $thing is a commit hash; $what is a description)
 
@@ -3134,6 +3164,8 @@ END_OVERWR
 Make fast forward from $i_arch_v->[0]
 END_MAKEFF
 
+    maybe_split_brain_save $maintview, $r, "pseudomerge";
+
     progress "Made pseudo-merge of $i_arch_v->[0] into dgit view.";
     return $r;
 }      
@@ -3362,8 +3394,7 @@ END
     my $dgithead = $actualhead;
     my $maintviewhead = undef;
 
-    my $upstreamversion = $clogp->{Version};
-    $upstreamversion =~ s/-[^-]*$//;
+    my $upstreamversion = upstreamversion $clogp->{Version};
 
     if (madformat_wantfixup($format)) {
        # user might have not used dgit build, so maybe do this now:
@@ -3651,6 +3682,12 @@ sub cmd_fetch {
 sub cmd_pull {
     parseopts();
     fetchpullargs();
+    if (quiltmode_splitbrain()) {
+       my ($format, $fopts) = get_source_format();
+       madformat($format) and fail <<END
+dgit pull not yet supported in split view mode (--quilt=$quilt_mode)
+END
+    }
     pull();
 }
 
@@ -4152,9 +4189,10 @@ END
     runcmd @git, qw(update-ref -m), $cachekey, "refs/$splitbraincache",
        $dgitview;
 
-    progress "dgit view: created (commit id $dgitview)";
-
     changedir '.git/dgit/unpack/work';
+
+    my $saved = maybe_split_brain_save $headref, $dgitview, "converted";
+    progress "dgit view: created ($saved)";
 }
 
 sub quiltify ($$$$) {
@@ -4453,8 +4491,7 @@ END
     prep_ud();
     changedir $ud;
 
-    my $upstreamversion=$version;
-    $upstreamversion =~ s/-[^-]*$//;
+    my $upstreamversion = upstreamversion $version;
 
     if ($fopts->{'single-debian-patch'}) {
        quilt_fixup_singlepatch($clogp, $headref, $upstreamversion);
@@ -4624,8 +4661,9 @@ sub quilt_check_splitbrain_cache ($$) {
            
        my $cachehit = $1;
        quilt_fixup_mkwork($headref);
+       my $saved = maybe_split_brain_save $headref, $cachehit, "cache-hit";
        if ($cachehit ne $headref) {
-           progress "dgit view: found cached (commit id $cachehit)";
+           progress "dgit view: found cached ($saved)";
            runcmd @git, qw(checkout -q -b dgit-view), $cachehit;
            $split_brain = 1;
            return ($cachehit, $splitbrain_cachekey);
@@ -4931,15 +4969,21 @@ sub cmd_clean () {
     maybe_unapply_patches_again();
 }
 
-sub build_prep () {
+sub build_prep_early () {
+    our $build_prep_early_done //= 0;
+    return if $build_prep_early_done++;
     notpushing();
     badusage "-p is not allowed when building" if defined $package;
-    check_not_dirty();
-    clean_tree();
     my $clogp = parsechangelog();
     $isuite = getfield $clogp, 'Distribution';
     $package = getfield $clogp, 'Source';
     $version = getfield $clogp, 'Version';
+    check_not_dirty();
+}
+
+sub build_prep () {
+    build_prep_early();
+    clean_tree();
     build_maybe_quilt_fixup();
     if ($rmchanges) {
        my $pat = changespat $version;
@@ -5138,6 +5182,24 @@ sub pre_gbp_build {
 }
 
 sub cmd_gbp_build {
+    build_prep_early();
+
+    # gbp can make .origs out of thin air.  In my tests it does this
+    # even for a 1.0 format package, with no origs present.  So I
+    # guess it keys off just the version number.  We don't know
+    # exactly what .origs ought to exist, but let's assume that we
+    # should run gbp if: the version has an upstream part and the main
+    # orig is absent.
+    my $upstreamversion = upstreamversion $version;
+    my $origfnpat = srcfn $upstreamversion, '.orig.tar.*';
+    my $gbp_make_orig = $version =~ m/-/ && !(() = glob "../$origfnpat");
+
+    if ($gbp_make_orig) {
+       clean_tree();
+       $cleanmode = 'none'; # don't do it again
+       $need_split_build_invocation = 1;
+    }
+
     my @dbp = @dpkgbuildpackage;
 
     my $wantsrc = massage_dbp_args \@dbp, \@ARGV;
@@ -5153,6 +5215,24 @@ sub cmd_gbp_build {
 
     push @cmd, (qw(-us -uc --git-no-sign-tags), "--git-builder=@dbp");
 
+    if ($gbp_make_orig) {
+       ensuredir '.git/dgit';
+       my $ok = '.git/dgit/origs-gen-ok';
+       unlink $ok or $!==&ENOENT or die $!;
+       my @origs_cmd = @cmd;
+       push @origs_cmd, qw(--git-cleaner=true);
+       push @origs_cmd, "--git-prebuild=touch $ok .git/dgit/no-such-dir/ok";
+       push @origs_cmd, @ARGV;
+       if (act_local()) {
+           debugcmd @origs_cmd;
+           system @origs_cmd;
+           do { local $!; stat_exists $ok; }
+               or failedcmd @origs_cmd;
+       } else {
+           dryrun_report @origs_cmd;
+       }
+    }
+
     if ($wantsrc > 0) {
        build_source();
        midbuild_checkchanges_vanilla $wantsrc;
@@ -5268,6 +5348,157 @@ sub cmd_quilt_fixup {
     build_maybe_quilt_fixup();
 }
 
+sub cmd_import_dsc {
+    my $needsig = 0;
+
+    while (@ARGV) {
+       last unless $ARGV[0] =~ m/^-/;
+       $_ = shift @ARGV;
+       last if m/^--?$/;
+       if (m/^--require-valid-signature$/) {
+           $needsig = 1;
+       } else {
+           badusage "unknown dgit import-dsc sub-option \`$_'";
+       }
+    }
+
+    badusage "usage: dgit import-dsc .../PATH/TO/.DSC BRANCH" unless @ARGV==2;
+    my ($dscfn, $dstbranch) = @ARGV;
+
+    badusage "dry run makes no sense with import-dsc" unless act_local();
+
+    my $force = $dstbranch =~ s/^\+//   ? +1 :
+               $dstbranch =~ s/^\.\.// ? -1 :
+                                           0;
+    my $info = $force ? " $&" : '';
+    $info = "$dscfn$info";
+
+    my $specbranch = $dstbranch;
+    $dstbranch = "refs/heads/$dstbranch" unless $dstbranch =~ m#^refs/#;
+    $dstbranch = cmdoutput @git, qw(check-ref-format --normalize), $dstbranch;
+
+    my @symcmd = (@git, qw(symbolic-ref -q HEAD));
+    my $chead = cmdoutput_errok @symcmd;
+    defined $chead or $?==256 or failedcmd @symcmd;
+
+    fail "$dstbranch is checked out - will not update it"
+       if defined $chead and $chead eq $dstbranch;
+
+    my $oldhash = git_get_ref $dstbranch;
+
+    open D, "<", $dscfn or fail "open import .dsc ($dscfn): $!";
+    $dscdata = do { local $/ = undef; <D>; };
+    D->error and fail "read $dscfn: $!";
+    close C;
+
+    # we don't normally need this so import it here
+    use Dpkg::Source::Package;
+    my $dp = new Dpkg::Source::Package filename => $dscfn,
+       require_valid_signature => $needsig;
+    {
+       local $SIG{__WARN__} = sub {
+           print STDERR $_[0];
+           return unless $needsig;
+           fail "import-dsc signature check failed";
+       };
+       if (!$dp->is_signed()) {
+           warn "$us: warning: importing unsigned .dsc\n";
+       } else {
+           my $r = $dp->check_signature();
+           die "->check_signature => $r" if $needsig && $r;
+       }
+    }
+
+    parse_dscdata();
+
+    my $dgit_commit = $dsc->{$ourdscfield[0]};
+    if (defined $dgit_commit && 
+       !forceing [qw(import-dsc-with-dgit-field)]) {
+       $dgit_commit =~ m/\w+/ or fail "invalid hash in .dsc";
+       progress "dgit: import-dsc of .dsc with Dgit field, using git hash";
+       my @cmd = (qw(sh -ec),
+                  "echo $dgit_commit | git cat-file --batch-check");
+       my $objgot = cmdoutput @cmd;
+       if ($objgot =~ m#^\w+ missing\b#) {
+           fail <<END
+.dsc contains Dgit field referring to object $dgit_commit
+Your git tree does not have that object.  Try `git fetch' from a
+plausible server (browse.dgit.d.o? alioth?), and try the import-dsc again.
+END
+       }
+       if ($oldhash && !is_fast_fwd $oldhash, $dgit_commit) {
+           if ($force > 0) {
+               progress "Not fast forward, forced update.";
+           } else {
+               fail "Not fast forward to $dgit_commit";
+           }
+       }
+       @cmd = (@git, qw(update-ref -m), "dgit import-dsc (Dgit): $info",
+               $dstbranch, $dgit_commit);
+       runcmd @cmd;
+       progress "dgit: import-dsc updated git ref $dstbranch";
+       return 0;
+    }
+
+    fail <<END
+Branch $dstbranch already exists
+Specify ..$specbranch for a pseudo-merge, binding in existing history
+Specify  +$specbranch to overwrite, discarding existing history
+END
+       if $oldhash && !$force;
+
+    $package = getfield $dsc, 'Source';
+    my @dfi = dsc_files_info();
+    foreach my $fi (@dfi) {
+       my $f = $fi->{Filename};
+       my $here = "../$f";
+       next if lstat $here;
+       fail "stat $here: $!" unless $! == ENOENT;
+       my $there = $dscfn;
+       if ($dscfn =~ m#^(?:\./+)?\.\./+#) {
+           $there = $';
+       } elsif ($dscfn =~ m#^/#) {
+           $there = $dscfn;
+       } else {
+           fail "cannot import $dscfn which seems to be inside working tree!";
+       }
+       $there =~ s#/+[^/]+$## or
+           fail "cannot import $dscfn which seems to not have a basename";
+       $there .= "/$f";
+       symlink $there, $here or fail "symlink $there to $here: $!";
+       progress "made symlink $here -> $there";
+       print STDERR Dumper($fi);
+    }
+    my @mergeinputs = generate_commits_from_dsc();
+    die unless @mergeinputs == 1;
+
+    my $newhash = $mergeinputs[0]{Commit};
+
+    if ($oldhash) {
+       if ($force > 0) {
+           progress "Import, forced update - synthetic orphan git history.";
+       } elsif ($force < 0) {
+           progress "Import, merging.";
+           my $tree = cmdoutput @git, qw(rev-parse), "$newhash:";
+           my $version = getfield $dsc, 'Version';
+           $newhash = make_commit_text <<END;
+tree $tree
+parent $newhash
+parent $oldhash
+
+Merge $package ($version) import into $dstbranch
+END
+       } else {
+           die; # caught earlier
+       }
+    }
+
+    my @cmd = (@git, qw(update-ref -m), "dgit import-dsc: $info",
+              $dstbranch, $newhash);
+    runcmd @cmd;
+    progress "dgit: import-dsc results are in in git ref $dstbranch";
+}
+
 sub cmd_archive_api_query {
     badusage "need only 1 subpath argument" unless @ARGV==1;
     my ($subpath) = @ARGV;
@@ -5423,6 +5654,13 @@ sub parseopts () {
            } elsif (m/^--overwrite=(.+)$/s) {
                push @ropts, $_;
                $overwrite_version = $1;
+           } elsif (m/^--delayed=(\d+)$/s) {
+               push @ropts, $_;
+               push @dput, $_;
+           } elsif (m/^--dgit-view-save=(.+)$/s) {
+               push @ropts, $_;
+               $split_brain_save = $1;
+               $split_brain_save =~ s#^(?!refs/)#refs/heads/#;
            } elsif (m/^--(no-)?rm-old-changes$/s) {
                push @ropts, $_;
                $rmchanges = !$1;