chiark / gitweb /
Test suite: inarchivecopy: Test a suite containing only inarchive copies
[dgit.git] / dgit
diff --git a/dgit b/dgit
index 6cdf8d2..8264f3e 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -41,6 +41,7 @@ use Carp;
 use Debian::Dgit;
 
 our $our_version = 'UNRELEASED'; ###substituted###
+our $absurdity = undef; ###substituted###
 
 our @rpushprotovsn_support = qw(4 3 2); # 4 is new tag format
 our $protovsn;
@@ -66,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;
@@ -73,6 +75,13 @@ our $tagformat_want;
 our $tagformat;
 our $tagformatfn;
 
+our %forceopts = map { $_=>0 }
+    qw(unrepresentable unsupported-source-format
+       dsc-changes-mismatch changes-origs-exactly
+       import-gitapply-absurd
+       import-gitapply-no-absurd
+       import-dsc-with-dgit-field);
+
 our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
 
 our $suite_re = '[-+.0-9a-z]+';
@@ -86,7 +95,7 @@ our $splitbraincache = 'dgit-intern/quilt-cache';
 
 our (@git) = qw(git);
 our (@dget) = qw(dget);
-our (@curl) = qw(curl -f);
+our (@curl) = qw(curl);
 our (@dput) = qw(dput);
 our (@debsign) = qw(debsign);
 our (@gpg) = qw(gpg);
@@ -144,6 +153,11 @@ our @ourdscfield = qw(Dgit Vcs-Dgit-Master);
 our $csuite;
 our $instead_distro;
 
