X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=Debian%2FDgit.pm;h=91d4c7111f57dc80a16943714f38fe66850e0dfb;hb=45abe880e0efbdc3834168f4fd384678e1c30a51;hp=066915b4e6008692c7265b1cc8ce2702a4bc9142;hpb=98f793a762f743f59663dcf61935a3648719fc4c;p=dgit.git diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm index 066915b4..91d4c711 100644 --- a/Debian/Dgit.pm +++ b/Debian/Dgit.pm @@ -32,6 +32,7 @@ use IPC::Open2; use File::Path; use File::Basename; use Dpkg::Control::Hash; +use Debian::Dgit::ExitStatus; BEGIN { use Exporter (); @@ -42,6 +43,9 @@ BEGIN { @EXPORT = qw(setup_sigwarn forkcheck_setup forkcheck_mainprocess dep14_version_mangle debiantags debiantag_old debiantag_new + debiantag_maintview + upstreamversion + stripepoch source_file_leafname is_orig_file_of_p_v server_branch server_ref stat_exists link_ltarget hashfile @@ -54,14 +58,18 @@ BEGIN { git_for_each_tag_referring is_fast_fwd git_check_unmodified git_reflog_action_msg git_update_ref_cmd + make_commit_text + reflog_cache_insert reflog_cache_lookup $package_re $component_re $deliberately_re $distro_re $versiontag_re $series_filename_re + $orig_f_comp_re $orig_f_sig_re $orig_f_tail_re $extra_orig_namepart_re $git_null_obj $branchprefix $ffq_refprefix $gdrlast_refprefix initdebug enabledebug enabledebuglevel printdebug debugcmd + $printdebug_when_debuglevel $debugcmd_when_debuglevel $debugprefix *debuglevel *DEBUG shellquote printcmd messagequote $negate_harmful_gitattrs @@ -90,9 +98,19 @@ 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 $orig_f_comp_re = qr{orig(?:-$extra_orig_namepart_re)?}; +our $orig_f_sig_re = '\\.(?:asc|gpg|pgp)'; +our $orig_f_tail_re = "$orig_f_comp_re\\.tar(?:\\.\\w+)?(?:$orig_f_sig_re)?"; our $git_null_obj = '0' x 40; our $ffq_refprefix = 'ffq-prev'; our $gdrlast_refprefix = 'debrebase-last'; +our $printdebug_when_debuglevel = 1; +our $debugcmd_when_debuglevel = 1; + +# these three all go together, only valid after record_maindir +our $maindir; +our $maindir_gitdir; +our $maindir_gitcommon; # policy hook exit status bits # see dgit-repos-server head comment for documentation @@ -149,7 +167,21 @@ sub enabledebuglevel ($) { } sub printdebug { - print DEBUG $debugprefix, @_ or die $! if $debuglevel>0; + # Prints a prefix, and @_, to DEBUG. @_ should normally contain + # a trailing \n. + + # With no (or only empty) arguments just prints the prefix and + # leaves the caller to do more with DEBUG. The caller should make + # sure then to call printdebug with something ending in "\n" to + # get the prefix right in subsequent calls. + + return unless $debuglevel >= $printdebug_when_debuglevel; + our $printdebug_noprefix; + print DEBUG $debugprefix unless $printdebug_noprefix; + pop @_ while @_ and !length $_[-1]; + return unless @_; + print DEBUG @_ or die $!; + $printdebug_noprefix = $_[-1] !~ m{\n$}; } sub messagequote ($) { @@ -188,7 +220,8 @@ sub printcmd { sub debugcmd { my $extraprefix = shift @_; - printcmd(\*DEBUG,$debugprefix.$extraprefix,@_) if $debuglevel>0; + printcmd(\*DEBUG,$debugprefix.$extraprefix,@_) + if $debuglevel >= $debugcmd_when_debuglevel; } sub dep14_version_mangle ($) { @@ -209,11 +242,40 @@ sub debiantag_new ($$) { return "archive/$distro/".dep14_version_mangle $v; } +sub debiantag_maintview ($$) { + my ($v,$distro) = @_; + return "$distro/".dep14_version_mangle $v; +} + sub debiantags ($$) { my ($version,$distro) = @_; map { $_->($version, $distro) } (\&debiantag_new, \&debiantag_old); } +sub stripepoch ($) { + my ($vsn) = @_; + $vsn =~ s/^\d+\://; + return $vsn; +} + +sub upstreamversion ($) { + my ($vsn) = @_; + $vsn =~ s/-[^-]+$//; + return $vsn; +} + +sub source_file_leafname ($$$) { + my ($package,$vsn,$sfx) = @_; + return "${package}_".(stripepoch $vsn).$sfx +} + +sub is_orig_file_of_p_v ($$$) { + my ($f, $package, $upstreamvsn) = @_; + my $base = source_file_leafname $package, $upstreamvsn, ''; + return 0 unless $f =~ m/^\Q$base\E\.$orig_f_tail_re$/; + return 1; +} + sub server_branch ($) { return "$branchprefix/$_[0]"; } sub server_ref ($) { return "refs/".server_branch($_[0]); } @@ -230,7 +292,7 @@ sub _us () { sub failmsg { my $s = "error: @_\n"; - $s =~ s/\n\n$/\n/; + $s =~ s/\n\n$/\n/g; my $prefix = _us().": "; $s =~ s/^/$prefix/gm; return "\n".$s; @@ -326,6 +388,7 @@ sub shell_cmd { sub cmdoutput_errok { confess Dumper(\@_)." ?" if grep { !defined } @_; + local $printdebug_when_debuglevel = $debugcmd_when_debuglevel; debugcmd "|",@_; open P, "-|", @_ or die "$_[0] $!"; my $d; @@ -378,6 +441,7 @@ sub git_cat_file ($;$) { # in scalar context, just the data # if $etype defined, dies unless type is $etype or in @$etype our ($gcf_pid, $gcf_i, $gcf_o); + local $printdebug_when_debuglevel = $debugcmd_when_debuglevel; my $chk = sub { my ($gtype, $data) = @_; if ($etype) { @@ -631,6 +695,88 @@ sub parsechangelog_loop ($$$) { close CLOGS or $?==SIGPIPE or failedcmd @$clogcmd; } +sub make_commit_text ($) { + my ($text) = @_; + my ($out, $in); + my @cmd = (qw(git hash-object -w -t commit --stdin)); + debugcmd "|",@cmd; + print Dumper($text) if $debuglevel > 1; + my $child = open2($out, $in, @cmd) or die $!; + my $h; + eval { + print $in $text or die $!; + close $in or die $!; + $h = <$out>; + $h =~ m/^\w+$/ or die; + $h = $&; + printdebug "=> $h\n"; + }; + close $out; + waitpid $child, 0 == $child or die "$child $!"; + $? and failedcmd @cmd; + return $h; +} + +sub reflog_cache_insert ($$$) { + my ($ref, $cachekey, $value) = @_; + # you must call this in $maindir + # you must have called record_maindir + + # When we no longer need to support squeeze, use --create-reflog + # instead of this: + my $parent = $ref; $parent =~ s{/[^/]+$}{}; + ensuredir "$maindir_gitcommon/logs/$parent"; + my $makelogfh = new IO::File "$maindir_gitcommon/logs/$ref", '>>' + or die $!; + + my $oldcache = git_get_ref $ref; + + if ($oldcache eq $value) { + my $tree = cmdoutput qw(git rev-parse), "$value:"; + # git update-ref doesn't always update, in this case. *sigh* + my $authline = (ucfirst _us()). + ' <'._us().'@example.com> 1000000000 +0000'; + my $dummy = make_commit_text <(no reflog)\n"; + finish 0; + } + exec @cmd; die $!; + } + while () { + chomp; + printdebug ">| ", $_, "\n" if $debuglevel > 1; + next unless m/^(\w+) (\S.*\S)$/ && $2 eq $cachekey; + close GC; + return $1; + } + die $! if GC->error; + failedcmd unless close GC; + return undef; +} + # ========== playground handling ========== # terminology: @@ -679,11 +825,6 @@ sub parsechangelog_loop ($$$) { # ----- maindir ----- -# these three all go together -our $maindir; -our $maindir_gitdir; -our $maindir_gitcommon; - our $local_git_cfg; sub record_maindir () {