X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=Debian%2FDgit.pm;h=6977ed21d36781d1246e83617f9921cf20d18787;hp=e9921d6a33435c5c34164eca3f2dc2174bf1e4ef;hb=6fab00d6201f741f87cc89a0a24443db584c4162;hpb=82da82e49b4ae7143bf9fdb582fcb46e1446a2e4 diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm index e9921d6a..6977ed21 100644 --- a/Debian/Dgit.pm +++ b/Debian/Dgit.pm @@ -28,6 +28,7 @@ use IO::Handle; use Config; use Digest::SHA; use Data::Dumper; +use IPC::Open2; BEGIN { use Exporter (); @@ -35,7 +36,7 @@ BEGIN { $VERSION = 1.00; @ISA = qw(Exporter); - @EXPORT = qw(setup_sigwarn + @EXPORT = qw(setup_sigwarn forkcheck_setup forkcheck_mainprocess dep14_version_mangle debiantags debiantag_old debiantag_new server_branch server_ref @@ -44,15 +45,18 @@ BEGIN { fail ensuredir executable_on_path waitstatusmsg failedcmd_waitstatus failedcmd_report_cmd failedcmd - cmdoutput cmdoutput_errok - git_rev_parse git_get_ref git_for_each_ref + runcmd cmdoutput cmdoutput_errok + git_rev_parse git_cat_file + git_get_ref git_for_each_ref git_for_each_tag_referring is_fast_fwd $package_re $component_re $deliberately_re + $distro_re $versiontag_re $series_filename_re $branchprefix initdebug enabledebug enabledebuglevel printdebug debugcmd $debugprefix *debuglevel *DEBUG - shellquote printcmd messagequote); + shellquote printcmd messagequote + $negate_harmful_gitattrs); # implicitly uses $main::us %EXPORT_TAGS = ( policyflags => [qw(NOFFCHECK FRESHREPO NOCOMMITCHECK)] ); @EXPORT_OK = @{ $EXPORT_TAGS{policyflags} }; @@ -63,7 +67,10 @@ our @EXPORT_OK; our $package_re = '[0-9a-z][-+.0-9a-z]*'; our $component_re = '[0-9a-zA-Z][-+.0-9a-zA-Z]*'; our $deliberately_re = "(?:TEST-)?$package_re"; +our $distro_re = $component_re; +our $versiontag_re = qr{[-+.\%_0-9a-zA-Z/]+}; our $branchprefix = 'dgit'; +our $series_filename_re = qr{(?:^|\.)series(?!\n)$}s; # policy hook exit status bits # see dgit-repos-server head comment for documentation @@ -76,10 +83,23 @@ sub NOCOMMITCHECK () { return 0x8; } our $debugprefix; our $debuglevel = 0; +our $negate_harmful_gitattrs = "-text -eol -crlf -ident -filter"; + +our $forkcheck_mainprocess; + +sub forkcheck_setup () { + $forkcheck_mainprocess = $$; +} + +sub forkcheck_mainprocess () { + # You must have called forkcheck_setup or setup_sigwarn already + getppid != $forkcheck_mainprocess; +} + sub setup_sigwarn () { - our $sigwarn_mainprocess = $$; + forkcheck_setup(); $SIG{__WARN__} = sub { - die $_[0] unless getppid == $sigwarn_mainprocess; + die $_[0] if forkcheck_mainprocess; }; } @@ -121,6 +141,7 @@ sub messagequote ($) { sub shellquote { my @out; local $_; + defined or confess 'internal error' foreach @_; foreach my $a (@_) { $_ = $a; if (!length || m{[^-=_./:0-9a-z]}i) { @@ -258,6 +279,12 @@ sub failedcmd { fail failedcmd_waitstatus(); } +sub runcmd { + debugcmd "+",@_; + $!=0; $?=-1; + failedcmd @_ if system @_; +} + sub cmdoutput_errok { confess Dumper(\@_)." ?" if grep { !defined } @_; debugcmd "|",@_; @@ -306,6 +333,29 @@ sub git_rev_parse ($) { return cmdoutput qw(git rev-parse), "$_[0]~0"; } +sub git_cat_file ($) { + my ($objname) = @_; + # => ($type, $data) or ('missing', undef) + # in scalar context, just the data + our ($gcf_pid, $gcf_i, $gcf_o); + if (!$gcf_pid) { + my @cmd = qw(git cat-file --batch); + debugcmd "GCF|", @cmd; + $gcf_pid = open2 $gcf_o, $gcf_i, @cmd or die $!; + } + printdebug "GCF>| ", $objname, "\n"; + print $gcf_i $objname, "\n" or die $!; + my $x = <$gcf_o>; + printdebug "GCF<| ", $x; + if ($x =~ m/ (missing)$/) { return ($1, undef); } + my ($type, $size) = $x =~ m/^.* (\w+) (\d+)\n/ or die "$objname ?"; + my $data; + (read $gcf_o, $data, $size) == $size or die "$objname $!"; + $x = <$gcf_o>; + $x eq "\n" or die "$objname ($_) $!"; + return ($type, $data); +} + sub git_for_each_ref ($$;$) { my ($pattern,$func,$gitdir) = @_; # calls $func->($objid,$objtype,$fullrefname,$reftail);