X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=9bdd2074b520d33ce14234d4e50e53971d4ebb27;hp=f068df6a50f267680368d2ffa5f72864c9644565;hb=c225785cc31e19f449fcfa903442b3ad2987a4d5;hpb=f83789bb6d8cda46a87a61ca846843376261ad35 diff --git a/dgit b/dgit index f068df6a..9bdd2074 100755 --- a/dgit +++ b/dgit @@ -75,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); @@ -155,7 +155,7 @@ END { local ($?); foreach my $f (@end) { eval { $f->(); }; - warn "$us: cleanup: $@" if length $@; + print STDERR "$us: cleanup: $@" if length $@; } }; @@ -1246,7 +1246,7 @@ sub mktree_in_ud_from_only_subdir () { remove_stray_gits(); mktree_in_ud_here(); - my $format=get_source_format(); + my ($format, $fopts) = get_source_format(); if (madformat($format)) { rmtree '.pc'; } @@ -1382,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" @@ -1481,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; } @@ -1498,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; } } @@ -1702,7 +1706,7 @@ sub clone ($) { 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); @@ -1747,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; @@ -1779,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 ''; @@ -1791,7 +1823,7 @@ sub get_source_format () { $_ = ; F->error and die $!; chomp; - return $_; + return ($_, \%options); } sub madformat ($) { @@ -2099,7 +2131,13 @@ sub cmd_clone { return if $!==&ENOENT; die "chdir $cwd_remove: $!"; } - rmtree($dstdir) or die "remove $dstdir: $!\n"; + if (stat $dstdir) { + rmtree($dstdir) or die "remove $dstdir: $!\n"; + } elsif (!grep { $! == $_ } + (ENOENT, ENOTDIR, EACCES, EPERM, ELOOP)) { + } else { + print STDERR "check whether to remove $dstdir: $!\n"; + } }; } @@ -2464,7 +2502,7 @@ END local $ENV{'EDITOR'} = cmdoutput qw(realpath --), $0; local $ENV{'VISUAL'} = $ENV{'EDITOR'}; local $ENV{$fakeeditorenv} = cmdoutput qw(realpath --), $descfn; - runcmd_ordryrun_local @dpkgsource, qw(--commit .), $patchname; + runcmd @dpkgsource, qw(--commit .), $patchname; } } @@ -2521,7 +2559,7 @@ sub quiltify ($$) { remove_stray_gits(); mktree_in_ud_here(); rmtree '.pc'; - runcmd @git, 'add', '.'; + runcmd @git, qw(add -Af .); my $oldtiptree=git_write_tree(); changedir '../work'; @@ -2622,7 +2660,7 @@ sub quiltify ($$) { my $abbrev = sub { my $x = $_[0]{Commit}; $x =~ s/(.*?[0-9a-z]{8})[0-9a-z]*$/$1/; - return $; + return $x; }; my $reportnot = sub { my ($notp) = @_; @@ -2709,12 +2747,95 @@ sub quiltify ($$) { } sub build_maybe_quilt_fixup () { - my $format=get_source_format; + my ($format,$fopts) = get_source_format; return unless madformat $format; # sigh check_for_vendor_patches(); + my $clogp = parsechangelog(); + my $headref = git_rev_parse('HEAD'); + + prep_ud(); + changedir $ud; + + my $upstreamversion=$version; + $upstreamversion =~ s/-[^-]*$//; + + if ($fopts->{'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 @@ -2738,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 @@ -2759,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 $!; @@ -2791,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'; @@ -2814,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") { @@ -2839,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 () { @@ -3045,7 +3146,7 @@ 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$/) @@ -3066,6 +3167,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(); } @@ -3111,18 +3214,39 @@ sub cmd_version { our (%valopts_long, %valopts_short); our @rvalopts; -sub defvalopt ($$$&) { - my ($long,$short,$val_re,$fn) = @_; - my $oi = { Long => $long, Short => $short, Re => $val_re, Fn => $fn }; +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; - # $fn subref should: + # $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', '[^_]+|_', sub { - ($changes_since_version) = @_; +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 () { @@ -3140,13 +3264,18 @@ sub parseopts () { my ($what) = @_; @rvalopts = ($_); if (!defined $val) { - badusage "$what needs a value" unless length @ARGV; + 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; - $oi->{Fn}($val); + my $how = $oi->{How}; + if (ref($how) eq 'SCALAR') { + $$how = $val; + } else { + $how->($val); + } push @ropts, @rvalopts; }; @@ -3181,30 +3310,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=($cleanmode_re)$/os) { - 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; @@ -3244,23 +3349,6 @@ sub parseopts () { 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/^-[dCk]$/) { - badusage - "option \`$_' requires an argument (and no space before the argument)"; } elsif (s/^-wn$//s) { push @ropts, $&; $cleanmode = 'none';