X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=135abe5fd1b69291af30d5b2740840c01bbe797c;hp=e90baf3bd9a6470e6f7e348b90c92f93039d2dee;hb=f8b6719127ece2bdf5d26c85a5f35060a4222b70;hpb=b1efb14b9990ecee625335bafd206635ff2ec245 diff --git a/dgit b/dgit index e90baf3b..135abe5f 100755 --- a/dgit +++ b/dgit @@ -48,7 +48,7 @@ our $absurdity = undef; ###substituted### our @rpushprotovsn_support = qw(4 3 2); # 4 is new tag format our $protovsn; -our $isuite = 'unstable'; +our $isuite; our $idistro; our $package; our @ropts; @@ -73,11 +73,13 @@ our $dodep14tag; our $dodep14tag_re = 'want|no|always'; our $split_brain_save; our $we_are_responder; +our $we_are_initiator; our $initiator_tempdir; our $patches_applied_dirtily = 00; our $tagformat_want; our $tagformat; our $tagformatfn; +our $chase_dsc_distro=1; our %forceopts = map { $_=>0 } qw(unrepresentable unsupported-source-format @@ -185,30 +187,6 @@ sub lref () { return "refs/heads/".lbranch(); } sub lrref () { return "refs/remotes/$remotename/".server_branch($csuite); } sub rrref () { return server_ref($csuite); } -sub lrfetchrefs () { return "refs/dgit-fetch/$csuite"; } -sub lrfetchref () { return lrfetchrefs.'/'.server_branch($csuite); } - -# We fetch some parts of lrfetchrefs/*. Ideally we delete these -# locally fetched refs because they have unhelpful names and clutter -# up gitk etc. So we track whether we have "used up" head ref (ie, -# whether we have made another local ref which refers to this object). -# -# (If we deleted them unconditionally, then we might end up -# re-fetching the same git objects each time dgit fetch was run.) -# -# So, leach use of lrfetchrefs needs to be accompanied by arrangements -# in git_fetch_us to fetch the refs in question, and possibly a call -# to lrfetchref_used. - -our (%lrfetchrefs_f, %lrfetchrefs_d); -# $lrfetchrefs_X{lrfetchrefs."/heads/whatever"} = $objid - -sub lrfetchref_used ($) { - my ($fullrefname) = @_; - my $objid = $lrfetchrefs_f{$fullrefname}; - $lrfetchrefs_d{$fullrefname} = $objid if defined $objid; -} - sub stripepoch ($) { my ($vsn) = @_; $vsn =~ s/^\d+\://; @@ -588,6 +566,8 @@ sub cmd_help () { our $td = $ENV{DGIT_TEST_DUMMY_DIR} || "DGIT_TEST_DUMMY_DIR-unset"; our %defcfg = ('dgit.default.distro' => 'debian', + 'dgit.default.default-suite' => 'unstable', + 'dgit.default.old-dsc-distro' => 'debian', 'dgit-suite.*-security.distro' => 'debian-security', 'dgit.default.username' => '', 'dgit.default.archive-query-default-component' => 'main', @@ -596,6 +576,10 @@ our %defcfg = ('dgit.default.distro' => 'debian', 'dgit.default.sshpsql-dbname' => 'service=projectb', 'dgit.default.aptget-components' => 'main', 'dgit.default.dgit-tag-format' => 'new,old,maint', + 'dgit.dsc-url-proto-ok.http' => 'true', + 'dgit.dsc-url-proto-ok.https' => 'true', + 'dgit.dsc-url-proto-ok.git' => 'true', + 'dgit.default.dsc-url-proto-ok' => 'false', # old means "repo server accepts pushes with old dgit tags" # new means "repo server accepts pushes with new dgit tags" # maint means "repo server accepts split brain pushes" @@ -683,7 +667,10 @@ sub git_get_config ($) { my ($c) = @_; foreach my $src (@gitcfgsources) { my $l = $gitcfgs{$src}{$c}; - printdebug"C $c ".(defined $l ? messagequote "'$l'" : "undef")."\n" + croak "$l $c" if $l && !ref $l; + printdebug"C $c ".(defined $l ? + join " ", map { messagequote "'$_'" } @$l : + "undef")."\n" if $debuglevel >= 4; $l or next; @$l==1 or badcfg "multiple values for $c". @@ -696,16 +683,20 @@ sub git_get_config ($) { sub cfg { foreach my $c (@_) { return undef if $c =~ /RETURN-UNDEF/; + printdebug "C? $c\n" if $debuglevel >= 5; my $v = git_get_config($c); return $v if defined $v; my $dv = $defcfg{$c}; - return $dv if defined $dv; + if (defined $dv) { + printdebug "CD $c $dv\n" if $debuglevel >= 4; + return $dv; + } } badcfg "need value for one of: @_\n". "$us: distro or suite appears not to be (properly) supported"; } -sub access_basedistro () { +sub access_basedistro__noalias () { if (defined $idistro) { return $idistro; } else { @@ -725,9 +716,18 @@ sub access_basedistro () { } } +sub access_basedistro () { + my $noalias = access_basedistro__noalias(); + my $canon = cfg("dgit-distro.$noalias.alias-canon",'RETURN-UNDEF'); + return $canon // $noalias; +} + sub access_nomdistro () { my $base = access_basedistro(); - return cfg("dgit-distro.$base.nominal-distro",'RETURN-UNDEF') // $base; + my $r = cfg("dgit-distro.$base.nominal-distro",'RETURN-UNDEF') // $base; + $r =~ m/^$distro_re$/ or badcfg + "bad syntax for (nominal) distro \`$r' (does not match /^$distro_re$/)"; + return $r; } sub access_quirk () { @@ -1680,6 +1680,7 @@ sub create_remote_git_repo () { } our ($dsc_hash,$lastpush_mergeinput); +our ($dsc_distro, $dsc_hint_tag, $dsc_hint_url); our $ud = '.git/dgit/unpack'; @@ -2069,10 +2070,11 @@ sub generate_commits_from_dsc () { foreach my $fi (@dfi) { my $f = $fi->{Filename}; die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#; + my $upper_f = "../../../../$f"; printdebug "considering linking $f: "; - link_ltarget "../../../../$f", $f + link_ltarget $upper_f, $f or ((printdebug "($!) "), 0) or $!==&ENOENT or die "$f $!"; @@ -2082,11 +2084,9 @@ sub generate_commits_from_dsc () { complete_file_from_dsc('.', $fi) or next; - if (is_orig_file_in_dsc($f, \@dfi)) { - link $f, "../../../../$f" - or $!==&EEXIST - or die "$f $!"; - } + link $f, $upper_f + or $!==&EEXIST + or die "$f $!"; } # We unpack and record the orig tarballs first, so that we only @@ -2503,19 +2503,41 @@ sub ensure_we_have_orig () { } } -sub git_fetch_us () { - # Want to fetch only what we are going to use, unless - # deliberately-not-ff, in which case we must fetch everything. +#---------- git fetch ---------- - my @specs = deliberately_not_fast_forward ? qw(tags/*) : - map { "tags/$_" } - (quiltmode_splitbrain - ? (map { $_->('*',access_nomdistro) } - \&debiantag_new, \&debiantag_maintview) - : debiantags('*',access_nomdistro)); - push @specs, server_branch($csuite); - push @specs, $rewritemap; - push @specs, qw(heads/*) if deliberately_not_fast_forward; +sub lrfetchrefs () { return "refs/dgit-fetch/".access_basedistro(); } +sub lrfetchref () { return lrfetchrefs.'/'.server_branch($csuite); } + +# We fetch some parts of lrfetchrefs/*. Ideally we delete these +# locally fetched refs because they have unhelpful names and clutter +# up gitk etc. So we track whether we have "used up" head ref (ie, +# whether we have made another local ref which refers to this object). +# +# (If we deleted them unconditionally, then we might end up +# re-fetching the same git objects each time dgit fetch was run.) +# +# So, leach use of lrfetchrefs needs to be accompanied by arrangements +# in git_fetch_us to fetch the refs in question, and possibly a call +# to lrfetchref_used. + +our (%lrfetchrefs_f, %lrfetchrefs_d); +# $lrfetchrefs_X{lrfetchrefs."/heads/whatever"} = $objid + +sub lrfetchref_used ($) { + my ($fullrefname) = @_; + my $objid = $lrfetchrefs_f{$fullrefname}; + $lrfetchrefs_d{$fullrefname} = $objid if defined $objid; +} + +sub git_lrfetch_sane { + my ($supplementary, @specs) = @_; + # Make a 'refs/'.lrfetchrefs.'/*' be just like on server, + # at least as regards @specs. Also leave the results in + # %lrfetchrefs_f, and arrange for lrfetchref_used to be + # able to clean these up. + # + # With $supplementary==1, @specs must not contain wildcards + # and we add to our previous fetches (non-atomically). # This is rather miserable: # When git fetch --prune is passed a fetchspec ending with a *, @@ -2539,30 +2561,33 @@ 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 $url = access_giturl(); + + printdebug "git_lrfetch_sane suppl=$supplementary specs @specs\n"; my $specre = join '|', map { my $x = $_; $x =~ s/\W/\\$&/g; - $x =~ s/\\\*$/.*/; + my $wildcard = $x =~ s/\\\*$/.*/; + die if $wildcard && $supplementary; "(?:refs/$x)"; } @specs; - printdebug "git_fetch_us specre=$specre\n"; + printdebug "git_lrfetch_sane specre=$specre\n"; my $wanted_rref = sub { local ($_) = @_; - return m/^(?:$specre)$/o; + return m/^(?:$specre)$/; }; my $fetch_iteration = 0; FETCH_ITERATION: for (;;) { - printdebug "git_fetch_us iteration $fetch_iteration\n"; + printdebug "git_lrfetch_sane iteration $fetch_iteration\n"; if (++$fetch_iteration > 10) { fail "too many iterations trying to get sane fetch!"; } my @look = map { "refs/$_" } @specs; - my @lcmd = (@git, qw(ls-remote -q --refs), access_giturl(), @look); + my @lcmd = (@git, qw(ls-remote -q --refs), $url, @look); debugcmd "|",@lcmd; my %wantr; @@ -2588,13 +2613,14 @@ END "+refs/$_:".lrfetchrefs."/$_"; } @specs; - printdebug "git_fetch_us fspecs @fspecs\n"; + printdebug "git_lrfetch_sane 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; + my @fcmd = (@git, qw(fetch -p -n -q), $url, @fspecs); + runcmd_ordryrun_local @fcmd if @fspecs; - %lrfetchrefs_f = (); + if (!$supplementary) { + %lrfetchrefs_f = (); + } my %objgot; git_for_each_ref(lrfetchrefs, sub { @@ -2603,6 +2629,10 @@ END $objgot{$objid} = 1; }); + if ($supplementary) { + last; + } + foreach my $lrefname (sort keys %lrfetchrefs_f) { my $rrefname = 'refs'.substr($lrefname, length lrfetchrefs); if (!exists $wantr{$rrefname}) { @@ -2644,8 +2674,35 @@ END } last; } - printdebug "git_fetch_us: git fetch --no-insane emulation complete\n", + + if (defined $csuite) { + printdebug "git_lrfetch_sane: tidying any old suite lrfetchrefs\n"; + git_for_each_ref("refs/dgit-fetch/$csuite", sub { + my ($objid,$objtype,$lrefname,$reftail) = @_; + next if $lrfetchrefs_f{$lrefname}; # $csuite eq $distro ? + runcmd_ordryrun_local @git, qw(update-ref -d), $lrefname; + }); + } + + printdebug "git_lrfetch_sane: git fetch --no-insane emulation complete\n", Dumper(\%lrfetchrefs_f); +} + +sub git_fetch_us () { + # Want to fetch only what we are going to use, unless + # deliberately-not-ff, in which case we must fetch everything. + + my @specs = deliberately_not_fast_forward ? qw(tags/*) : + map { "tags/$_" } + (quiltmode_splitbrain + ? (map { $_->('*',access_nomdistro) } + \&debiantag_new, \&debiantag_maintview) + : debiantags('*',access_nomdistro)); + push @specs, server_branch($csuite); + push @specs, $rewritemap; + push @specs, qw(heads/*) if deliberately_not_fast_forward; + + git_lrfetch_sane 0, @specs; my %here; my @tagpats = debiantags('*',access_nomdistro); @@ -2672,6 +2729,8 @@ END }); } +#---------- dsc and archive handling ---------- + sub mergeinfo_getclogp ($) { # Ensures thit $mi->{Clogp} exists and returns it my ($mi) = @_; @@ -2700,6 +2759,126 @@ sub fetch_from_archive_record_2 ($) { } } +sub parse_dsc_field ($$) { + my ($dsc, $what) = @_; + my $f; + foreach my $field (@ourdscfield) { + $f = $dsc->{$field}; + last if defined $f; + } + if (!defined $f) { + progress "$what: NO git hash"; + } elsif (($dsc_hash, $dsc_distro, $dsc_hint_tag, $dsc_hint_url) + = $f =~ m/^(\w+)\s+($distro_re)\s+($versiontag_re)\s+(\S+)(?:\s|$)/) { + progress "$what: specified git info ($dsc_distro)"; + $dsc_hint_tag = [ $dsc_hint_tag ]; + } elsif ($f =~ m/^\w+\s*$/) { + $dsc_hash = $&; + $dsc_distro //= cfg qw(dgit.default.old-dsc-distro + dgit.default.distro); + $dsc_hint_tag = [ debiantags +(getfield $dsc, 'Version'), + $dsc_distro ]; + progress "$what: specified git hash"; + } else { + fail "$what: invalid Dgit info"; + } +} + +sub resolve_dsc_field_commit ($$) { + my ($already_distro, $already_mapref) = @_; + + return unless defined $dsc_hash; + + my $mapref = + defined $already_mapref && + ($already_distro eq $dsc_distro || !$chase_dsc_distro) + ? $already_mapref : undef; + + my $do_fetch; + $do_fetch = sub { + my ($what, @fetch) = @_; + + local $idistro = $dsc_distro; + my $lrf = lrfetchrefs; + + if (!$chase_dsc_distro) { + progress + "not chasing .dsc distro $dsc_distro: not fetching $what"; + return 0; + } + + progress + ".dsc names distro $dsc_distro: fetching $what"; + + my $url = access_giturl(); + if (!defined $url) { + defined $dsc_hint_url or fail <("rewrite map", $rewritemap) or return; + $mapref = $lrf.'/'.$rewritemap; + } + my $rewritemapdata = git_cat_file $mapref.':map'; + if (defined $rewritemapdata + && $rewritemapdata =~ m/^$dsc_hash(?:[ \t](\w+))/m) { + progress + "server's git history rewrite map contains a relevant entry!"; + + $dsc_hash = $1; + if (defined $dsc_hash) { + progress "using rewritten git hash in place of .dsc value"; + } else { + progress "server data says .dsc hash is to be disregarded"; + } + } + } + + if (!defined git_cat_file $dsc_hash) { + my @tags = map { "tags/".$_ } @$dsc_hint_tag; + my $lrf = $do_fetch->("additional commits", @tags) && + defined git_cat_file $dsc_hash + or fail <{$field}; - last if defined $dsc_hash; - } - if (defined $dsc_hash) { - $dsc_hash =~ m/\w+/ or fail "invalid hash in .dsc \`$dsc_hash'"; - $dsc_hash = $&; - progress "last upload to archive specified git hash"; - } else { - progress "last upload to archive has NO git hash"; - } + parse_dsc_field($dsc, 'last upload to archive'); + resolve_dsc_field_commit access_basedistro, + lrfetchrefs."/".$rewritemap } else { progress "no version available from the archive"; } - my $rewritemapdata = git_cat_file lrfetchrefs."/".$rewritemap.':map'; - if (defined $rewritemapdata - && $rewritemapdata =~ m/^$dsc_hash(?:[ \t](\w+))/m) { - progress "server's git history rewrite map contains a relevant entry!"; - $dsc_hash = $1; - if (defined $dsc_hash) { - progress "using rewritten git hash in place of .dsc value"; - } else { - progress "server data says .dsc hash is to be disregarded"; - } - } - # If the archive's .dsc has a Dgit field, there are three # relevant git commitids we need to choose between and/or merge # together: @@ -3659,8 +3818,12 @@ sub push_parse_changelog ($) { fail "-p specified $package but changelog specified $clogpackage" unless $package eq $clogpackage; my $cversion = getfield $clogp, 'Version'; - my $tag = debiantag($cversion, access_nomdistro); - runcmd @git, qw(check-ref-format), $tag; + + if (!$we_are_initiator) { + # rpush initiator can't do this because it doesn't have $isuite yet + my $tag = debiantag($cversion, access_nomdistro); + runcmd @git, qw(check-ref-format), $tag; + } my $dscfn = dscfn($cversion); @@ -3723,7 +3886,11 @@ sub push_mktags ($$ $$ $) { die unless $tagwants->[0]{View} eq 'dgit'; - $dsc->{$ourdscfield[0]} = $tagwants->[0]{Objid}; + my $declaredistro = access_nomdistro(); + my $reader_giturl = do { local $access_forpush=0; access_giturl(); }; + $dsc->{$ourdscfield[0]} = join " ", + $tagwants->[0]{Objid}, $declaredistro, $tagwants->[0]{Tag}, + $reader_giturl; $dsc->save("$dscfn.tmp") or die $!; my $changes = parsecontrol($changesfile,$changesfilewhat); @@ -3740,7 +3907,6 @@ 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_nomdistro(); my $mktag = sub { my ($tw) = @_; @@ -3842,6 +4008,7 @@ END prep_ud(); access_giturl(); # check that success is vaguely likely + rpush_handle_protovsn_bothends() if $we_are_initiator; select_tagformat(); my $clogpfn = ".git/dgit/changelog.822.tmp"; @@ -3970,6 +4137,7 @@ END responder_send_file('changes',$changesfile); responder_send_command("param head $dgithead"); responder_send_command("param csuite $csuite"); + responder_send_command("param isuite $isuite"); responder_send_command("param tagformat $tagformat"); if (defined $maintviewhead) { die unless ($protovsn//4) >= 4; @@ -4131,7 +4299,6 @@ sub branchsuite () { } sub fetchpullargs () { - notpushing(); if (!defined $package) { my $sourcep = parsecontrol('debian/control','debian/control'); $package = getfield $sourcep, 'Source'; @@ -4140,13 +4307,15 @@ sub fetchpullargs () { $isuite = branchsuite(); if (!$isuite) { my $clogp = parsechangelog(); - $isuite = getfield $clogp, 'Distribution'; + my $clogsuite = getfield $clogp, 'Distribution'; + $isuite= $clogsuite if $clogsuite ne 'UNRELEASED'; } } elsif (@ARGV==1) { ($isuite) = @ARGV; } else { badusage "incorrect arguments to dgit fetch or dgit pull"; } + notpushing(); } sub cmd_fetch { @@ -4171,7 +4340,6 @@ END sub cmd_push { parseopts(); - pushing(); badusage "-p is not allowed with dgit push" if defined $package; check_not_dirty(); my $clogp = parsechangelog(); @@ -4184,6 +4352,7 @@ sub cmd_push { badusage "incorrect arguments to dgit push"; } $isuite = getfield $clogp, 'Distribution'; + pushing(); if ($new_package) { local ($package) = $existing_package; # this is a hack canonicalise_suite(); @@ -4214,8 +4383,6 @@ sub cmd_remote_push_build_host { $we_are_responder = 1; $us .= " (build host)"; - pushing(); - open PI, "<&STDIN" or die $!; open STDIN, "/dev/null" or die $!; open PO, ">&STDOUT" or die $!; @@ -4234,7 +4401,6 @@ sub cmd_remote_push_build_host { unless defined $protovsn; responder_send_command("dgit-remote-push-ready $protovsn"); - rpush_handle_protovsn_bothends(); changedir $dir; &cmd_push; } @@ -4276,7 +4442,6 @@ sub i_method { } sub cmd_rpush { - pushing(); my $host = nextarg; my $dir; if ($host =~ m/^((?:[^][]|\[[^][]*\])*)\:/) { @@ -4296,6 +4461,8 @@ sub cmd_rpush { my @cmd = (@ssh, $host, shellquote @rdgit); debugcmd "+",@cmd; + $we_are_initiator=1; + if (defined $initiator_tempdir) { rmtree $initiator_tempdir; mkdir $initiator_tempdir, 0700 or die "$initiator_tempdir: $!"; @@ -4309,11 +4476,6 @@ sub cmd_rpush { die "$protovsn ?" unless grep { $_ eq $protovsn } @rpushprotovsn_support; $supplementary_message = '' unless $protovsn >= 3; - fail "rpush negotiated protocol version $protovsn". - " which does not support quilt mode $quilt_mode" - if quiltmode_splitbrain; - - rpush_handle_protovsn_bothends(); for (;;) { my ($icmd,$iargs) = initiator_expect { m/^(\S+)(?: (.*))?$/; @@ -4377,6 +4539,18 @@ our %i_wanted; sub i_resp_want ($) { my ($keyword) = @_; die "$keyword ?" if $i_wanted{$keyword}++; + + defined $i_param{'csuite'} or badproto \*RO, "premature desire, no csuite"; + $isuite = $i_param{'isuite'} // $i_param{'csuite'}; + die unless $isuite =~ m/^$suite_re$/; + + pushing(); + rpush_handle_protovsn_bothends(); + + fail "rpush negotiated protocol version $protovsn". + " which does not support quilt mode $quilt_mode" + if quiltmode_splitbrain; + my @localpaths = i_method "i_want", $keyword; printdebug "[[ $keyword @localpaths\n"; foreach my $localpath (@localpaths) { @@ -5255,6 +5429,7 @@ sub quilt_fixup_multipatch ($$$) { rmtree '.pc'; + runcmd @git, qw(checkout -f), $headref, qw(-- debian); my $unapplied=git_add_write_tree(); printdebug "fake orig tree object $unapplied\n"; @@ -5888,31 +6063,35 @@ sub cmd_import_dsc { parse_dscdata(); - my $dgit_commit = $dsc->{$ourdscfield[0]}; - if (defined $dgit_commit - && !forceing [qw(import-dsc-with-dgit-field)]) { - $dgit_commit =~ m/\w+/ or fail "invalid hash in .dsc"; - $dgit_commit = $&; + $package = getfield $dsc, 'Source'; + + parse_dsc_field($dsc, "Dgit metadata in .dsc") + unless forceing [qw(import-dsc-with-dgit-field)]; + + if (defined $dsc_hash) { progress "dgit: import-dsc of .dsc with Dgit field, using git hash"; + resolve_dsc_field_commit undef, undef; + } + if (defined $dsc_hash) { my @cmd = (qw(sh -ec), - "echo $dgit_commit | git cat-file --batch-check"); + "echo $dsc_hash | git cat-file --batch-check"); my $objgot = cmdoutput @cmd; if ($objgot =~ m#^\w+ missing\b#) { fail < 0) { progress "Not fast forward, forced update."; } else { - fail "Not fast forward to $dgit_commit"; + fail "Not fast forward to $dsc_hash"; } } @cmd = (@git, qw(update-ref -m), "dgit import-dsc (Dgit): $info", - $dstbranch, $dgit_commit); + $dstbranch, $dsc_hash); runcmd @cmd; progress "dgit: import-dsc updated git ref $dstbranch"; return 0; @@ -5925,7 +6104,8 @@ Specify +$specbranch to overwrite, discarding existing history END if $oldhash && !$force; - $package = getfield $dsc, 'Source'; + notpushing(); + my @dfi = dsc_files_info(); foreach my $fi (@dfi) { my $f = $fi->{Filename}; @@ -5994,18 +6174,28 @@ sub cmd_clone_dgit_repos_server { badusage "need destination argument" unless @ARGV==1; my ($destdir) = @ARGV; $package = '_dgit-repos-server'; + local $access_forpush = 0; my @cmd = (@git, qw(clone), access_giturl(), $destdir); debugcmd ">",@cmd; exec @cmd or fail "exec git clone: $!\n"; } +sub cmd_print_dgit_repos_server_source_url { + badusage "no arguments allowed to dgit print-dgit-repos-server-source-url" + if @ARGV; + $package = '_dgit-repos-server'; + local $access_forpush = 0; + my $url = access_giturl(); + print $url, "\n" or die $!; +} + sub cmd_setup_mergechangelogs { badusage "no arguments allowed to dgit setup-mergechangelogs" if @ARGV; setup_mergechangelogs(1); } sub cmd_setup_useremail { - badusage "no arguments allowed to dgit setup-mergechangelogs" if @ARGV; + badusage "no arguments allowed to dgit setup-useremail" if @ARGV; setup_useremail(1); } @@ -6131,6 +6321,9 @@ sub parseopts () { } elsif (m/^--no-rm-on-error$/s) { push @ropts, $_; $rmonerror = 0; + } elsif (m/^--no-chase-dsc-distro$/s) { + push @ropts, $_; + $chase_dsc_distro = 0; } elsif (m/^--overwrite$/s) { push @ropts, $_; $overwrite_version = ''; @@ -6176,6 +6369,11 @@ sub parseopts () { # undocumented, for testing push @ropts, $_; $need_split_build_invocation = 1; + } elsif (m/^--config-lookup-explode=(.+)$/s) { + # undocumented, for testing + push @ropts, $_; + $gitcfgs{cmdline}{$1} = 'CONFIG-LOOKUP-EXPLODE'; + # ^ it's supposed to be an array ref } elsif (m/^(--[-0-9a-z]+)(=|$)/ && ($oi = $valopts_long{$1})) { $val = $2 ? $' : undef; #'; $valopt->($oi->{Long}); @@ -6265,6 +6463,10 @@ END sub parseopts_late_defaults () { + $isuite //= cfg("dgit-distro.$idistro.default-suite", 'RETURN-UNDEF') + if defined $idistro; + $isuite //= cfg('dgit.default.default-suite'); + foreach my $k (keys %opts_opt_map) { my $om = $opts_opt_map{$k};