}
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;
{ 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);
if length $@;
}
@rows = sort { -version_compare($a->[0],$b->[0]) } @rows;
- return @rows;
+ return archive_query_prepend_mirror @rows;
}
sub file_in_archive_ftpmasterapi {
#---------- `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 {
my ($vsn,$component,$filename,$sha256sum) = @$_;
[ $vsn, "/pool/$component/$filename",$digester,$sha256sum ];
} @rows;
- return @rows;
+ return archive_query_prepend_mirror @rows;
}
sub canonicalise_suite_sshpsql ($$) {
}
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; }
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;
# 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;
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!";
}
# 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;
};
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 $!;
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",
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);
runcmd @git, qw(check-ref-format), $tag;
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 {