X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=ad6289d53411a4ca155484dc48a1699e4ff6f056;hb=b7dec4080f555d202570cd3293465db52a9139ec;hp=972a839bb0be2a98b6a4e1e5d958dfa822a2f01b;hpb=36e765bdfb9e3b186be796d784f00a900050c295;p=dgit.git

diff --git a/dgit b/dgit
index 972a839b..ad6289d5 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,13 @@ our $changesfile;
 our $buildproductsdir = '..';
 our $new_package = 0;
 our $ignoredirty = 0;
-our $noquilt = 0;
 our $rmonerror = 1;
+our @deliberatelies;
 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 +104,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 +185,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 +522,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/',
@@ -776,6 +772,27 @@ sub must_getcwd () {
     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 ($) {
@@ -1414,6 +1431,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 +1505,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 +1561,7 @@ 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);
     open TO, '>', $tfn->('.tmp') or die $!;
     print TO <<END or die $!;
 object $head
@@ -1551,6 +1570,7 @@ tag $tag
 tagger $authline
 
 $package release $cversion for $clogsuite ($csuite) [dgit]
+[dgit distro=$distro$delibs]
 END
     close TO or die $!;
 
@@ -2604,6 +2624,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 +2710,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 +2748,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 {