diff options
Diffstat (limited to 'dgit')
| -rwxr-xr-x | dgit | 474 |
1 files changed, 434 insertions, 40 deletions
@@ -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; @@ -76,9 +77,10 @@ our $tagformatfn; our %forceopts = map { $_=>0 } qw(unrepresentable unsupported-source-format - dsc-changes-mismatch + 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(''); @@ -619,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', @@ -960,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 ($$) { @@ -1009,9 +1024,9 @@ 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); @@ -1023,12 +1038,13 @@ sub api_query ($$) { 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; @@ -1052,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; @@ -1079,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 { @@ -1127,6 +1179,8 @@ sub canonicalise_suite_madison { return $r[0][2]; } +sub file_in_archive_madison { return undef; } + #---------- `sshpsql' archive query method ---------- sub sshpsql ($$$) { @@ -1202,6 +1256,8 @@ END return $rows[0]; } +sub file_in_archive_sshpsql ($$$) { return undef; } + #---------- `dummycat' archive query method ---------- sub canonicalise_suite_dummycat ($$) { @@ -1243,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 () { @@ -1315,10 +1373,7 @@ 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'; $format_ok{$fmt} or forceable_fail [qw(unsupported-source-format)], "unsupported source format $fmt, sorry"; @@ -1464,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) { @@ -1572,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; @@ -1686,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; @@ -1706,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) { @@ -2068,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"; @@ -2137,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; @@ -2152,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!"; } @@ -2179,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; @@ -2416,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 $!; @@ -2587,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", @@ -2719,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"; } @@ -2832,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) @@ -2950,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..."; } @@ -2992,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; } @@ -3023,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; @@ -3220,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; @@ -3308,9 +3488,15 @@ 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: responder_send_file('changes',$changesfile); @@ -3502,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(); } @@ -4003,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 ($$$$) { @@ -4304,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); @@ -4475,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); @@ -4782,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; @@ -4989,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; @@ -5004,6 +5221,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; @@ -5119,6 +5354,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; @@ -5179,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 { @@ -5274,6 +5661,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; |