X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=41b7ac845808bf554f56057b62ce2a86f533ff4e;hp=19245e0ed1ef2c75c379048149aed8ecea5e04b2;hb=5dd559b5eaedf57a1081c03ab8602669c9e72e4a;hpb=df1c835ec8cea9ea7cbab65d9726a9a5881b66e1 diff --git a/dgit b/dgit index 19245e0e..41b7ac84 100755 --- a/dgit +++ b/dgit @@ -36,6 +36,7 @@ use Digest::SHA; use Digest::MD5; use List::Util qw(any); use List::MoreUtils qw(pairwise); +use Text::Glob qw(match_glob); use Carp; use Debian::Dgit; @@ -67,6 +68,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; @@ -221,6 +223,12 @@ sub changespat ($;$) { return "${package}_".(stripepoch $vsn)."_".($arch//'*').".changes"; } +sub upstreamversion ($) { + my ($vsn) = @_; + $vsn =~ s/-[^-]+$//; + return $vsn; +} + our $us = 'dgit'; initdebug(''); @@ -687,11 +695,27 @@ sub access_basedistro () { if (defined $idistro) { return $idistro; } else { - return cfg("dgit-suite.$isuite.distro", - "dgit.default.distro"); + my $def = cfg("dgit-suite.$isuite.distro", 'RETURN-UNDEF'); + return $def if defined $def; + foreach my $src (@gitcfgsources, 'internal') { + my $kl = $src eq 'internal' ? \%defcfg : $gitcfgs{$src}; + next unless $kl; + foreach my $k (keys %$kl) { + next unless $k =~ m#^dgit-suite\.(.*)\.distro$#; + my $dpat = $1; + next unless match_glob $dpat, $isuite; + return $kl->{$k}; + } + } + return cfg("dgit.default.distro"); } } +sub access_nomdistro () { + my $base = access_basedistro(); + return cfg("dgit-distro.$base.nominal-distro",'RETURN-UNDEF') // $base; +} + sub access_quirk () { # returns (quirk name, distro to use instead or undef, quirk-specific info) my $basedistro = access_basedistro(); @@ -787,6 +811,8 @@ sub access_distros () { unshift @l, $instead_distro; @l = grep { defined } @l; + push @l, access_nomdistro(); + if (access_forpush()) { @l = map { ("$_/push", $_) } @l; } @@ -916,10 +942,10 @@ sub parsecontrolfh ($$;$) { } sub parsecontrol { - my ($file, $desc) = @_; + my ($file, $desc, $allowsigned) = @_; my $fh = new IO::Handle; open $fh, '<', $file or die "$file: $!"; - my $c = parsecontrolfh($fh,$desc); + my $c = parsecontrolfh($fh,$desc,$allowsigned); $fh->error and die $!; close $fh; return $c; @@ -979,6 +1005,11 @@ sub archive_query ($;@) { { no strict qw(refs); &{"${method}_${proto}"}($proto,$data,@_); } } +sub archive_query_prepend_mirror { + my $m = access_cfg('mirror'); + return map { [ $_->[0], $m.$_->[1], @$_[2..$#$_] ] } @_; +} + sub pool_dsc_subpath ($$) { my ($vsn,$component) = @_; # $package is implict arg my $prefix = substr($package, 0, $package =~ m/^l/ ? 4 : 1); @@ -1085,7 +1116,7 @@ sub archive_query_ftpmasterapi { if length $@; } @rows = sort { -version_compare($a->[0],$b->[0]) } @rows; - return @rows; + return archive_query_prepend_mirror @rows; } sub file_in_archive_ftpmasterapi { @@ -1127,7 +1158,8 @@ sub file_in_archive_dummycatapi ($$$) { #---------- `madison' archive query method ---------- sub archive_query_madison { - return map { [ @$_[0..1] ] } madison_get_parse(@_); + return archive_query_prepend_mirror + map { [ @$_[0..1] ] } madison_get_parse(@_); } sub madison_get_parse { @@ -1233,7 +1265,7 @@ END my ($vsn,$component,$filename,$sha256sum) = @$_; [ $vsn, "/pool/$component/$filename",$digester,$sha256sum ]; } @rows; - return @rows; + return archive_query_prepend_mirror @rows; } sub canonicalise_suite_sshpsql ($$) { @@ -1289,7 +1321,8 @@ sub archive_query_dummycat ($$) { } C->error and die "$dpath: $!"; close C; - return sort { -version_compare($a->[0],$b->[0]); } @rows; + return archive_query_prepend_mirror + sort { -version_compare($a->[0],$b->[0]); } @rows; } sub file_in_archive_dummycat () { return undef; } @@ -1351,8 +1384,8 @@ sub get_archive_dsc () { canonicalise_suite(); my @vsns = archive_query('archive_query'); foreach my $vinfo (@vsns) { - my ($vsn,$subpath,$digester,$digest) = @$vinfo; - $dscurl = access_cfg('mirror').$subpath; + my ($vsn,$vsn_dscurl,$digester,$digest) = @$vinfo; + $dscurl = $vsn_dscurl; $dscdata = url_get($dscurl); if (!$dscdata) { $skew_warning_vsn = $vsn if !defined $skew_warning_vsn; @@ -1815,7 +1848,9 @@ sub check_for_vendor_patches () { vendor_patches_distro(Dpkg::Vendor::get_current_vendor(), "Dpkg::Vendor \`current vendor'"); vendor_patches_distro(access_basedistro(), - "distro being accessed"); + "(base) distro being accessed"); + vendor_patches_distro(access_nomdistro(), + "(nominal) distro being accessed"); } sub generate_commits_from_dsc () { @@ -1854,8 +1889,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) { @@ -2258,9 +2292,9 @@ sub git_fetch_us () { my @specs = deliberately_not_fast_forward ? qw(tags/*) : map { "tags/$_" } (quiltmode_splitbrain - ? (map { $_->('*',access_basedistro) } + ? (map { $_->('*',access_nomdistro) } \&debiantag_new, \&debiantag_maintview) - : debiantags('*',access_basedistro)); + : debiantags('*',access_nomdistro)); push @specs, server_branch($csuite); push @specs, qw(heads/*) if deliberately_not_fast_forward; @@ -2286,6 +2320,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; @@ -2301,6 +2337,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!"; } @@ -2328,10 +2365,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; @@ -2390,7 +2429,7 @@ END Dumper(\%lrfetchrefs_f); my %here; - my @tagpats = debiantags('*',access_basedistro); + my @tagpats = debiantags('*',access_nomdistro); git_for_each_ref([map { "refs/tags/$_" } @tagpats], sub { my ($objid,$objtype,$fullrefname,$reftail) = @_; @@ -2565,11 +2604,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 <($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", @@ -2868,6 +2905,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"; } @@ -2981,6 +3023,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) @@ -3113,9 +3167,9 @@ sub splitbrain_pseudomerge ($$$$) { if (defined $overwrite_version) { } elsif (!eval { - my $t_dep14 = debiantag_maintview $i_arch_v->[0], access_basedistro; + my $t_dep14 = debiantag_maintview $i_arch_v->[0], access_nomdistro; my $i_dep14 = infopair_lrf_tag_lookup($t_dep14, "maintainer view tag"); - my $t_dgit = debiantag_new $i_arch_v->[0], access_basedistro; + my $t_dgit = debiantag_new $i_arch_v->[0], access_nomdistro; my $i_dgit = infopair_lrf_tag_lookup($t_dgit, "dgit view tag"); my $i_archive = [ $archive_hash, "current archive contents" ]; @@ -3141,6 +3195,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; } @@ -3172,9 +3228,12 @@ 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); + my $tag = debiantag($cversion, access_nomdistro); runcmd @git, qw(check-ref-format), $tag; my $dscfn = dscfn($cversion); @@ -3210,7 +3269,7 @@ sub push_tagwants ($$$$) { }; } foreach my $tw (@tagwants) { - $tw->{Tag} = $tw->{TagFn}($cversion, access_basedistro); + $tw->{Tag} = $tw->{TagFn}($cversion, access_nomdistro); $tw->{Tfn} = sub { $tfbase.$tw->{TfSuffix}.$_[0]; }; } printdebug 'push_tagwants: ', Dumper(\@_, \@tagwants); @@ -3241,7 +3300,7 @@ sub push_mktags ($$ $$ $) { # to control the "tagger" (b) we can do remote signing my $authline = clogp_authline $clogp; my $delibs = join(" ", "",@deliberatelies); - my $declaredistro = access_basedistro(); + my $declaredistro = access_nomdistro(); my $mktag = sub { my ($tw) = @_; @@ -3369,8 +3428,7 @@ END my $dgithead = $actualhead; my $maintviewhead = undef; - my $upstreamversion = $clogp->{Version}; - $upstreamversion =~ s/-[^-]*$//; + my $upstreamversion = upstreamversion $clogp->{Version}; if (madformat_wantfixup($format)) { # user might have not used dgit build, so maybe do this now: @@ -3658,6 +3716,12 @@ sub cmd_fetch { sub cmd_pull { parseopts(); fetchpullargs(); + if (quiltmode_splitbrain()) { + my ($format, $fopts) = get_source_format(); + madformat($format) and fail <{'single-debian-patch'}) { quilt_fixup_singlepatch($clogp, $headref, $upstreamversion); @@ -4631,8 +4695,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); @@ -4938,15 +5003,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; @@ -5145,6 +5216,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; @@ -5160,6 +5249,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; @@ -5324,8 +5431,8 @@ sub cmd_import_dsc { require_valid_signature => $needsig; { local $SIG{__WARN__} = sub { - return unless $needsig; print STDERR $_[0]; + return unless $needsig; fail "import-dsc signature check failed"; }; if (!$dp->is_signed()) { @@ -5486,6 +5593,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 { @@ -5581,6 +5689,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;