# dgit
# Integration between git and Debian-style archives
#
-# Copyright (C)2013-2015 Ian Jackson
+# Copyright (C)2013-2016 Ian Jackson
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
'dgit-distro.debian.git-check' => 'url',
'dgit-distro.debian.git-check-suffix' => '/info/refs',
'dgit-distro.debian.new-private-pushers' => 't',
- 'dgit-distro.debian.dgit-tag-format' => 'new',
'dgit-distro.debian/push.git-url' => '',
'dgit-distro.debian/push.git-host' => 'push.dgit.debian.org',
'dgit-distro.debian/push.git-user-force' => 'dgit',
'dgit-distro.test-dummy.upload-host' => 'test-dummy',
);
-our %gitcfg;
+our %gitcfgs;
+our @gitcfgsources = qw(cmdline local global system);
sub git_slurp_config () {
local ($debuglevel) = $debuglevel-2;
local $/="\0";
- my @cmd = (@git, qw(config -z --get-regexp .*));
- debugcmd "|",@cmd;
-
- open GITS, "-|", @cmd or die $!;
- while (<GITS>) {
- chomp or die;
- printdebug "=> ", (messagequote $_), "\n";
- m/\n/ or die "$_ ?";
- push @{ $gitcfg{$`} }, $'; #';
+ # This algoritm is a bit subtle, but this is needed so that for
+ # options which we want to be single-valued, we allow the
+ # different config sources to override properly. See #835858.
+ foreach my $src (@gitcfgsources) {
+ next if $src eq 'cmdline';
+ # we do this ourselves since git doesn't handle it
+
+ my @cmd = (@git, qw(config -z --get-regexp), "--$src", qw(.*));
+ debugcmd "|",@cmd;
+
+ open GITS, "-|", @cmd or die $!;
+ while (<GITS>) {
+ chomp or die;
+ printdebug "=> ", (messagequote $_), "\n";
+ m/\n/ or die "$_ ?";
+ push @{ $gitcfgs{$src}{$`} }, $'; #';
+ }
+ $!=0; $?=0;
+ close GITS
+ or ($!==0 && $?==256)
+ or failedcmd @cmd;
}
- $!=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];
+ foreach my $src (@gitcfgsources) {
+ my $l = $gitcfgs{$src}{$c};
+ printdebug"C $c ".(defined $l ? messagequote "'$l'" : "undef")."\n"
+ if $debuglevel >= 4;
+ $l or next;
+ @$l==1 or badcfg "multiple values for $c".
+ " (in $src git config)" if @$l > 1;
+ return $l->[0];
+ }
+ return undef;
}
sub cfg {
printdebug "import clog $r1clogp->{version} becomes r1\n";
}
die $! if CLOGS->error;
- close CLOGS or $?==(SIGPIPE<<8) or failedcmd @clogcmd;
+ close CLOGS or $?==SIGPIPE or failedcmd @clogcmd;
$clogp or fail "package changelog has no entries!";
push @specs, qw(heads/*) if deliberately_not_fast_forward;
# This is rather miserable:
- # When git-fetch --prune is passed a fetchspec ending with a *,
+ # When git fetch --prune is passed a fetchspec ending with a *,
# it does a plausible thing. If there is no * then:
# - it matches subpaths too, even if the supplied refspec
# starts refs, and behaves completely madly if the source
# We want to fetch a fixed ref, and we don't know in advance
# if it exists, so this is not suitable.
#
- # Our workaround is to use git-ls-remote. git-ls-remote has its
+ # Our workaround is to use git ls-remote. git ls-remote has its
# own qairks. Notably, it has the absurd multi-tail-matching
- # behaviour: git-ls-remote R refs/foo can report refs/foo AND
+ # behaviour: git ls-remote R refs/foo can report refs/foo AND
# refs/refs/foo etc.
#
# Also, we want an idempotent snapshot, but we have to make two
- # calls to the remote: one to git-ls-remote and to git-fetch. The
- # solution is use git-ls-remote to obtain a target state, and
- # git-fetch to try to generate it. If we don't manage to generate
+ # calls to the remote: one to git ls-remote and to git fetch. The
+ # solution is use git ls-remote to obtain a target state, and
+ # git fetch to try to generate it. If we don't manage to generate
# the target state, we try again.
my $specre = join '|', map {
my ($objid,$rrefname) = ($1,$2);
if (!$wanted_rref->($rrefname)) {
print STDERR <<END;
-warning: git-ls-remote @look reported $rrefname; this is silly, ignoring it.
+warning: git ls-remote @look reported $rrefname; this is silly, ignoring it.
END
next;
}
if (!exists $wantr{$rrefname}) {
if ($wanted_rref->($rrefname)) {
printdebug <<END;
-git-fetch @fspecs created $lrefname which git-ls-remote @look didn't list.
+git-fetch @fspecs created $lrefname which git ls-remote @look didn't list.
END
} else {
print STDERR <<END
-warning: git-fetch @fspecs created $lrefname; this is silly, deleting it.
+warning: git fetch @fspecs created $lrefname; this is silly, deleting it.
END
}
runcmd_ordryrun_local @git, qw(update-ref -d), $lrefname;
next if $got eq $want;
if (!defined $objgot{$want}) {
print STDERR <<END;
-warning: git-ls-remote suggests we want $lrefname
+warning: git ls-remote suggests we want $lrefname
warning: and it should refer to $want
-warning: but git-fetch didn't fetch that object to any relevant ref.
+warning: but git fetch didn't fetch that object to any relevant ref.
warning: This may be due to a race with someone updating the server.
warning: Will try again...
END
next FETCH_ITERATION;
}
printdebug <<END;
-git-fetch @fspecs made $lrefname=$got but want git-ls-remote @look says $want
+git-fetch @fspecs made $lrefname=$got but want git ls-remote @look says $want
END
runcmd_ordryrun_local @git, qw(update-ref -m),
- "dgit fetch git-fetch fixup", $lrefname, $want;
+ "dgit fetch git fetch fixup", $lrefname, $want;
$lrfetchrefs_f{$lrefname} = $want;
}
last;
}
- printdebug "git_fetch_us: git-fetch --no-insane emulation complete\n",
+ printdebug "git_fetch_us: git fetch --no-insane emulation complete\n",
Dumper(\%lrfetchrefs_f);
my %here;
return $dgitview if is_fast_fwd $archive_hash, $dgitview;
- my $t_dep14 = debiantag_maintview $i_arch_v->[0], access_basedistro;
- my $i_dep14 = infopair_lrf_tag_lookup($t_dep14, "maintainer view tag");
- my $t_dgit = debiantag_new $i_arch_v->[0], access_basedistro;
- my $i_dgit = infopair_lrf_tag_lookup($t_dgit, "dgit view tag");
- my $i_archive = [ $archive_hash, "current archive contents" ];
-
- printdebug "splitbrain_pseudomerge i_archive @$i_archive\n";
-
- infopair_cond_equal($i_dgit, $i_archive);
- infopair_cond_ff($i_dep14, $i_dgit);
- $overwrite_version // infopair_cond_ff($i_dep14, [ $maintview, 'HEAD' ]);
+ if (defined $overwrite_version) {
+ } elsif (!eval {
+ my $t_dep14 = debiantag_maintview $i_arch_v->[0], access_basedistro;
+ my $i_dep14 = infopair_lrf_tag_lookup($t_dep14, "maintainer view tag");
+ my $t_dgit = debiantag_new $i_arch_v->[0], access_basedistro;
+ my $i_dgit = infopair_lrf_tag_lookup($t_dgit, "dgit view tag");
+ my $i_archive = [ $archive_hash, "current archive contents" ];
+
+ printdebug "splitbrain_pseudomerge i_archive @$i_archive\n";
+
+ infopair_cond_equal($i_dgit, $i_archive);
+ infopair_cond_ff($i_dep14, $i_dgit);
+ infopair_cond_ff($i_dep14, [ $maintview, 'HEAD' ]);
+ 1;
+ }) {
+ print STDERR <<END;
+$us: check failed (maybe --overwrite is needed, consult documentation)
+END
+ die "$@";
+ }
my $r = pseudomerge_make_commit
$clogp, $dgitview, $archive_hash, $i_arch_v,
"dgit --quilt=$quilt_mode",
(defined $overwrite_version ? <<END_OVERWR : <<END_MAKEFF);
-Declare fast forward from $overwrite_version
+Declare fast forward from $i_arch_v->[0]
END_OVERWR
Make fast forward from $i_arch_v->[0]
END_MAKEFF
my $i_arch_v = pseudomerge_version_check($clogp, $archive_hash);
- my @tagformats = access_cfg_tagformats();
- my @t_overwr =
- map { $_->($i_arch_v->[0], access_basedistro) }
- (grep { m/^(?:old|hist)$/ } @tagformats)
- ? \&debiantags : \&debiantag_new;
- my $i_overwr = infopair_lrf_tag_lookup \@t_overwr, "previous version tag";
- my $i_archive = [ $archive_hash, "current archive contents" ];
-
- infopair_cond_equal($i_overwr, $i_archive);
-
return $head if is_fast_fwd $archive_hash, $head;
my $m = "Declare fast forward from $i_arch_v->[0]";
$upstreamversion =~ s/-[^-]*$//;
changedir $ud;
quilt_make_fake_dsc($upstreamversion);
- my ($dgitview, $cachekey) =
+ my $cachekey;
+ ($dgithead, $cachekey) =
quilt_check_splitbrain_cache($actualhead, $upstreamversion);
- $dgitview or fail
+ $dgithead or fail
"--quilt=$quilt_mode but no cached dgit view:
perhaps tree changed since dgit build[-source] ?";
$split_brain = 1;
$dgithead = splitbrain_pseudomerge($clogp,
- $actualhead, $dgitview,
+ $actualhead, $dgithead,
$archive_hash);
$maintviewhead = $actualhead;
changedir '../../../..';
my ($tree,$dir) = mktree_in_ud_from_only_subdir();
check_for_vendor_patches() if madformat($dsc->{format});
changedir '../../../..';
- my $diffopt = $debuglevel>0 ? '--exit-code' : '--quiet';
- my @diffcmd = (@git, qw(diff), $diffopt, $tree, $dgithead);
+ my @diffcmd = (@git, qw(diff --quiet), $tree, $dgithead);
debugcmd "+",@diffcmd;
$!=0; $?=-1;
my $r = system @diffcmd;
if ($r) {
if ($r==256) {
- fail "$dscfn specifies a different tree to your HEAD commit;".
- " perhaps you forgot to build".
- ($diffopt eq '--exit-code' ? "" :
- " (run with -D to see full diff output)");
+ my $diffs = cmdoutput @git, qw(diff --stat), $tree, $dgithead;
+ fail <<END
+HEAD specifies a different tree to $dscfn:
+$diffs
+Perhaps you forgot to build. Or perhaps there is a problem with your
+ source tree (see dgit(7) for some hints). To see a full diff, run
+ git diff $tree HEAD
+END
} else {
failedcmd @diffcmd;
}
}
if (stat $dstdir) {
rmtree($dstdir) or die "remove $dstdir: $!\n";
- } elsif (!grep { $! == $_ }
+ } elsif (grep { $! == $_ }
(ENOENT, ENOTDIR, EACCES, EPERM, ELOOP)) {
} else {
print STDERR "check whether to remove $dstdir: $!\n";
my $dgitview = git_rev_parse 'refs/heads/dgit-view';
changedir '../../../..';
+ # When we no longer need to support squeeze, use --create-reflog
+ # instead of this:
ensuredir ".git/logs/refs/dgit-intern";
my $makelogfh = new IO::File ".git/logs/refs/$splitbraincache", '>>'
or die $!;
+
+ my $oldcache = git_get_ref "refs/$splitbraincache";
+ if ($oldcache eq $dgitview) {
+ my $tree = cmdoutput qw(git rev-parse), "$dgitview:";
+ # git update-ref doesn't always update, in this case. *sigh*
+ my $dummy = make_commit_text <<END;
+tree $tree
+parent $dgitview
+author Dgit <dgit\@example.com> 1000000000 +0000
+committer Dgit <dgit\@example.com> 1000000000 +0000
+
+Dummy commit - do not use
+END
+ runcmd @git, qw(update-ref -m), "dgit $our_version - dummy",
+ "refs/$splitbraincache", $dummy;
+ }
runcmd @git, qw(update-ref -m), $cachekey, "refs/$splitbraincache",
$dgitview;
if (!defined $patchname) {
$patchname = $title;
$patchname =~ s/[.:]$//;
+ use Text::Iconv;
+ eval {
+ my $converter = new Text::Iconv qw(UTF-8 ASCII//TRANSLIT);
+ my $translitname = $converter->convert($patchname);
+ die unless defined $translitname;
+ $patchname = $translitname;
+ };
+ print STDERR
+ "dgit: patch title transliteration error: $@"
+ if $@;
$patchname =~ y/ A-Z/-a-z/;
$patchname =~ y/-a-z0-9_.+=~//cd;
$patchname =~ s/^\W/x-$&/;
my $srcshash = Digest::SHA->new(256);
my %sfs = ( %INC, '$0(dgit)' => $0 );
foreach my $sfk (sort keys %sfs) {
- next unless m/^\$0\b/ || m{^Debian/Dgit\b};
+ next unless $sfk =~ m/^\$0\b/ || $sfk =~ m{^Debian/Dgit\b};
$srcshash->add($sfk," ");
$srcshash->add(hashfile($sfs{$sfk}));
$srcshash->add("\n");
push @cachekey, $srcshash->hexdigest();
$splitbrain_cachekey = "@cachekey";
- my @cmd = (@git, qw(reflog), '--pretty=format:%H %gs',
+ my @cmd = (@git, qw(log -g), '--pretty=format:%H %gs',
$splitbraincache);
printdebug "splitbrain cachekey $splitbrain_cachekey\n";
debugcmd "|(probably)",@cmd;
# 2. Copy .pc from the fake's extraction, if necessary
# 3. Run dpkg-source --commit
# 4. If the result has changes to debian/, then
- # - git-add them them
- # - git-add .pc if we had a .pc in-tree
- # - git-commit
- # 5. If we had a .pc in-tree, delete it, and git-commit
+ # - git add them them
+ # - git add .pc if we had a .pc in-tree
+ # - git commit
+ # 5. If we had a .pc in-tree, delete it, and git commit
# 6. Back in the main tree, fast forward to the new HEAD
# Another situation we may have to cope with is gbp-style
# We would want to detect these, so we know to escape into
# quilt_fixup_gbp. However, this is in general not possible.
# Consider a package with a one patch which the dgit user reverts
- # (with git-revert or the moral equivalent).
+ # (with git revert or the moral equivalent).
#
# That is indistinguishable in contents from a patches-unapplied
# tree. And looking at the history to distinguish them is not
}
maybe_unapply_patches_again();
if ($wantsrc < 2) {
- unless (grep { m/^--git-debian-branch|^--git-ignore-branch/ } @ARGV) {
- canonicalise_suite();
- push @cmd, "--git-debian-branch=".lbranch();
- }
push @cmd, changesopts();
runcmd_ordryrun_local @cmd, @ARGV;
}
if (!$rmchanges) {
my @unwanted = map { s#^\.\./##; $_; } glob "../$pat";
@unwanted = grep { $_ ne changespat $version,'source' } @unwanted;
- fail "changes files other than source matching $pat".
- " already present (@unwanted);".
- " building would result in ambiguity about the intended results"
+ fail <<END
+changes files other than source matching $pat already present; building would result in ambiguity about the intended results.
+Suggest you delete @unwanted.
+END
if @unwanted;
}
my $wasdir = must_getcwd();
($b =~ m/_source\.changes$/ <=> $a =~ m/_source\.changes$/)
or $a cmp $b
} @changesfiles;
+ fail <<END if @changesfiles==1;
+only one changes file from sbuild (@changesfiles)
+perhaps you need to pass -A ? (sbuild's default is to build only
+arch-specific binaries; dgit 1.4 used to override that.)
+END
fail "wrong number of different changes files (@changesfiles)"
unless @changesfiles==2;
my $binchanges = parsecontrol($changesfiles[1], "binary changes file");
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#^(.*)/##) {
} elsif (s/^-wc$//s) {
push @ropts, $&;
$cleanmode = 'check';
+ } elsif (s/^-c([^=]*)\=(.*)$//s) {
+ push @git, '-c', $&;
+ $gitcfgs{cmdline}{$1} = [ $2 ];
+ } elsif (s/^-c([^=]+)$//s) {
+ push @git, '-c', $&;
+ $gitcfgs{cmdline}{$1} = [ 'true' ];
} elsif (m/^-[a-zA-Z]/ && ($oi = $valopts_short{$&})) {
$val = $'; #';
$val = undef unless length $val;
}
}
+sub check_env_sanity () {
+ my $blocked = new POSIX::SigSet;
+ sigprocmask SIG_UNBLOCK, $blocked, $blocked or die $!;
+
+ eval {
+ foreach my $name (qw(PIPE CHLD)) {
+ my $signame = "SIG$name";
+ my $signum = eval "POSIX::$signame" // die;
+ ($SIG{$name} // 'DEFAULT') eq 'DEFAULT' or
+ die "$signame is set to something other than SIG_DFL\n";
+ $blocked->ismember($signum) and
+ die "$signame is blocked\n";
+ }
+ };
+ return unless $@;
+ chomp $@;
+ fail <<END;
+On entry to dgit, $@
+This is a bug produced by something in in your execution environment.
+Giving up.
+END
+}
+
+
sub finalise_opts_opts () {
foreach my $k (keys %opts_opt_map) {
my $om = $opts_opt_map{$k};
}
foreach my $c (access_cfg_cfgs("opts-$k")) {
- my $vl = $gitcfg{$c};
- printdebug "CL $c ",
- ($vl ? join " ", map { shellquote } @$vl : ""),
+ my @vl =
+ map { $_ ? @$_ : () }
+ map { $gitcfgs{$_}{$c} }
+ reverse @gitcfgsources;
+ printdebug "CL $c ", (join " ", map { shellquote } @vl),
"\n" if $debuglevel >= 4;
- next unless $vl;
+ 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,
+ @vl,
@$om[$insertpos..$#$om] );
}
}
}
parseopts();
+check_env_sanity();
git_slurp_config();
print STDERR "DRY RUN ONLY\n" if $dryrun_level > 1;
~ianmdlvl / dgit.git / blobdiff