X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=916177c3cd0ed895c727abfe9dc585c6950dfe3e;hp=d8a49dbc60351c60d3bee80e1b963b79b335e10f;hb=3d241c37fc1139f8942299323d72fc2e493f036c;hpb=b03d65e3455ddc7ec7ef7ac666693f2013841817

diff --git a/dgit b/dgit
index d8a49dbc..916177c3 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);
@@ -91,13 +92,14 @@ 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_cmdonly = ('gpg' => 1, 'git' => 1);
 our %opts_cfg_insertpos = map {
     $_,
     scalar @{ $opts_opt_map{$_} }
@@ -422,7 +424,8 @@ our $helpmsg = <<END;
 main usages:
   dgit [dgit-opts] clone [dgit-opts] package [suite] [./dir|/dir]
   dgit [dgit-opts] fetch|pull [dgit-opts] [suite]
-  dgit [dgit-opts] build [git-buildpackage-opts|dpkg-buildpackage-opts]
+  dgit [dgit-opts] build [dpkg-buildpackage-opts]
+  dgit [dgit-opts] sbuild [sbuild-opts]
   dgit [dgit-opts] push [dgit-opts] [suite]
   dgit [dgit-opts] rpush build-host:build-dir ...
 important dgit options:
@@ -1157,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);
@@ -1214,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;
@@ -1235,7 +1234,17 @@ 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();
     if (madformat($format)) {
@@ -1373,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"
@@ -1472,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;
     }
 
@@ -1489,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;
     }
 }
 
@@ -1668,8 +1681,24 @@ 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 ($) {
@@ -1754,7 +1783,8 @@ 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";
 }
 
@@ -1853,6 +1883,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;
@@ -2490,9 +2523,10 @@ sub quiltify ($$) {
     # should be contained within debian/patches.
 
     changedir '../fake';
+    remove_stray_gits();
     mktree_in_ud_here();
     rmtree '.pc';
-    runcmd @git, 'add', '.';
+    runcmd @git, qw(add -Af .);
     my $oldtiptree=git_write_tree();
     changedir '../work';
 
@@ -2765,7 +2799,7 @@ END
     foreach my $f (<../../../../*>) { #/){
 	my $b=$f; $b =~ s{.*/}{};
 	next unless is_orig_file $b, srcfn $upstreamversion,'';
-	link $f, $b or die "$b $!";
+	link_ltarget $f, $b or die "$b $!";
         $dscaddfile->($b);
     }
 
@@ -2839,7 +2873,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') {
@@ -2878,8 +2915,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();
@@ -2900,40 +2940,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();
@@ -2942,8 +3002,13 @@ 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);
@@ -3031,6 +3096,11 @@ sub cmd_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();
@@ -3043,6 +3113,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;
 
@@ -3052,6 +3160,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;
@@ -3073,9 +3202,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]) {
@@ -3086,30 +3212,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=(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'";
 	    } elsif (m/^--ignore-dirty$/s) {
 		push @ropts, $_;
 		$ignoredirty = 1;
@@ -3122,6 +3224,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 \`$_'";
 	    }
@@ -3142,30 +3247,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';
@@ -3184,6 +3269,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 \`$_'";
 		}
@@ -3247,6 +3337,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->();