use Digest::MD5;
use Config;
+use Debian::Dgit;
+
our $our_version = 'UNRELEASED'; ###substituted###
our $rpushprotovsn = 2;
our $new_package = 0;
our $ignoredirty = 0;
our $rmonerror = 1;
+our @deliberatelies;
+our %supersedes;
our $existing_package = 'dpkg';
our $cleanmode = 'dpkg-source';
our $changes_since_version;
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) = @_;
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 ----------
'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/',
return $d;
}
+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;
+}
+
our %rmad;
sub archive_query ($) {
# 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 <<END or die $!;
object $head
tagger $authline
$package release $cversion for $clogsuite ($csuite) [dgit]
+[dgit distro=$declaredistro$delibs]
END
+ foreach my $ref (sort keys %supersedes) {
+ print TO <<END or die $!;
+[dgit supersede:$ref=$supersedes{$ref}]
+END
+ }
+
close TO or die $!;
my $tagobjfn = $tfn->('.tmp');
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;
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) {
$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 ($) {
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 {
} 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 \`$_'";
}
} 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 {
~ianmdlvl / dgit.git / blobdiff