X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=da62de1f39f57708a7874b7f33cfebac2d84730d;hp=ca907f3f8af2394aa450fdea52fb6a5b3100709b;hb=1b72149044ab77e11215ab4780daa981c5c03225;hpb=8e3a97ee058cdfd1d9318fff2e9dcea9c78bb98d

diff --git a/dgit b/dgit
index ca907f3f..da62de1f 100755
--- a/dgit
+++ b/dgit
@@ -36,6 +36,8 @@ use Digest::SHA;
 use Digest::MD5;
 use List::Util qw(any);
 use List::MoreUtils qw(pairwise);
+use Text::Glob qw(match_glob);
+use Fcntl qw(:DEFAULT :flock);
 use Carp;
 
 use Debian::Dgit;
@@ -102,6 +104,8 @@ our (@gpg) = qw(gpg);
 our (@sbuild) = qw(sbuild);
 our (@ssh) = 'ssh';
 our (@dgit) = qw(dgit);
+our (@aptget) = qw(apt-get);
+our (@aptcache) = qw(apt-cache);
 our (@dpkgbuildpackage) = qw(dpkg-buildpackage -i\.git/ -I.git);
 our (@dpkgsource) = qw(dpkg-source -i\.git/ -I.git);
 our (@dpkggenchanges) = qw(dpkg-genchanges);
