X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=9ac8d54435508550c0b557794f8a32a4d70437d6;hp=de14f92bb7d7394f474b262ec470b19bb99bf7e7;hb=adcac7cc282e2683ebdeaee9c53b2d98c0bf8661;hpb=596f5bac104b0f6a1e87b509f945fd6e6ad7001a diff --git a/dgit b/dgit index de14f92b..9ac8d544 100755 --- a/dgit +++ b/dgit @@ -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); @@ -74,7 +75,7 @@ our (@curl) = qw(curl -f); our (@dput) = qw(dput); our (@debsign) = qw(debsign); our (@gpg) = qw(gpg); -our (@sbuild) = qw(sbuild -A); +our (@sbuild) = qw(sbuild); our (@ssh) = 'ssh'; our (@dgit) = qw(dgit); our (@dpkgbuildpackage) = qw(dpkg-buildpackage -i\.git/ -I.git); @@ -91,14 +92,19 @@ 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_cmdline_opts; +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; @@ -149,7 +155,7 @@ END { local ($?); foreach my $f (@end) { eval { $f->(); }; - warn "$us: cleanup: $@" if length $@; + print STDERR "$us: cleanup: $@" if length $@; } }; @@ -418,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 { @@ -645,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 @@ -672,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/) { @@ -966,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; @@ -1134,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); @@ -1191,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; @@ -1212,9 +1234,19 @@ 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(); + my ($format, $fopts) = get_source_format(); if (madformat($format)) { rmtree '.pc'; } @@ -1350,11 +1382,12 @@ 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 $!"; - complete_file_from_dsc('.', $fi); + complete_file_from_dsc('.', $fi) + or next; if (is_orig_file($f)) { link $f, "../../../../$f" @@ -1449,10 +1482,10 @@ 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(); + return 0 if !act_local(); $downloaded = 1; } @@ -1466,13 +1499,16 @@ sub complete_file_from_dsc ($$) { " demands hash $fi->{Hash} ". ($downloaded ? "(got wrong file from archive!)" : "(perhaps you should delete this file?)"); + + return 1; } sub ensure_we_have_orig () { foreach my $fi (dsc_files_info()) { my $f = $fi->{Filename}; next unless is_orig_file($f); - complete_file_from_dsc('..', $fi); + complete_file_from_dsc('..', $fi) + or next; } } @@ -1615,7 +1651,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'; @@ -1642,12 +1681,32 @@ 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(); badusage "dry run makes no sense with clone" unless act_local(); my $hasgit = check_for_git(); - mkdir $dstdir or die "$dstdir $!"; + mkdir $dstdir or fail "create \`$dstdir': $!"; changedir $dstdir; runcmd @git, qw(init -q); my $giturl = access_giturl(1); @@ -1671,7 +1730,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"; } @@ -1692,7 +1751,14 @@ sub pull () { } sub check_not_dirty () { + foreach my $f (qw(local-options local-patch-header)) { + if (stat_exists "debian/source/$f") { + fail "git tree contains debian/source/$f"; + } + } + return if $ignoredirty; + my @cmd = (@git, qw(diff --quiet HEAD)); debugcmd "+",@cmd; $!=0; $?=0; system @cmd; @@ -1724,11 +1790,32 @@ sub commit_quilty_patch () { progress "nothing quilty to commit, ok."; return; } - runcmd_ordryrun_local @git, qw(add), sort keys %adds; + my @adds = map { s/[][*?\\]/\\$&/g; $_; } sort keys %adds; + runcmd_ordryrun_local @git, qw(add -f), @adds; commit_admin "Commit Debian 3.0 (quilt) metadata"; } sub get_source_format () { + my %options; + if (open F, "debian/source/options") { + while () { + next if m/^\s*\#/; + next unless m/\S/; + s/\s+$//; # ignore missing final newline + if (m/\s*\#\s*/) { + my ($k, $v) = ($`, $'); #'); + $v =~ s/^"(.*)"$/$1/; + $options{$k} = $v; + } else { + $options{$_} = 1; + } + } + F->error and die $!; + close F; + } else { + die $! unless $!==&ENOENT; + } + if (!open F, "debian/source/format") { die $! unless $!==&ENOENT; return ''; @@ -1736,7 +1823,7 @@ sub get_source_format () { $_ = ; F->error and die $!; chomp; - return $_; + return ($_, \%options); } sub madformat ($) { @@ -1823,6 +1910,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; @@ -1993,7 +2083,7 @@ END sign_changes $changesfile; } - supplementary_message(<<'END'); + supplementary_message(<{'single-debian-patch'}) { + quilt_fixup_singlepatch($clogp, $headref, $upstreamversion); + } else { + quilt_fixup_multipatch($clogp, $headref, $upstreamversion); + } + + changedir '../../../..'; + runcmd_ordryrun_local + @git, qw(pull --ff-only -q .git/dgit/unpack/work master); +} + +sub quilt_fixup_mkwork ($) { + my ($headref) = @_; + + mkdir "work" or die $!; + changedir "work"; + mktree_in_ud_here(); + runcmd @git, qw(reset --hard), $headref; +} + +sub quilt_fixup_linkorigs ($$) { + my ($upstreamversion, $fn) = @_; + # calls $fn->($leafname); + + foreach my $f (<../../../../*>) { #/){ + my $b=$f; $b =~ s{.*/}{}; + { + local ($debuglevel) = $debuglevel-1; + printdebug "QF linkorigs $b, $f ?\n"; + } + next unless is_orig_file $b, srcfn $upstreamversion,''; + printdebug "QF linkorigs $b, $f Y\n"; + link_ltarget $f, $b or die "$b $!"; + $fn->($b); + } +} + +sub quilt_fixup_delete_pc () { + runcmd @git, qw(rm -rqf .pc); + commit_admin "Commit removal of .pc (quilt series tracking data)"; +} + +sub quilt_fixup_singlepatch ($$$) { + my ($clogp, $headref, $upstreamversion) = @_; + + progress "starting quiltify (single-debian-patch)"; + + # dpkg-source --commit generates new patches even if + # single-debian-patch is in debian/source/options. In order to + # get it to generate debian/patches/debian-changes, it is + # necessary to build the source package. + + quilt_fixup_linkorigs($upstreamversion, sub { }); + quilt_fixup_mkwork($headref); + + rmtree("debian/patches"); + + runcmd @dpkgsource, qw(-b .); + chdir ".."; + runcmd @dpkgsource, qw(-x), (srcfn $version, ".dsc"); + rename srcfn("$upstreamversion", "/debian/patches"), + "work/debian/patches"; + + chdir "work"; + commit_quilty_patch(); + + +} + +sub quilt_fixup_multipatch ($$$) { + my ($clogp, $headref, $upstreamversion) = @_; + + progress "starting quiltify (multiple patches, $quilt_mode mode)"; + # Our objective is: # - honour any existing .pc in case it has any strangeness # - determine the git commit corresponding to the tip of @@ -2679,7 +2859,7 @@ sub build_maybe_quilt_fixup () { # can work. We do this as follows: # 1. Collect all relevant .orig from parent directory # 2. Generate a debian.tar.gz out of - # debian/{patches,rules,source/format} + # debian/{patches,rules,source/format,source/options} # 3. Generate a fake .dsc containing just these fields: # Format Source Version Files # 4. Extract the fake .dsc @@ -2700,15 +2880,6 @@ sub build_maybe_quilt_fixup () { # 5. If we had a .pc in-tree, delete it, and git-commit # 6. Back in the main tree, fast forward to the new HEAD - my $clogp = parsechangelog(); - my $headref = git_rev_parse('HEAD'); - - prep_ud(); - changedir $ud; - - my $upstreamversion=$version; - $upstreamversion =~ s/-[^-]*$//; - my $fakeversion="$upstreamversion-~~DGITFAKE"; my $fakedsc=new IO::File 'fake.dsc', '>' or die $!; @@ -2732,16 +2903,12 @@ END print $fakedsc " ".$md->hexdigest." $size $b\n" or die $!; }; - foreach my $f (<../../../../*>) { #/){ - my $b=$f; $b =~ s{.*/}{}; - next unless is_orig_file $b, srcfn $upstreamversion,''; - link $f, $b or die "$b $!"; - $dscaddfile->($b); - } + quilt_fixup_linkorigs($upstreamversion, $dscaddfile); my @files=qw(debian/source/format debian/rules); - if (stat_exists '../../../debian/patches') { - push @files, 'debian/patches'; + foreach my $maybe (qw(debian/patches debian/source/options)) { + next unless stat_exists "../../../$maybe"; + push @files, $maybe; } my $debtar= srcfn $fakeversion,'.debian.tar.gz'; @@ -2755,10 +2922,7 @@ END my $fakexdir= $package.'-'.(stripepoch $upstreamversion); rename $fakexdir, "fake" or die "$fakexdir $!"; - mkdir "work" or die $!; - changedir "work"; - mktree_in_ud_here(); - runcmd @git, qw(reset --hard), $headref; + quilt_fixup_mkwork($headref); my $mustdeletepc=0; if (stat_exists ".pc") { @@ -2780,12 +2944,8 @@ END commit_quilty_patch(); if ($mustdeletepc) { - runcmd @git, qw(rm -rqf .pc); - commit_admin "Commit removal of .pc (quilt series tracking data)"; + quilt_fixup_delete_pc(); } - - changedir '../../../..'; - runcmd @git, qw(pull --ff-only -q .git/dgit/unpack/work master); } sub quilt_fixup_editor () { @@ -2809,7 +2969,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') { @@ -2848,8 +3011,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(); @@ -2870,40 +3036,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(); @@ -2912,17 +3098,22 @@ 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); if ($cleanmode eq 'dpkg-source') { - runcmd_ordryrun_local (@dpkgbuildpackage, qw(-us -uc -S)), - changesopts(); + runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc -S), + changesopts(); } elsif ($cleanmode eq 'dpkg-source-d') { - runcmd_ordryrun_local (@dpkgbuildpackage, qw(-us -uc -S -d)), - changesopts(); + runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc -S -d), + changesopts(); } else { my $pwd = must_getcwd(); my $leafdir = basename $pwd; @@ -2955,18 +3146,27 @@ sub cmd_sbuild { unlink $cf or fail "remove $cf: $!"; } } - runcmd_ordryrun_local @sbuild, @ARGV, qw(-d), $isuite, $dscfn; + runcmd_ordryrun_local @sbuild, qw(-d), $isuite, @ARGV, $dscfn; my @changesfiles = glob $pat; @changesfiles = sort { ($b =~ m/_source\.changes$/ <=> $a =~ m/_source\.changes$/) or $a cmp $b } @changesfiles; fail "wrong number of different changes files (@changesfiles)" - unless @changesfiles; + unless @changesfiles==2; + my $binchanges = parsecontrol($changesfiles[1], "binary changes file"); + foreach my $l (split /\n/, getfield $binchanges, 'Files') { + fail "$l found in binaries changes file $binchanges" + if $l =~ m/\.dsc$/; + } runcmd_ordryrun_local @mergechanges, @changesfiles; my $multichanges = "${package}_".(stripepoch $version)."_multi.changes"; if (act_local()) { stat_exists $multichanges or fail "$multichanges: $!"; + foreach my $cf (glob $pat) { + next if $cf eq $multichanges; + rename "$cf", "$cf.inmulti" or fail "$cf\{,.inmulti}: $!"; + } } printdone "build successful, results in $multichanges\n" or die $!; } @@ -2976,6 +3176,8 @@ sub cmd_quilt_fixup { my $clogp = parsechangelog(); $version = getfield $clogp, 'Version'; $package = getfield $clogp, 'Source'; + check_not_dirty(); + clean_tree(); build_maybe_quilt_fixup(); } @@ -2998,7 +3200,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 ---------- @@ -3008,6 +3220,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; @@ -3017,6 +3267,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; @@ -3038,9 +3309,6 @@ 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 && ($om = $opts_opt_map{$1}) && length $om->[0]) { @@ -3050,31 +3318,7 @@ sub parseopts () { !$opts_opt_cmdonly{$1} && ($om = $opts_opt_map{$1})) { push @ropts, $_; - push @{ $opts_opt_cmdline_opts{$1} }, $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'"; + push @$om, $2; } elsif (m/^--ignore-dirty$/s) { push @ropts, $_; $ignoredirty = 1; @@ -3087,6 +3331,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 \`$_'"; } @@ -3107,30 +3354,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'; @@ -3149,6 +3376,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 \`$_'"; } @@ -3158,16 +3390,39 @@ sub parseopts () { } sub finalise_opts_opts () { - foreach my $k (keys %opts_opt_cmdline_opts) { - push @{ $opts_opt_map{$k} }, @{ $opts_opt_cmdline_opts{$k} }; + 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" @@ -3189,6 +3444,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->();