X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=c353b8e2fd774db2bdcf1046b3afd6ac1b4e5af6;hp=c66a001482120f40932a3b300d4f4704783c1a2d;hb=8b9c62a712a865440b0c56c0d6d45c53d7df1c29;hpb=713eaae4d3f172cca513f90c2a0a00501f440bd6

diff --git a/dgit b/dgit
index c66a0014..c353b8e2 100755
--- a/dgit
+++ b/dgit
@@ -26,7 +26,6 @@ use Dpkg::Control::Hash;
 use File::Path;
 use POSIX;
 
-our $mirror = 'http://mirror.relativity.greenend.org.uk/mirror/debian-ftp/';
 our $suite = 'sid';
 our $package;
 
@@ -42,6 +41,7 @@ our (@dput) = qw(dput);
 our (@debsign) = qw(debsign);
 our $keyid;
 
+our $debug = 0;
 open DEBUG, ">/dev/null" or die $!;
 
 our %opts_opt_map = ('dget' => \@dget,
@@ -49,7 +49,7 @@ our %opts_opt_map = ('dget' => \@dget,
 		     'debsign' => \@debsign);
 
 our $remotename = 'dgit';
-our $ourdscfield = 'Vcs-Git-Master';
+our $ourdscfield = 'Vcs-Dgit-Master';
 our $branchprefix = 'dgit';
 
 sub lbranch () { return "$branchprefix/$suite"; }
@@ -96,14 +96,14 @@ sub printcmd {
 }
 
 sub runcmd {
-    printcmd(\*DEBUG,"+",@_);
+    printcmd(\*DEBUG,"+",@_) if $debug>0;
     $!=0; $?=0;
     die "@_ $! $?" if system @_;
 }
 
 sub cmdoutput_errok {
     die Dumper(\@_)." ?" if grep { !defined } @_;
-    printcmd(\*DEBUG,"|",@_);
+    printcmd(\*DEBUG,"|",@_) if $debug>0;
     open P, "-|", @_ or die $!;
     my $d;
     $!=0; $?=0;
@@ -134,16 +134,22 @@ sub runcmd_ordryrun {
 
 our %defcfg = ('dgit.default.distro' => 'debian',
 	       'dgit.default.username' => '',
+	       'dgit.default.archive-query-default-component' => 'main',
 	       'dgit.default.ssh' => 'ssh',
 	       'dgit-distro.debian.git-host' => 'git.debian.org',
 	       'dgit-distro.debian.git-proto' => 'git+ssh://',
 	       'dgit-distro.debian.git-path' => '/git/dgit-repos',
 	       'dgit-distro.debian.git-check' => 'ssh-cmd',
-	       'dgit-distro.debian.git-create' => 'ssh-cmd');
+	       'dgit-distro.debian.git-create' => 'ssh-cmd',
+	       'dgit-distro.debian.mirror' => 'http://ftp.debian.org/debian/');
 
 sub cfg {
     foreach my $c (@_) {
-	my $v = cmdoutput_errok(@git, qw(config --), $c);
+	my $v;
+	{
+	    local ($debug) = $debug-1;
+	    $v = cmdoutput_errok(@git, qw(config --), $c);
+	};
 	if ($?==0) {
 	    chomp $v;
 	    return $v;
@@ -156,10 +162,14 @@ sub cfg {
     return undef;
 }
 
+sub access_distro () {
+    return cfg("dgit-suite.$suite.distro",
+	       "dgit.default.distro");
+}
+
 sub access_cfg ($) {
     my ($key) = @_;
-    my $distro = cfg("dgit-suite.$suite.distro",
-		     "dgit.default.distro");
+    my $distro = access_distro();
     my $value = cfg("dgit-distro.$distro.$key",
 		    "dgit.default.$key");
     return $value;
@@ -199,12 +209,18 @@ sub parsechangelog {
 
 our $rmad;
 
-sub askmadison () {
-    $rmad ||= cmdoutput qw(rmadison -asource),"-s$suite",$package;
-    $rmad =~ m/^ \s*( [^ \t|]+ )\s* \|
+sub archive_query () {
+    my $query = access_cfg('archive-query');
+    $query ||= "madison:".access_distro();
+    $query =~ s/^(\w+):// or die "$query ?";
+    my $proto = $1;
+    my $url = $'; #';
+    die unless $proto eq 'madison';
+    $rmad ||= cmdoutput qw(rmadison -asource),"-s$suite","-u$url",$package;
+    $rmad =~ m{^ \s*( [^ \t|]+ )\s* \|
                  \s*( [^ \t|]+ )\s* \|
-                 \s*( [^ \t|]+ )\s* \|
-                 \s*( [^ \t|]+ )\s* /x or die "$rmad $?";
+                 \s*( [^ \t|/]+ )(?:/([^ \t|/]+)) \s* \|
+                 \s*( [^ \t|]+ )\s* }x or die "$rmad $?";
     $1 eq $package or die "$rmad $package ?";
     my $vsn = $2;
     if ($suite ne $3) {
@@ -212,25 +228,32 @@ sub askmadison () {
 	print "canonical suite name for $suite is $3\n";
 	$suite = $3;
     }
-    $4 eq 'source' or die "$rmad ?";
-    return $vsn;
+    my $component;
+    if (defined $4) {
+	$component = $4;
+    } else {
+	$component = access_cfg('archive-query-default-component');
+    }
+    $5 eq 'source' or die "$rmad ?";
+    my $prefix = substr($package, 0, $package =~ m/^l/ ? 4 : 1);
+    my $subpath = "/pool/$component/$prefix/$package/${package}_$vsn.dsc";
+    return ($vsn,$subpath);
 }
 
 sub canonicalise_suite () {
-    askmadison();
+    archive_query();
 }
 
 sub get_archive_dsc () {
-    my $vsn = askmadison();
+    my ($vsn,$subpath) = archive_query();
     # fixme madison does not show us the component
-    my $prefix = substr($package, 0, $package =~ m/^l/ ? 4 : 1);
-    $dscurl = "$mirror/pool/main/$prefix/$package/${package}_$vsn.dsc";
+    $dscurl = access_cfg('mirror').$subpath;
     $dscdata = url_get($dscurl);
     my $dscfh = new IO::File \$dscdata, '<' or die $!;
-    print DEBUG Dumper($dscdata);
+    print DEBUG Dumper($dscdata) if $debug>1;
     $dsc = Dpkg::Control::Hash->new(allow_pgp=>1);
     $dsc->parse($dscfh, 'dsc') or die "parsing of $dscurl failed\n";
-    print DEBUG Dumper($dsc);
+    print DEBUG Dumper($dsc) if $debug>1;
     my $fmt = $dsc->{Format};
     die "unsupported format $fmt, sorry\n" unless $format_ok{$fmt};
 }
@@ -243,7 +266,7 @@ sub check_for_git () {
 	    (access_cfg('ssh'),access_gituserhost(),
 	     " set -e; cd ".access_cfg('git-path').";".
 	     " if test -d $package.git; then echo 1; else echo 0; fi");
-	print DEBUG ">$r<\n";
+	print DEBUG "got \`$r'\n";
 	die "$r $! $?" unless $r =~ m/^[01]$/;
 	return $r+0;
     } else {
@@ -655,6 +678,7 @@ sub parseopts () {
 		    $dryrun=1;
 		} elsif (s/^-D/-/) {
 		    open DEBUG, ">&STDERR" or die $!;
+		    $debug++;
 		} elsif (s/^-c(.*=.*)//s) {
 		    push @git, '-c', $1;
 		} elsif (s/^-C(.*)//s) {