X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=e99df73b161280fc5396431fcc4d63592f8c754f;hb=0143e613578b90d0e320fe4bab748b7a8726fa13;hp=7e642c037b8dedef77c9f62c9750efccf73fe5e4;hpb=eab588a83905122af678182876c2f800e4b6fa77;p=dgit.git
diff --git a/dgit b/dgit
index 7e642c03..e99df73b 100755
--- a/dgit
+++ b/dgit
@@ -18,6 +18,7 @@
# along with this program. If not, see
; } die $! if P->error; - if (!close P) { printdebug "=>!$?\n" if $debug>0; return undef; } + if (!close P) { printdebug "=>!$?\n"; return undef; } chomp $d; $d =~ m/^.*/; printdebug "=> \`$&'",(length $' ? '...' : ''),"\n" if $debug>0; #'; @@ -525,11 +491,12 @@ our %defcfg = ('dgit.default.distro' => 'debian', 'dgit.default.ssh' => 'ssh', 'dgit.default.archive-query' => 'madison:', 'dgit.default.sshpsql-dbname' => 'service=projectb', - 'dgit-distro.debian.archive-query' => 'sshpsql:', + 'dgit-distro.debian.archive-query' => 'ftpmasterapi:', 'dgit-distro.debian.git-host' => 'dgit-git.debian.net', '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', @@ -538,9 +505,7 @@ our %defcfg = ('dgit.default.distro' => 'debian', '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.sshpsql-host' => 'mirror.ftp-master.debian.org', + 'dgit-distro.debian/alioth.git-create' => 'ssh-cmd', 'dgit-distro.debian.upload-host' => 'ftp-master', # for dput 'dgit-distro.debian.mirror' => 'http://ftp.debian.org/debian/', 'dgit-distro.debian.backports-quirk' => '(squeeze)-backports*', @@ -554,7 +519,8 @@ our %defcfg = ('dgit.default.distro' => 'debian', 'dgit-distro.test-dummy.git-url' => "$td/git", 'dgit-distro.test-dummy.git-host' => "git", 'dgit-distro.test-dummy.git-path' => "$td/git", - 'dgit-distro.test-dummy.archive-query' => "dummycat:$td/aq", + 'dgit-distro.test-dummy.archive-query' => "ftpmasterapi:", + 'dgit-distro.test-dummy.archive-query-url' => "file://$td/aq/", 'dgit-distro.test-dummy.mirror' => "file://$td/mirror/", 'dgit-distro.test-dummy.upload-host' => 'test-dummy', ); @@ -565,7 +531,8 @@ sub cfg { my @cmd = (@git, qw(config --), $c); my $v; { - local ($debug) = $debug-1; + local ($Debian::Dgit::debug) = $debug-1; + *debug = *Debian::Dgit::debug; # nnng $v = cmdoutput_errok @cmd; }; if ($?==0) { @@ -780,6 +747,25 @@ sub must_getcwd () { return $d; } +our %rmad; + +sub archive_query ($) { + my ($method) = @_; + my $query = access_cfg('archive-query','RETURN-UNDEF'); + $query =~ s/^(\w+):// or badcfg "invalid archive-query method \`$query'"; + my $proto = $1; + my $data = $'; #'; + { no strict qw(refs); &{"${method}_${proto}"}($proto,$data); } +} + +sub pool_dsc_subpath ($$) { + my ($vsn,$component) = @_; # $package is implict arg + my $prefix = substr($package, 0, $package =~ m/^l/ ? 4 : 1); + return "/pool/$component/$prefix/$package/".dscfn($vsn); +} + +#---------- `ftpmasterapi' archive query method (nascent) ---------- + sub archive_api_query_cmd ($) { my ($subpath) = @_; my @cmd = qw(curl -sS); @@ -801,23 +787,69 @@ sub archive_api_query_cmd ($) { return @cmd; } -our %rmad; +sub api_query ($$) { + use JSON; + my ($data, $subpath) = @_; + badcfg "ftpmasterapi archive query method takes no data part" + if length $data; + my @cmd = archive_api_query_cmd($subpath); + my $json = cmdoutput @cmd; + return decode_json($json); +} -sub archive_query ($) { - my ($method) = @_; - my $query = access_cfg('archive-query','RETURN-UNDEF'); - $query =~ s/^(\w+):// or badcfg "invalid archive-query method \`$query'"; - my $proto = $1; - my $data = $'; #'; - { no strict qw(refs); &{"${method}_${proto}"}($proto,$data); } +sub canonicalise_suite_ftpmasterapi () { + my ($proto,$data) = @_; + my $suites = api_query($data, 'suites'); + my @matched; + foreach my $entry (@$suites) { + next unless grep { + my $v = $entry->{$_}; + defined $v && $v eq $isuite; + } qw(codename name); + push @matched, $entry; + } + fail "unknown suite $isuite" unless @matched; + my $cn; + eval { + @matched==1 or die "multiple matches for suite $isuite\n"; + $cn = "$matched[0]{codename}"; + defined $cn or die "suite $isuite info has no codename\n"; + $cn =~ m/^$suite_re$/ or die "suite $isuite maps to bad codename\n"; + }; + die "bad ftpmaster api response: $@\n".Dumper(\@matched) + if length $@; + return $cn; } -sub pool_dsc_subpath ($$) { - my ($vsn,$component) = @_; # $package is implict arg - my $prefix = substr($package, 0, $package =~ m/^l/ ? 4 : 1); - return "/pool/$component/$prefix/$package/".dscfn($vsn); +sub archive_query_ftpmasterapi () { + my ($proto,$data) = @_; + my $info = api_query($data, "dsc_in_suite/$isuite/$package"); + my @rows; + my $digester = Digest::SHA->new(256); + foreach my $entry (@$info) { + eval { + my $vsn = "$entry->{version}"; + my ($ok,$msg) = version_check $vsn; + die "bad version: $msg\n" unless $ok; + my $component = "$entry->{component}"; + $component =~ m/^$component_re$/ or die "bad component"; + my $filename = "$entry->{filename}"; + $filename && $filename !~ m#[^-+:._~0-9a-zA-Z/]|^[/.]|/[/.]# + or die "bad filename"; + my $sha256sum = "$entry->{sha256sum}"; + $sha256sum =~ m/^[0-9a-f]+$/ or die "bad sha256sum"; + push @rows, [ $vsn, "/pool/$component/$filename", + $digester, $sha256sum ]; + }; + die "bad ftpmaster api response: $@\n".Dumper($entry) + if length $@; + } + @rows = sort { -version_compare($a->[0],$b->[0]) } @rows; + return @rows; } +#---------- `madison' archive query method ---------- + sub archive_query_madison { return map { [ @$_[0..1] ] } madison_get_parse(@_); } @@ -864,6 +896,8 @@ sub canonicalise_suite_madison { return $r[0][2]; } +#---------- `sshpsql' archive query method ---------- + sub sshpsql ($$$) { my ($data,$runeinfo,$sql) = @_; if (!length $data) { @@ -875,9 +909,9 @@ sub sshpsql ($$$) { my @rows; my @cmd = (access_cfg_ssh, $userhost, access_runeinfo("ssh-psql $runeinfo"). - " export LANG=C;". + " export LC_MESSAGES=C; export LC_CTYPE=C;". " ".shellquote qw(psql -A), $dbname, qw(-c), $sql); - printcmd(\*DEBUG,$debugprefix."|",@cmd) if $debug>0; + debugcmd "|",@cmd; open P, "-|", @cmd or die $!; while (
) {
chomp or die;
@@ -937,6 +971,8 @@ END
return $rows[0];
}
+#---------- `dummycat' archive query method ----------
+
sub canonicalise_suite_dummycat ($$) {
my ($proto,$data) = @_;
my $dpath = "$data/suite.$isuite";
@@ -976,6 +1012,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';
@@ -1352,8 +1390,8 @@ $later_warning_msg
END
$hash = $lastpush_hash;
} else {
- fail "archive's .dsc refers to ".$dsc_hash.
- " but this is an ancestor of ".$lastpush_hash;
+ fail "git head (".lrref()."=$lastpush_hash) is not a ".
+ "descendant of archive's .dsc hash ($dsc_hash)";
}
} elsif ($dsc) {
$hash = generate_commit_from_dsc();
@@ -1439,8 +1477,8 @@ sub clone ($) {
}
fetch_from_archive() or no_such_package;
my $vcsgiturl = $dsc->{'Vcs-Git'};
- $vcsgiturl =~ s/\s+-b\s+\S+//g;
if (length $vcsgiturl) {
+ $vcsgiturl =~ s/\s+-b\s+\S+//g;
runcmd @git, qw(remote add vcs-git), $vcsgiturl;
}
runcmd @git, qw(reset --hard), lrref();
@@ -1465,7 +1503,7 @@ sub pull () {
sub check_not_dirty () {
return if $ignoredirty;
my @cmd = (@git, qw(diff --quiet HEAD));
- printcmd(\*DEBUG,$debugprefix."+",@cmd) if $debug>0;
+ debugcmd "+",@cmd;
$!=0; $?=0; system @cmd;
return if !$! && !$?;
if (!$! && $?==256) {
@@ -1570,6 +1608,7 @@ sub push_mktag ($$$$$$$) {
# 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 <