X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=Debian%2FDgit.pm;h=5b5591d5499695def37c47f023a00f854bfa1738;hb=4523f77bba9b97925030bcf641584a4a74819178;hp=314bd8c712c6159fe031bfe8073a62f902666f84;hpb=e9a3ab8ab115a663975026c84332a1d0bdc7264b;p=dgit.git diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm index 314bd8c7..5b5591d5 100644 --- a/Debian/Dgit.pm +++ b/Debian/Dgit.pm @@ -36,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 @@ -45,11 +45,12 @@ BEGIN { fail ensuredir executable_on_path waitstatusmsg failedcmd_waitstatus failedcmd_report_cmd failedcmd - cmdoutput cmdoutput_errok + 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 @@ -65,7 +66,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 @@ -78,10 +82,21 @@ sub NOCOMMITCHECK () { return 0x8; } our $debugprefix; our $debuglevel = 0; +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; }; } @@ -123,6 +138,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) { @@ -260,6 +276,12 @@ sub failedcmd { fail failedcmd_waitstatus(); } +sub runcmd { + debugcmd "+",@_; + $!=0; $?=-1; + failedcmd @_ if system @_; +} + sub cmdoutput_errok { confess Dumper(\@_)." ?" if grep { !defined } @_; debugcmd "|",@_; @@ -311,6 +333,7 @@ sub git_rev_parse ($) { 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);