Break out remove_stray_gits

[dgit.git] / dgit

diff --git a/dgit b/dgit
index 7d2023e5c91ab266d3c94a81b9cd8f8ad5497c44..40e50d17ebd29d484a4b6079943f10de4ebd1260 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -503,28 +503,36 @@ our %defcfg = ('dgit.default.distro' => 'debian',
               'dgit-distro.test-dummy.upload-host' => 'test-dummy',
                );
 
-sub git_get_config ($) {
-    my ($c) = @_;
+our %gitcfg;
 
-    our %git_get_config_memo;
-    if (exists $git_get_config_memo{$c}) {
-       return $git_get_config_memo{$c};
-    }
+sub git_slurp_config () {
+    local ($debuglevel) = $debuglevel-2;
+    local $/="\0";
 
-    my $v;
-    my @cmd = (@git, qw(config --), $c);
-    {
-       local ($debuglevel) = $debuglevel-2;
-       $v = cmdoutput_errok @cmd;
-    };
-    if ($?==0) {
-    } elsif ($?==256) {
-       $v = undef;
-    } else {
-       failedcmd @cmd;
+    my @cmd = (@git, qw(config -z --get-regexp .*));
+    debugcmd "|",@cmd;
+
+    open GITS, "-|", @cmd or failedcmd @cmd;
+    while (<GITS>) {
+       chomp or die;
+       printdebug "=> ", (messagequote $_), "\n";
+       m/\n/ or die "$_ ?";
+       push @{ $gitcfg{$`} }, $'; #';
     }
-    $git_get_config_memo{$c} = $v;
-    return $v;
+    $!=0; $?=0;
+    close GITS
+       or ($!==0 && $?==256)
+       or failedcmd @cmd;
+}
+
+sub git_get_config ($) {
+    my ($c) = @_;
+    my $l = $gitcfg{$c};
+    printdebug"C $c ".(defined $l ? messagequote "'$l'" : "undef")."\n"
+       if $debuglevel >= 4;
+    $l or return undef;
+    @$l==1 or badcfg "multiple values for $c" if @$l > 1;
+    return $l->[0];
 }
 
 sub cfg {
@@ -686,6 +694,11 @@ sub access_cfg (@) {
     return $value;
 }
 
+sub access_cfg_bool ($$) {
+    my ($def, @keys) = @_;
+    parse_cfg_bool($keys[0], $def, access_cfg(@keys, 'RETURN-UNDEF'));
+}
+
 sub string_to_ssh ($) {
     my ($spec) = @_;
     if ($spec =~ m/\s/) {
@@ -976,7 +989,7 @@ sub sshpsql ($$$) {
     open P, "-|", @cmd or die $!;
     while (<P>) {
        chomp or die;
-       printdebug("$debugprefix>|$_|\n");
+       printdebug(">|$_|\n");
        push @rows, $_;
     }
     $!=0; $?=0; close P or failedcmd @cmd;
@@ -1144,6 +1157,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);
@@ -1201,14 +1217,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;
@@ -1222,7 +1231,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)) {
@@ -1625,7 +1644,10 @@ sub set_local_git_config ($$) {
     runcmd @git, qw(config), $k, $v;
 }
 
-sub setup_mergechangelogs () {
+sub setup_mergechangelogs (;$) {
+    my ($always) = @_;
+    return unless $always || access_cfg_bool(1, 'setup-mergechangelogs');
+
     my $driver = 'dpkg-mergechangelogs';
     my $cb = "merge.$driver";
     my $attrs = '.git/info/attributes';
@@ -1652,6 +1674,26 @@ 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 ($) {
     my ($dstdir) = @_;
     canonicalise_suite();
@@ -1681,7 +1723,7 @@ sub clone ($) {
        $vcsgiturl =~ s/\s+-b\s+\S+//g;
        runcmd @git, qw(remote add vcs-git), $vcsgiturl;
     }
-    setup_mergechangelogs();
+    setup_new_tree();
     runcmd @git, qw(reset --hard), lrref();
     printdone "ready for work in $dstdir";
 }
@@ -3008,7 +3050,17 @@ sub cmd_clone_dgit_repos_server {
 
 sub cmd_setup_mergechangelogs {
     badusage "no arguments allowed to dgit setup-mergechangelogs" if @ARGV;
-    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();
 }
 
 #---------- argument parsing and main program ----------
@@ -3179,30 +3231,28 @@ sub finalise_opts_opts () {
        }
 
        foreach my $c (access_cfg_cfgs("opts-$k")) {
-           local ($debuglevel) = $debuglevel-2;
-           my @cmd = (@git, qw(config -z --get-all), $c);
-           my $vs = cmdoutput_errok @cmd;
-           if ($?==0) {
-               badcfg "cannot configure options for $k"
-                   if $opts_opt_cmdonly{$k};
-               my $insertpos = $opts_cfg_insertpos{$k};
-               @$om = ( @$om[0..$insertpos-1],
-                        (split /\0/, $vs),
-                        @$om[$insertpos..$#$om] );
-           } elsif ($?==256) {
-               die "$k $c ?" if length $vs;
-           } else {
-               failedcmd @cmd;
-           }
+           my $vl = $gitcfg{$c};
+           printdebug "CL $c ",
+               ($vl ? join " ", map { shellquote } @$vl : ""),
+               "\n" if $debuglevel >= 4;
+           next unless $vl;
+           badcfg "cannot configure options for $k"
+               if $opts_opt_cmdonly{$k};
+           my $insertpos = $opts_cfg_insertpos{$k};
+           @$om = ( @$om[0..$insertpos-1],
+                    @$vl,
+                    @$om[$insertpos..$#$om] );
        }
     }
 }
 
 if ($ENV{$fakeeditorenv}) {
+    git_slurp_config();
     quilt_fixup_editor();
 }
 
 parseopts();
+git_slurp_config();
 
 print STDERR "DRY RUN ONLY\n" if $dryrun_level > 1;
 print STDERR "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n"