server_branch server_ref
stat_exists link_ltarget
hashfile
- fail ensuredir must_getcwd executable_on_path
+ fail failmsg ensuredir must_getcwd executable_on_path
waitstatusmsg failedcmd_waitstatus
failedcmd_report_cmd failedcmd
- runcmd cmdoutput cmdoutput_errok
+ runcmd shell_cmd cmdoutput cmdoutput_errok
git_rev_parse git_cat_file
git_get_ref git_get_symref git_for_each_ref
git_for_each_tag_referring is_fast_fwd
+ git_check_unmodified
+ git_reflog_action_msg git_update_ref_cmd
$package_re $component_re $deliberately_re
$distro_re $versiontag_re $series_filename_re
+ $extra_orig_namepart_re
+ $git_null_obj
$branchprefix
+ $ffq_refprefix $gdrlast_refprefix
initdebug enabledebug enabledebuglevel
printdebug debugcmd
$debugprefix *debuglevel *DEBUG
shellquote printcmd messagequote
$negate_harmful_gitattrs
changedir git_slurp_config_src
+ gdr_ffq_prev_branchinfo
playtree_setup);
# implicitly uses $main::us
%EXPORT_TAGS = ( policyflags => [qw(NOFFCHECK FRESHREPO NOCOMMITCHECK)],
our $versiontag_re = qr{[-+.\%_0-9a-zA-Z/]+};
our $branchprefix = 'dgit';
our $series_filename_re = qr{(?:^|\.)series(?!\n)$}s;
+our $extra_orig_namepart_re = qr{[-0-9a-z]+};
+our $git_null_obj = '0' x 40;
+our $ffq_refprefix = 'ffq-prev';
+our $gdrlast_refprefix = 'debrebase-last';
# policy hook exit status bits
# see dgit-repos-server head comment for documentation
our $debugprefix;
our $debuglevel = 0;
-our $negate_harmful_gitattrs = "-text -eol -crlf -ident -filter";
+our $negate_harmful_gitattrs =
+ "-text -eol -crlf -ident -filter -working-tree-encoding";
+ # ^ when updating this, alter the regexp in dgit:is_gitattrs_setup
our $forkcheck_mainprocess;
$::us // ($0 =~ m#[^/]*$#, $&);
}
-sub fail {
- my $s = "@_\n";
+sub failmsg {
+ my $s = "error: @_\n";
$s =~ s/\n\n$/\n/;
my $prefix = _us().": ";
$s =~ s/^/$prefix/gm;
- die $s;
+ return "\n".$s;
+}
+
+sub fail {
+ die failmsg @_;
}
sub ensuredir ($) {
failedcmd @_ if system @_;
}
+sub shell_cmd {
+ my ($first_shell, @cmd) = @_;
+ return qw(sh -ec), $first_shell.'; exec "$@"', 'x', @cmd;
+}
+
sub cmdoutput_errok {
confess Dumper(\@_)." ?" if grep { !defined } @_;
debugcmd "|",@_;
});
}
+sub git_check_unmodified () {
+ foreach my $cached (qw(0 1)) {
+ my @cmd = qw(git diff --quiet);
+ push @cmd, qw(--cached) if $cached;
+ push @cmd, qw(HEAD);
+ debugcmd "+",@cmd;
+ $!=0; $?=-1; system @cmd;
+ return if !$?;
+ if ($?==256) {
+ fail
+ $cached
+ ? "git index contains changes (does not match HEAD)"
+ : "working tree is dirty (does not match HEAD)";
+ } else {
+ failedcmd @cmd;
+ }
+ }
+}
+
sub is_fast_fwd ($$) {
my ($ancestor,$child) = @_;
my @cmd = (qw(git merge-base), $ancestor, $child);
}
}
+sub git_reflog_action_msg ($) {
+ my ($msg) = @_;
+ my $rla = $ENV{GIT_REFLOG_ACTION};
+ $msg = "$rla: $msg" if length $rla;
+ return $msg;
+}
+
+sub git_update_ref_cmd {
+ # returns qw(git update-ref), qw(-m), @_
+ # except that message may be modified to honour GIT_REFLOG_ACTION
+ my $msg = shift @_;
+ $msg = git_reflog_action_msg $msg;
+ return qw(git update-ref -m), $msg, @_;
+}
+
sub changedir ($) {
my ($newdir) = @_;
printdebug "CD $newdir\n";
return $r;
}
+sub gdr_ffq_prev_branchinfo ($) {
+ my ($symref) = @_;
+ # => ('status', "message", [$symref, $ffq_prev, $gdrlast])
+ # 'status' may be
+ # branch message is undef
+ # weird-symref } no $symref,
+ # notbranch } no $ffq_prev
+ return ('detached', 'detached HEAD') unless defined $symref;
+ return ('weird-symref', 'HEAD symref is not to refs/')
+ unless $symref =~ m{^refs/};
+ my $ffq_prev = "refs/$ffq_refprefix/$'";
+ my $gdrlast = "refs/$gdrlast_refprefix/$'";
+ printdebug "ffq_prev_branchinfo branch current $symref\n";
+ return ('branch', undef, $symref, $ffq_prev, $gdrlast);
+}
+
# ========== playground handling ==========
# terminology: