X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=dgit;h=c2622ef7eb4ff7a949b77fcea66d1ad194a90213;hb=2046b269f987d70a6b89cbcd8926ef4931586706;hp=3ff58a7e156e7bbc2f8f119400c963a58bce5b0e;hpb=3ab702cf007572af5419a92d3688c0bb59013a82;p=dgit.git

diff --git a/dgit b/dgit
index 3ff58a7e..c2622ef7 100755
--- a/dgit
+++ b/dgit
@@ -669,7 +669,7 @@ sub git_get_config ($) {
     my ($c) = @_;
     foreach my $src (@gitcfgsources) {
 	my $l = $gitcfgs{$src}{$c};
-	croak "$l $c" if $l && !ref $l;
+	confess "internal error ($l $c)" if $l && !ref $l;
 	printdebug"C $c ".(defined $l ?
 			   join " ", map { messagequote "'$_'" } @$l :
 			   "undef")."\n"
@@ -1319,6 +1319,8 @@ sub archive_query_aptget {
     return [ (getfield $pre_dsc, 'Version'), $uri ];
 }
 
+sub file_in_archive_aptget () { return undef; }
+
 #---------- `dummyapicat' archive query method ----------
 
 sub archive_query_dummycatapi { archive_query_ftpmasterapi @_; }
@@ -1697,9 +1699,14 @@ sub prep_ud (;$) {
 sub mktree_in_ud_here () {
     runcmd qw(git init -q);
     runcmd qw(git config gc.auto 0);
+    foreach my $copy (qw(user.email user.name user.useConfigOnly)) {
+	my $v = $gitcfgs{local}{$copy};
+	next unless $v;
+	runcmd qw(git config), $copy, $_ foreach @$v;
+    }
     rmtree('.git/objects');
     symlink '../../../../objects','.git/objects' or die $!;
-    setup_gitattrs();
+    setup_gitattrs(1);
 }
 
 sub git_write_tree () {
@@ -1988,7 +1995,14 @@ sub make_commit_text ($) {
 sub clogp_authline ($) {
     my ($clogp) = @_;
     my $author = getfield $clogp, 'Maintainer';
-    $author =~ s#,.*##ms;
+    if ($author =~ m/^[^"\@]+\,/) {
+	# single entry Maintainer field with unquoted comma
+	$author = ($& =~ y/,//rd).$'; # strip the comma
+    }
+    # git wants a single author; any remaining commas in $author
+    # are by now preceded by @ (or ").  It seems safer to punt on
+    # "..." for now rather than attempting to dequote or something.
+    $author =~ s#,.*##ms unless $author =~ m/"/;
     my $date = cmdoutput qw(date), '+%s %z', qw(-d), getfield($clogp,'Date');
     my $authline = "$author $date";
     $authline =~ m/$git_authline_re/o or
@@ -2310,6 +2324,7 @@ sub generate_commits_from_dsc () {
 
     my $authline = clogp_authline $clogp;
     my $changes = getfield $clogp, 'Changes';
+    $changes =~ s/^\n//; # Changes: \n
     my $cversion = getfield $clogp, 'Version';
 
     if (@tartrees) {
@@ -2572,7 +2587,7 @@ sub lrfetchref_used ($) {
 }
 
 sub git_lrfetch_sane {
-    my ($supplementary, @specs) = @_;
+    my ($url, $supplementary, @specs) = @_;
     # Make a 'refs/'.lrfetchrefs.'/*' be just like on server,
     # at least as regards @specs.  Also leave the results in
     # %lrfetchrefs_f, and arrange for lrfetchref_used to be
@@ -2603,8 +2618,6 @@ sub git_lrfetch_sane {
     # git fetch to try to generate it.  If we don't manage to generate
     # the target state, we try again.
 
-    my $url = access_giturl();
-
     printdebug "git_lrfetch_sane suppl=$supplementary specs @specs\n";
 
     my $specre = join '|', map {
@@ -2744,7 +2757,8 @@ sub git_fetch_us () {
     push @specs, $rewritemap;
     push @specs, qw(heads/*) if deliberately_not_fast_forward;
 
-    git_lrfetch_sane 0, @specs;
+    my $url = access_giturl();
+    git_lrfetch_sane $url, 0, @specs;
 
     my %here;
     my @tagpats = debiantags('*',access_nomdistro);
@@ -2873,13 +2887,13 @@ END
 		or fail <<END;
 .dsc Dgit metadata is in context of distro $dsc_distro
 for which we have no configured url;
-.dsc provices hinted url with protocol $proto which is unsafe.
+.dsc provides hinted url with protocol $proto which is unsafe.
 (can be overridden by config - consult documentation)
 END
 	    $url = $dsc_hint_url;
 	}
 
-	git_lrfetch_sane 1, @fetch;
+	git_lrfetch_sane $url, 1, @fetch;
 
 	return $lrf;
     };
@@ -3601,6 +3615,7 @@ sub clone ($) {
     mkdir $dstdir or fail "create \`$dstdir': $!";
     changedir $dstdir;
     runcmd @git, qw(init -q);
+    setup_new_tree();
     clone_set_head();
     my $giturl = access_giturl(1);
     if (defined $giturl) {
@@ -3619,7 +3634,6 @@ sub clone ($) {
 	$vcsgiturl =~ s/\s+-b\s+\S+//g;
 	runcmd @git, qw(remote add vcs-git), $vcsgiturl;
     }
-    setup_new_tree();
     clone_finish($dstdir);
 }
 
@@ -3798,18 +3812,28 @@ sub pseudomerge_version_check ($$) {
 	} else {
 	    my $v = $i_arch_v->[0];
 	    progress "Checking package changelog for archive version $v ...";
+	    my $cd;
 	    eval {
 		my @xa = ("-f$v", "-t$v");
 		my $vclogp = parsechangelog @xa;
-		my $cv = [ (getfield $vclogp, 'Version'),
-			   "Version field from dpkg-parsechangelog @xa" ];
+		my $gf = sub {
+		    my ($fn) = @_;
+		    [ (getfield $vclogp, $fn),
+		      "$fn field from dpkg-parsechangelog @xa" ];
+		};
+		my $cv = $gf->('Version');
 		infopair_cond_equal($i_arch_v, $cv);
+		$cd = $gf->('Distribution');
 	    };
 	    if ($@) {
 		$@ =~ s/^dgit: //gm;
 		fail "$@".
 		    "Perhaps debian/changelog does not mention $v ?";
 	    }
+	    fail <<END if $cd->[0] =~ m/UNRELEASED/;
+$cd->[1] is $cd->[0]
+Your tree seems to based on earlier (not uploaded) $v.
+END
 	}
     }
     
@@ -4342,9 +4366,9 @@ If you need to change the package, you must use a new version number.
 END
     if ($we_are_responder) {
 	my $dryrunsuffix = act_local() ? "" : ".tmp";
+	my @rfiles = ($dscpath, $changesfile);
 	responder_receive_files('signed-dsc-changes',
-				"$dscpath$dryrunsuffix",
-				"$changesfile$dryrunsuffix");
+				map { "$_$dryrunsuffix" } @rfiles);
     } else {
 	if (act_local()) {
 	    rename "$dscpath.tmp",$dscpath or die "$dscfn $!";
@@ -4418,7 +4442,12 @@ sub cmd_clone {
 }
 
 sub branchsuite () {
-    my $branch = cmdoutput_errok @git, qw(symbolic-ref HEAD);
+    my @cmd = (@git, qw(symbolic-ref -q HEAD));
+    my $branch = cmdoutput_errok @cmd;
+    if (!defined $branch) {
+	$?==256 or failedcmd @cmd;
+	return undef;
+    }
     if ($branch =~ m#$lbranch_re#o) {
 	return $1;
     } else {
@@ -6312,12 +6341,18 @@ sub cmd_archive_api_query {
     exec @cmd or fail "exec curl: $!\n";
 }
 
+sub repos_server_url () {
+    $package = '_dgit-repos-server';
+    local $access_forpush = 1;
+    local $isuite = 'DGIT-REPOS-SERVER';
+    my $url = access_giturl();
+}    
+
 sub cmd_clone_dgit_repos_server {
     badusage "need destination argument" unless @ARGV==1;
     my ($destdir) = @ARGV;
-    $package = '_dgit-repos-server';
-    local $access_forpush = 0;
-    my @cmd = (@git, qw(clone), access_giturl(), $destdir);
+    my $url = repos_server_url();
+    my @cmd = (@git, qw(clone), $url, $destdir);
     debugcmd ">",@cmd;
     exec @cmd or fail "exec git clone: $!\n";
 }
@@ -6325,29 +6360,31 @@ sub cmd_clone_dgit_repos_server {
 sub cmd_print_dgit_repos_server_source_url {
     badusage "no arguments allowed to dgit print-dgit-repos-server-source-url"
 	if @ARGV;
-    $package = '_dgit-repos-server';
-    local $access_forpush = 0;
-    my $url = access_giturl();
+    my $url = repos_server_url();
     print $url, "\n" or die $!;
 }
 
 sub cmd_setup_mergechangelogs {
     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;
+    local $isuite = 'DGIT-SETUP-TREE';
     setup_useremail(1);
 }
 
 sub cmd_setup_gitattributes {
     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;
+    local $isuite = 'DGIT-SETUP-TREE';
     setup_new_tree();
 }