use IPC::Open2;
use Digest::SHA;
use Digest::MD5;
-use List::Util qw(any);
use List::MoreUtils qw(pairwise);
use Text::Glob qw(match_glob);
use Fcntl qw(:DEFAULT :flock);
our $quilt_mode;
our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck|gbp|dpm|unapplied';
our $dodep14tag;
-our $dodep14tag_re = 'want|no|always';
our $split_brain_save;
our $we_are_responder;
our $we_are_initiator;
} keys %opts_opt_map;
sub parseopts_late_defaults();
+sub setup_gitattrs(;$);
+sub check_gitattrs($$);
our $keyid;
END {
local ($@, $?);
+ return unless forkcheck_mainprocess();
print STDERR "! $_\n" foreach $supplementary_message =~ m/^.+$/mg;
}
our @end;
END {
local ($?);
+ return unless forkcheck_mainprocess();
foreach my $f (@end) {
eval { $f->(); };
print STDERR "$us: cleanup: $@" if length $@;
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"
return [ (getfield $pre_dsc, 'Version'), $uri ];
}
+sub file_in_archive_aptget () { return undef; }
+
#---------- `dummyapicat' archive query method ----------
sub archive_query_dummycatapi { archive_query_ftpmasterapi @_; }
runcmd qw(git config gc.auto 0);
rmtree('.git/objects');
symlink '../../../../objects','.git/objects' or die $!;
+ setup_gitattrs(1);
}
sub git_write_tree () {
# (If we deleted them unconditionally, then we might end up
# re-fetching the same git objects each time dgit fetch was run.)
#
-# So, leach use of lrfetchrefs needs to be accompanied by arrangements
+# So, each use of lrfetchrefs needs to be accompanied by arrangements
# in git_fetch_us to fetch the refs in question, and possibly a call
# to 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
# 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 {
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);
} elsif ($here{$lref} eq $objid) {
lrfetchref_used $fullrefname;
} else {
- print STDERR \
- "Not updateting $lref from $here{$lref} to $objid.\n";
+ print STDERR
+ "Not updating $lref from $here{$lref} to $objid.\n";
}
});
}
}
}
+sub parse_dsc_field_def_dsc_distro () {
+ $dsc_distro //= cfg qw(dgit.default.old-dsc-distro
+ dgit.default.distro);
+}
+
sub parse_dsc_field ($$) {
my ($dsc, $what) = @_;
my $f;
$f = $dsc->{$field};
last if defined $f;
}
+
if (!defined $f) {
progress "$what: NO git hash";
+ parse_dsc_field_def_dsc_distro();
} elsif (($dsc_hash, $dsc_distro, $dsc_hint_tag, $dsc_hint_url)
= $f =~ m/^(\w+)\s+($distro_re)\s+($versiontag_re)\s+(\S+)(?:\s|$)/) {
progress "$what: specified git info ($dsc_distro)";
$dsc_hint_tag = [ $dsc_hint_tag ];
} elsif ($f =~ m/^\w+\s*$/) {
$dsc_hash = $&;
- $dsc_distro //= cfg qw(dgit.default.old-dsc-distro
- dgit.default.distro);
+ parse_dsc_field_def_dsc_distro();
$dsc_hint_tag = [ debiantags +(getfield $dsc, 'Version'),
$dsc_distro ];
progress "$what: specified git hash";
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;
};
END
foreach my $t (@tags) {
my $fullrefname = $lrf.'/'.$t;
- print STDERR "CHK $t $fullrefname ".Dumper(\%lrfetchrefs_f);
+# print STDERR "CHK $t $fullrefname ".Dumper(\%lrfetchrefs_f);
next unless $lrfetchrefs_f{$fullrefname};
next unless is_fast_fwd "$fullrefname~0", $dsc_hash;
lrfetchref_used $fullrefname;
lrfetchref_used lrfetchref();
+ check_gitattrs($hash, "fetched source tree");
+
unshift @end, $del_lrfetchrefs;
return $hash;
}
set_local_git_config $k, 'true';
}
+sub open_gitattrs () {
+ my $gai = new IO::File ".git/info/attributes"
+ or $!==ENOENT
+ or die "open .git/info/attributes: $!";
+ return $gai;
+}
+
+sub is_gitattrs_setup () {
+ my $gai = open_gitattrs();
+ return 0 unless $gai;
+ while (<$gai>) {
+ return 1 if m{^\[attr\]dgit-defuse-attrs\s};
+ }
+ $gai->error and die $!;
+ return 0;
+}
+
+sub setup_gitattrs (;$) {
+ my ($always) = @_;
+ return unless $always || access_cfg_bool(1, 'setup-gitattributes');
+
+ if (is_gitattrs_setup()) {
+ progress <<END;
+[attr]dgit-defuse-attrs already found in .git/info/attributes
+ not doing further gitattributes setup
+END
+ return;
+ }
+ my $af = ".git/info/attributes";
+ open GAO, "> $af.new" or die $!;
+ print GAO <<END or die $!;
+* dgit-defuse-attrs
+[attr]dgit-defuse-attrs -text -eol -crlf -ident -filter
+# ^ see GITATTRIBUTES in dgit(7) and dgit setup-new-tree in dgit(1)
+END
+ my $gai = open_gitattrs();
+ if ($gai) {
+ while (<$gai>) {
+ chomp;
+ print GAO $_, "\n" or die $!;
+ }
+ $gai->error and die $!;
+ }
+ close GAO or die $!;
+ rename "$af.new", "$af" or die "install $af: $!";
+}
+
sub setup_new_tree () {
setup_mergechangelogs();
setup_useremail();
+ setup_gitattrs();
}
+sub check_gitattrs ($$) {
+ my ($treeish, $what) = @_;
+
+ return if is_gitattrs_setup;
+
+ local $/="\0";
+ my @cmd = (@git, qw(ls-tree -lrz --), "${treeish}:");
+ debugcmd "|",@cmd;
+ my $gafl = new IO::File;
+ open $gafl, "-|", @cmd or die $!;
+ while (<$gafl>) {
+ chomp or die;
+ s/^\d+\s+\w+\s+\w+\s+(\d+)\t// or die;
+ next if $1 == 0;
+ next unless m{(?:^|/)\.gitattributes$};
+
+ # oh dear, found one
+ print STDERR <<END;
+dgit: warning: $what contains .gitattributes
+dgit: .gitattributes have not been defused. Recommended: dgit setup-new-tree.
+END
+ close $gafl;
+ return;
+ }
+ # tree contains no .gitattributes files
+ $?=0; $!=0; close $gafl or failedcmd @cmd;
+}
+
+
sub multisuite_suite_child ($$$) {
my ($tsuite, $merginputs, $fn) = @_;
# in child, sets things up, calls $fn->(), and returns undef
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) {
$vcsgiturl =~ s/\s+-b\s+\S+//g;
runcmd @git, qw(remote add vcs-git), $vcsgiturl;
}
- setup_new_tree();
clone_finish($dstdir);
}
}
}
-END { i_cleanup(); }
+END {
+ return unless forkcheck_mainprocess();
+ i_cleanup();
+}
sub i_method {
my ($base,$selector,@args) = @_;
build_maybe_quilt_fixup();
}
+sub import_dsc_result {
+ my ($dstref, $newhash, $what_log, $what_msg) = @_;
+ my @cmd = (@git, qw(update-ref -m), $what_log, $dstref, $newhash);
+ runcmd @cmd;
+ check_gitattrs($newhash, "source tree");
+
+ progress "dgit: import-dsc: $what_msg";
+}
+
sub cmd_import_dsc {
my $needsig = 0;
parse_dsc_field($dsc, "Dgit metadata in .dsc")
unless forceing [qw(import-dsc-with-dgit-field)];
+ parse_dsc_field_def_dsc_distro();
+
+ $isuite = 'DGIT-IMPORT-DSC';
+ $idistro //= $dsc_distro;
+
+ notpushing();
if (defined $dsc_hash) {
progress "dgit: import-dsc of .dsc with Dgit field, using git hash";
fail "Not fast forward to $dsc_hash";
}
}
- @cmd = (@git, qw(update-ref -m), "dgit import-dsc (Dgit): $info",
- $dstbranch, $dsc_hash);
- runcmd @cmd;
- progress "dgit: import-dsc updated git ref $dstbranch";
+ import_dsc_result $dstbranch, $dsc_hash,
+ "dgit import-dsc (Dgit): $info",
+ "updated git ref $dstbranch";
return 0;
}
END
if $oldhash && !$force;
- notpushing();
-
my @dfi = dsc_files_info();
foreach my $fi (@dfi) {
my $f = $fi->{Filename};
}
}
- my @cmd = (@git, qw(update-ref -m), "dgit import-dsc: $info",
- $dstbranch, $newhash);
- runcmd @cmd;
- progress "dgit: import-dsc results are in in git ref $dstbranch";
+ import_dsc_result $dstbranch, $newhash,
+ "dgit import-dsc: $info",
+ "results are in in git ref $dstbranch";
}
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";
}
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 $!;
}
setup_useremail(1);
}
+sub cmd_setup_gitattributes {
+ badusage "no arguments allowed to dgit setup-useremail" if @ARGV;
+ setup_gitattrs(1);
+}
+
sub cmd_setup_new_tree {
badusage "no arguments allowed to dgit setup-tree" if @ARGV;
setup_new_tree();
}
our (%valopts_long, %valopts_short);
+our (%funcopts_long);
our @rvalopts;
+our (@modeopt_cfgs);
sub defvalopt ($$$$) {
my ($long,$short,$val_re,$how) = @_;
" absolute, not relative, directory."
};
+sub defoptmodes ($@) {
+ my ($varref, $cfgkey, $default, %optmap) = @_;
+ my %permit;
+ while (my ($opt,$val) = each %optmap) {
+ $funcopts_long{$opt} = sub { $$varref = $val; };
+ $permit{$val} = $val;
+ }
+ push @modeopt_cfgs, {
+ Var => $varref,
+ Key => $cfgkey,
+ Default => $default,
+ Vals => \%permit
+ };
+}
+
+defoptmodes \$dodep14tag, qw( dep14tag want
+ --dep14tag want
+ --no-dep14tag no
+ --always-dep14tag always );
+
sub parseopts () {
my $om;
} elsif (m/^--overwrite=(.+)$/s) {
push @ropts, $_;
$overwrite_version = $1;
- } elsif (m/^--dep14tag$/s) {
- push @ropts, $_;
- $dodep14tag= 'want';
- } elsif (m/^--no-dep14tag$/s) {
- push @ropts, $_;
- $dodep14tag= 'no';
- } elsif (m/^--always-dep14tag$/s) {
- push @ropts, $_;
- $dodep14tag= 'always';
} elsif (m/^--delayed=(\d+)$/s) {
push @ropts, $_;
push @dput, $_;
} elsif (m/^(--[-0-9a-z]+)(=|$)/ && ($oi = $valopts_long{$1})) {
$val = $2 ? $' : undef; #';
$valopt->($oi->{Long});
+ } elsif ($funcopts_long{$_}) {
+ push @ropts, $_;
+ $funcopts_long{$_}();
} else {
badusage "unknown long option \`$_'";
}
$quilt_mode = $1;
}
- if (!defined $dodep14tag) {
+ foreach my $moc (@modeopt_cfgs) {
local $access_forpush;
- $dodep14tag = access_cfg('dep14tag', 'RETURN-UNDEF') // 'want';
- $dodep14tag =~ m/^($dodep14tag_re)$/
- or badcfg "unknown dep14tag setting \`$dodep14tag'";
- $dodep14tag = $1;
+ my $vr = $moc->{Var};
+ next if defined $$vr;
+ $$vr = access_cfg($moc->{Key}, 'RETURN-UNDEF') // $moc->{Default};
+ my $v = $moc->{Vals}{$$vr};
+ badcfg "unknown $moc->{Key} setting \`$$vr'" unless defined $v;
+ $$vr = $v;
}
$need_split_build_invocation ||= quiltmode_splitbrain();
~ianmdlvl / dgit.git / blobdiff