X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=40e50d17ebd29d484a4b6079943f10de4ebd1260;hp=7d2023e5c91ab266d3c94a81b9cd8f8ad5497c44;hb=daa72e2ec119b82756efa0ead41d9e6a29e35d3a;hpb=c31333cd83a4262af8e54d96311d1368b66909cc diff --git a/dgit b/dgit index 7d2023e5..40e50d17 100755 --- 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 () { + 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 (

) { 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"