+if (!defined $absurdity) {
+    $absurdity = $0;
+    $absurdity =~ s{/[^/]+$}{/absurd} or die;
+}
+
 sub debiantag ($$) {
     my ($v,$distro) = @_;
     return $tagformatfn->($v, $distro);
@@ -208,6 +222,12 @@ sub changespat ($;$) {
     return "${package}_".(stripepoch $vsn)."_".($arch//'*').".changes";
 }
 
+sub upstreamversion ($) {
+    my ($vsn) = @_;
+    $vsn =~ s/-[^-]+$//;
+    return $vsn;
+}
+
 our $us = 'dgit';
 initdebug('');
 
@@ -222,6 +242,20 @@ END {
 
 sub badcfg { print STDERR "$us: invalid configuration: @_\n"; exit 12; }
 
+sub forceable_fail ($$) {
+    my ($forceoptsl, $msg) = @_;
+    fail $msg unless grep { $forceopts{$_} } @$forceoptsl;
+    print STDERR "warning: overriding problem due to --force:\n". $msg;
+}
+
+sub forceing ($) {
+    my ($forceoptsl) = @_;
+    my @got = grep { $forceopts{$_} } @$forceoptsl;
+    return 0 unless @got;
+    print STDERR
+ "warning: skipping checks or functionality due to --force-$got[0]\n";
+}
+
 sub no_such_package () {
     print STDERR "$us: package $package does not exist in suite $isuite\n";
     exit 4;
@@ -593,7 +627,7 @@ our %defcfg = ('dgit.default.distro' => 'debian',
               'dgit-distro.test-dummy.git-url' => "$td/git",
               'dgit-distro.test-dummy.git-host' => "git",
               'dgit-distro.test-dummy.git-path' => "$td/git",
-              'dgit-distro.test-dummy.archive-query' => "ftpmasterapi:",
+              'dgit-distro.test-dummy.archive-query' => "dummycatapi:",
               'dgit-distro.test-dummy.archive-query-url' => "file://$td/aq/",
               'dgit-distro.test-dummy.mirror' => "file://$td/mirror/",
               'dgit-distro.test-dummy.upload-host' => 'test-dummy',
@@ -934,15 +968,22 @@ sub must_getcwd () {
     return $d;
 }
 
+sub parse_dscdata () {
+    my $dscfh = new IO::File \$dscdata, '<' or die $!;
+    printdebug Dumper($dscdata) if $debuglevel>1;
+    $dsc = parsecontrolfh($dscfh,$dscurl,1);
+    printdebug Dumper($dsc) if $debuglevel>1;
+}
+
 our %rmad;
 
-sub archive_query ($) {
-    my ($method) = @_;
+sub archive_query ($;@) {
+    my ($method) = shift @_;
     my $query = access_cfg('archive-query','RETURN-UNDEF');
     $query =~ s/^(\w+):// or badcfg "invalid archive-query method \`$query'";
     my $proto = $1;
     my $data = $'; #';
-    { no strict qw(refs); &{"${method}_${proto}"}($proto,$data); }
+    { no strict qw(refs); &{"${method}_${proto}"}($proto,$data,@_); }
 }
 
 sub pool_dsc_subpath ($$) {
@@ -955,7 +996,7 @@ sub pool_dsc_subpath ($$) {
 
 sub archive_api_query_cmd ($) {
     my ($subpath) = @_;
-    my @cmd = qw(curl -sS);
+    my @cmd = (@curl, qw(-sS));
     my $url = access_cfg('archive-query-url');
     if ($url =~ m#^https://([-.0-9a-z]+)/#) {
        my $host = $1;
@@ -983,17 +1024,27 @@ sub archive_api_query_cmd ($) {
     return @cmd;
 }
 
-sub api_query ($$) {
+sub api_query ($$;$) {
     use JSON;
-    my ($data, $subpath) = @_;
+    my ($data, $subpath, $ok404) = @_;
     badcfg "ftpmasterapi archive query method takes no data part"
        if length $data;
     my @cmd = archive_api_query_cmd($subpath);
+    my $url = $cmd[$#cmd];
+    push @cmd, qw(-w %{http_code});
     my $json = cmdoutput @cmd;
+    unless ($json =~ s/\d+\d+\d$//) {
+       failedcmd_report_cmd undef, @cmd;
+       fail "curl failed to print 3-digit HTTP code";
+    }
+    my $code = $&;
+    return undef if $code eq '404' && $ok404;
+    fail "fetch of $url gave HTTP code $code"
+       unless $url =~ m#^file://# or $code =~ m/^2/;
     return decode_json($json);
 }
 
-sub canonicalise_suite_ftpmasterapi () {
+sub canonicalise_suite_ftpmasterapi {
     my ($proto,$data) = @_;
     my $suites = api_query($data, 'suites');
     my @matched;
@@ -1017,7 +1068,7 @@ sub canonicalise_suite_ftpmasterapi () {
     return $cn;
 }
 
-sub archive_query_ftpmasterapi () {
+sub archive_query_ftpmasterapi {
     my ($proto,$data) = @_;
     my $info = api_query($data, "dsc_in_suite/$isuite/$package");
     my @rows;
@@ -1044,6 +1095,42 @@ sub archive_query_ftpmasterapi () {
     return @rows;
 }
 
+sub file_in_archive_ftpmasterapi {
+    my ($proto,$data,$filename) = @_;
+    my $pat = $filename;
+    $pat =~ s/_/\\_/g;
+    $pat = "%/$pat";
+    $pat =~ s#[^-+_.0-9a-z/]# sprintf '%%%02x', ord $& #ge;
+    my $info = api_query($data, "file_in_archive/$pat", 1);
+}
+
+#---------- `dummyapicat' archive query method ----------
+
+sub archive_query_dummycatapi { archive_query_ftpmasterapi @_; }
+sub canonicalise_suite_dummycatapi { canonicalise_suite_ftpmasterapi @_; }
+
+sub file_in_archive_dummycatapi ($$$) {
+    my ($proto,$data,$filename) = @_;
+    my $mirror = access_cfg('mirror');
+    $mirror =~ s#^file://#/# or die "$mirror ?";
+    my @out;
+    my @cmd = (qw(sh -ec), '
+            cd "$1"
+            find -name "$2" -print0 |
+            xargs -0r sha256sum
+        ', qw(x), $mirror, $filename);
+    debugcmd "-|", @cmd;
+    open FIA, "-|", @cmd or die $!;
+    while (<FIA>) {
+       chomp or die;
+       printdebug "| $_\n";
+       m/^(\w+)  (\S+)$/ or die "$_ ?";
+       push @out, { sha256sum => $1, filename => $2 };
+    }
+    close FIA or die failedcmd @cmd;
+    return \@out;
+}
+
 #---------- `madison' archive query method ----------
 
 sub archive_query_madison {
@@ -1092,6 +1179,8 @@ sub canonicalise_suite_madison {
     return $r[0][2];
 }
 
+sub file_in_archive_madison { return undef; }
+
 #---------- `sshpsql' archive query method ----------
 
 sub sshpsql ($$$) {
@@ -1167,6 +1256,8 @@ END
     return $rows[0];
 }
 
+sub file_in_archive_sshpsql ($$$) { return undef; }
+
 #---------- `dummycat' archive query method ----------
 
 sub canonicalise_suite_dummycat ($$) {
@@ -1208,6 +1299,8 @@ sub archive_query_dummycat ($$) {
     return sort { -version_compare($a->[0],$b->[0]); } @rows;
 }
 
+sub file_in_archive_dummycat () { return undef; }
+
 #---------- tag format handling ----------
 
 sub access_cfg_tagformats () {
@@ -1280,12 +1373,11 @@ sub get_archive_dsc () {
                fail "$dscurl has hash $got but".
                    " archive told us to expect $digest";
        }
-       my $dscfh = new IO::File \$dscdata, '<' or die $!;
-       printdebug Dumper($dscdata) if $debuglevel>1;
-       $dsc = parsecontrolfh($dscfh,$dscurl,1);
-       printdebug Dumper($dsc) if $debuglevel>1;
+       parse_dscdata();
        my $fmt = getfield $dsc, 'Format';
-       fail "unsupported source format $fmt, sorry" unless $format_ok{$fmt};
+       $format_ok{$fmt} or forceable_fail [qw(unsupported-source-format)],
+           "unsupported source format $fmt, sorry";
+           
        $dsc_checked = !!$digester;
        printdebug "get_archive_dsc: Version ".(getfield $dsc, 'Version')."\n";
        return;
@@ -1321,7 +1413,7 @@ sub check_for_git () {
        my $suffix = access_cfg('git-check-suffix','git-suffix',
                                'RETURN-UNDEF') // '.git';
        my $url = "$prefix/$package$suffix";
-       my @cmd = (qw(curl -sS -I), $url);
+       my @cmd = (@curl, qw(-sS -I), $url);
        my $result = cmdoutput @cmd;
        $result =~ s/^\S+ 200 .*\n\r?\n//;
        # curl -sS -I with https_proxy prints
@@ -1427,9 +1519,9 @@ sub mktree_in_ud_from_only_subdir (;$) {
 }
 
 our @files_csum_info_fields = 
-    (['Checksums-Sha256','Digest::SHA', 'new(256)'],
-     ['Checksums-Sha1',  'Digest::SHA', 'new(1)'],
-     ['Files',           'Digest::MD5', 'new()']);
+    (['Checksums-Sha256','Digest::SHA', 'new(256)', 'sha256sum'],
+     ['Checksums-Sha1',  'Digest::SHA', 'new(1)',   'sha1sum'],
+     ['Files',           'Digest::MD5', 'new()',    'md5sum']);
 
 sub dsc_files_info () {
     foreach my $csumi (@files_csum_info_fields) {
@@ -1535,6 +1627,101 @@ sub is_orig_file_of_vsn ($$) {
     return 1;
 }
 
+sub changes_update_origs_from_dsc ($$$$) {
+    my ($dsc, $changes, $upstreamvsn, $changesfile) = @_;
+    my %changes_f;
+    printdebug "checking origs needed ($upstreamvsn)...\n";
+    $_ = getfield $changes, 'Files';
+    m/^\w+ \d+ (\S+ \S+) \S+$/m or
+       fail "cannot find section/priority from .changes Files field";
+    my $placementinfo = $1;
+    my %changed;
+    printdebug "checking origs needed placement '$placementinfo'...\n";
+    foreach my $l (split /\n/, getfield $dsc, 'Files') {
+       $l =~ m/\S+$/ or next;
+       my $file = $&;
+       printdebug "origs $file | $l\n";
+       next unless is_orig_file_of_vsn $file, $upstreamvsn;
+       printdebug "origs $file is_orig\n";
+       my $have = archive_query('file_in_archive', $file);
+       if (!defined $have) {
+           print STDERR <<END;
+archive does not support .orig check; hope you used --ch:--sa/-sd if needed
+END
+           return;
+       }
+       my $found_same = 0;
+       my @found_differ;
+       printdebug "origs $file \$#\$have=$#$have\n";
+       foreach my $h (@$have) {
+           my $same = 0;
+           my @differ;
+           foreach my $csumi (@files_csum_info_fields) {
+               my ($fname, $module, $method, $archivefield) = @$csumi;
+               next unless defined $h->{$archivefield};
+               $_ = $dsc->{$fname};
+               next unless defined;
+               m/^(\w+) .* \Q$file\E$/m or
+                   fail ".dsc $fname missing entry for $file";
+               if ($h->{$archivefield} eq $1) {
+                   $same++;
+               } else {
+                   push @differ,
+ "$archivefield: $h->{$archivefield} (archive) != $1 (local .dsc)";
+               }
+           }
+           die "$file ".Dumper($h)." ?!" if $same && @differ;
+           $found_same++
+               if $same;
+           push @found_differ, "archive $h->{filename}: ".join "; ", @differ
+               if @differ;
+       }
+       print "origs $file f.same=$found_same #f._differ=$#found_differ\n";
+       if (@found_differ && !$found_same) {
+           fail join "\n",
+               "archive contains $file with different checksum",
+               @found_differ;
+       }
+       # Now we edit the changes file to add or remove it
+       foreach my $csumi (@files_csum_info_fields) {
+           my ($fname, $module, $method, $archivefield) = @$csumi;
+           next unless defined $changes->{$fname};
+           if ($found_same) {
+               # in archive, delete from .changes if it's there
+               $changed{$file} = "removed" if
+                   $changes->{$fname} =~ s/^.* \Q$file\E$(?:)\n//m;
+           } elsif ($changes->{$fname} =~ m/^.* \Q$file\E$(?:)\n/m) {
+               # not in archive, but it's here in the .changes
+           } else {
+               my $dsc_data = getfield $dsc, $fname;
+               $dsc_data =~ m/^(.* \Q$file\E$)\n/m or die "$dsc_data $file ?";
+               my $extra = $1;
+               $extra =~ s/ \d+ /$&$placementinfo /
+                   or die "$fname $extra >$dsc_data< ?"
+                   if $fname eq 'Files';
+               $changes->{$fname} .= "\n". $extra;
+               $changed{$file} = "added";
+           }
+       }
+    }
+    if (%changed) {
+       foreach my $file (keys %changed) {
+           progress sprintf
+               "edited .changes for archive .orig contents: %s %s",
+               $changed{$file}, $file;
+       }
+       my $chtmp = "$changesfile.tmp";
+       $changes->save($chtmp);
+       if (act_local()) {
+           rename $chtmp,$changesfile or die "$changesfile $!";
+       } else {
+           progress "[new .changes left in $changesfile]";
+       }
+    } else {
+       progress "$changesfile already has appropriate .orig(s) (if any)";
+    }
+}
+
 sub make_commit ($) {
     my ($file) = @_;
     return cmdoutput @git, qw(hash-object -w -t commit), $file;
@@ -1649,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;
 
@@ -1669,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) {
@@ -1931,25 +2122,54 @@ END
        local $ENV{GIT_AUTHOR_EMAIL} = $authline[1];
        local $ENV{GIT_AUTHOR_DATE} =  $authline[2];
 
-       eval {
-           runcmd shell_cmd 'exec >/dev/null 2>../../gbp-pq-output',
-               gbp_pq, qw(import);
-       };
-       if ($@) {
-           { local $@; eval { runcmd qw(cat ../../gbp-pq-output); }; }
-           die $@;
-       }
+       my $path = $ENV{PATH} or die;
+
+       foreach my $use_absurd (qw(0 1)) {
+           local $ENV{PATH} = $path;
+           if ($use_absurd) {
+               chomp $@;
+               progress "warning: $@";
+               $path = "$absurdity:$path";
+               progress "$us: trying slow absurd-git-apply...";
+               rename "../../gbp-pq-output","../../gbp-pq-output.0"
+                   or $!==ENOENT
+                   or die $!;
+           }
+           eval {
+               die "forbid absurd git-apply\n" if $use_absurd
+                   && forceing [qw(import-gitapply-no-absurd)];
+               die "only absurd git-apply!\n" if !$use_absurd
+                   && forceing [qw(import-gitapply-absurd)];
+
+               local $ENV{PATH} = $path if $use_absurd;
+
+               my @showcmd = (gbp_pq, qw(import));
+               my @realcmd = shell_cmd
+                   'exec >/dev/null 2>../../gbp-pq-output', @showcmd;
+               debugcmd "+",@realcmd;
+               if (system @realcmd) {
+                   die +(shellquote @showcmd).
+                       " failed: ".
+                       failedcmd_waitstatus()."\n";
+               }
 
-       my $gapplied = git_rev_parse('HEAD');
-       my $gappliedtree = cmdoutput @git, qw(rev-parse HEAD:);
-       $gappliedtree eq $dappliedtree or
-           fail <<END;
+               my $gapplied = git_rev_parse('HEAD');
+               my $gappliedtree = cmdoutput @git, qw(rev-parse HEAD:);
+               $gappliedtree eq $dappliedtree or
+                   fail <<END;
 gbp-pq import and dpkg-source disagree!
  gbp-pq import gave commit $gapplied
  gbp-pq import gave tree $gappliedtree
  dpkg-source --before-build gave tree $dappliedtree
 END
-       $rawimport_hash = $gapplied;
+               $rawimport_hash = $gapplied;
+           };
+           last unless $@;
+       }
+       if ($@) {
+           { local $@; eval { runcmd qw(cat ../../gbp-pq-output); }; }
+           die $@;
+       }
     }
 
     progress "synthesised git commit from .dsc $cversion";
@@ -2002,12 +2222,13 @@ 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";
        die "$f ?" unless $f =~ m/^\Q${package}\E_/;
        die "$f ?" if $f =~ m#/#;
-       runcmd_ordryrun_local @curl,qw(-o),$tf,'--',"$furl";
+       runcmd_ordryrun_local @curl,qw(-f -o),$tf,'--',"$furl";
        return 0 if !act_local();
        $downloaded = 1;
     }
@@ -2071,6 +2292,8 @@ sub git_fetch_us () {
     # git fetch to try to generate it.  If we don't manage to generate
     # the target state, we try again.
 
+    printdebug "git_fetch_us specs @specs\n";
+
     my $specre = join '|', map {
        my $x = $_;
        $x =~ s/\W/\\$&/g;
@@ -2086,6 +2309,7 @@ sub git_fetch_us () {
     my $fetch_iteration = 0;
     FETCH_ITERATION:
     for (;;) {
+       printdebug "git_fetch_us iteration $fetch_iteration\n";
         if (++$fetch_iteration > 10) {
            fail "too many iterations trying to get sane fetch!";
        }
@@ -2113,10 +2337,12 @@ END
 
        # OK, now %want is exactly what we want for refs in @specs
        my @fspecs = map {
-           return () if !m/\*$/ && !exists $wantr{"refs/$_"};
+           !m/\*$/ && !exists $wantr{"refs/$_"} ? () :
            "+refs/$_:".lrfetchrefs."/$_";
        } @specs;
 
+       printdebug "git_fetch_us fspecs @fspecs\n";
+
        my @fcmd = (@git, qw(fetch -p -n -q), access_giturl(), @fspecs);
        runcmd_ordryrun_local @git, qw(fetch -p -n -q), access_giturl(),
            @fspecs;
@@ -2350,11 +2576,8 @@ sub fetch_from_archive () {
     };
 
     if (defined $dsc_hash) {
-       fail "missing remote git history even though dsc has hash -".
-           " could not find ref ".rref()." at ".access_giturl()
-           unless $lastpush_hash;
        ensure_we_have_orig();
-       if ($dsc_hash eq $lastpush_hash) {
+       if (!$lastpush_hash || $dsc_hash eq $lastpush_hash) {
            @mergeinputs = $dsc_mergeinput
        } elsif (is_fast_fwd($dsc_hash,$lastpush_hash)) {
            print STDERR <<END or die $!;
@@ -2521,7 +2744,8 @@ END
        die "$lasth $hash $what ?" unless is_fast_fwd($lasth, $hash);
     };
 
-    $chkff->($lastpush_hash, 'dgit repo server tip (last push)');
+    $chkff->($lastpush_hash, 'dgit repo server tip (last push)')
+       if $lastpush_hash;
     $chkff->($lastfetch_hash, 'local tracking tip (last fetch)');
 
     runcmd @git, qw(update-ref -m), "dgit fetch $csuite",
@@ -2653,6 +2877,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";
 }
 
@@ -2766,6 +2995,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)
 
@@ -2884,12 +3125,12 @@ sub splitbrain_pseudomerge ($$$$) {
     #   this:                                   $dgitview'
     #
 
+    return $dgitview unless defined $archive_hash;
+
     printdebug "splitbrain_pseudomerge...\n";
 
     my $i_arch_v = pseudomerge_version_check($clogp, $archive_hash);
 
-    return $dgitview unless defined $archive_hash;
-
     if (!defined $overwrite_version) {
        progress "Checking that HEAD inciudes all changes in archive...";
     }
@@ -2926,6 +3167,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;
 }      
@@ -2957,7 +3200,10 @@ sub push_parse_changelog ($) {
     my $clogp = Dpkg::Control::Hash->new();
     $clogp->load($clogpfn) or die;
 
-    $package = getfield $clogp, 'Source';
+    my $clogpackage = getfield $clogp, 'Source';
+    $package //= $clogpackage;
+    fail "-p specified $package but changelog specified $clogpackage"
+       unless $package eq $clogpackage;
     my $cversion = getfield $clogp, 'Version';
     my $tag = debiantag($cversion, access_basedistro);
     runcmd @git, qw(check-ref-format), $tag;
@@ -3154,11 +3400,11 @@ END
     my $dgithead = $actualhead;
     my $maintviewhead = undef;
 
+    my $upstreamversion = upstreamversion $clogp->{Version};
+
     if (madformat_wantfixup($format)) {
        # user might have not used dgit build, so maybe do this now:
        if (quiltmode_splitbrain()) {
-           my $upstreamversion = $clogp->{Version};
-           $upstreamversion =~ s/-[^-]*$//;
            changedir $ud;
            quilt_make_fake_dsc($upstreamversion);
            my $cachekey;
@@ -3242,7 +3488,14 @@ END
 
     # Check that changes and .dsc agree enough
     $changesfile =~ m{[^/]*$};
-    files_compare_inputs($dsc, parsecontrol($changesfile,$&));
+    my $changes = parsecontrol($changesfile,$&);
+    files_compare_inputs($dsc, $changes)
+       unless forceing [qw(dsc-changes-mismatch)];
+
+    # Perhaps adjust .dsc to contain right set of origs
+    changes_update_origs_from_dsc($dsc, $changes, $upstreamversion,
+                                 $changesfile)
+       unless forceing [qw(changes-origs-exactly)];
 
     # Checks complete, we're going to try and go ahead:
 
@@ -3435,6 +3688,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();
 }
 
@@ -3909,7 +4168,7 @@ Commit patch to update .gitignore
 END
     }
 
-    my $dgitview = git_rev_parse 'refs/heads/dgit-view';
+    my $dgitview = git_rev_parse 'HEAD';
 
     changedir '../../../..';
     # When we no longer need to support squeeze, use --create-reflog
@@ -3936,9 +4195,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 ($$$$) {
@@ -4237,8 +4497,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);
@@ -4408,8 +4667,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);
@@ -4596,7 +4856,7 @@ END
     if (@unrepres) {
        print STDERR "dgit:  cannot represent change: $_->[1]: $_->[0]\n"
            foreach @unrepres;
-       fail <<END;
+       forceable_fail [qw(unrepresentable)], <<END;
 HEAD has changes to .orig[s] which are not representable by `3.0 (quilt)'
 END
     }
@@ -4608,7 +4868,7 @@ END
         push @failsuggestion, "This might be a patches-applied branch.";
     }
     push @failsuggestion, "Maybe you need to specify one of".
-        " --quilt=gbp --quilt=dpm --quilt=unapplied ?";
+        " --[quilt=]gbp --[quilt=]dpm --quilt=unapplied ?";
 
     if (quiltmode_splitbrain()) {
        quiltify_splitbrain($clogp, $unapplied, $headref,
@@ -4715,15 +4975,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;
@@ -4824,11 +5090,87 @@ sub massage_dbp_args ($;$) {
     return $r;
 }
 
+sub in_parent (&) {
+    my ($fn) = @_;
+    my $wasdir = must_getcwd();
+    changedir "..";
+    $fn->();
+    changedir $wasdir;
+}    
+
+sub postbuild_mergechanges ($) { # must run with CWD=.. (eg in in_parent)
+    my ($msg_if_onlyone) = @_;
+    # If there is only one .changes file, fail with $msg_if_onlyone,
+    # or if that is undef, be a no-op.
+    # Returns the changes file to report to the user.
+    my $pat = changespat $version;
+    my @changesfiles = glob $pat;
+    @changesfiles = sort {
+       ($b =~ m/_source\.changes$/ <=> $a =~ m/_source\.changes$/)
+           or $a cmp $b
+    } @changesfiles;
+    my $result;
+    if (@changesfiles==1) {
+       fail <<END.$msg_if_onlyone if defined $msg_if_onlyone;
+only one changes file from build (@changesfiles)
+END
+       $result = $changesfiles[0];
+    } elsif (@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 = 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}: $!";
+           }
+       }
+       $result = $multichanges;
+    } else {
+       fail "wrong number of different changes files (@changesfiles)";
+    }
+    printdone "build successful, results in $result\n" or die $!;
+}
+
+sub midbuild_checkchanges () {
+    my $pat = changespat $version;
+    return if $rmchanges;
+    my @unwanted = map { s#^\.\./##; $_; } glob "../$pat";
+    @unwanted = grep { $_ ne changespat $version,'source' } @unwanted;
+    fail <<END
+changes files other than source matching $pat already present; building would result in ambiguity about the intended results.
+Suggest you delete @unwanted.
+END
+       if @unwanted;
+}
+
+sub midbuild_checkchanges_vanilla ($) {
+    my ($wantsrc) = @_;
+    midbuild_checkchanges() if $wantsrc == 1;
+}
+
+sub postbuild_mergechanges_vanilla ($) {
+    my ($wantsrc) = @_;
+    if ($wantsrc == 1) {
+       in_parent {
+           postbuild_mergechanges(undef);
+       };
+    } else {
+       printdone "build successful\n";
+    }
+}
+
 sub cmd_build {
     my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts_initial(), @ARGV);
     my $wantsrc = massage_dbp_args \@dbp;
     if ($wantsrc > 0) {
        build_source();
+       midbuild_checkchanges_vanilla $wantsrc;
     } else {
        build_prep();
     }
@@ -4838,7 +5180,7 @@ sub cmd_build {
        runcmd_ordryrun_local @dbp;
     }
     maybe_unapply_patches_again();
-    printdone "build successful\n";
+    postbuild_mergechanges_vanilla $wantsrc;
 }
 
 sub pre_gbp_build {
@@ -4846,6 +5188,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;
@@ -4861,8 +5221,27 @@ 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;
     } else {
        if (!$clean_using_builder) {
            push @cmd, '--git-cleaner=true';
@@ -4874,7 +5253,7 @@ sub cmd_gbp_build {
        push @cmd, changesopts();
        runcmd_ordryrun_local @cmd, @ARGV;
     }
-    printdone "build successful\n";
+    postbuild_mergechanges_vanilla $wantsrc;
 }
 sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0
 
@@ -4947,53 +5326,22 @@ sub cmd_build_source {
 
 sub cmd_sbuild {
     build_source();
-    my $pat = changespat $version;
-    if (!$rmchanges) {
-       my @unwanted = map { s#^\.\./##; $_; } glob "../$pat";
-       @unwanted = grep { $_ ne changespat $version,'source' } @unwanted;
-       fail <<END
-changes files other than source matching $pat already present; building would result in ambiguity about the intended results.
-Suggest you delete @unwanted.
-END
-           if @unwanted;
-    }
-    my $wasdir = must_getcwd();
-    changedir "..";
-    if (act_local()) {
-       stat_exists $dscfn or fail "$dscfn (in parent directory): $!";
-       stat_exists $sourcechanges
-           or fail "$sourcechanges (in parent directory): $!";
-    }
-    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 <<END if @changesfiles==1;
-only one changes file from sbuild (@changesfiles)
+    midbuild_checkchanges();
+    in_parent {
+       if (act_local()) {
+           stat_exists $dscfn or fail "$dscfn (in parent directory): $!";
+           stat_exists $sourcechanges
+               or fail "$sourcechanges (in parent directory): $!";
+       }
+       runcmd_ordryrun_local @sbuild, qw(-d), $isuite, @ARGV, $dscfn;
+    };
+    maybe_unapply_patches_again();
+    in_parent {
+       postbuild_mergechanges(<<END);
 perhaps you need to pass -A ?  (sbuild's default is to build only
 arch-specific binaries; dgit 1.4 used to override that.)
 END
-    fail "wrong number of different changes files (@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 = 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}: $!";
-       }
-    }
-    changedir $wasdir;
-    maybe_unapply_patches_again();
-    printdone "build successful, results in $multichanges\n" or die $!;
+    };
 }    
 
 sub cmd_quilt_fixup {
@@ -5006,10 +5354,162 @@ 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;
     my @cmd = archive_api_query_cmd($subpath);
+    push @cmd, qw(-f);
     debugcmd ">",@cmd;
     exec @cmd or fail "exec curl: $!\n";
 }
@@ -5065,6 +5565,7 @@ defvalopt '',                '-k', '.+',      \$keyid;
 defvalopt '--existing-package','', '.*',      \$existing_package;
 defvalopt '--build-products-dir','','.*',     \$buildproductsdir;
 defvalopt '--clean',       '', $cleanmode_re, \$cleanmode;
+defvalopt '--package',   '-p',   $package_re, \$package;
 defvalopt '--quilt',     '', $quilt_modes_re, \$quilt_mode;
 
 defvalopt '', '-C', '.+', sub {
@@ -5142,6 +5643,9 @@ sub parseopts () {
                     ($om = $opts_opt_map{$1})) {
                push @ropts, $_;
                push @$om, $2;
+           } elsif (m/^--(gbp|dpm)$/s) {
+               push @ropts, "--quilt=$1";
+               $quilt_mode = $1;
            } elsif (m/^--ignore-dirty$/s) {
                push @ropts, $_;
                $ignoredirty = 1;
@@ -5157,12 +5661,27 @@ 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;
            } elsif (m/^--deliberately-($deliberately_re)$/s) {
                push @ropts, $_;
                push @deliberatelies, $&;
+           } elsif (m/^--force-(.*)/ && defined $forceopts{$1}) {
+               push @ropts, $&;
+               $forceopts{$1} = 1;
+               $_='';
+           } elsif (m/^--force-/) {
+               print STDERR
+                   "$us: warning: ignoring unknown force option $_\n";
+               $_='';
            } elsif (m/^--dgit-tag-format=(old|new)$/s) {
                # undocumented, for testing
                push @ropts, $_;