X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=a0d2e0a0f86034b6accf6fe81fb4f8556c65d9b3;hp=f826cdaae1ffe82fdc14ed33dd7cc4a31760314e;hb=3193ca2bad512d2563797eca11ceb9d707a65004;hpb=e080e3f7d2ef1af449d88be632ebbb7ce097dfe5 diff --git a/dgit b/dgit index f826cdaa..a0d2e0a0 100755 --- a/dgit +++ b/dgit @@ -32,6 +32,7 @@ use Data::Dumper; use LWP::UserAgent; use Dpkg::Control::Hash; use File::Path; +use File::Spec; use File::Temp qw(tempdir); use File::Basename; use Dpkg::Version; @@ -101,7 +102,11 @@ our %forceopts = map { $_=>0 } 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 $cleanmode_re = qr{(?: dpkg-source (?: -d )? (?: ,no-check | ,all-check )? + | (?: git | git-ff ) (?: ,always )? + | check (?: ,ignores )? + | none + )}x; our $git_authline_re = '^([^<>]+) \<(\S+)\> (\d+ [-+]\d+)$'; our $splitbraincache = 'dgit-intern/quilt-cache'; @@ -128,8 +133,8 @@ our (@mergechanges) = qw(mergechanges -f); our (@gbp_build) = (''); our (@gbp_pq) = ('gbp pq'); our (@changesopts) = (''); -our (@pbuilder) = ("sudo -E pbuilder"); -our (@cowbuilder) = ("sudo -E cowbuilder"); +our (@pbuilder) = ("sudo -E pbuilder","--no-source-only-changes"); +our (@cowbuilder) = ("sudo -E cowbuilder","--no-source-only-changes"); our %opts_opt_map = ('dget' => \@dget, # accept for compatibility 'curl' => \@curl, @@ -160,6 +165,7 @@ our %opts_cfg_insertpos = map { } keys %opts_opt_map; sub parseopts_late_defaults(); +sub quiltify_trees_differ ($$;$$$); sub setup_gitattrs(;$); sub check_gitattrs($$); @@ -253,7 +259,7 @@ sub forceing ($) { } sub no_such_package () { - print STDERR f_ "%s: package %s does not exist in suite %s\n", + print STDERR f_ "%s: source package %s does not exist in suite %s\n", $us, $package, $isuite; finish 4; } @@ -379,6 +385,10 @@ sub branch_is_gdr ($) { printdebug "branch_is_gdr $walk ?-octopus NO\n"; return 0; } + if (!@parents) { + printdebug "branch_is_gdr $walk origin\n"; + return 0; + } if ($get_patches->($walk) ne $tip_patches) { # Our parent added, removed, or edited patches, and wasn't # a gdr make-patches commit. gdr make-patches probably @@ -388,7 +398,9 @@ sub branch_is_gdr ($) { return 0; } if ($tip_patches eq '' and - !defined git_cat_file "$walk:debian") { + !defined git_cat_file "$walk~:debian" and + !quiltify_trees_differ "$walk~", $walk + ) { # (gdr classification of parent: BreakwaterStart printdebug "branch_is_gdr $walk unmarked BreakwaterStart YES\n"; return 1; @@ -786,6 +798,9 @@ sub git_get_config ($) { @$l==1 or badcfg f_ "multiple values for %s (in %s git config)", $c, $src if @$l > 1; + $l->[0] =~ m/\n/ and badcfg f_ + "value for config option %s (in %s git config) contains newline(s)!", + $c, $src; return $l->[0]; } return undef; @@ -2186,17 +2201,89 @@ sub check_for_vendor_patches () { __ "(nominal) distro being accessed"); } +sub check_bpd_exists () { + stat $buildproductsdir + or fail f_ "build-products-dir %s is not accessible: %s\n", + $buildproductsdir, $!; +} + +sub dotdot_bpd_transfer_origs ($$$) { + my ($bpd_abs, $upstreamversion, $wanted) = @_; + # checks is_orig_file_of_vsn and if + # calls $wanted->{$leaf} and expects boolish + + return if $buildproductsdir eq '..'; + + my $warned; + my $dotdot = $maindir; + $dotdot =~ s{/[^/]+$}{}; + opendir DD, $dotdot or fail "opendir .. ($dotdot): $!"; + while ($!=0, defined(my $leaf = readdir DD)) { + { + local ($debuglevel) = $debuglevel-1; + printdebug "DD_BPD $leaf ?\n"; + } + next unless is_orig_file_of_vsn $leaf, $upstreamversion; + next unless $wanted->($leaf); + next if lstat "$bpd_abs/$leaf"; + + print STDERR f_ + "%s: found orig(s) in .. missing from build-products-dir, transferring:\n", + $us + unless $warned++; + $! == &ENOENT or fail f_ + "check orig file %s in bpd %s: %s", $leaf, $bpd_abs, $!; + lstat "$dotdot/$leaf" or fail f_ + "check orig file %s in ..: %s", $leaf, $!; + if (-l _) { + stat "$dotdot/$leaf" or fail f_ + "check target of orig symlink %s in ..: %s", $leaf, $!; + my $ltarget = readlink "$dotdot/$leaf" or + die "readlink $dotdot/$leaf: $!"; + if ($ltarget !~ m{^/}) { + $ltarget = "$dotdot/$ltarget"; + } + symlink $ltarget, "$bpd_abs/$leaf" + or die "$ltarget $bpd_abs $leaf: $!"; + print STDERR f_ + "%s: cloned orig symlink from ..: %s\n", + $us, $leaf; + } elsif (link "$dotdot/$leaf", "$bpd_abs/$leaf") { + print STDERR f_ + "%s: hardlinked orig from ..: %s\n", + $us, $leaf; + } elsif ($! != EXDEV) { + fail f_ "failed to make %s a hardlink to %s: %s", + "$bpd_abs/$leaf", "$dotdot/$leaf", $!; + } else { + symlink "$bpd_abs/$leaf", "$dotdot/$leaf" + or die "$bpd_abs $dotdot $leaf $!"; + print STDERR f_ + "%s: symmlinked orig from .. on other filesystem: %s\n", + $us, $leaf; + } + } + die "$dotdot; $!" if $!; + closedir DD; +} + sub generate_commits_from_dsc () { # See big comment in fetch_from_archive, below. # See also README.dsc-import. prep_ud(); changedir $playground; + my $bpd_abs = bpd_abs(); + my $upstreamv = upstreamversion $dsc->{version}; my @dfi = dsc_files_info(); + + dotdot_bpd_transfer_origs $bpd_abs, $upstreamv, + sub { grep { $_->{Filename} eq $_[0] } @dfi }; + foreach my $fi (@dfi) { my $f = $fi->{Filename}; die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#; - my $upper_f = (bpd_abs()."/$f"); + my $upper_f = "$bpd_abs/$f"; printdebug "considering reusing $f: "; @@ -2220,18 +2307,18 @@ sub generate_commits_from_dsc () { printdebug "considering saving $f: "; - if (link $f, $upper_f) { + if (rename_link_xf 1, $f, $upper_f) { printdebug "linked.\n"; - } elsif ((printdebug "($!) "), + } elsif ((printdebug "($@) "), $! != EEXIST) { - fail f_ "saving %s: %s", "$buildproductsdir/$f", $!; + fail f_ "saving %s: %s", "$buildproductsdir/$f", $@; } elsif (!$refetched) { printdebug "no need.\n"; - } elsif (link $f, "$upper_f,fetch") { + } elsif (rename_link_xf 1, $f, "$upper_f,fetch") { printdebug "linked (using ...,fetch).\n"; - } elsif ((printdebug "($!) "), + } elsif ((printdebug "($@) "), $! != EEXIST) { - fail f_ "saving %s: %s", "$buildproductsdir/$f,fetch", $!; + fail f_ "saving %s: %s", "$buildproductsdir/$f,fetch", $@; } else { printdebug "cannot.\n"; } @@ -2243,7 +2330,6 @@ sub generate_commits_from_dsc () { # from the debian/changelog, so we record the tree objects now and # make them into commits later. my @tartrees; - my $upstreamv = upstreamversion $dsc->{version}; my $orig_f_base = srcfn $upstreamv, ''; foreach my $fi (@dfi) { @@ -3051,6 +3137,7 @@ END } sub fetch_from_archive () { + check_bpd_exists(); ensure_setup_existing_tree(); # Ensures that lrref() is what is actually in the archive, one way @@ -3747,10 +3834,13 @@ sub clone ($) { } printdebug "clone main body\n"; - canonicalise_suite(); - my $hasgit = check_for_git(); mkdir $dstdir or fail f_ "create \`%s': %s", $dstdir, $!; changedir $dstdir; + check_bpd_exists(); + + canonicalise_suite(); + my $hasgit = check_for_git(); + runcmd @git, qw(init -q); record_maindir(); setup_new_tree(); @@ -3813,12 +3903,25 @@ sub pull () { } sub check_not_dirty () { - foreach my $f (qw(local-options local-patch-header)) { - if (stat_exists "debian/source/$f") { - fail f_ "git tree contains debian/source/%s", $f; + my @forbid = qw(local-options local-patch-header); + @forbid = map { "debian/source/$_" } @forbid; + foreach my $f (@forbid) { + if (stat_exists $f) { + fail f_ "git tree contains %s", $f; } } + my @cmd = (@git, qw(status -uall --ignored --porcelain)); + push @cmd, qw(debian/source/format debian/source/options); + push @cmd, @forbid; + + my $bad = cmdoutput @cmd; + if (length $bad) { + fail +(__ + "you have uncommitted changes to critical files, cannot continue:\n"). + $bad; + } + return if $includedirty; git_check_unmodified(); @@ -4012,7 +4115,7 @@ END sub pseudomerge_make_commit ($$$$ $$) { my ($clogp, $dgitview, $archive_hash, $i_arch_v, $msg_cmd, $msg_msg) = @_; - progress f_ "Declaring that HEAD inciudes all changes in %s...", + progress f_ "Declaring that HEAD includes all changes in %s...", $i_arch_v->[0]; my $tree = cmdoutput qw(git rev-parse), "${dgitview}:"; @@ -4068,7 +4171,7 @@ sub splitbrain_pseudomerge ($$$$) { my $i_arch_v = pseudomerge_version_check($clogp, $archive_hash); if (!defined $overwrite_version) { - progress __ "Checking that HEAD inciudes all changes in archive..."; + progress __ "Checking that HEAD includes all changes in archive..."; } return $dgitview if is_fast_fwd $archive_hash, $dgitview; @@ -4519,11 +4622,11 @@ ENDT if ($sourceonlypolicy eq 'ok') { } elsif ($sourceonlypolicy eq 'always') { forceable_fail [qw(uploading-binaries)], - __ "uploading binaries, although distroy policy is source only" + __ "uploading binaries, although distro policy is source only" if $hasdebs; } elsif ($sourceonlypolicy eq 'never') { forceable_fail [qw(uploading-source-only)], - __ "source-only upload, although distroy policy requires .debs" + __ "source-only upload, although distro policy requires .debs" if !$hasdebs; } elsif ($sourceonlypolicy eq 'not-wholly-new') { forceable_fail [qw(uploading-source-only)], @@ -5499,7 +5602,8 @@ sub quiltify ($$$$) { printdebug "considering C=$c->{Commit} P=$p->{Commit}\n"; my @cmd= (@git, qw(diff-tree -r --name-only), - $p->{Commit},$c->{Commit}, qw(-- debian/patches .pc)); + $p->{Commit},$c->{Commit}, + qw(-- debian/patches .pc debian/source/format)); my $patchstackchange = cmdoutput @cmd; if (length $patchstackchange) { $patchstackchange =~ s/\n/,/g; @@ -5715,7 +5819,10 @@ END if (act_local()) { debugcmd "+",@cmd; $!=0; $?=-1; - failedcmd @cmd if system @cmd and $?!=7*256; + failedcmd @cmd + if system @cmd + and not ($? == 7*256 or + $? == -1 && $!==ENOENT); } else { dryrun_report @cmd; } @@ -5752,17 +5859,20 @@ sub unpack_playtree_linkorigs ($$) { # calls $fn->($leafname); my $bpd_abs = bpd_abs(); + + dotdot_bpd_transfer_origs $bpd_abs, $upstreamversion, sub { 1 }; + opendir QFD, $bpd_abs or fail "buildproductsdir: $bpd_abs: $!"; - while ($!=0, defined(my $b = readdir QFD)) { - my $f = bpd_abs()."/".$b; + while ($!=0, defined(my $leaf = readdir QFD)) { + my $f = bpd_abs()."/".$leaf; { local ($debuglevel) = $debuglevel-1; - printdebug "QF linkorigs $b, $f ?\n"; + printdebug "QF linkorigs bpd $leaf, $f ?\n"; } - next unless is_orig_file_of_vsn $b, $upstreamversion; - printdebug "QF linkorigs $b, $f Y\n"; - link_ltarget $f, $b or die "$b $!"; - $fn->($b); + next unless is_orig_file_of_vsn $leaf, $upstreamversion; + printdebug "QF linkorigs $leaf, $f Y\n"; + link_ltarget $f, $leaf or die "$leaf $!"; + $fn->($leaf); } die "$buildproductsdir: $!" if $!; closedir QFD; @@ -5797,7 +5907,9 @@ sub quilt_fixup_singlepatch ($$$) { changedir ".."; runcmd @dpkgsource, qw(-x), (srcfn $version, ".dsc"); rename srcfn("$upstreamversion", "/debian/patches"), - "work/debian/patches"; + "work/debian/patches" + or $!==ENOENT + or confess "install d/patches: $!"; changedir "work"; commit_quilty_patch(); @@ -5817,16 +5929,16 @@ Files: END my $dscaddfile=sub { - my ($b) = @_; + my ($leaf) = @_; my $md = new Digest::MD5; - my $fh = new IO::File $b, '<' or die "$b $!"; + my $fh = new IO::File $leaf, '<' or die "$leaf $!"; stat $fh or confess $!; my $size = -s _; $md->addfile($fh); - print $fakedsc " ".$md->hexdigest." $size $b\n" or confess $!; + print $fakedsc " ".$md->hexdigest." $size $leaf\n" or confess $!; }; unpack_playtree_linkorigs($upstreamversion, $dscaddfile); @@ -6062,9 +6174,9 @@ END }; my @dl; - foreach my $b (qw(01 02)) { + foreach my $bits (qw(01 02)) { foreach my $v (qw(O2H O2A H2A)) { - push @dl, ($diffbits->{$v} & $b) ? '##' : '=='; + push @dl, ($diffbits->{$v} & $bits) ? '##' : '=='; } } printdebug "differences \@dl @dl.\n"; @@ -6149,7 +6261,7 @@ sub quilt_fixup_editor () { sub maybe_apply_patches_dirtily () { return unless $quilt_mode =~ m/gbp|unapplied/; - print STDERR <[0] } @vsns; @vsns = sort { -version_compare($a, $b) } @vsns; $changes_since_version = $vsns[0]; - progress "changelog will contain changes since $vsns[0]"; + progress f_ "changelog will contain changes since %s", $vsns[0]; } else { $changes_since_version = '_'; - progress "package seems new, not specifying -v"; + progress __ "package seems new, not specifying -v"; } } if ($changes_since_version ne '_') { @@ -6322,14 +6485,14 @@ sub massage_dbp_args ($;$) { $r |= WANTSRC_SOURCE if grep { s/^full$/binary/ } @d; $r |= WANTSRC_SOURCE if grep { s/^source$// } @d; $r |= WANTSRC_BUILDER if grep { m/./ } @d; - fail "Wanted to build nothing!" unless $r; + fail __ "Wanted to build nothing!" unless $r; $dmode = '--build='. join ',', grep m/./, @d; } else { $r = $dmode =~ m/[S]/ ? WANTSRC_SOURCE : $dmode =~ y/gGF/ABb/ ? WANTSRC_SOURCE | WANTSRC_BUILDER : $dmode =~ m/[ABb]/ ? WANTSRC_BUILDER : - die "$dmode ?"; + confess "$dmode ?"; } printdebug "massage done $r $dmode.\n"; push @$cmd, $dmode; @@ -6359,30 +6522,35 @@ sub postbuild_mergechanges ($) { } @changesfiles; my $result; if (@changesfiles==1) { - fail <; }; - D->error and fail "read $dscfn: $!"; + D->error and fail f_ "read %s: %s", $dscfn, $!; close C; # we don't normally need this so import it here @@ -6752,13 +6945,13 @@ sub cmd_import_dsc { local $SIG{__WARN__} = sub { print STDERR $_[0]; return unless $needsig; - fail "import-dsc signature check failed"; + fail __ "import-dsc signature check failed"; }; if (!$dp->is_signed()) { - warn "$us: warning: importing unsigned .dsc\n"; + warn f_ "%s: warning: importing unsigned .dsc\n", $us; } else { my $r = $dp->check_signature(); - die "->check_signature => $r" if $needsig && $r; + confess "->check_signature => $r" if $needsig && $r; } } @@ -6766,7 +6959,7 @@ sub cmd_import_dsc { $package = getfield $dsc, 'Source'; - parse_dsc_field($dsc, "Dgit metadata in .dsc") + parse_dsc_field($dsc, __ "Dgit metadata in .dsc") unless forceing [qw(import-dsc-with-dgit-field)]; parse_dsc_field_def_dsc_distro(); @@ -6776,7 +6969,8 @@ sub cmd_import_dsc { notpushing(); if (defined $dsc_hash) { - progress "dgit: import-dsc of .dsc with Dgit field, using git hash"; + progress __ + "dgit: import-dsc of .dsc with Dgit field, using git hash"; resolve_dsc_field_commit undef, undef; } if (defined $dsc_hash) { @@ -6784,56 +6978,81 @@ sub cmd_import_dsc { "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."; + progress __ "Not fast forward, forced update."; } else { - fail "Not fast forward to $dsc_hash"; + fail f_ "Not fast forward to %s", $dsc_hash; } } import_dsc_result $dstbranch, $dsc_hash, "dgit import-dsc (Dgit): $info", - "updated git ref $dstbranch"; + f_ "updated git ref %s", $dstbranch; return 0; } - fail <{Filename}; + # We transfer all the pieces of the dsc to the bpd, not just + # origs. This is by analogy with dgit fetch, which wants to + # keep them somewhere to avoid downloading them again. + # We make symlinks, though. If the user wants copies, then + # they can copy the parts of the dsc to the bpd using dcmd, + # or something. my $here = "$buildproductsdir/$f"; if (lstat $here) { - next if stat $here; - fail "lstat $here works but stat gives $! !"; + if (stat $here) { + next; + } + fail f_ "lstat %s works but stat gives %s !", $here, $!; } - fail "stat $here: $!" unless $! == ENOENT; + fail f_ "stat %s: %s", $here, $! unless $! == ENOENT; + printdebug "not in bpd, $f ...\n"; + # $f does not exist in bpd, we need to transfer it my $there = $dscfn; - if ($dscfn =~ m#^(?:\./+)?\.\./+#) { - $there = $'; - } elsif ($dscfn =~ m#^/#) { - $there = $dscfn; + $there =~ s{[^/]+$}{$f} or confess "$there ?"; + # $there is file we want, relative to user's cwd, or abs + printdebug "not in bpd, $f, test $there ...\n"; + stat $there or fail f_ + "import %s requires %s, but: %s", $dscfn, $there, $!; + if ($there =~ m#^(?:\./+)?\.\./+#) { + # $there is relative to user's cwd + my $there_from_parent = $'; + if ($buildproductsdir !~ m{^/}) { + # abs2rel, despite its name, can take two relative paths + $there = File::Spec->abs2rel($there,$buildproductsdir); + # now $there is relative to bpd, great + printdebug "not in bpd, $f, abs2rel, $there ...\n"; + } else { + $there = (dirname $maindir)."/$there_from_parent"; + # now $there is absoute + printdebug "not in bpd, $f, rel2rel, $there ...\n"; + } + } elsif ($there =~ m#^/#) { + # $there is absolute already + printdebug "not in bpd, $f, abs, $there ...\n"; } else { - fail "cannot import $dscfn which seems to be inside working tree!"; + fail f_ + "cannot import %s which seems to be inside working tree!", + $dscfn; } - $there =~ s#/+[^/]+$## or - fail "import $dscfn requires ../$f, but it does not exist"; - $there .= "/$f"; - my $test = $there =~ m{^/} ? $there : "../$there"; - stat $test or fail "import $dscfn requires $test, but: $!"; - symlink $there, $here or fail "symlink $there to $here: $!"; - progress "made symlink $here -> $there"; + symlink $there, $here or fail f_ + "symlink %s to %s: %s", $there, $here, $!; + progress f_ "made symlink %s -> %s", $here, $there; # print STDERR Dumper($fi); } my @mergeinputs = generate_commits_from_dsc(); @@ -6843,21 +7062,24 @@ END if ($oldhash) { if ($force > 0) { - progress "Import, forced update - synthetic orphan git history."; + progress __ + "Import, forced update - synthetic orphan git history."; } elsif ($force < 0) { - progress "Import, merging."; + progress __ "Import, merging."; my $tree = cmdoutput @git, qw(rev-parse), "$newhash:"; my $version = getfield $dsc, 'Version'; my $clogp = commit_getclogp $newhash; my $authline = clogp_authline $clogp; - $newhash = make_commit_text <",@cmd; - exec @cmd or fail "exec curl: $!\n"; + exec @cmd or fail f_ "exec curl: %s\n", $!; } sub repos_server_url () { @@ -6893,19 +7115,20 @@ sub pre_clone_dgit_repos_server () { not_necessarily_a_tree(); } sub cmd_clone_dgit_repos_server { - badusage "need destination argument" unless @ARGV==1; + badusage __ "need destination argument" unless @ARGV==1; my ($destdir) = @ARGV; my $url = repos_server_url(); my @cmd = (@git, qw(clone), $url, $destdir); debugcmd ">",@cmd; - exec @cmd or fail "exec git clone: $!\n"; + exec @cmd or fail f_ "exec git clone: %s\n", $!; } sub pre_print_dgit_repos_server_source_url () { not_necessarily_a_tree(); } sub cmd_print_dgit_repos_server_source_url { - badusage "no arguments allowed to dgit print-dgit-repos-server-source-url" + badusage __ + "no arguments allowed to dgit print-dgit-repos-server-source-url" if @ARGV; my $url = repos_server_url(); print $url, "\n" or confess $!; @@ -6915,31 +7138,33 @@ sub pre_print_dpkg_source_ignores { not_necessarily_a_tree(); } sub cmd_print_dpkg_source_ignores { - badusage "no arguments allowed to dgit print-dpkg-source-ignores" + badusage __ + "no arguments allowed to dgit print-dpkg-source-ignores" if @ARGV; print "@dpkg_source_ignores\n" or confess $!; } sub cmd_setup_mergechangelogs { - badusage "no arguments allowed to dgit setup-mergechangelogs" if @ARGV; + badusage __ "no arguments allowed to dgit setup-mergechangelogs" + if @ARGV; local $isuite = 'DGIT-SETUP-TREE'; setup_mergechangelogs(1); } sub cmd_setup_useremail { - badusage "no arguments allowed to dgit setup-useremail" if @ARGV; + badusage __ "no arguments allowed to dgit setup-useremail" if @ARGV; local $isuite = 'DGIT-SETUP-TREE'; setup_useremail(1); } sub cmd_setup_gitattributes { - badusage "no arguments allowed to dgit setup-useremail" if @ARGV; + badusage __ "no arguments allowed to dgit setup-useremail" if @ARGV; local $isuite = 'DGIT-SETUP-TREE'; setup_gitattrs(1); } sub cmd_setup_new_tree { - badusage "no arguments allowed to dgit setup-tree" if @ARGV; + badusage __ "no arguments allowed to dgit setup-tree" if @ARGV; local $isuite = 'DGIT-SETUP-TREE'; setup_new_tree(); } @@ -6986,8 +7211,8 @@ defvalopt '', '-C', '.+', sub { defvalopt '--initiator-tempdir','','.*', sub { ($initiator_tempdir) = (@_); $initiator_tempdir =~ m#^/# or - badusage "--initiator-tempdir must be used specify an". - " absolute, not relative, directory." + badusage __ "--initiator-tempdir must be used specify an". + " absolute, not relative, directory." }; sub defoptmodes ($@) { @@ -7025,11 +7250,11 @@ sub parseopts () { my ($what) = @_; @rvalopts = ($_); if (!defined $val) { - badusage "$what needs a value" unless @ARGV; + badusage f_ "%s needs a value", $what unless @ARGV; $val = shift @ARGV; push @rvalopts, $val; } - badusage "bad value \`$val' for $what" unless + badusage f_ "bad value \`%s' for %s", $val, $what unless $val =~ m/^$oi->{Re}$(?!\n)/s; my $how = $oi->{How}; if (ref($how) eq 'SCALAR') { @@ -7071,6 +7296,12 @@ sub parseopts () { ($om = $opts_opt_map{$1})) { push @ropts, $_; push @$om, $2; + } elsif (m/^--([-0-9a-z]+)\!:(.*)/s && + !$opts_opt_cmdonly{$1} && + ($om = $opts_opt_map{$1})) { + push @ropts, $_; + my $cmd = shift @$om; + @$om = ($cmd, grep { $_ ne $2 } @$om); } elsif (m/^--(gbp|dpm)$/s) { push @ropts, "--quilt=$1"; $quilt_mode = $1; @@ -7114,7 +7345,8 @@ sub parseopts () { $_=''; } elsif (m/^--force-/) { print STDERR - "$us: warning: ignoring unknown force option $_\n"; + f_ "%s: warning: ignoring unknown force option %s\n", + $us, $_; $_=''; } elsif (m/^--dgit-tag-format=(old|new)$/s) { # undocumented, for testing @@ -7133,7 +7365,7 @@ sub parseopts () { push @ropts, $_; $funcopts_long{$_}(); } else { - badusage "unknown long option \`$_'"; + badusage f_ "unknown long option \`%s'", $_; } } else { while (m/^-./s) { @@ -7159,21 +7391,23 @@ sub parseopts () { } elsif (s/^-wn$//s) { push @ropts, $&; $cleanmode = 'none'; - } elsif (s/^-wg$//s) { + } elsif (s/^-wg(f?)(a?)$//s) { push @ropts, $&; $cleanmode = 'git'; - } elsif (s/^-wgf$//s) { - push @ropts, $&; - $cleanmode = 'git-ff'; - } elsif (s/^-wd$//s) { + $cleanmode .= '-ff' if $1; + $cleanmode .= ',always' if $2; + } elsif (s/^-wd(d?)([na]?)$//s) { push @ropts, $&; $cleanmode = 'dpkg-source'; - } elsif (s/^-wdd$//s) { - push @ropts, $&; - $cleanmode = 'dpkg-source-d'; + $cleanmode .= '-d' if $1; + $cleanmode .= ',no-check' if $2 eq 'n'; + $cleanmode .= ',all-check' if $2 eq 'a'; } elsif (s/^-wc$//s) { push @ropts, $&; $cleanmode = 'check'; + } elsif (s/^-wci$//s) { + push @ropts, $&; + $cleanmode = 'check,ignores'; } elsif (s/^-c([^=]*)\=(.*)$//s) { push @git, '-c', $&; $gitcfgs{cmdline}{$1} = [ $2 ]; @@ -7186,7 +7420,7 @@ sub parseopts () { $valopt->($oi->{Short}); $_ = ''; } else { - badusage "unknown short option \`$_'"; + badusage f_ "unknown short option \`%s'", $_; } } } @@ -7201,17 +7435,18 @@ sub check_env_sanity () { foreach my $name (qw(PIPE CHLD)) { my $signame = "SIG$name"; my $signum = eval "POSIX::$signame" // die; - die "$signame is set to something other than SIG_DFL\n" + die f_ "%s is set to something other than SIG_DFL\n", + $signame if defined $SIG{$name} and $SIG{$name} ne 'DEFAULT'; $blocked->ismember($signum) and - die "$signame is blocked\n"; + die f_ "%s is blocked\n", $signame; } }; return unless $@; chomp $@; - fail <[0]; $om->[0] = $v; } @@ -7240,7 +7475,7 @@ sub parseopts_late_defaults () { printdebug "CL $c ", (join " ", map { shellquote } @vl), "\n" if $debuglevel >= 4; next unless @vl; - badcfg "cannot configure options for $k" + badcfg f_ "cannot configure options for %s", $k if $opts_opt_cmdonly{$k}; my $insertpos = $opts_cfg_insertpos{$k}; @$om = ( @$om[0..$insertpos-1], @@ -7260,7 +7495,7 @@ sub parseopts_late_defaults () { // access_cfg('quilt-mode', 'RETURN-UNDEF') // 'linear'; $quilt_mode =~ m/^($quilt_modes_re)$/ - or badcfg "unknown quilt-mode \`$quilt_mode'"; + or badcfg f_ "unknown quilt-mode \`%s'", $quilt_mode; $quilt_mode = $1; } @@ -7270,7 +7505,8 @@ sub parseopts_late_defaults () { next if defined $$vr; $$vr = access_cfg($moc->{Key}, 'RETURN-UNDEF') // $moc->{Default}; my $v = $moc->{Vals}{$$vr}; - badcfg "unknown $moc->{Key} setting \`$$vr'" unless defined $v; + badcfg f_ "unknown %s setting \`%s'", $moc->{Key}, $$vr + unless defined $v; $$vr = $v; } @@ -7279,11 +7515,14 @@ sub parseopts_late_defaults () { if (!defined $cleanmode) { local $access_forpush; - $cleanmode = access_cfg('clean-mode', 'RETURN-UNDEF'); + $cleanmode = access_cfg('clean-mode-newer', 'RETURN-UNDEF'); + $cleanmode = undef if $cleanmode && $cleanmode !~ m/^$cleanmode_re$/; + + $cleanmode //= access_cfg('clean-mode', 'RETURN-UNDEF'); $cleanmode //= 'dpkg-source'; - badcfg "unknown clean-mode \`$cleanmode'" unless - $cleanmode =~ m/^($cleanmode_re)$(?!\n)/s; + badcfg f_ "unknown clean-mode \`%s'", $cleanmode unless + $cleanmode =~ m/$cleanmode_re/; } $buildproductsdir //= access_cfg('build-products-dir', 'RETURN-UNDEF'); @@ -7303,8 +7542,8 @@ if ($ENV{$fakeeditorenv}) { parseopts(); check_env_sanity(); -print STDERR "DRY RUN ONLY\n" if $dryrun_level > 1; -print STDERR "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n" +print STDERR __ "DRY RUN ONLY\n" if $dryrun_level > 1; +print STDERR __ "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n" if $dryrun_level == 1; if (!@ARGV) { print STDERR __ $helpmsg or confess $!; @@ -7316,11 +7555,14 @@ $cmd =~ y/-/_/; my $pre_fn = ${*::}{"pre_$cmd"}; $pre_fn->() if $pre_fn; -record_maindir if $invoked_in_git_tree; +if ($invoked_in_git_tree) { + changedir_git_toplevel(); + record_maindir(); +} git_slurp_config(); my $fn = ${*::}{"cmd_$cmd"}; -$fn or badusage "unknown operation $cmd"; +$fn or badusage f_ "unknown operation %s", $cmd; $fn->(); finish 0;