X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=2e67eb5be574b26115d412101be1956c314d9bfb;hp=972a839bb0be2a98b6a4e1e5d958dfa822a2f01b;hb=b839e9edc77dde4c40f2a8479e1b42223852daee;hpb=36e765bdfb9e3b186be796d784f00a900050c295 diff --git a/dgit b/dgit index 972a839b..2e67eb5b 100755 --- a/dgit +++ b/dgit @@ -33,6 +33,8 @@ use Digest::SHA; use Digest::MD5; use Config; +use Debian::Dgit; + our $our_version = 'UNRELEASED'; ###substituted### our $rpushprotovsn = 2; @@ -48,13 +50,14 @@ our $changesfile; our $buildproductsdir = '..'; our $new_package = 0; our $ignoredirty = 0; -our $noquilt = 0; our $rmonerror = 1; +our @deliberatelies; +our %supersedes; our $existing_package = 'dpkg'; our $cleanmode = 'dpkg-source'; our $changes_since_version; our $quilt_mode; -our $quilt_modes_re = 'linear|smash|auto|nofix'; +our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck'; our $we_are_responder; our $initiator_tempdir; @@ -102,20 +105,14 @@ autoflush STDOUT 1; our $remotename = 'dgit'; our @ourdscfield = qw(Dgit Vcs-Dgit-Master); -our $branchprefix = 'dgit'; our $csuite; our $instead_distro; sub lbranch () { return "$branchprefix/$csuite"; } my $lbranch_re = '^refs/heads/'.$branchprefix.'/([^/.]+)$'; sub lref () { return "refs/heads/".lbranch(); } -sub lrref () { return "refs/remotes/$remotename/$branchprefix/$csuite"; } -sub rrref () { return "refs/$branchprefix/$csuite"; } -sub debiantag ($) { - my ($v) = @_; - $v =~ y/~:/_%/; - return "debian/$v"; -} +sub lrref () { return "refs/remotes/$remotename/".server_branch($csuite); } +sub rrref () { return server_ref($csuite); } sub stripepoch ($) { my ($vsn) = @_; @@ -189,11 +186,8 @@ sub changedir ($) { chdir $newdir or die "chdir: $newdir: $!"; } -sub stat_exists ($) { - my ($f) = @_; - return 1 if stat $f; - return 0 if $!==&ENOENT; - die "stat $f: $!"; +sub deliberately ($) { + return !!grep { $_[0] eq $_ } @deliberatelies; } #---------- remote protocol support, common ---------- @@ -529,13 +523,16 @@ our %defcfg = ('dgit.default.distro' => 'debian', 'dgit-distro.debian.git-user-force' => 'dgit', 'dgit-distro.debian.git-proto' => 'git+ssh://', 'dgit-distro.debian.git-path' => '/dgit/debian/repos', + 'dgit-distro.debian.git-check' => 'ssh-cmd', + 'dgit-distro.debian.archive-query-url', 'https://api.ftp-master.debian.org/', + 'dgit-distro.debian.archive-query-tls-key', + '/etc/ssl/certs/%HOST%.pem:/etc/dgit/%HOST%.pem', 'dgit-distro.debian.diverts.alioth' => '/alioth', 'dgit-distro.debian/alioth.git-host' => 'git.debian.org', 'dgit-distro.debian/alioth.git-user-force' => '', 'dgit-distro.debian/alioth.git-proto' => 'git+ssh://', 'dgit-distro.debian/alioth.git-path' => '/git/dgit-repos/repos', - 'dgit-distro.debian.git-check' => 'ssh-cmd', - 'dgit-distro.debian.git-create' => 'ssh-cmd', + 'dgit-distro.debian/alioth.git-create' => 'ssh-cmd', 'dgit-distro.debian.sshpsql-host' => 'mirror.ftp-master.debian.org', 'dgit-distro.debian.upload-host' => 'ftp-master', # for dput 'dgit-distro.debian.mirror' => 'http://ftp.debian.org/debian/', @@ -793,6 +790,31 @@ sub pool_dsc_subpath ($$) { return "/pool/$component/$prefix/$package/".dscfn($vsn); } +#---------- `ftpmaster-api' archive query method (nascent) ---------- + +sub archive_api_query_cmd ($) { + my ($subpath) = @_; + my @cmd = qw(curl -sS); + my $url = access_cfg('archive-query-url'); + if ($url =~ m#^https://([-.0-9a-z]+)/#) { + my $host = $1; + my $keys = access_cfg('archive-query-tls-key','RETURN-UNDEF'); + foreach my $key (split /\:/, $keys) { + $key =~ s/\%HOST\%/$host/g; + if (!stat $key) { + fail "for $url: stat $key: $!" unless $!==ENOENT; + next; + } + push @cmd, "--ca-certificate=$key", "--ca-directory=/dev/enoent"; + last; + } + } + push @cmd, $url.$subpath; + return @cmd; +} + +#---------- `madison' archive query method ---------- + sub archive_query_madison { return map { [ @$_[0..1] ] } madison_get_parse(@_); } @@ -839,6 +861,8 @@ sub canonicalise_suite_madison { return $r[0][2]; } +#---------- `sshpsql' archive query method ---------- + sub sshpsql ($$$) { my ($data,$runeinfo,$sql) = @_; if (!length $data) { @@ -912,6 +936,8 @@ END return $rows[0]; } +#---------- `dummycat' archive query method ---------- + sub canonicalise_suite_dummycat ($$) { my ($proto,$data) = @_; my $dpath = "$data/suite.$isuite"; @@ -951,6 +977,8 @@ sub archive_query_dummycat ($$) { return sort { -version_compare($a->[0],$b->[0]); } @rows; } +#---------- archive query entrypoints and rest of program ---------- + sub canonicalise_suite () { return if defined $csuite; fail "cannot operate on $isuite suite" if $isuite eq 'UNRELEASED'; @@ -1414,6 +1442,7 @@ sub clone ($) { } fetch_from_archive() or no_such_package; my $vcsgiturl = $dsc->{'Vcs-Git'}; + $vcsgiturl =~ s/\s+-b\s+\S+//g; if (length $vcsgiturl) { runcmd @git, qw(remote add vcs-git), $vcsgiturl; } @@ -1487,7 +1516,7 @@ sub get_source_format () { sub madformat ($) { my ($format) = @_; return 0 unless $format eq '3.0 (quilt)'; - if ($noquilt) { + if ($quilt_mode eq 'nocheck') { progress "Not doing any fixup of \`$format' due to --no-quilt-fixup"; return 0; } @@ -1543,6 +1572,8 @@ sub push_mktag ($$$$$$$) { # We make the git tag by hand because (a) that makes it easier # to control the "tagger" (b) we can do remote signing my $authline = clogp_authline $clogp; + my $delibs = join(" ", "",@deliberatelies); + my $declaredistro = access_basedistro(); open TO, '>', $tfn->('.tmp') or die $!; print TO <('.tmp'); @@ -1664,6 +1702,15 @@ sub dopush () { responder_send_command("param head $head"); responder_send_command("param csuite $csuite"); + my $forceflag = deliberately('not-fast-forward') ? '+' : ''; + if ($forceflag && defined $lastpush_hash) { + git_for_each_tag_referring($lastpush_hash, sub { + my ($objid,$fullrefname,$tagname) = @_; + responder_send_command("supersedes $fullrefname=$objid"); + $supersedes{$fullrefname} = $objid; + }); + } + my $tfn = sub { ".git/dgit/tag$_[0]"; }; my $tagobjfn; @@ -1687,7 +1734,7 @@ sub dopush () { create_remote_git_repo(); } runcmd_ordryrun @git, qw(push),access_giturl(), - "HEAD:".rrref(), "refs/tags/$tag"; + $forceflag."HEAD:".rrref(), "refs/tags/$tag"; runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), 'HEAD'; if ($we_are_responder) { @@ -1968,6 +2015,14 @@ sub i_resp_param ($) { $i_param{$1} = $2; } +sub i_resp_supersedes ($) { + $_[0] =~ m#^(refs/tags/\S+)=(\w+)$# + or badproto \*RO, "bad supersedes spec"; + my $r = system qw(git check-ref-format), $1; + die "bad supersedes ref spec ($r)" if $r; + $supersedes{$1} = $2; +} + our %i_wanted; sub i_resp_want ($) { @@ -2604,6 +2659,13 @@ sub cmd_quilt_fixup { build_maybe_quilt_fixup(); } +sub cmd_archive_api_query { + badusage "need only 1 subpath argument" unless @ARGV==1; + my ($subpath) = @ARGV; + my @cmd = archive_api_query_cmd($subpath); + exec @cmd or fail "exec curl: $!\n"; +} + #---------- argument parsing and main program ---------- sub cmd_version { @@ -2683,10 +2745,13 @@ sub parseopts () { $ignoredirty = 1; } elsif (m/^--no-quilt-fixup$/s) { push @ropts, $_; - $noquilt = 1; + $quilt_mode = 'nocheck'; } elsif (m/^--no-rm-on-error$/s) { push @ropts, $_; $rmonerror = 0; + } elsif (m/^--deliberately-($suite_re)$/s) { + push @ropts, $_; + push @deliberatelies, $&; } else { badusage "unknown long option \`$_'"; } @@ -2718,24 +2783,27 @@ sub parseopts () { } elsif (s/^-c(.*=.*)//s) { push @ropts, $&; push @git, '-c', $1; - } elsif (s/^-d(.*)//s) { + } elsif (s/^-d(.+)//s) { push @ropts, $&; $idistro = $1; - } elsif (s/^-C(.*)//s) { + } elsif (s/^-C(.+)//s) { push @ropts, $&; $changesfile = $1; if ($changesfile =~ s#^(.*)/##) { $buildproductsdir = $1; } - } elsif (s/^-k(.*)//s) { + } elsif (s/^-k(.+)//s) { $keyid=$1; - } elsif (s/^-wn//s) { + } elsif (m/^-[vdCk]$/) { + badusage + "option \`$_' requires an argument (and no space before the argument)"; + } elsif (s/^-wn$//s) { push @ropts, $&; $cleanmode = 'none'; - } elsif (s/^-wg//s) { + } elsif (s/^-wg$//s) { push @ropts, $&; $cleanmode = 'git'; - } elsif (s/^-wd//s) { + } elsif (s/^-wd$//s) { push @ropts, $&; $cleanmode = 'dpkg-source'; } else {