X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;ds=sidebyside;f=dgit;h=c84fb80e40f4cd4359c064d0d696261c21426545;hb=a8287b3568a7d563ea9bcfa611275bbee4bce21f;hp=a73fffddc1d635aa44512b3e6e4199d2ddffdf5c;hpb=233fa856bec4d90e55531f54b81a264273cd4cb8;p=dgit.git
diff --git a/dgit b/dgit
index a73fffdd..c84fb80e 100755
--- a/dgit
+++ b/dgit
@@ -2,7 +2,7 @@
# dgit
# Integration between git and Debian-style archives
#
-# Copyright (C)2013 Ian Jackson
+# Copyright (C)2013-2015 Ian Jackson
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
@@ -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; } - chomp $d; - $d =~ m/^.*/; - printdebug "=> \`$&'",(length $' ? '...' : ''),"\n" if $debug>0; #'; - return $d; -} - -sub cmdoutput { - my $d = cmdoutput_errok @_; - defined $d or failedcmd @_; - return $d; -} - sub dryrun_report { printcmd(\*STDERR,$debugprefix."#",@_); } @@ -518,7 +443,7 @@ 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://', @@ -533,7 +458,6 @@ our %defcfg = ('dgit.default.distro' => 'debian', 'dgit-distro.debian/alioth.git-proto' => 'git+ssh://', 'dgit-distro.debian/alioth.git-path' => '/git/dgit-repos/repos', '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/', 'dgit-distro.debian.backports-quirk' => '(squeeze)-backports*', @@ -547,7 +471,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', ); @@ -558,7 +483,7 @@ sub cfg { my @cmd = (@git, qw(config --), $c); my $v; { - local ($debug) = $debug-1; + local ($debuglevel) = $debuglevel-2; $v = cmdoutput_errok @cmd; }; if ($?==0) { @@ -750,23 +675,6 @@ sub parsechangelog { return $c; } -sub git_get_ref ($) { - my ($refname) = @_; - my $got = cmdoutput_errok @git, qw(show-ref --), $refname; - if (!defined $got) { - $?==256 or fail "git show-ref failed (status $?)"; - printdebug "ref $refname= [show-ref exited 1]\n"; - return ''; - } - if ($got =~ m/^(\w+) \Q$refname\E$/m) { - printdebug "ref $refname=$1\n"; - return $1; - } else { - printdebug "ref $refname= [no match]\n"; - return ''; - } -} - sub must_getcwd () { my $d = getcwd(); defined $d or fail "getcwd failed: $!"; @@ -790,7 +698,7 @@ sub pool_dsc_subpath ($$) { return "/pool/$component/$prefix/$package/".dscfn($vsn); } -#---------- `ftpmaster-api' archive query method (nascent) ---------- +#---------- `ftpmasterapi' archive query method (nascent) ---------- sub archive_api_query_cmd ($) { my ($subpath) = @_; @@ -813,6 +721,67 @@ sub archive_api_query_cmd ($) { return @cmd; } +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 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 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 { @@ -874,9 +843,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;
@@ -1008,9 +977,9 @@ sub get_archive_dsc () {
" archive told us to expect $digest";
}
my $dscfh = new IO::File \$dscdata, '<' or die $!;
- printdebug Dumper($dscdata) if $debug>1;
+ printdebug Dumper($dscdata) if $debuglevel>1;
$dsc = parsecontrolfh($dscfh,$dscurl,1);
- printdebug Dumper($dsc) if $debug>1;
+ printdebug Dumper($dsc) if $debuglevel>1;
my $fmt = getfield $dsc, 'Format';
fail "unsupported source format $fmt, sorry" unless $format_ok{$fmt};
$dsc_checked = !!$digester;
@@ -1293,24 +1262,13 @@ sub ensure_we_have_orig () {
}
}
-sub rev_parse ($) {
- return cmdoutput @git, qw(rev-parse), "$_[0]~0";
-}
-
-sub is_fast_fwd ($$) {
- my ($ancestor,$child) = @_;
- my @cmd = (@git, qw(merge-base), $ancestor, $child);
- my $mb = cmdoutput_errok @cmd;
- if (defined $mb) {
- return rev_parse($mb) eq rev_parse($ancestor);
- } else {
- $?==256 or failedcmd @cmd;
- return 0;
- }
-}
-
sub git_fetch_us () {
runcmd_ordryrun_local @git, qw(fetch),access_giturl(),fetchspec();
+ if (deliberately_not_fast_forward) {
+ runcmd_ordryrun_local @git, qw(fetch -p), access_giturl(),
+ map { "+refs/$_/*:".lrfetchrefs."/$_/*" }
+ qw(tags heads);
+ }
}
sub fetch_from_archive () {
@@ -1442,8 +1400,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();
@@ -1468,7 +1426,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) {
@@ -1584,9 +1542,9 @@ tagger $authline
$package release $cversion for $clogsuite ($csuite) [dgit]
[dgit distro=$declaredistro$delibs]
END
- foreach my $ref (sort keys %supersedes) {
+ foreach my $ref (sort keys %previously) {
print TO <