X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=3afaf193a4127e320ce611162b9f5f896086350f;hp=c8567ed473d838cab555bfd5c118a7d695eb4bef;hb=f0b46b0422f6ce3bb7c360ee3717eef95d621526;hpb=17474e7732a9a3fcba657bec60264c2629724d5e diff --git a/dgit b/dgit index c8567ed4..3afaf193 100755 --- a/dgit +++ b/dgit @@ -63,9 +63,10 @@ our @ropts; our $sign = 1; our $dryrun_level = 0; our $changesfile; -our $buildproductsdir = '..'; +our $buildproductsdir; +our $bpd_glob; our $new_package = 0; -our $ignoredirty = 0; +our $includedirty = 0; our $rmonerror = 1; our @deliberatelies; our %previously; @@ -90,6 +91,7 @@ our $chase_dsc_distro=1; our %forceopts = map { $_=>0 } qw(unrepresentable unsupported-source-format dsc-changes-mismatch changes-origs-exactly + uploading-binaries uploading-source-only import-gitapply-absurd import-gitapply-no-absurd import-dsc-with-dgit-field); @@ -164,7 +166,7 @@ our $keyid; autoflush STDOUT 1; our $supplementary_message = ''; -our $need_split_build_invocation = 0; +our $need_split_build_invocation = 1; our $split_brain = 0; END { @@ -188,11 +190,6 @@ sub debiantag ($$) { return $tagformatfn->($v, $distro); } -sub debiantag_maintview ($$) { - my ($v,$distro) = @_; - return "$distro/".dep14_version_mangle $v; -} - sub madformat ($) { $_[0] eq '3.0 (quilt)' } sub lbranch () { return "$branchprefix/$csuite"; } @@ -292,6 +289,38 @@ sub dgit_privdir () { our $dgit_privdir_made //= ensure_a_playground 'dgit'; } +sub bpd_abs () { + my $r = $buildproductsdir; + $r = "$maindir/$r" unless $r =~ m{^/}; + return $r; +} + +sub branch_gdr_info ($$) { + my ($symref, $head) = @_; + my ($status, $msg, $current, $ffq_prev, $gdrlast) = + gdr_ffq_prev_branchinfo($symref); + return () unless $status eq 'branch'; + $ffq_prev = git_get_ref $ffq_prev; + $gdrlast = git_get_ref $gdrlast; + $gdrlast &&= is_fast_fwd $gdrlast, $head; + return ($ffq_prev, $gdrlast); +} + +sub branch_is_gdr ($$) { + my ($symref, $head) = @_; + my ($ffq_prev, $gdrlast) = branch_gdr_info($symref, $head); + return 0 unless $ffq_prev || $gdrlast; + return 1; +} + +sub branch_is_gdr_unstitched_ff ($$$) { + my ($symref, $head, $ancestor) = @_; + my ($ffq_prev, $gdrlast) = branch_gdr_info($symref, $head); + return 0 unless $ffq_prev; + return 0 unless is_fast_fwd $ancestor, $ffq_prev; + return 1; +} + #---------- remote protocol support, common ---------- # remote push initiator/responder protocol: @@ -535,11 +564,6 @@ sub runcmd_ordryrun_local { } } -sub shell_cmd { - my ($first_shell, @cmd) = @_; - return qw(sh -ec), $first_shell.'; exec "$@"', 'x', @cmd; -} - our $helpmsg = < 'debian', 'dgit.default.sshpsql-dbname' => 'service=projectb', 'dgit.default.aptget-components' => 'main', 'dgit.default.dgit-tag-format' => 'new,old,maint', + 'dgit.default.source-only-uploads' => 'ok', 'dgit.dsc-url-proto-ok.http' => 'true', 'dgit.dsc-url-proto-ok.https' => 'true', 'dgit.dsc-url-proto-ok.git' => 'true', + 'dgit.vcs-git.suites', => 'sid', # ;-separated 'dgit.default.dsc-url-proto-ok' => 'false', # old means "repo server accepts pushes with old dgit tags" # new means "repo server accepts pushes with new dgit tags" @@ -606,6 +632,7 @@ our %defcfg = ('dgit.default.distro' => 'debian', 'dgit-distro.debian.git-check' => 'url', 'dgit-distro.debian.git-check-suffix' => '/info/refs', 'dgit-distro.debian.new-private-pushers' => 't', + 'dgit-distro.debian.source-only-uploads' => 'not-wholly-new', 'dgit-distro.debian/push.git-url' => '', 'dgit-distro.debian/push.git-host' => 'push.dgit.debian.org', 'dgit-distro.debian/push.git-user-force' => 'dgit', @@ -937,59 +964,6 @@ sub access_giturl (;$) { return "$url/$package$suffix"; } -sub parsecontrolfh ($$;$) { - my ($fh, $desc, $allowsigned) = @_; - our $dpkgcontrolhash_noissigned; - my $c; - for (;;) { - my %opts = ('name' => $desc); - $opts{allow_pgp}= $allowsigned || !$dpkgcontrolhash_noissigned; - $c = Dpkg::Control::Hash->new(%opts); - $c->parse($fh,$desc) or die "parsing of $desc failed"; - last if $allowsigned; - last if $dpkgcontrolhash_noissigned; - my $issigned= $c->get_option('is_pgp_signed'); - if (!defined $issigned) { - $dpkgcontrolhash_noissigned= 1; - seek $fh, 0,0 or die "seek $desc: $!"; - } elsif ($issigned) { - fail "control file $desc is (already) PGP-signed. ". - " Note that dgit push needs to modify the .dsc and then". - " do the signature itself"; - } else { - last; - } - } - return $c; -} - -sub parsecontrol { - my ($file, $desc, $allowsigned) = @_; - my $fh = new IO::Handle; - open $fh, '<', $file or die "$file: $!"; - my $c = parsecontrolfh($fh,$desc,$allowsigned); - $fh->error and die $!; - close $fh; - return $c; -} - -sub getfield ($$) { - my ($dctrl,$field) = @_; - my $v = $dctrl->{$field}; - return $v if defined $v; - fail "missing field $field in ".$dctrl->get_option('name'); -} - -sub parsechangelog { - my $c = Dpkg::Control::Hash->new(name => 'parsed changelog'); - my $p = new IO::Handle; - my @cmd = (qw(dpkg-parsechangelog), @_); - open $p, '-|', @cmd or die $!; - $c->parse($p); - $?=0; $!=0; close $p or failedcmd @cmd; - return $c; -} - sub commit_getclogp ($) { # Returns the parsed changelog hashref for a particular commit my ($objid) = @_; @@ -1157,6 +1131,12 @@ sub file_in_archive_ftpmasterapi { my $info = api_query($data, "file_in_archive/$pat", 1); } +sub package_not_wholly_new_ftpmasterapi { + my ($proto,$data,$pkg) = @_; + my $info = api_query($data,"madison?package=${pkg}&f=json"); + return !!@$info; +} + #---------- `aptget' archive query method ---------- our $aptget_base; @@ -1264,7 +1244,14 @@ END } my @inreleasefiles = grep { m#/InRelease$# } @releasefiles; @releasefiles = @inreleasefiles if @inreleasefiles; - die "apt updated wrong number of Release files (@releasefiles), erk" + if (!@releasefiles) { + fail <) { - chomp or die; - printdebug "| $_\n"; - m/^(\w+) (\S+)$/ or die "$_ ?"; - push @out, { sha256sum => $1, filename => $2 }; - } - close FIA or die failedcmd @cmd; + my $r = $fn->(); + close FIA or ($!==0 && $?==141) or die failedcmd @cmd; + return $r; +} + +sub file_in_archive_dummycatapi ($$$) { + my ($proto,$data,$filename) = @_; + my @out; + dummycatapi_run_in_mirror ' + find -name "$1" -print0 | + xargs -0r sha256sum + ', [$filename], sub { + while () { + chomp or die; + printdebug "| $_\n"; + m/^(\w+) (\S+)$/ or die "$_ ?"; + push @out, { sha256sum => $1, filename => $2 }; + } + }; return \@out; } +sub package_not_wholly_new_dummycatapi { + my ($proto,$data,$pkg) = @_; + dummycatapi_run_in_mirror " + find -name ${pkg}_*.dsc + ", [], sub { + local $/ = undef; + !!; + }; +} + #---------- `madison' archive query method ---------- sub archive_query_madison { @@ -1398,6 +1406,7 @@ sub canonicalise_suite_madison { } sub file_in_archive_madison { return undef; } +sub package_not_wholly_new_madison { return undef; } #---------- `sshpsql' archive query method ---------- @@ -1475,6 +1484,7 @@ END } sub file_in_archive_sshpsql ($$$) { return undef; } +sub package_not_wholly_new_sshpsql ($$$) { return undef; } #---------- `dummycat' archive query method ---------- @@ -1519,6 +1529,7 @@ sub archive_query_dummycat ($$) { } sub file_in_archive_dummycat () { return undef; } +sub package_not_wholly_new_dummycat () { return undef; } #---------- tag format handling ---------- @@ -1953,12 +1964,12 @@ END 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) { + $changes->{$fname} =~ s/\n.* \Q$file\E$(?:)$//m; + } elsif ($changes->{$fname} =~ m/^.* \Q$file\E$(?:)$/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 ?"; + $dsc_data =~ m/^(.* \Q$file\E$)$/m or die "$dsc_data $file ?"; my $extra = $1; $extra =~ s/ \d+ /$&$placementinfo / or die "$fname $extra >$dsc_data< ?" @@ -2108,7 +2119,7 @@ sub generate_commits_from_dsc () { foreach my $fi (@dfi) { my $f = $fi->{Filename}; die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#; - my $upper_f = "$maindir/../$f"; + my $upper_f = (bpd_abs()."/$f"); printdebug "considering reusing $f: "; @@ -2116,12 +2127,12 @@ sub generate_commits_from_dsc () { printdebug "linked (using ...,fetch).\n"; } elsif ((printdebug "($!) "), $! != ENOENT) { - fail "accessing ../$f,fetch: $!"; + fail "accessing $buildproductsdir/$f,fetch: $!"; } elsif (link_ltarget $upper_f, $f) { printdebug "linked.\n"; } elsif ((printdebug "($!) "), $! != ENOENT) { - fail "accessing ../$f: $!"; + fail "accessing $buildproductsdir/$f: $!"; } else { printdebug "absent.\n"; } @@ -2136,14 +2147,14 @@ sub generate_commits_from_dsc () { printdebug "linked.\n"; } elsif ((printdebug "($!) "), $! != EEXIST) { - fail "saving ../$f: $!"; + fail "saving $buildproductsdir/$f: $!"; } elsif (!$refetched) { printdebug "no need.\n"; } elsif (link $f, "$upper_f,fetch") { printdebug "linked (using ...,fetch).\n"; } elsif ((printdebug "($!) "), $! != EEXIST) { - fail "saving ../$f,fetch: $!"; + fail "saving $buildproductsdir/$f,fetch: $!"; } else { printdebug "cannot.\n"; } @@ -2287,22 +2298,14 @@ sub generate_commits_from_dsc () { } my @clogcmd = qw(dpkg-parsechangelog --format rfc822 --all); - debugcmd "|",@clogcmd; - open CLOGS, "-|", @clogcmd or die $!; - my $clogp; my $r1clogp; printdebug "import clog search...\n"; + parsechangelog_loop \@clogcmd, "package changelog", sub { + my ($thisstanza, $desc) = @_; + no warnings qw(exiting); - for (;;) { - my $stanzatext = do { local $/=""; ; }; - printdebug "import clogp ".Dumper($stanzatext) if $debuglevel>1; - last if !defined $stanzatext; - - my $desc = "package changelog, entry no.$."; - open my $stanzafh, "<", \$stanzatext or die; - my $thisstanza = parsecontrolfh $stanzafh, $desc, 1; $clogp //= $thisstanza; printdebug "import clog $thisstanza->{version} $desc...\n"; @@ -2328,7 +2331,7 @@ sub generate_commits_from_dsc () { # version). Then it remains to choose between the physically # last entry in the file, and the one with the lowest version # number. If these are not the same, we guess that the - # versions were created in a non-monotic order rather than + # versions were created in a non-monotonic order rather than # that the changelog entries have been misordered. printdebug "import clog $thisstanza->{version} vs $upstreamv...\n"; @@ -2337,9 +2340,7 @@ sub generate_commits_from_dsc () { $r1clogp = $thisstanza; printdebug "import clog $r1clogp->{version} becomes r1\n"; - } - die $! if CLOGS->error; - close CLOGS or $?==SIGPIPE or failedcmd @clogcmd; + }; $clogp or fail "package changelog has no entries!"; @@ -2580,7 +2581,7 @@ sub ensure_we_have_orig () { foreach my $fi (@dfi) { my $f = $fi->{Filename}; next unless is_orig_file_in_dsc($f, \@dfi); - complete_file_from_dsc('..', $fi) + complete_file_from_dsc($buildproductsdir, $fi) or next; } } @@ -2736,6 +2737,11 @@ END my $want = $wantr{$rrefname}; next if $got eq $want; if (!defined $objgot{$want}) { + fail <) { - return 1 if m{^\[attr\]dgit-defuse-attrs\s}; + next unless m{$gitattrs_ourmacro_re}; + return 1 if m{\s-working-tree-encoding\s}; + printdebug "is_gitattrs_setup: found old macro\n"; + return 0; } $gai->error and die $!; - return 0; + printdebug "is_gitattrs_setup: found nothing\n"; + return undef; } sub setup_gitattrs (;$) { my ($always) = @_; return unless $always || access_cfg_bool(1, 'setup-gitattributes'); - if (is_gitattrs_setup()) { + my $already = is_gitattrs_setup(); + if ($already) { progress < $af.new" or die $!; - print GAO <) { + if (m{$gitattrs_ourmacro_re}) { + die unless defined $already; + $_ = $new; + } chomp; print GAO $_, "\n" or die $!; } @@ -3433,7 +3457,7 @@ sub check_gitattrs ($$) { # oh dear, found one print STDERR <{'Vcs-Git'}; + if (length $vcsgiturl and + (grep { $csuite eq $_ } + split /\;/, + cfg 'dgit.vcs-git.suites')) { + my $current = cfg 'remote.vcs-git.url', 'RETURN-UNDEF'; + if (defined $current && $current ne $vcsgiturl) { + print STDERR < message fragment "$saved" describing disposition of $dgitview return "commit id $dgitview" unless defined $split_brain_save; my @cmd = (shell_cmd 'cd "$1"; shift', $maindir, - @git, qw(update-ref -m), + git_update_ref_cmd "dgit --dgit-view-save $msg HEAD=$headref", $split_brain_save, $dgitview); runcmd @cmd; @@ -3954,10 +3996,12 @@ sub splitbrain_pseudomerge ($$$$) { infopair_cond_ff($i_dep14, [ $maintview, 'HEAD' ]); 1; }) { + $@ =~ s/^\n//; chomp $@; print STDERR <[0] into your HEAD."; return $r; @@ -4220,7 +4264,14 @@ END my $format = getfield $dsc, 'Format'; printdebug "format $format\n"; + my $symref = git_get_symref(); my $actualhead = git_rev_parse('HEAD'); + + if (branch_is_gdr_unstitched_ff($symref, $actualhead, $archive_hash)) { + runcmd_ordryrun_local @git_debrebase, 'stitch'; + $actualhead = git_rev_parse('HEAD'); + } + my $dgithead = $actualhead; my $maintviewhead = undef; @@ -4249,7 +4300,8 @@ END } } - if (defined $overwrite_version && !defined $maintviewhead) { + if (defined $overwrite_version && !defined $maintviewhead + && $archive_hash) { $dgithead = plain_overwrite_pseudomerge($clogp, $dgithead, $archive_hash); @@ -4345,6 +4397,29 @@ END files_compare_inputs($dsc, $changes) unless forceing [qw(dsc-changes-mismatch)]; + # Check whether this is a source only upload + my $hasdebs = $changes->{Files} =~ m{\.deb$}m; + my $sourceonlypolicy = access_cfg 'source-only-uploads'; + if ($sourceonlypolicy eq 'ok') { + } elsif ($sourceonlypolicy eq 'always') { + forceable_fail [qw(uploading-binaries)], + "uploading binaries, although distroy policy is source only" + if $hasdebs; + } elsif ($sourceonlypolicy eq 'never') { + forceable_fail [qw(uploading-source-only)], + "source-only upload, although distroy policy requires .debs" + if !$hasdebs; + } elsif ($sourceonlypolicy eq 'not-wholly-new') { + forceable_fail [qw(uploading-source-only)], + "source-only upload, even though package is entirely NEW\n". + "(this is contrary to policy in ".(access_nomdistro()).")" + if !$hasdebs + && $new_package + && !(archive_query('package_not_wholly_new', $package) // 1); + } else { + badcfg "unknown source-only-uploads policy \`$sourceonlypolicy'"; + } + # Perhaps adjust .dsc to contain right set of origs changes_update_origs_from_dsc($dsc, $changes, $upstreamversion, $changesfile) @@ -4428,7 +4503,7 @@ END runcmd_ordryrun @git, qw(-c push.followTags=false push), access_giturl(), @pushrefs; - runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), $dgithead; + runcmd_ordryrun git_update_ref_cmd 'dgit push', lrref(), $dgithead; supplementary_message(<<'END'); Push failed, while obtaining signatures on the .changes and .dsc. @@ -4528,11 +4603,15 @@ sub branchsuite () { } } -sub fetchpullargs () { +sub package_from_d_control () { if (!defined $package) { my $sourcep = parsecontrol('debian/control','debian/control'); $package = getfield $sourcep, 'Source'; } +} + +sub fetchpullargs () { + package_from_d_control(); if (@ARGV==0) { $isuite = branchsuite(); if (!$isuite) { @@ -4551,9 +4630,7 @@ sub fetchpullargs () { sub cmd_fetch { parseopts(); fetchpullargs(); - my $multi_fetched = fork_for_multisuite(sub { }); - finish 0 if $multi_fetched; - fetch(); + dofetch(); } sub cmd_pull { @@ -4568,6 +4645,86 @@ END pull(); } +sub cmd_checkout { + parseopts(); + package_from_d_control(); + @ARGV==1 or badusage "dgit checkout needs a suite argument"; + ($isuite) = @ARGV; + notpushing(); + + foreach my $canon (qw(0 1)) { + if (!$canon) { + $csuite= $isuite; + } else { + undef $csuite; + canonicalise_suite(); + } + if (length git_get_ref lref()) { + # local branch already exists, yay + last; + } + if (!length git_get_ref lrref()) { + if (!$canon) { + # nope + next; + } + dofetch(); + } + # now lrref exists + runcmd (@git, qw(update-ref), lref(), lrref(), ''); + last; + } + local $ENV{GIT_REFLOG_ACTION} = git_reflog_action_msg + "dgit checkout $isuite"; + runcmd (@git, qw(checkout), lbranch()); +} + +sub cmd_update_vcs_git () { + my $specsuite; + if (@ARGV==0 || $ARGV[0] =~ m/^-/) { + ($specsuite,) = split /\;/, cfg 'dgit.vcs-git.suites'; + } else { + ($specsuite) = (@ARGV); + shift @ARGV; + } + my $dofetch=1; + if (@ARGV) { + if ($ARGV[0] eq '-') { + $dofetch = 0; + } elsif ($ARGV[0] eq '-') { + shift; + } + } + + package_from_d_control(); + my $ctrl; + if ($specsuite eq '.') { + $ctrl = parsecontrol 'debian/control', 'debian/control'; + } else { + $isuite = $specsuite; + get_archive_dsc(); + $ctrl = $dsc; + } + my $url = getfield $ctrl, 'Vcs-Git'; + + my @cmd; + my $orgurl = cfg 'remote.vcs-git.url', 'RETURN-UNDEF'; + if (!defined $orgurl) { + print STDERR "setting up vcs-git: $url\n"; + @cmd = (@git, qw(remote add vcs-git), $url); + } elsif ($orgurl eq $url) { + print STDERR "vcs git already configured: $url\n"; + } else { + print STDERR "changing vcs-git url to: $url\n"; + @cmd = (@git, qw(remote set-url vcs-git), $url); + } + runcmd_ordryrun_local @cmd; + if ($dofetch) { + print "fetching (@ARGV)\n"; + runcmd_ordryrun_local @git, qw(fetch vcs-git), @ARGV; + } +} + sub prep_push () { parseopts(); build_or_push_prep_early(); @@ -4601,6 +4758,8 @@ sub cmd_push { sub cmd_push_source { prep_push(); + fail "dgit push-source: --include-dirty/--ignore-dirty does not make". + "sense with push-source!" if $includedirty; if ($changesfile) { my $changes = parsecontrol("$buildproductsdir/$changesfile", "source changes file"); @@ -5015,13 +5174,15 @@ sub quiltify_splitbrain_needed () { } } -sub quiltify_splitbrain ($$$$$$) { - my ($clogp, $unapplied, $headref, $diffbits, +sub quiltify_splitbrain ($$$$$$$) { + my ($clogp, $unapplied, $headref, $oldtiptree, $diffbits, $editedignores, $cachekey) = @_; + my $gitignore_special = 1; if ($quilt_mode !~ m/gbp|dpm/) { # treat .gitignore just like any other upstream file $diffbits = { %$diffbits }; $_ = !!$_ foreach values %$diffbits; + $gitignore_special = 0; } # We would like any commits we generate to be reproducible my @authline = clogp_authline($clogp); @@ -5032,11 +5193,19 @@ sub quiltify_splitbrain ($$$$$$) { local $ENV{GIT_AUTHOR_EMAIL} = $authline[1]; local $ENV{GIT_AUTHOR_DATE} = $authline[2]; + my $fulldiffhint = sub { + my ($x,$y) = @_; + my $cmd = "git diff $x $y -- :/ ':!debian'"; + $cmd .= " ':!/.gitignore' ':!*/.gitignore'" if $gitignore_special; + return "\nFor full diff showing the problem(s), type:\n $cmd\n"; + }; + if ($quilt_mode =~ m/gbp|unapplied/ && ($diffbits->{O2H} & 01)) { my $msg = "--quilt=$quilt_mode specified, implying patches-unapplied git tree\n". " but git tree differs from orig in upstream files."; + $msg .= $fulldiffhint->($unapplied, 'HEAD'); if (!stat_exists "debian/patches") { $msg .= "\n ... debian/patches is missing; perhaps this is a patch queue branch?"; @@ -5045,7 +5214,7 @@ sub quiltify_splitbrain ($$$$$$) { } if ($quilt_mode =~ m/dpm/ && ($diffbits->{H2A} & 01)) { - fail <($oldtiptree,'HEAD'); --quilt=$quilt_mode specified, implying patches-applied git tree but git tree differs from result of applying debian/patches to upstream END @@ -5061,7 +5230,7 @@ END } if ($quilt_mode =~ m/gbp|dpm/ && ($diffbits->{O2A} & 02)) { - fail <($notp), "\n"; } print STDERR "$us: $_\n" foreach @$failsuggestion; - fail "quilt fixup naive history linearisation failed.\n". + fail + "quilt history linearisation failed. Search \`quilt fixup' in dgit(7).\n". "Use dpkg-source --commit by hand; or, --quilt=smash for one ugly patch"; } elsif ($quilt_mode eq 'smash') { } elsif ($quilt_mode eq 'auto') { @@ -5425,6 +5595,33 @@ END my $clogp = parsechangelog(); my $headref = git_rev_parse('HEAD'); + my $symref = git_get_symref(); + + if ($quilt_mode eq 'linear' + && !$fopts->{'single-debian-patch'} + && branch_is_gdr($symref, $headref)) { + # This is much faster. It also makes patches that gdr + # likes better for future updates without laundering. + # + # However, it can fail in some casses where we would + # succeed: if there are existing patches, which correspond + # to a prefix of the branch, but are not in gbp/gdr + # format, gdr will fail (exiting status 7), but we might + # be able to figure out where to start linearising. That + # will be slower so hopefully there's not much to do. + my @cmd = (@git_debrebase, + qw(--noop-ok -funclean-mixed -funclean-ordering + make-patches --quiet-would-amend)); + # We tolerate soe snags that gdr wouldn't, by default. + if (act_local()) { + debugcmd "+",@cmd; + $!=0; $?=-1; + failedcmd @cmd if system @cmd and $?!=7*256; + } else { + dryrun_report @cmd; + } + $headref = git_rev_parse('HEAD'); + } prep_ud(); changedir $playground; @@ -5444,7 +5641,7 @@ END @git, qw(pull --ff-only -q), "$playground/work", qw(master); } -sub quilt_fixup_mkwork ($) { +sub unpack_playtree_mkwork ($) { my ($headref) = @_; mkdir "work" or die $!; @@ -5453,12 +5650,14 @@ sub quilt_fixup_mkwork ($) { runcmd @git, qw(reset -q --hard), $headref; } -sub quilt_fixup_linkorigs ($$) { +sub unpack_playtree_linkorigs ($$) { my ($upstreamversion, $fn) = @_; # calls $fn->($leafname); - foreach my $f (<$maindir/../*>) { #/){ - my $b=$f; $b =~ s{.*/}{}; + my $bpd_abs = bpd_abs(); + opendir QFD, $bpd_abs or fail "buildproductsdir: $bpd_abs: $!"; + while ($!=0, defined(my $b = readdir QFD)) { + my $f = bpd_abs()."/".$b; { local ($debuglevel) = $debuglevel-1; printdebug "QF linkorigs $b, $f ?\n"; @@ -5468,6 +5667,8 @@ sub quilt_fixup_linkorigs ($$) { link_ltarget $f, $b or die "$b $!"; $fn->($b); } + die "$buildproductsdir: $!" if $!; + closedir QFD; } sub quilt_fixup_delete_pc () { @@ -5489,8 +5690,8 @@ sub quilt_fixup_singlepatch ($$$) { # get it to generate debian/patches/debian-changes, it is # necessary to build the source package. - quilt_fixup_linkorigs($upstreamversion, sub { }); - quilt_fixup_mkwork($headref); + unpack_playtree_linkorigs($upstreamversion, sub { }); + unpack_playtree_mkwork($headref); rmtree("debian/patches"); @@ -5530,7 +5731,7 @@ END print $fakedsc " ".$md->hexdigest." $size $b\n" or die $!; }; - quilt_fixup_linkorigs($upstreamversion, $dscaddfile); + unpack_playtree_linkorigs($upstreamversion, $dscaddfile); my @files=qw(debian/source/format debian/rules debian/control debian/changelog); @@ -5598,7 +5799,7 @@ sub quilt_check_splitbrain_cache ($$) { next unless m/^(\w+) (\S.*\S)$/ && $2 eq $splitbrain_cachekey; my $cachehit = $1; - quilt_fixup_mkwork($headref); + unpack_playtree_mkwork($headref); my $saved = maybe_split_brain_save $headref, $cachehit, "cache-hit"; if ($cachehit ne $headref) { progress "dgit view: found cached ($saved)"; @@ -5729,13 +5930,13 @@ sub quilt_fixup_multipatch ($$$) { failed to apply your git tree's patch stack (from debian/patches/) to the corresponding upstream tarball(s). Your source tree and .orig are probably too inconsistent. dgit can only fix up certain kinds of - anomaly (depending on the quilt mode). See --quilt= in dgit(1). + anomaly (depending on the quilt mode). Please see --quilt= in dgit(1). END } changedir '..'; - quilt_fixup_mkwork($headref); + unpack_playtree_mkwork($headref); my $mustdeletepc=0; if (stat_exists ".pc") { @@ -5803,7 +6004,7 @@ END " --[quilt=]gbp --[quilt=]dpm --quilt=unapplied ?"; if (quiltmode_splitbrain()) { - quiltify_splitbrain($clogp, $unapplied, $headref, + quiltify_splitbrain($clogp, $unapplied, $headref, $oldtiptree, $diffbits, \%editedignores, $splitbrain_cachekey); return; @@ -5907,6 +6108,10 @@ sub cmd_clean () { maybe_unapply_patches_again(); } +# return values from massage_dbp_args are one or both of these flags +sub WANTSRC_SOURCE () { 01; } # caller should build source (separately) +sub WANTSRC_BUILDER () { 02; } # caller should run dpkg-buildpackage + sub build_or_push_prep_early () { our $build_or_push_prep_early_done //= 0; return if $build_or_push_prep_early_done++; @@ -5945,13 +6150,21 @@ sub changesopts_initial () { sub changesopts_version () { if (!defined $changes_since_version) { - my @vsns = archive_query('archive_query'); - my @quirk = access_quirk(); - if ($quirk[0] eq 'backports') { - local $isuite = $quirk[2]; - local $csuite; - canonicalise_suite(); - push @vsns, archive_query('archive_query'); + my @vsns; + unless (eval { + @vsns = archive_query('archive_query'); + my @quirk = access_quirk(); + if ($quirk[0] eq 'backports') { + local $isuite = $quirk[2]; + local $csuite; + canonicalise_suite(); + push @vsns, archive_query('archive_query'); + } + 1; + }) { + print STDERR $@; + fail + "archive query failed (queried because --since-version not specified)"; } if (@vsns) { @vsns = map { $_->[0] } @vsns; @@ -5987,16 +6200,11 @@ sub massage_dbp_args ($;$) { # unless we're not doing a split build and want dpkg-source # as cleanmode, in which case we can do nothing # - # return values: - # 0 - source will NOT need to be built separately by caller - # +1 - source will need to be built separately by caller - # +2 - source will need to be built separately by caller AND - # dpkg-buildpackage should not in fact be run at all! debugcmd '#massaging#', @$cmd if $debuglevel>1; #print STDERR "MASS0 ",Dumper($cmd, $xargs, $need_split_build_invocation); if ($cleanmode eq 'dpkg-source' && !$need_split_build_invocation) { $clean_using_builder = 1; - return 0; + return WANTSRC_BUILDER; } # -nc has the side effect of specifying -b if nothing else specified # and some combinations of -S, -b, et al, are errors, rather than @@ -6012,12 +6220,12 @@ sub massage_dbp_args ($;$) { } push @$cmd, '-nc'; #print STDERR "MASS1 ",Dumper($cmd, $xargs, $dmode); - my $r = 0; + my $r = WANTSRC_BUILDER; if ($need_split_build_invocation) { printdebug "massage split $dmode.\n"; - $r = $dmode =~ m/[S]/ ? +2 : - $dmode =~ y/gGF/ABb/ ? +1 : - $dmode =~ m/[ABb]/ ? 0 : + $r = $dmode =~ m/[S]/ ? WANTSRC_SOURCE : + $dmode =~ y/gGF/ABb/ ? WANTSRC_SOURCE | WANTSRC_BUILDER : + $dmode =~ m/[ABb]/ ? WANTSRC_BUILDER : die "$dmode ?"; } printdebug "massage done $r $dmode.\n"; @@ -6026,21 +6234,22 @@ sub massage_dbp_args ($;$) { return $r; } -sub in_parent (&) { +sub in_bpd (&) { my ($fn) = @_; my $wasdir = must_getcwd(); - changedir ".."; + changedir $buildproductsdir; $fn->(); changedir $wasdir; } -sub postbuild_mergechanges ($) { # must run with CWD=.. (eg in in_parent) +# this sub must run with CWD=$buildproductsdir (eg in in_bpd) +sub postbuild_mergechanges ($) { 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; + my @changesfiles = grep { !m/_multi\.changes/ } glob $pat; @changesfiles = sort { ($b =~ m/_source\.changes$/ <=> $a =~ m/_source\.changes$/) or $a cmp $b @@ -6076,8 +6285,11 @@ END sub midbuild_checkchanges () { my $pat = changespat $version; return if $rmchanges; - my @unwanted = map { s#^\.\./##; $_; } glob "../$pat"; - @unwanted = grep { $_ ne changespat $version,'source' } @unwanted; + my @unwanted = map { s#.*/##; $_; } glob "$bpd_glob/$pat"; + @unwanted = grep { + $_ ne changespat $version,'source' and + $_ ne changespat $version,'multi' + } @unwanted; fail < 0) { + if ($wantsrc & WANTSRC_SOURCE) { build_source(); midbuild_checkchanges_vanilla $wantsrc; } else { build_prep(); } - if ($wantsrc < 2) { + if ($wantsrc & WANTSRC_BUILDER) { push @dbp, changesopts_version(); maybe_apply_patches_dirtily(); runcmd_ordryrun_local @dbp; @@ -6135,7 +6347,7 @@ sub cmd_gbp_build { # orig is absent. my $upstreamversion = upstreamversion $version; my $origfnpat = srcfn $upstreamversion, '.orig.tar.*'; - my $gbp_make_orig = $version =~ m/-/ && !(() = glob "../$origfnpat"); + my $gbp_make_orig = $version =~ m/-/ && !(() = glob "$bpd_glob/$origfnpat"); if ($gbp_make_orig) { clean_tree(); @@ -6178,7 +6390,7 @@ sub cmd_gbp_build { } } - if ($wantsrc > 0) { + if ($wantsrc & WANTSRC_SOURCE) { build_source(); midbuild_checkchanges_vanilla $wantsrc; } else { @@ -6188,7 +6400,7 @@ sub cmd_gbp_build { build_prep(); } maybe_unapply_patches_again(); - if ($wantsrc < 2) { + if ($wantsrc & WANTSRC_BUILDER) { push @cmd, changesopts(); runcmd_ordryrun_local @cmd, @ARGV; } @@ -6207,7 +6419,7 @@ sub build_source { build_prep(); $sourcechanges = changespat $version,'source'; if (act_local()) { - unlink "../$sourcechanges" or $!==ENOENT + unlink "$buildproductsdir/$sourcechanges" or $!==ENOENT or fail "remove $sourcechanges: $!"; } $dscfn = dscfn($version); @@ -6224,7 +6436,7 @@ sub build_source { ($f =~ m/\.debian\.tar(?:\.\w+)$/ && $f eq srcfn($version, $&)); printdebug "source copy, found $f - renaming\n"; - rename "$playground/$f", "../$f" or $!==ENOENT + rename "$playground/$f", "$buildproductsdir/$f" or $!==ENOENT or fail "put in place new source file ($f): $!"; } } else { @@ -6236,7 +6448,7 @@ sub build_source { } runcmd_ordryrun_local qw(sh -ec), 'exec >$1; shift; exec "$@"','x', - "../$sourcechanges", + "$buildproductsdir/$sourcechanges", @dpkggenchanges, qw(-S), changesopts(); } @@ -6251,7 +6463,7 @@ sub cmd_build_source { sub cmd_sbuild { build_source(); midbuild_checkchanges(); - in_parent { + in_bpd { if (act_local()) { stat_exists $dscfn or fail "$dscfn (in parent directory): $!"; stat_exists $sourcechanges @@ -6260,7 +6472,7 @@ sub cmd_sbuild { runcmd_ordryrun_local @sbuild, qw(-d), $isuite, @ARGV, $dscfn; }; maybe_unapply_patches_again(); - in_parent { + in_bpd { postbuild_mergechanges(<{Filename}; - my $here = "../$f"; + my $here = "$buildproductsdir/$f"; if (lstat $here) { next if stat $here; fail "lstat $here works but stat gives $! !"; @@ -6657,9 +6869,9 @@ sub parseopts () { } elsif (m/^--(gbp|dpm)$/s) { push @ropts, "--quilt=$1"; $quilt_mode = $1; - } elsif (m/^--ignore-dirty$/s) { + } elsif (m/^--(?:ignore|include)-dirty$/s) { push @ropts, $_; - $ignoredirty = 1; + $includedirty = 1; } elsif (m/^--no-quilt-fixup$/s) { push @ropts, $_; $quilt_mode = 'nocheck'; @@ -6860,6 +7072,9 @@ sub parseopts_late_defaults () { $need_split_build_invocation ||= quiltmode_splitbrain(); + fail "dgit: --include-dirty is not supported in split view quilt mode" + if $split_brain && $includedirty; + if (!defined $cleanmode) { local $access_forpush; $cleanmode = access_cfg('clean-mode', 'RETURN-UNDEF'); @@ -6868,6 +7083,11 @@ sub parseopts_late_defaults () { badcfg "unknown clean-mode \`$cleanmode'" unless $cleanmode =~ m/^($cleanmode_re)$(?!\n)/s; } + + $buildproductsdir //= access_cfg('build-products-dir', 'RETURN-UNDEF'); + $buildproductsdir //= '..'; + $bpd_glob = $buildproductsdir; + $bpd_glob =~ s#[][\\{}*?~]#\\$&#g; } if ($ENV{$fakeeditorenv}) {