X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=5fa500c65cc7ff2393d0ceb6fdce458b52446954;hp=60ab9a6cc723e37c27742ab195dd104c2560d718;hb=37913654d58e03354aa4d5a6aa5afb9c5aeca6b7;hpb=8ff24012c9e4b826cedca7eada4476abf518ccd5 diff --git a/dgit b/dgit index 60ab9a6c..5fa500c6 100755 --- a/dgit +++ b/dgit @@ -73,6 +73,8 @@ our $tagformat_want; our $tagformat; our $tagformatfn; +our %forceopts = map { $_=>0 } qw(unrepresentable); + our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)"); our $suite_re = '[-+.0-9a-z]+'; @@ -86,7 +88,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); @@ -222,6 +224,12 @@ 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 no_such_package () { print STDERR "$us: package $package does not exist in suite $isuite\n"; exit 4; @@ -551,7 +559,7 @@ our %defcfg = ('dgit.default.distro' => 'debian', 'dgit.default.ssh' => 'ssh', 'dgit.default.archive-query' => 'madison:', 'dgit.default.sshpsql-dbname' => 'service=projectb', - 'dgit.default.dgit-tag-format' => 'old,new,maint', + 'dgit.default.dgit-tag-format' => 'new,old,maint', # old means "repo server accepts pushes with old dgit tags" # new means "repo server accepts pushes with new dgit tags" # maint means "repo server accepts split brain pushes" @@ -955,7 +963,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; @@ -989,7 +997,16 @@ sub api_query ($$) { 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 = $&; + fail "fetch of $url gave HTTP code $code" + unless $url =~ m#^file://# or $code =~ m/^2/; return decode_json($json); } @@ -1321,7 +1338,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 @@ -2007,7 +2024,7 @@ sub complete_file_from_dsc ($$) { $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; } @@ -2896,23 +2913,32 @@ sub splitbrain_pseudomerge ($$$$) { return $dgitview if is_fast_fwd $archive_hash, $dgitview; - my $t_dep14 = debiantag_maintview $i_arch_v->[0], access_basedistro; - my $i_dep14 = infopair_lrf_tag_lookup($t_dep14, "maintainer view tag"); - my $t_dgit = debiantag_new $i_arch_v->[0], access_basedistro; - my $i_dgit = infopair_lrf_tag_lookup($t_dgit, "dgit view tag"); - my $i_archive = [ $archive_hash, "current archive contents" ]; - - printdebug "splitbrain_pseudomerge i_archive @$i_archive\n"; - - infopair_cond_equal($i_dgit, $i_archive); - infopair_cond_ff($i_dep14, $i_dgit); - $overwrite_version // infopair_cond_ff($i_dep14, [ $maintview, 'HEAD' ]); + if (defined $overwrite_version) { + } elsif (!eval { + my $t_dep14 = debiantag_maintview $i_arch_v->[0], access_basedistro; + my $i_dep14 = infopair_lrf_tag_lookup($t_dep14, "maintainer view tag"); + my $t_dgit = debiantag_new $i_arch_v->[0], access_basedistro; + my $i_dgit = infopair_lrf_tag_lookup($t_dgit, "dgit view tag"); + my $i_archive = [ $archive_hash, "current archive contents" ]; + + printdebug "splitbrain_pseudomerge i_archive @$i_archive\n"; + + infopair_cond_equal($i_dgit, $i_archive); + infopair_cond_ff($i_dep14, $i_dgit); + infopair_cond_ff($i_dep14, [ $maintview, 'HEAD' ]); + 1; + }) { + print STDERR <[0] END_OVERWR Make fast forward from $i_arch_v->[0] END_MAKEFF @@ -2928,16 +2954,6 @@ sub plain_overwrite_pseudomerge ($$$) { my $i_arch_v = pseudomerge_version_check($clogp, $archive_hash); - my @tagformats = access_cfg_tagformats(); - my @t_overwr = - map { $_->($i_arch_v->[0], access_basedistro) } - (grep { m/^(?:old|hist)$/ } @tagformats) - ? \&debiantags : \&debiantag_new; - my $i_overwr = infopair_lrf_tag_lookup \@t_overwr, "previous version tag"; - my $i_archive = [ $archive_hash, "current archive contents" ]; - - infopair_cond_equal($i_overwr, $i_archive); - return $head if is_fast_fwd $archive_hash, $head; my $m = "Declare fast forward from $i_arch_v->[0]"; @@ -3162,14 +3178,15 @@ END $upstreamversion =~ s/-[^-]*$//; changedir $ud; quilt_make_fake_dsc($upstreamversion); - my ($dgitview, $cachekey) = + my $cachekey; + ($dgithead, $cachekey) = quilt_check_splitbrain_cache($actualhead, $upstreamversion); - $dgitview or fail + $dgithead or fail "--quilt=$quilt_mode but no cached dgit view: perhaps tree changed since dgit build[-source] ?"; $split_brain = 1; $dgithead = splitbrain_pseudomerge($clogp, - $actualhead, $dgitview, + $actualhead, $dgithead, $archive_hash); $maintviewhead = $actualhead; changedir '../../../..'; @@ -3909,12 +3926,30 @@ 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 + # instead of this: ensuredir ".git/logs/refs/dgit-intern"; my $makelogfh = new IO::File ".git/logs/refs/$splitbraincache", '>>' or die $!; + + my $oldcache = git_get_ref "refs/$splitbraincache"; + if ($oldcache eq $dgitview) { + my $tree = cmdoutput qw(git rev-parse), "$dgitview:"; + # git update-ref doesn't always update, in this case. *sigh* + my $dummy = make_commit_text < 1000000000 +0000 +committer Dgit 1000000000 +0000 + +Dummy commit - do not use +END + runcmd @git, qw(update-ref -m), "dgit $our_version - dummy", + "refs/$splitbraincache", $dummy; + } runcmd @git, qw(update-ref -m), $cachekey, "refs/$splitbraincache", $dgitview; @@ -4361,7 +4396,7 @@ sub quilt_check_splitbrain_cache ($$) { my $srcshash = Digest::SHA->new(256); my %sfs = ( %INC, '$0(dgit)' => $0 ); foreach my $sfk (sort keys %sfs) { - next unless m/^\$0\b/ || m{^Debian/Dgit\b}; + next unless $sfk =~ m/^\$0\b/ || $sfk =~ m{^Debian/Dgit\b}; $srcshash->add($sfk," "); $srcshash->add(hashfile($sfs{$sfk})); $srcshash->add("\n"); @@ -4369,7 +4404,7 @@ sub quilt_check_splitbrain_cache ($$) { push @cachekey, $srcshash->hexdigest(); $splitbrain_cachekey = "@cachekey"; - my @cmd = (@git, qw(reflog), '--pretty=format:%H %gs', + my @cmd = (@git, qw(log -g), '--pretty=format:%H %gs', $splitbraincache); printdebug "splitbrain cachekey $splitbrain_cachekey\n"; debugcmd "|(probably)",@cmd; @@ -4578,7 +4613,7 @@ END if (@unrepres) { print STDERR "dgit: cannot represent change: $_->[1]: $_->[0]\n" foreach @unrepres; - fail <",@cmd; exec @cmd or fail "exec curl: $!\n"; } @@ -5128,6 +5160,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; @@ -5149,6 +5184,10 @@ sub parseopts () { } elsif (m/^--deliberately-($deliberately_re)$/s) { push @ropts, $_; push @deliberatelies, $&; + } elsif (m/^--force-(.*)/ && defined $forceopts{$1}) { + push @ropts, $&; + $forceopts{$1} = 1; + $_=''; } elsif (m/^--dgit-tag-format=(old|new)$/s) { # undocumented, for testing push @ropts, $_; @@ -5222,6 +5261,30 @@ sub parseopts () { } } +sub check_env_sanity () { + my $blocked = new POSIX::SigSet; + sigprocmask SIG_UNBLOCK, $blocked, $blocked or die $!; + + eval { + foreach my $name (qw(PIPE CHLD)) { + my $signame = "SIG$name"; + my $signum = eval "POSIX::$signame" // die; + ($SIG{$name} // 'DEFAULT') eq 'DEFAULT' or + die "$signame is set to something other than SIG_DFL\n"; + $blocked->ismember($signum) and + die "$signame is blocked\n"; + } + }; + return unless $@; + chomp $@; + fail < 1;