X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=b6bfd5605684ae5fbebb3343175ccc2bd5c2ac4f;hb=aa57a5799afda71dd5750b05bfaccd9ec74e5c08;hp=b25d344f46a496516735dd9cb088cd76008c7341;hpb=07a861b637e45f33cfbb9031e6fe4061f31e929c;p=dgit.git

diff --git a/dgit b/dgit
index b25d344f..b6bfd560 100755
--- a/dgit
+++ b/dgit
@@ -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;
@@ -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
@@ -3760,6 +3832,7 @@ sub clone ($) {
 
     mkdir $dstdir or fail f_ "create \`%s': %s", $dstdir, $!;
     changedir $dstdir;
+    check_bpd_exists();
 
     canonicalise_suite();
     my $hasgit = check_for_git();
@@ -5782,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;
@@ -5849,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);
@@ -6094,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";
@@ -6205,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;
     }
 }
@@ -6221,8 +6298,7 @@ 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 (-wdn/-wddn) to ignore them
 or --clean=git (-wg/-wgf) to use \`git clean' instead.
@@ -6230,20 +6306,19 @@ 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 ?";
@@ -6261,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();
@@ -6305,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
@@ -7289,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';