diff options
Diffstat (limited to 'dgit')
| -rwxr-xr-x | dgit | 159 |
1 files changed, 122 insertions, 37 deletions
@@ -102,7 +102,7 @@ our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)"); our $suite_re = '[-+.0-9a-z]+'; our $cleanmode_re = qr{(?: dpkg-source (?: -d )? (?: ,no-check | ,all-check )? - | git | git-ff + | (?: git | git-ff ) (?: ,always )? | check (?: ,ignores )? | none )}x; @@ -132,8 +132,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, @@ -257,7 +257,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; } @@ -2197,17 +2197,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 targe 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: "; @@ -2254,7 +2326,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) { @@ -3062,6 +3133,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 @@ -3758,10 +3830,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(); @@ -5780,17 +5855,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; @@ -5847,16 +5925,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); @@ -6092,9 +6170,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"; @@ -6203,13 +6281,14 @@ sub maybe_unapply_patches_again () { #----- other building ----- -sub clean_tree_check_git ($$) { - my ($honour_ignores, $message) = @_; +sub clean_tree_check_git ($$$) { + my ($honour_ignores, $message, $ignmessage) = @_; my @cmd = (@git, qw(clean -dn)); push @cmd, qw(-x) unless $honour_ignores; my $leftovers = cmdoutput @cmd; if (length $leftovers) { print STDERR $leftovers, "\n" or confess $!; + $message .= $ignmessage if $honour_ignores; fail $message; } } @@ -6219,29 +6298,27 @@ sub clean_tree_check_git_wd ($) { return if $cleanmode =~ m{no-check}; return if $patches_applied_dirtily; # yuk clean_tree_check_git +($cleanmode !~ m{all-check}), - (f_ <<END, $message); -%s + $message, "\n".__ <<END; If this is just missing .gitignore entries, use a different clean -mode, eg --clean=dpkg-source,no-check (-wdu/-wddu) to ignore them +mode, eg --clean=dpkg-source,no-check (-wdn/-wddn) to ignore them or --clean=git (-wg/-wgf) to use \`git clean' instead. END } sub clean_tree_check () { - # Not yet fully implemented. # This function needs to not care about modified but tracked files. # That was done by check_not_dirty, and by now we may have run # the rules clean target which might modify tracked files (!) if ($cleanmode =~ m{^check}) { clean_tree_check_git +($cleanmode =~ m{ignores}), __ - "tree contains uncommitted files and --clean=check specified"; + "tree contains uncommitted files and --clean=check specified", ''; } elsif ($cleanmode =~ m{^dpkg-source}) { clean_tree_check_git_wd __ "tree contains uncommitted files (NB dgit didn't run rules clean)"; } elsif ($cleanmode =~ m{^git}) { - # If we were actually cleaning these files would be summarily - # deleted. Since we're not, and not using the working tree - # anyway, we can just ignore them - nothing will use them. + clean_tree_check_git 1, __ + "tree contains uncommited, untracked, unignored files\n". + "You can use --clean=git[-ff],always (-wga/-wgfa) to delete them.", ''; } elsif ($cleanmode eq 'none') { } else { confess "$cleanmode ?"; @@ -6259,9 +6336,9 @@ sub clean_tree () { runcmd_ordryrun_local @cmd; clean_tree_check_git_wd __ "tree contains uncommitted files (after running rules clean)"; - } elsif ($cleanmode eq 'git') { + } elsif ($cleanmode =~ m{^git(?!-)}) { runcmd_ordryrun_local @git, qw(clean -xdf); - } elsif ($cleanmode eq 'git-ff') { + } elsif ($cleanmode =~ m{^git-ff}) { runcmd_ordryrun_local @git, qw(clean -xdff); } elsif ($cleanmode =~ m{^check}) { clean_tree_check(); @@ -6303,10 +6380,13 @@ sub build_prep_early () { sub build_prep ($) { my ($wantsrc) = @_; build_prep_early(); - if (!building_source_in_playtree() || ($wantsrc & WANTSRC_BUILDER)) { + check_bpd_exists(); + if (!building_source_in_playtree() || ($wantsrc & WANTSRC_BUILDER) # Clean the tree because we're going to use the contents of # $maindir. (We trying to include dirty changes in the source # package, or we are running the builder in $maindir.) + || $cleanmode =~ m{always}) { + # Or because the user asked us to. clean_tree(); } else { # We don't actually need to do anything in $maindir, but we @@ -7192,6 +7272,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; @@ -7281,12 +7367,11 @@ 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'; + $cleanmode .= '-ff' if $1; + $cleanmode .= ',always' if $2; } elsif (s/^-wd(d?)([na]?)$//s) { push @ropts, $&; $cleanmode = 'dpkg-source'; |