@@ -119,6 +123,8 @@ our %opts_opt_map = ('dget' => \@dget, # accept for compatibility
                      'ssh' => \@ssh,
                      'dgit' => \@dgit,
                      'git' => \@git,
+                     'apt-get' => \@aptget,
+                     'apt-cache' => \@aptcache,
                      'dpkg-source' => \@dpkgsource,
                      'dpkg-buildpackage' => \@dpkgbuildpackage,
                      'dpkg-genchanges' => \@dpkggenchanges,
@@ -580,11 +586,13 @@ sub cmd_help () {
 our $td = $ENV{DGIT_TEST_DUMMY_DIR} || "DGIT_TEST_DUMMY_DIR-unset";
 
 our %defcfg = ('dgit.default.distro' => 'debian',
+	       'dgit-suite.*-security.distro' => 'debian-security',
 	       'dgit.default.username' => '',
 	       'dgit.default.archive-query-default-component' => 'main',
 	       'dgit.default.ssh' => 'ssh',
 	       'dgit.default.archive-query' => 'madison:',
 	       'dgit.default.sshpsql-dbname' => 'service=projectb',
+	       'dgit.default.aptget-components' => 'main',
 	       'dgit.default.dgit-tag-format' => 'new,old,maint',
 	       # old means "repo server accepts pushes with old dgit tags"
 	       # new means "repo server accepts pushes with new dgit tags"
@@ -616,6 +624,11 @@ our %defcfg = ('dgit.default.distro' => 'debian',
 	       'dgit-distro.debian.git-url-suffix' => '',
 	       'dgit-distro.debian.upload-host' => 'ftp-master', # for dput
 	       'dgit-distro.debian.mirror' => 'http://ftp.debian.org/debian/',
+ 'dgit-distro.debian-security.archive-query' => 'aptget:',
+ 'dgit-distro.debian-security.mirror' => 'http://security.debian.org/debian-security/',
+ 'dgit-distro.debian-security.aptget-suite-map' => 's#-security$#/updates#',
+ 'dgit-distro.debian-security.aptget-suite-rmap' => 's#$#-security#',
+ 'dgit-distro.debian-security.nominal-distro' => 'debian',
  'dgit-distro.debian.backports-quirk' => '(squeeze)-backports*',
  'dgit-distro.debian-backports.mirror' => 'http://backports.debian.org/debian-backports/',
 	       'dgit-distro.ubuntu.git-check' => 'false',
@@ -694,11 +707,27 @@ sub access_basedistro () {
     if (defined $idistro) {
 	return $idistro;
     } else {	
-	return cfg("dgit-suite.$isuite.distro",
-		   "dgit.default.distro");
+	my $def = cfg("dgit-suite.$isuite.distro", 'RETURN-UNDEF');
+	return $def if defined $def;
+	foreach my $src (@gitcfgsources, 'internal') {
+	    my $kl = $src eq 'internal' ? \%defcfg : $gitcfgs{$src};
+	    next unless $kl;
+	    foreach my $k (keys %$kl) {
+		next unless $k =~ m#^dgit-suite\.(.*)\.distro$#;
+		my $dpat = $1;
+		next unless match_glob $dpat, $isuite;
+		return $kl->{$k};
+	    }
+	}
+	return cfg("dgit.default.distro");
     }
 }
 
+sub access_nomdistro () {
+    my $base = access_basedistro();
+    return cfg("dgit-distro.$base.nominal-distro",'RETURN-UNDEF') // $base;
+}
+
 sub access_quirk () {
     # returns (quirk name, distro to use instead or undef, quirk-specific info)
     my $basedistro = access_basedistro();
@@ -794,6 +823,8 @@ sub access_distros () {
     unshift @l, $instead_distro;
     @l = grep { defined } @l;
 
+    push @l, access_nomdistro();
+
     if (access_forpush()) {
 	@l = map { ("$_/push", $_) } @l;
     }
@@ -923,10 +954,10 @@ sub parsecontrolfh ($$;$) {
 }
 
 sub parsecontrol {
-    my ($file, $desc) = @_;
+    my ($file, $desc, $allowsigned) = @_;
     my $fh = new IO::Handle;
     open $fh, '<', $file or die "$file: $!";
-    my $c = parsecontrolfh($fh,$desc);
+    my $c = parsecontrolfh($fh,$desc,$allowsigned);
     $fh->error and die $!;
     close $fh;
     return $c;
@@ -986,12 +1017,28 @@ sub archive_query ($;@) {
     { no strict qw(refs); &{"${method}_${proto}"}($proto,$data,@_); }
 }
 
+sub archive_query_prepend_mirror {
+    my $m = access_cfg('mirror');
+    return map { [ $_->[0], $m.$_->[1], @$_[2..$#$_] ] } @_;
+}
+
 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 cfg_apply_map ($$$) {
+    my ($varref, $what, $mapspec) = @_;
+    return unless $mapspec;
+
+    printdebug "config $what EVAL{ $mapspec; }\n";
+    $_ = $$varref;
+    eval "package Dgit::Config; $mapspec;";
+    die $@ if $@;
+    $$varref = $_;
+}
+
 #---------- `ftpmasterapi' archive query method (nascent) ----------
 
 sub archive_api_query_cmd ($) {
@@ -1092,7 +1139,7 @@ sub archive_query_ftpmasterapi {
 	    if length $@;
     }
     @rows = sort { -version_compare($a->[0],$b->[0]) } @rows;
-    return @rows;
+    return archive_query_prepend_mirror @rows;
 }
 
 sub file_in_archive_ftpmasterapi {
@@ -1104,6 +1151,168 @@ sub file_in_archive_ftpmasterapi {
     my $info = api_query($data, "file_in_archive/$pat", 1);
 }
 
+#---------- `aptget' archive query method ----------
+
+our $aptget_base;
+our $aptget_releasefile;
+our $aptget_configpath;
+
+sub aptget_aptget   () { return @aptget,   qw(-c), $aptget_configpath; }
+sub aptget_aptcache () { return @aptcache, qw(-c), $aptget_configpath; }
+
+sub aptget_cache_clean {
+    runcmd_ordryrun_local qw(sh -ec),
+	'cd "$1"; pwd; find -atime +30 -type f -print0 | xargs -0r echo rm --',
+	'x', $aptget_base;
+}
+
+sub aptget_lock_acquire () {
+    my $lockfile = "$aptget_base/lock";
+    open APTGET_LOCK, '>', $lockfile or die "open $lockfile: $!";
+    flock APTGET_LOCK, LOCK_EX or die "lock $lockfile: $!";
+}
+
+sub aptget_prep ($) {
+    my ($data) = @_;
+    return if defined $aptget_base;
+
+    badcfg "aptget archive query method takes no data part"
+	if length $data;
+
+    my $cache = $ENV{XDG_CACHE_DIR} // "$ENV{HOME}/.cache";
+
+    ensuredir $cache;
+    ensuredir "$cache/dgit";
+    my $cachekey =
+	access_cfg('aptget-cachekey','RETURN-UNDEF')
+	// access_nomdistro();
+
+    $aptget_base = "$cache/dgit/aptget";
+    ensuredir $aptget_base;
+
+    my $quoted_base = $aptget_base;
+    die "$quoted_base contains bad chars, cannot continue"
+	if $quoted_base =~ m/["\\]/; # apt.conf(5) says no escaping :-/
+
+    ensuredir $aptget_base;
+
+    aptget_lock_acquire();
+
+    aptget_cache_clean();
+
+    $aptget_configpath = "$aptget_base/apt.conf#$cachekey";
+    my $sourceslist = "source.list#$cachekey";
+
+    my $aptsuites = $isuite;
+    cfg_apply_map(\$aptsuites, 'suite map',
+		  access_cfg('aptget-suite-map', 'RETURN-UNDEF'));
+
+    open SRCS, ">", "$aptget_base/$sourceslist" or die $!;
+    printf SRCS "deb-src %s %s %s\n",
+	access_cfg('mirror'),
+	$aptsuites,
+	access_cfg('aptget-components')
+	or die $!;
+
+    ensuredir "$aptget_base/cache";
+    ensuredir "$aptget_base/lists";
+
+    open CONF, ">", $aptget_configpath or die $!;
+    print CONF <<END;
+Debug::NoLocking "true";
+APT::Get::List-Cleanup "false";
+#clear APT::Update::Post-Invoke-Success;
+Dir::Etc::SourceList "$quoted_base/$sourceslist";
+Dir::State::Lists "$quoted_base/lists";
+Dir::Etc::preferences "$quoted_base/preferences";
+Dir::Cache::srcpkgcache "$quoted_base/cache/srcs#$cachekey";
+Dir::Cache::pkgcache "$quoted_base/cache/pkgs#$cachekey";
+END
+
+    foreach my $key (qw(
+			Dir::Cache
+			Dir::State
+			Dir::Cache::Archives
+			Dir::Etc::SourceParts
+			Dir::Etc::preferencesparts
+		      )) {
+	ensuredir "$aptget_base/$key";
+	print CONF "$key \"$quoted_base/$key\";\n" or die $!;
+    };
+
+    my $oldatime = (time // die $!) - 1;
+    foreach my $oldlist (<$aptget_base/lists/*Release>) {
+	next unless stat_exists $oldlist;
+	my ($mtime) = (stat _)[9];
+	utime $oldatime, $mtime, $oldlist or die "$oldlist $!";
+    }
+
+    runcmd_ordryrun_local aptget_aptget(), qw(update);
+
+    my @releasefiles;
+    foreach my $oldlist (<$aptget_base/lists/*Release>) {
+	next unless stat_exists $oldlist;
+	my ($atime) = (stat _)[8];
+	next if $atime == $oldatime;
+	push @releasefiles, $oldlist;
+    }
+    my @inreleasefiles = grep { m#/InRelease$# } @releasefiles;
+    @releasefiles = @inreleasefiles if @inreleasefiles;
+    die "apt updated wrong number of Release files (@releasefiles), erk"
+	unless @releasefiles == 1;
+
+    ($aptget_releasefile) = @releasefiles;
+}
+
+sub canonicalise_suite_aptget {
+    my ($proto,$data) = @_;
+    aptget_prep($data);
+
+    my $release = parsecontrol $aptget_releasefile, "Release file", 1;
+
+    foreach my $name (qw(Codename Suite)) {
+	my $val = $release->{$name};
+	if (defined $val) {
+	    printdebug "release file $name: $val\n";
+	    $val =~ m/^$suite_re$/o or fail
+ "Release file ($aptget_releasefile) specifies intolerable $name";
+	    cfg_apply_map(\$val, 'suite rmap',
+			  access_cfg('aptget-suite-rmap', 'RETURN-UNDEF'));
+	    return $val
+	}
+    }
+    return $isuite;
+}
+
+sub archive_query_aptget {
+    my ($proto,$data) = @_;
+    aptget_prep($data);
+
+    ensuredir "$aptget_base/source";
+    foreach my $old (<$aptget_base/source/*.dsc>) {
+	unlink $old or die "$old: $!";
+    }
+
+    my $showsrc = cmdoutput aptget_aptcache(), qw(showsrc), $package;
+    return () unless $showsrc =~ m/^package:\s*\Q$package\E\s*$/mi;
+    # avoids apt-get source failing with ambiguous error code
+
+    runcmd_ordryrun_local
+	shell_cmd 'cd "$1"/source; shift', $aptget_base,
+	aptget_aptget(), qw(--download-only --only-source source), $package;
+
+    my @dscs = <$aptget_base/source/*.dsc>;
+    fail "apt-get source did not produce a .dsc" unless @dscs;
+    fail "apt-get source produced several .dscs (@dscs)" unless @dscs==1;
+
+    my $pre_dsc = parsecontrol $dscs[0], $dscs[0], 1;
+
+    use URI::Escape;
+    my $uri = "file://". uri_escape $dscs[0];
+    $uri =~ s{\%2f}{/}gi;
+    return [ (getfield $pre_dsc, 'Version'), $uri ];
+}
+
 #---------- `dummyapicat' archive query method ----------
 
 sub archive_query_dummycatapi { archive_query_ftpmasterapi @_; }
@@ -1134,7 +1343,8 @@ sub file_in_archive_dummycatapi ($$$) {
 #---------- `madison' archive query method ----------
 
 sub archive_query_madison {
-    return map { [ @$_[0..1] ] } madison_get_parse(@_);
+    return archive_query_prepend_mirror
+	map { [ @$_[0..1] ] } madison_get_parse(@_);
 }
 
 sub madison_get_parse {
@@ -1240,7 +1450,7 @@ END
 	my ($vsn,$component,$filename,$sha256sum) = @$_;
 	[ $vsn, "/pool/$component/$filename",$digester,$sha256sum ];
     } @rows;
-    return @rows;
+    return archive_query_prepend_mirror @rows;
 }
 
 sub canonicalise_suite_sshpsql ($$) {
@@ -1296,7 +1506,8 @@ sub archive_query_dummycat ($$) {
     }
     C->error and die "$dpath: $!";
     close C;
-    return sort { -version_compare($a->[0],$b->[0]); } @rows;
+    return archive_query_prepend_mirror
+	sort { -version_compare($a->[0],$b->[0]); } @rows;
 }
 
 sub file_in_archive_dummycat () { return undef; }
@@ -1358,8 +1569,8 @@ sub get_archive_dsc () {
     canonicalise_suite();
     my @vsns = archive_query('archive_query');
     foreach my $vinfo (@vsns) {
-	my ($vsn,$subpath,$digester,$digest) = @$vinfo;
-	$dscurl = access_cfg('mirror').$subpath;
+	my ($vsn,$vsn_dscurl,$digester,$digest) = @$vinfo;
+	$dscurl = $vsn_dscurl;
 	$dscdata = url_get($dscurl);
 	if (!$dscdata) {
 	    $skew_warning_vsn = $vsn if !defined $skew_warning_vsn;
@@ -1822,7 +2033,9 @@ sub check_for_vendor_patches () {
     vendor_patches_distro(Dpkg::Vendor::get_current_vendor(),
 			 "Dpkg::Vendor \`current vendor'");
     vendor_patches_distro(access_basedistro(),
-			  "distro being accessed");
+			  "(base) distro being accessed");
+    vendor_patches_distro(access_nomdistro(),
+			  "(nominal) distro being accessed");
 }
 
 sub generate_commits_from_dsc () {
@@ -2264,9 +2477,9 @@ sub git_fetch_us () {
     my @specs = deliberately_not_fast_forward ? qw(tags/*) :
 	map { "tags/$_" }
 	(quiltmode_splitbrain
-	 ? (map { $_->('*',access_basedistro) }
+	 ? (map { $_->('*',access_nomdistro) }
 	    \&debiantag_new, \&debiantag_maintview)
-	 : debiantags('*',access_basedistro));
+	 : debiantags('*',access_nomdistro));
     push @specs, server_branch($csuite);
     push @specs, qw(heads/*) if deliberately_not_fast_forward;
 
@@ -2292,6 +2505,8 @@ sub git_fetch_us () {
     # git fetch to try to generate it.  If we don't manage to generate
     # the target state, we try again.
 
+    printdebug "git_fetch_us specs @specs\n";
+
     my $specre = join '|', map {
 	my $x = $_;
 	$x =~ s/\W/\\$&/g;
@@ -2307,6 +2522,7 @@ sub git_fetch_us () {
     my $fetch_iteration = 0;
     FETCH_ITERATION:
     for (;;) {
+	printdebug "git_fetch_us iteration $fetch_iteration\n";
         if (++$fetch_iteration > 10) {
 	    fail "too many iterations trying to get sane fetch!";
 	}
@@ -2334,10 +2550,12 @@ END
 
 	# OK, now %want is exactly what we want for refs in @specs
 	my @fspecs = map {
-	    return () if !m/\*$/ && !exists $wantr{"refs/$_"};
+	    !m/\*$/ && !exists $wantr{"refs/$_"} ? () :
 	    "+refs/$_:".lrfetchrefs."/$_";
 	} @specs;
 
+	printdebug "git_fetch_us fspecs @fspecs\n";
+
 	my @fcmd = (@git, qw(fetch -p -n -q), access_giturl(), @fspecs);
 	runcmd_ordryrun_local @git, qw(fetch -p -n -q), access_giturl(),
 	    @fspecs;
@@ -2396,7 +2614,7 @@ END
 	Dumper(\%lrfetchrefs_f);
 
     my %here;
-    my @tagpats = debiantags('*',access_basedistro);
+    my @tagpats = debiantags('*',access_nomdistro);
 
     git_for_each_ref([map { "refs/tags/$_" } @tagpats], sub {
 	my ($objid,$objtype,$fullrefname,$reftail) = @_;
@@ -2571,11 +2789,8 @@ sub fetch_from_archive () {
     };
 
     if (defined $dsc_hash) {
-	fail "missing remote git history even though dsc has hash -".
-	    " could not find ref ".rref()." at ".access_giturl()
-	    unless $lastpush_hash;
 	ensure_we_have_orig();
-	if ($dsc_hash eq $lastpush_hash) {
+	if (!$lastpush_hash || $dsc_hash eq $lastpush_hash) {
 	    @mergeinputs = $dsc_mergeinput
 	} elsif (is_fast_fwd($dsc_hash,$lastpush_hash)) {
 	    print STDERR <<END or die $!;
@@ -2742,7 +2957,8 @@ END
 	die "$lasth $hash $what ?" unless is_fast_fwd($lasth, $hash);
     };
 
-    $chkff->($lastpush_hash, 'dgit repo server tip (last push)');
+    $chkff->($lastpush_hash, 'dgit repo server tip (last push)')
+	if $lastpush_hash;
     $chkff->($lastfetch_hash, 'local tracking tip (last fetch)');
 
     runcmd @git, qw(update-ref -m), "dgit fetch $csuite",
@@ -3136,9 +3352,9 @@ sub splitbrain_pseudomerge ($$$$) {
 
     if (defined $overwrite_version) {
     } elsif (!eval {
-	my $t_dep14 = debiantag_maintview $i_arch_v->[0], access_basedistro;
+	my $t_dep14 = debiantag_maintview $i_arch_v->[0], access_nomdistro;
 	my $i_dep14 = infopair_lrf_tag_lookup($t_dep14, "maintainer view tag");
-	my $t_dgit = debiantag_new $i_arch_v->[0], access_basedistro;
+	my $t_dgit = debiantag_new $i_arch_v->[0], access_nomdistro;
 	my $i_dgit = infopair_lrf_tag_lookup($t_dgit, "dgit view tag");
 	my $i_archive = [ $archive_hash, "current archive contents" ];
 
@@ -3197,9 +3413,12 @@ sub push_parse_changelog ($) {
     my $clogp = Dpkg::Control::Hash->new();
     $clogp->load($clogpfn) or die;
 
-    $package = getfield $clogp, 'Source';
+    my $clogpackage = getfield $clogp, 'Source';
+    $package //= $clogpackage;
+    fail "-p specified $package but changelog specified $clogpackage"
+	unless $package eq $clogpackage;
     my $cversion = getfield $clogp, 'Version';
-    my $tag = debiantag($cversion, access_basedistro);
+    my $tag = debiantag($cversion, access_nomdistro);
     runcmd @git, qw(check-ref-format), $tag;
 
     my $dscfn = dscfn($cversion);
@@ -3235,7 +3454,7 @@ sub push_tagwants ($$$$) {
         };
     }
     foreach my $tw (@tagwants) {
-	$tw->{Tag} = $tw->{TagFn}($cversion, access_basedistro);
+	$tw->{Tag} = $tw->{TagFn}($cversion, access_nomdistro);
 	$tw->{Tfn} = sub { $tfbase.$tw->{TfSuffix}.$_[0]; };
     }
     printdebug 'push_tagwants: ', Dumper(\@_, \@tagwants);
@@ -3266,7 +3485,7 @@ sub push_mktags ($$ $$ $) {
     # to control the "tagger" (b) we can do remote signing
     my $authline = clogp_authline $clogp;
     my $delibs = join(" ", "",@deliberatelies);
-    my $declaredistro = access_basedistro();
+    my $declaredistro = access_nomdistro();
 
     my $mktag = sub {
 	my ($tw) = @_;
@@ -3682,6 +3901,12 @@ sub cmd_fetch {
 sub cmd_pull {
     parseopts();
     fetchpullargs();
+    if (quiltmode_splitbrain()) {
+	my ($format, $fopts) = get_source_format();
+	madformat($format) and fail <<END
+dgit pull not yet supported in split view mode (--quilt=$quilt_mode)
+END
+    }
     pull();
 }
 
@@ -5176,6 +5401,24 @@ sub pre_gbp_build {
 }
 
 sub cmd_gbp_build {
+    build_prep_early();
+
+    # gbp can make .origs out of thin air.  In my tests it does this
+    # even for a 1.0 format package, with no origs present.  So I
+    # guess it keys off just the version number.  We don't know
+    # exactly what .origs ought to exist, but let's assume that we
+    # should run gbp if: the version has an upstream part and the main
+    # orig is absent.
+    my $upstreamversion = upstreamversion $version;
+    my $origfnpat = srcfn $upstreamversion, '.orig.tar.*';
+    my $gbp_make_orig = $version =~ m/-/ && !(() = glob "../$origfnpat");
+
+    if ($gbp_make_orig) {
+	clean_tree();
+	$cleanmode = 'none'; # don't do it again
+	$need_split_build_invocation = 1;
+    }
+
     my @dbp = @dpkgbuildpackage;
 
     my $wantsrc = massage_dbp_args \@dbp, \@ARGV;
@@ -5191,6 +5434,24 @@ sub cmd_gbp_build {
 
     push @cmd, (qw(-us -uc --git-no-sign-tags), "--git-builder=@dbp");
 
+    if ($gbp_make_orig) {
+	ensuredir '.git/dgit';
+	my $ok = '.git/dgit/origs-gen-ok';
+	unlink $ok or $!==&ENOENT or die $!;
+	my @origs_cmd = @cmd;
+	push @origs_cmd, qw(--git-cleaner=true);
+	push @origs_cmd, "--git-prebuild=touch $ok .git/dgit/no-such-dir/ok";
+	push @origs_cmd, @ARGV;
+	if (act_local()) {
+	    debugcmd @origs_cmd;
+	    system @origs_cmd;
+	    do { local $!; stat_exists $ok; }
+		or failedcmd @origs_cmd;
+	} else {
+	    dryrun_report @origs_cmd;
+	}
+    }
+
     if ($wantsrc > 0) {
 	build_source();
 	midbuild_checkchanges_vanilla $wantsrc;
@@ -5517,6 +5778,7 @@ defvalopt '',                '-k', '.+',      \$keyid;
 defvalopt '--existing-package','', '.*',      \$existing_package;
 defvalopt '--build-products-dir','','.*',     \$buildproductsdir;
 defvalopt '--clean',       '', $cleanmode_re, \$cleanmode;
+defvalopt '--package',   '-p',   $package_re, \$package;
 defvalopt '--quilt',     '', $quilt_modes_re, \$quilt_mode;
 
 defvalopt '', '-C', '.+', sub {