Do not quote `:' in shellquote.

[dgit.git] / Debian / Dgit.pm

diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm
index a270cd80836f1206d1033cb5441816dc9cd9f09c..a453f352718b33a5567e040cdd9302973c40b279 100644 (file)
--- a/Debian/Dgit.pm
+++ b/Debian/Dgit.pm
@@ -15,17 +15,18 @@ BEGIN {
 
     $VERSION     = 1.00;
     @ISA         = qw(Exporter);
-    @EXPORT      = qw(debiantag server_branch server_ref
+    @EXPORT      = qw(setup_sigwarn
+                      debiantag server_branch server_ref
                       stat_exists fail ensuredir waitstatusmsg failedcmd
                       cmdoutput cmdoutput_errok
-                      git_rev_parse git_for_each_ref
+                      git_rev_parse git_get_ref git_for_each_ref
                       git_for_each_tag_referring is_fast_fwd
                       $package_re $component_re $deliberately_re
                       $branchprefix
                       initdebug enabledebug enabledebuglevel
                       printdebug debugcmd
                       $debugprefix *debuglevel *DEBUG
-                      shellquote printcmd);
+                      shellquote printcmd messagequote);
     # implicitly uses $main::us
     %EXPORT_TAGS = ( policyflags => [qw(NOFFCHECK FRESHREPO)] );
     @EXPORT_OK   = @{ $EXPORT_TAGS{policyflags} };
@@ -48,6 +49,13 @@ sub FRESHREPO () { return 0x4; }
 our $debugprefix;
 our $debuglevel = 0;
 
+sub setup_sigwarn () {
+    our $sigwarn_mainprocess = $$;
+    $SIG{__WARN__} = sub { 
+       die $_[0] unless getppid == $sigwarn_mainprocess;
+    };
+}
+
 sub initdebug ($) { 
     ($debugprefix) = @_;
     open DEBUG, ">/dev/null" or die $!;
@@ -73,12 +81,22 @@ sub printdebug {
     print DEBUG $debugprefix, @_ or die $! if $debuglevel>0;
 }
 
+sub messagequote ($) {
+    local ($_) = @_;
+    s{\\}{\\\\}g;
+    s{\n}{\\n}g;
+    s{\x08}{\\b}g;
+    s{\t}{\\t}g;
+    s{[\000-\037\177]}{ sprintf "\\x%02x", ord $& }ge;
+    $_;
+}
+
 sub shellquote {
     my @out;
     local $_;
     foreach my $a (@_) {
        $_ = $a;
-       if (!length || m{[^-=_./0-9a-z]}i) {
+       if (!length || m{[^-=_./:0-9a-z]}i) {
            s{['\\]}{'\\$&'}g;
            push @out, "'$_'";
        } else {
@@ -101,10 +119,10 @@ sub debugcmd {
     printcmd(\*DEBUG,$debugprefix.$extraprefix,@_) if $debuglevel>0;
 }
 
-sub debiantag ($) { 
-    my ($v) = @_;
+sub debiantag ($$) { 
+    my ($v,$distro) = @_;
     $v =~ y/~:/_%/;
-    return "debian/$v";
+    return "$distro/$v";
 }
 
 sub server_branch ($) { return "$branchprefix/$_[0]"; }
@@ -173,8 +191,13 @@ sub cmdoutput_errok {
     die $! if P->error;
     if (!close P) { printdebug "=>!$?\n"; return undef; }
     chomp $d;
-    $d =~ m/^.*/;
-    printdebug "=> \`$&'",(length $' ? '...' : ''),"\n" if $debuglevel>0; #';
+    if ($debuglevel > 0) {
+       $d =~ m/^.*/;
+       my $dd = $&;
+       my $more = (length $' ? '...' : ''); #');
+       $dd =~ s{[^\n -~]|\\}{ sprintf "\\x%02x", ord $& }ge;
+       printdebug "=> \`$dd'",$more,"\n";
+    }
     return $d;
 }
 
@@ -188,12 +211,15 @@ sub git_rev_parse ($) {
     return cmdoutput qw(git rev-parse), "$_[0]~0";
 }
 
-sub git_for_each_ref ($$) {
-    my ($pattern,$func) = @_;
+sub git_for_each_ref ($$;$) {
+    my ($pattern,$func,$gitdir) = @_;
     # calls $func->($objid,$objtype,$fullrefname,$reftail);
     # $reftail is RHS of ref after refs/[^/]+/
     # breaks if $pattern matches any ref `refs/blah' where blah has no `/'
     my @cmd = (qw(git for-each-ref), $pattern);
+    if (defined $gitdir) {
+       @cmd = ('sh','-ec','cd "$1"; shift; exec "$@"','x', $gitdir, @cmd);
+    }
     open GFER, "-|", @cmd or die $!;
     debugcmd "|", @cmd;
     while (<GFER>) {
@@ -205,6 +231,14 @@ sub git_for_each_ref ($$) {
     $!=0; $?=0; close GFER or die "$pattern $? $!";
 }
 
+sub git_get_ref ($) {
+    # => '' if no such ref
+    my ($refname) = @_;
+    local $_ = $refname;
+    s{^refs/}{[r]efs/} or die "$refname $_ ?";
+    return cmdoutput qw(git for-each-ref --format=%(objectname)), $_;
+}
+
 sub git_for_each_tag_referring ($$) {
     my ($objreferring, $func) = @_;
     # calls $func->($tagobjid,$refobjid,$fullrefname,$tagname);