X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=60b39e4ae66d7be7f9f4a07eb736daf36ce2336a;hp=d5aa38718c551c7c46b32ecf6c046bb502a50b96;hb=5cde19017f6b64ab1e440633d59e36a231b57a3f;hpb=08246013777e261333f6f972554bc02ae17bc60a diff --git a/dgit b/dgit index d5aa3871..60b39e4a 100755 --- a/dgit +++ b/dgit @@ -39,7 +39,7 @@ use Debian::Dgit; our $our_version = 'UNRELEASED'; ###substituted### -our @rpushprotovsn_support = qw(2); +our @rpushprotovsn_support = qw(3 2); our $protovsn; our $isuite = 'unstable'; @@ -57,7 +57,7 @@ our $rmonerror = 1; our @deliberatelies; our %previously; our $existing_package = 'dpkg'; -our $cleanmode = 'dpkg-source'; +our $cleanmode; our $changes_since_version; our $quilt_mode; our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck'; @@ -67,6 +67,7 @@ our $initiator_tempdir; our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)"); our $suite_re = '[-+.0-9a-z]+'; +our $cleanmode_re = 'dpkg-source(?:-d)?|git|git-ff|check|none'; our (@git) = qw(git); our (@dget) = qw(dget); @@ -91,18 +92,32 @@ our %opts_opt_map = ('dget' => \@dget, # accept for compatibility 'sbuild' => \@sbuild, 'ssh' => \@ssh, 'dgit' => \@dgit, + 'git' => \@git, 'dpkg-source' => \@dpkgsource, 'dpkg-buildpackage' => \@dpkgbuildpackage, 'dpkg-genchanges' => \@dpkggenchanges, 'ch' => \@changesopts, 'mergechanges' => \@mergechanges); -our %opts_opt_cmdonly = ('gpg' => 1); +our %opts_opt_cmdonly = ('gpg' => 1, 'git' => 1); +our %opts_cfg_insertpos = map { + $_, + scalar @{ $opts_opt_map{$_} } +} keys %opts_opt_map; + +sub finalise_opts_opts(); our $keyid; autoflush STDOUT 1; +our $supplementary_message = ''; + +END { + local ($@, $?); + print STDERR "! $_\n" foreach $supplementary_message =~ m/^.+$/mg; +} + our $remotename = 'dgit'; our @ourdscfield = qw(Dgit Vcs-Dgit-Master); our $csuite; @@ -409,7 +424,8 @@ our $helpmsg = < 'debian', 'dgit-distro.test-dummy.upload-host' => 'test-dummy', ); -sub git_get_config ($) { - my ($c) = @_; +our %gitcfg; - our %git_get_config_memo; - if (exists $git_get_config_memo{$c}) { - return $git_get_config_memo{$c}; - } +sub git_slurp_config () { + local ($debuglevel) = $debuglevel-2; + local $/="\0"; - my $v; - my @cmd = (@git, qw(config --), $c); - { - local ($debuglevel) = $debuglevel-2; - $v = cmdoutput_errok @cmd; - }; - if ($?==0) { - } elsif ($?==256) { - $v = undef; - } else { - failedcmd @cmd; + my @cmd = (@git, qw(config -z --get-regexp .*)); + debugcmd "|",@cmd; + + open GITS, "-|", @cmd or failedcmd @cmd; + while () { + chomp or die; + printdebug "=> ", (messagequote $_), "\n"; + m/\n/ or die "$_ ?"; + push @{ $gitcfg{$`} }, $'; #'; } - $git_get_config_memo{$c} = $v; - return $v; + $!=0; $?=0; + close GITS + or ($!==0 && $?==256) + or failedcmd @cmd; +} + +sub git_get_config ($) { + my ($c) = @_; + my $l = $gitcfg{$c}; + printdebug"C $c ".(defined $l ? messagequote "'$l'" : "undef")."\n" + if $debuglevel >= 4; + $l or return undef; + @$l==1 or badcfg "multiple values for $c" if @$l > 1; + return $l->[0]; } sub cfg { @@ -592,6 +616,27 @@ sub pushing () { badcfg "pushing but distro is configured readonly" if access_forpush_config() eq '0'; $access_forpush = 1; + $supplementary_message = <<'END' unless $we_are_responder; +Push failed, before we got started. +You can retry the push, after fixing the problem, if you like. +END + finalise_opts_opts(); +} + +sub notpushing () { + finalise_opts_opts(); +} + +sub supplementary_message ($) { + my ($msg) = @_; + if (!$we_are_responder) { + $supplementary_message = $msg; + return; + } elsif ($protovsn >= 3) { + responder_send_command "supplementary-message ".length($msg) + or die $!; + print PO $msg or die $!; + } } sub access_distros () { @@ -615,7 +660,7 @@ sub access_distros () { @l; } -sub access_cfg (@) { +sub access_cfg_cfgs (@) { my (@keys) = @_; my @cfgs; # The nesting of these loops determines the search order. We put @@ -642,10 +687,21 @@ sub access_cfg (@) { } push @cfgs, map { "dgit.default.$_" } @realkeys; push @cfgs, @rundef; + return @cfgs; +} + +sub access_cfg (@) { + my (@keys) = @_; + my (@cfgs) = access_cfg_cfgs(@keys); my $value = cfg(@cfgs); return $value; } +sub access_cfg_bool ($$) { + my ($def, @keys) = @_; + parse_cfg_bool($keys[0], $def, access_cfg(@keys, 'RETURN-UNDEF')); +} + sub string_to_ssh ($) { my ($spec) = @_; if ($spec =~ m/\s/) { @@ -936,7 +992,7 @@ sub sshpsql ($$$) { open P, "-|", @cmd or die $!; while (

) { chomp or die; - printdebug("$debugprefix>|$_|\n"); + printdebug(">|$_|\n"); push @rows, $_; } $!=0; $?=0; close P or failedcmd @cmd; @@ -1104,6 +1160,9 @@ sub check_for_git () { my $url = "$prefix/$package$suffix"; my @cmd = (qw(curl -sS -I), $url); my $result = cmdoutput @cmd; + $result =~ s/^\S+ 200 .*\n\r?\n//; + # curl -sS -I with https_proxy prints + # HTTP/1.0 200 Connection established $result =~ m/^\S+ (404|200) /s or fail "unexpected results from git check query - ". Dumper($prefix, $result); @@ -1161,14 +1220,7 @@ sub git_write_tree () { return $tree; } -sub mktree_in_ud_from_only_subdir () { - # changes into the subdir - my (@dirs) = <*/.>; - die unless @dirs==1; - $dirs[0] =~ m#^([^/]+)/\.$# or die; - my $dir = $1; - changedir $dir; - +sub remove_stray_gits () { my @gitscmd = qw(find -name .git -prune -print0); debugcmd "|",@gitscmd; open GITS, "-|", @gitscmd or failedcmd @gitscmd; @@ -1182,7 +1234,17 @@ sub mktree_in_ud_from_only_subdir () { } } $!=0; $?=0; close GITS or failedcmd @gitscmd; +} + +sub mktree_in_ud_from_only_subdir () { + # changes into the subdir + my (@dirs) = <*/.>; + die unless @dirs==1; + $dirs[0] =~ m#^([^/]+)/\.$# or die; + my $dir = $1; + changedir $dir; + remove_stray_gits(); mktree_in_ud_here(); my $format=get_source_format(); if (madformat($format)) { @@ -1320,7 +1382,7 @@ sub generate_commit_from_dsc () { my $f = $fi->{Filename}; die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#; - link "../../../$f", $f + link_ltarget "../../../$f", $f or $!==&ENOENT or die "$f $!"; @@ -1419,7 +1481,7 @@ sub complete_file_from_dsc ($$) { my $furl = $dscurl; $furl =~ s{/[^/]+$}{}; $furl .= "/$f"; - die "$f ?" unless $f =~ m/^${package}_/; + die "$f ?" unless $f =~ m/^\Q${package}\E_/; die "$f ?" if $f =~ m#/#; runcmd_ordryrun_local @curl,qw(-o),$tf,'--',"$furl"; next if !act_local(); @@ -1585,7 +1647,10 @@ sub set_local_git_config ($$) { runcmd @git, qw(config), $k, $v; } -sub setup_mergechangelogs () { +sub setup_mergechangelogs (;$) { + my ($always) = @_; + return unless $always || access_cfg_bool(1, 'setup-mergechangelogs'); + my $driver = 'dpkg-mergechangelogs'; my $cb = "merge.$driver"; my $attrs = '.git/info/attributes'; @@ -1612,6 +1677,26 @@ sub setup_mergechangelogs () { rename "$attrs.new", "$attrs" or die "$attrs: $!"; } +sub setup_useremail (;$) { + my ($always) = @_; + return unless $always || access_cfg_bool(1, 'setup-useremail'); + + my $setup = sub { + my ($k, $envvar) = @_; + my $v = access_cfg("user-$k", 'RETURN-UNDEF') // $ENV{$envvar}; + return unless defined $v; + set_local_git_config "user.$k", $v; + }; + + $setup->('email', 'DEBEMAIL'); + $setup->('name', 'DEBFULLNAME'); +} + +sub setup_new_tree () { + setup_mergechangelogs(); + setup_useremail(); +} + sub clone ($) { my ($dstdir) = @_; canonicalise_suite(); @@ -1641,7 +1726,7 @@ sub clone ($) { $vcsgiturl =~ s/\s+-b\s+\S+//g; runcmd @git, qw(remote add vcs-git), $vcsgiturl; } - setup_mergechangelogs(); + setup_new_tree(); runcmd @git, qw(reset --hard), lrref(); printdone "ready for work in $dstdir"; } @@ -1793,6 +1878,9 @@ END if (!defined $keyid) { $keyid = access_cfg('keyid','RETURN-UNDEF'); } + if (!defined $keyid) { + $keyid = getfield $clogp, 'Maintainer'; + } unlink $tfn->('.tmp.asc') or $!==&ENOENT or die $!; my @sign_cmd = (@gpg, qw(--detach-sign --armor)); push @sign_cmd, qw(-u),$keyid if defined $keyid; @@ -1822,6 +1910,10 @@ sub sign_changes ($) { sub dopush ($) { my ($forceflag) = @_; printdebug "actually entering push\n"; + supplementary_message(<<'END'); +Push failed, while preparing your push. +You can retry the push, after fixing the problem, if you like. +END prep_ud(); access_giturl(); # check that success is vaguely likely @@ -1906,6 +1998,11 @@ sub dopush ($) { my $tfn = sub { ".git/dgit/tag$_[0]"; }; my $tagobjfn; + supplementary_message(<<'END'); +Push failed, while signing the tag. +You can retry the push, after fixing the problem, if you like. +END + # If we manage to sign but fail to record it anywhere, it's fine. if ($we_are_responder) { $tagobjfn = $tfn->('.signed.tmp'); responder_receive_files('signed-tag', $tagobjfn); @@ -1916,11 +2013,19 @@ sub dopush ($) { $changesfile,$changesfile, $tfn); } + supplementary_message(<<'END'); +Push failed, *after* signing the tag. +If you want to try again, you should use a new version number. +END my $tag_obj_hash = cmdoutput @git, qw(hash-object -w -t tag), $tagobjfn; runcmd_ordryrun @git, qw(verify-tag), $tag_obj_hash; runcmd_ordryrun_local @git, qw(update-ref), "refs/tags/$tag", $tag_obj_hash; + supplementary_message(<<'END'); +Push failed, while updating the remote git repository - see messages above. +If you want to try again, you should use a new version number. +END if (!check_for_git()) { create_remote_git_repo(); } @@ -1928,6 +2033,10 @@ sub dopush ($) { $forceflag."HEAD:".rrref(), $forceflag."refs/tags/$tag"; runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), 'HEAD'; + supplementary_message(<<'END'); +Push failed, after updating the remote git repository. +If you want to try again, you must use a new version number. +END if ($we_are_responder) { my $dryrunsuffix = act_local() ? "" : ".tmp"; responder_receive_files('signed-dsc-changes', @@ -1942,16 +2051,25 @@ sub dopush ($) { sign_changes $changesfile; } + supplementary_message(<<'END'); +Push failed, while uploading package(s) to the archive server. +You can retry the upload of exactly these same files with dput of: + $changesfile +If that .changes file is broken, you will need to use a new version +number for your next attempt at the upload. +END my $host = access_cfg('upload-host','RETURN-UNDEF'); my @hostarg = defined($host) ? ($host,) : (); runcmd_ordryrun @dput, @hostarg, $changesfile; printdone "pushed and uploaded $cversion"; + supplementary_message(''); responder_send_command("complete"); } sub cmd_clone { parseopts(); + notpushing(); my $dstdir; badusage "-p is not allowed with clone; specify as argument instead" if defined $package; @@ -1999,6 +2117,7 @@ sub branchsuite () { } sub fetchpullargs () { + notpushing(); if (!defined $package) { my $sourcep = parsecontrol('debian/control','debian/control'); $package = getfield $sourcep, 'Source'; @@ -2032,8 +2151,8 @@ sub cmd_pull { } sub cmd_push { - pushing(); parseopts(); + pushing(); badusage "-p is not allowed with dgit push" if defined $package; check_not_dirty(); my $clogp = parsechangelog(); @@ -2058,6 +2177,10 @@ sub cmd_push { fail "dgit push: changelog specifies $isuite ($csuite)". " but command line specifies $specsuite"; } + supplementary_message(<<'END'); +Push failed, while checking state of the archive. +You can retry the push, after fixing the problem, if you like. +END if (check_for_git()) { git_fetch_us(); } @@ -2086,7 +2209,6 @@ sub cmd_push { #---------- remote commands' implementation ---------- sub cmd_remote_push_build_host { - pushing(); my ($nrargs) = shift @ARGV; my (@rargs) = @ARGV[0..$nrargs-1]; @ARGV = @ARGV[$nrargs..$#ARGV]; @@ -2099,6 +2221,8 @@ 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 $!; @@ -2183,6 +2307,7 @@ sub cmd_rpush { changedir $i_tmp; ($protovsn) = initiator_expect { m/^dgit-remote-push-ready (\S+)/ }; die "$protovsn ?" unless grep { $_ eq $protovsn } @rpushprotovsn_support; + $supplementary_message = '' unless $protovsn >= 3; for (;;) { my ($icmd,$iargs) = initiator_expect { m/^(\S+)(?: (.*))?$/; @@ -2198,6 +2323,11 @@ sub i_resp_progress ($) { progress $msg; } +sub i_resp_supplementary_message ($) { + my ($rhs) = @_; + $supplementary_message = protocol_read_bytes \*RO, $rhs; +} + sub i_resp_complete { my $pid = $i_child_pid; $i_child_pid = undef; # prevents killing some other process with same pid @@ -2388,6 +2518,7 @@ sub quiltify ($$) { # should be contained within debian/patches. changedir '../fake'; + remove_stray_gits(); mktree_in_ud_here(); rmtree '.pc'; runcmd @git, 'add', '.'; @@ -2663,7 +2794,7 @@ END foreach my $f (<../../../../*>) { #/){ my $b=$f; $b =~ s{.*/}{}; next unless is_orig_file $b, srcfn $upstreamversion,''; - link $f, $b or die "$b $!"; + link_ltarget $f, $b or die "$b $!"; $dscaddfile->($b); } @@ -2737,7 +2868,10 @@ sub quilt_fixup_editor () { #----- other building ----- +our $suppress_clean; + sub clean_tree () { + return if $suppress_clean; if ($cleanmode eq 'dpkg-source') { runcmd_ordryrun_local @dpkgbuildpackage, qw(-T clean); } elsif ($cleanmode eq 'dpkg-source-d') { @@ -2760,10 +2894,12 @@ sub clean_tree () { sub cmd_clean () { badusage "clean takes no additional arguments" if @ARGV; + notpushing(); clean_tree(); } sub build_prep () { + notpushing(); badusage "-p is not allowed when building" if defined $package; check_not_dirty(); clean_tree(); @@ -2774,8 +2910,11 @@ sub build_prep () { build_maybe_quilt_fixup(); } -sub changesopts () { +sub changesopts_initial () { my @opts =@changesopts[1..$#changesopts]; +} + +sub changesopts_version () { if (!defined $changes_since_version) { my @vsns = archive_query('archive_query'); my @quirk = access_quirk(); @@ -2796,40 +2935,60 @@ sub changesopts () { } } if ($changes_since_version ne '_') { - unshift @opts, "-v$changes_since_version"; + return ("-v$changes_since_version"); + } else { + return (); } - return @opts; } -sub massage_dbp_args ($) { - my ($cmd) = @_; - return unless $cleanmode =~ m/git|none/; +sub changesopts () { + return (changesopts_initial(), changesopts_version()); +} + +sub massage_dbp_args ($;$) { + my ($cmd,$xargs) = @_; + if ($cleanmode eq 'dpkg-source') { + $suppress_clean = 1; + return; + } debugcmd '#massaging#', @$cmd if $debuglevel>1; my @newcmd = shift @$cmd; # -nc has the side effect of specifying -b if nothing else specified push @newcmd, '-nc'; # and some combinations of -S, -b, et al, are errors, rather than # later simply overriding earlier - push @newcmd, '-F' unless grep { m/^-[bBASF]$/ } @$cmd; + push @newcmd, '-F' unless grep { m/^-[bBASF]$/ } (@$cmd, @$xargs); push @newcmd, @$cmd; @$cmd = @newcmd; } sub cmd_build { - build_prep(); - my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts(), @ARGV); + my @dbp = (@dpkgbuildpackage, qw(-us -uc), changesopts_initial(), @ARGV); massage_dbp_args \@dbp; + build_prep(); + push @dbp, changesopts_version(); runcmd_ordryrun_local @dbp; printdone "build successful\n"; } -sub cmd_git_build { - build_prep(); +sub cmd_gbp_build { my @dbp = @dpkgbuildpackage; - massage_dbp_args \@dbp; - my @cmd = - (qw(git-buildpackage -us -uc --git-no-sign-tags), - "--git-builder=@dbp"); + massage_dbp_args \@dbp, \@ARGV; + + my @cmd; + if (length executable_on_path('git-buildpackage')) { + @cmd = qw(git-buildpackage); + } else { + @cmd = qw(gbp buildpackage); + } + push @cmd, (qw(-us -uc --git-no-sign-tags), "--git-builder=@dbp"); + + if ($cleanmode eq 'dpkg-source') { + $suppress_clean = 1; + } else { + push @cmd, '--git-cleaner=true'; + } + build_prep(); unless (grep { m/^--git-debian-branch|^--git-ignore-branch/ } @ARGV) { canonicalise_suite(); push @cmd, "--git-debian-branch=".lbranch(); @@ -2838,8 +2997,13 @@ sub cmd_git_build { runcmd_ordryrun_local @cmd, @ARGV; printdone "build successful\n"; } +sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0 sub build_source { + if ($cleanmode =~ m/^dpkg-source/) { + # dpkg-source will clean, so we shouldn't + $suppress_clean = 1; + } build_prep(); $sourcechanges = "${package}_".(stripepoch $version)."_source.changes"; $dscfn = dscfn($version); @@ -2924,7 +3088,17 @@ sub cmd_clone_dgit_repos_server { sub cmd_setup_mergechangelogs { badusage "no arguments allowed to dgit setup-mergechangelogs" if @ARGV; - setup_mergechangelogs(); + setup_mergechangelogs(1); +} + +sub cmd_setup_useremail { + badusage "no arguments allowed to dgit setup-mergechangelogs" if @ARGV; + setup_useremail(1); +} + +sub cmd_setup_new_tree { + badusage "no arguments allowed to dgit setup-tree" if @ARGV; + setup_new_tree(); } #---------- argument parsing and main program ---------- @@ -2934,6 +3108,44 @@ sub cmd_version { exit 0; } +our (%valopts_long, %valopts_short); +our @rvalopts; + +sub defvalopt ($$$$) { + my ($long,$short,$val_re,$how) = @_; + my $oi = { Long => $long, Short => $short, Re => $val_re, How => $how }; + $valopts_long{$long} = $oi; + $valopts_short{$short} = $oi; + # $how subref should: + # do whatever assignemnt or thing it likes with $_[0] + # if the option should not be passed on to remote, @rvalopts=() + # or $how can be a scalar ref, meaning simply assign the value +} + +defvalopt '--since-version', '-v', '[^_]+|_', \$changes_since_version; +defvalopt '--distro', '-d', '.+', \$idistro; +defvalopt '', '-k', '.+', \$keyid; +defvalopt '--existing-package','', '.*', \$existing_package; +defvalopt '--build-products-dir','','.*', \$buildproductsdir; +defvalopt '--clean', '', $cleanmode_re, \$cleanmode; +defvalopt '--quilt', '', $quilt_modes_re, \$quilt_mode; + +defvalopt '', '-c', '.*=.*', sub { push @git, '-c', @_; }; + +defvalopt '', '-C', '.+', sub { + ($changesfile) = (@_); + if ($changesfile =~ s#^(.*)/##) { + $buildproductsdir = $1; + } +}; + +defvalopt '--initiator-tempdir','','.*', sub { + ($initiator_tempdir) = (@_); + $initiator_tempdir =~ m#^/# or + badusage "--initiator-tempdir must be used specify an". + " absolute, not relative, directory." +}; + sub parseopts () { my $om; @@ -2943,6 +3155,27 @@ sub parseopts () { @ssh = ($ENV{'GIT_SSH'}); } + my $oi; + my $val; + my $valopt = sub { + my ($what) = @_; + @rvalopts = ($_); + if (!defined $val) { + badusage "$what needs a value" unless @ARGV; + $val = shift @ARGV; + push @rvalopts, $val; + } + badusage "bad value \`$val' for $what" unless + $val =~ m/^$oi->{Re}$(?!\n)/s; + my $how = $oi->{How}; + if (ref($how) eq 'SCALAR') { + $$how = $val; + } else { + $how->($val); + } + push @ropts, @rvalopts; + }; + while (@ARGV) { last unless $ARGV[0] =~ m/^-/; $_ = shift @ARGV; @@ -2964,10 +3197,7 @@ sub parseopts () { } elsif (m/^--new$/) { push @ropts, $_; $new_package=1; - } elsif (m/^--since-version=([^_]+|_)$/) { - push @ropts, $_; - $changes_since_version = $1; - } elsif (m/^--([-0-9a-z]+)=(.*)/s && + } elsif (m/^--([-0-9a-z]+)=(.+)/s && ($om = $opts_opt_map{$1}) && length $om->[0]) { push @ropts, $_; @@ -2977,30 +3207,6 @@ sub parseopts () { ($om = $opts_opt_map{$1})) { push @ropts, $_; push @$om, $2; - } elsif (m/^--existing-package=(.*)/s) { - push @ropts, $_; - $existing_package = $1; - } elsif (m/^--initiator-tempdir=(.*)/s) { - $initiator_tempdir = $1; - $initiator_tempdir =~ m#^/# or - badusage "--initiator-tempdir must be used specify an". - " absolute, not relative, directory." - } elsif (m/^--distro=(.*)/s) { - push @ropts, $_; - $idistro = $1; - } elsif (m/^--build-products-dir=(.*)/s) { - push @ropts, $_; - $buildproductsdir = $1; - } elsif (m/^--clean=(dpkg-source(?:-d)?|git|git-ff|check|none)$/s) { - push @ropts, $_; - $cleanmode = $1; - } elsif (m/^--clean=(.*)$/s) { - badusage "unknown cleaning mode \`$1'"; - } elsif (m/^--quilt=($quilt_modes_re)$/s) { - push @ropts, $_; - $quilt_mode = $1; - } elsif (m/^--quilt=(.*)$/s) { - badusage "unknown quilt fixup mode \`$1'"; } elsif (m/^--ignore-dirty$/s) { push @ropts, $_; $ignoredirty = 1; @@ -3013,6 +3219,9 @@ sub parseopts () { } elsif (m/^--deliberately-($deliberately_re)$/s) { push @ropts, $_; push @deliberatelies, $&; + } elsif (m/^(--[-0-9a-z]+)(=|$)/ && ($oi = $valopts_long{$1})) { + $val = $2 ? $' : undef; #'; + $valopt->($oi->{Long}); } else { badusage "unknown long option \`$_'"; } @@ -3033,30 +3242,10 @@ sub parseopts () { } elsif (s/^-N/-/) { push @ropts, $&; $new_package=1; - } elsif (s/^-v([^_]+|_)$//s) { - push @ropts, $&; - $changes_since_version = $1; } elsif (m/^-m/) { push @ropts, $&; push @changesopts, $_; $_ = ''; - } elsif (s/^-c(.*=.*)//s) { - push @ropts, $&; - push @git, '-c', $1; - } elsif (s/^-d(.+)//s) { - push @ropts, $&; - $idistro = $1; - } elsif (s/^-C(.+)//s) { - push @ropts, $&; - $changesfile = $1; - if ($changesfile =~ s#^(.*)/##) { - $buildproductsdir = $1; - } - } elsif (s/^-k(.+)//s) { - $keyid=$1; - } elsif (m/^-[vdCk]$/) { - badusage - "option \`$_' requires an argument (and no space before the argument)"; } elsif (s/^-wn$//s) { push @ropts, $&; $cleanmode = 'none'; @@ -3075,6 +3264,11 @@ sub parseopts () { } elsif (s/^-wc$//s) { push @ropts, $&; $cleanmode = 'check'; + } elsif (m/^-[a-zA-Z]/ && ($oi = $valopts_short{$&})) { + $val = $'; #'; + $val = undef unless length $val; + $valopt->($oi->{Short}); + $_ = ''; } else { badusage "unknown short option \`$_'"; } @@ -3083,11 +3277,40 @@ sub parseopts () { } } +sub finalise_opts_opts () { + foreach my $k (keys %opts_opt_map) { + my $om = $opts_opt_map{$k}; + + my $v = access_cfg("cmd-$k", 'RETURN-UNDEF'); + if (defined $v) { + badcfg "cannot set command for $k" + unless length $om->[0]; + $om->[0] = $v; + } + + foreach my $c (access_cfg_cfgs("opts-$k")) { + my $vl = $gitcfg{$c}; + printdebug "CL $c ", + ($vl ? join " ", map { shellquote } @$vl : ""), + "\n" if $debuglevel >= 4; + next unless $vl; + badcfg "cannot configure options for $k" + if $opts_opt_cmdonly{$k}; + my $insertpos = $opts_cfg_insertpos{$k}; + @$om = ( @$om[0..$insertpos-1], + @$vl, + @$om[$insertpos..$#$om] ); + } + } +} + if ($ENV{$fakeeditorenv}) { + git_slurp_config(); quilt_fixup_editor(); } parseopts(); +git_slurp_config(); print STDERR "DRY RUN ONLY\n" if $dryrun_level > 1; print STDERR "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n" @@ -3109,6 +3332,15 @@ if (!defined $quilt_mode) { $quilt_mode = $1; } +if (!defined $cleanmode) { + local $access_forpush; + $cleanmode = access_cfg('clean-mode', 'RETURN-UNDEF'); + $cleanmode //= 'dpkg-source'; + + badcfg "unknown clean-mode \`$cleanmode'" unless + $cleanmode =~ m/^($cleanmode_re)$(?!\n)/s; +} + my $fn = ${*::}{"cmd_$cmd"}; $fn or badusage "unknown operation $cmd"; $fn->();