Merge tag dgit/2.14 into `defence in dgit-repos-server' branch

[dgit.git] / Debian / Dgit.pm

diff --git a/Debian/Dgit.pm b/Debian/Dgit.pm
index 57ae99418a1fc79bc4e734d15b18a36f09b5f529..e9921d6a33435c5c34164eca3f2dc2174bf1e4ef 100644 (file)
--- a/Debian/Dgit.pm
+++ b/Debian/Dgit.pm
@@ -36,6 +36,7 @@ BEGIN {
     $VERSION     = 1.00;
     @ISA         = qw(Exporter);
     @EXPORT      = qw(setup_sigwarn
+                     dep14_version_mangle
                       debiantags debiantag_old debiantag_new
                      server_branch server_ref
                       stat_exists link_ltarget
@@ -53,7 +54,7 @@ BEGIN {
                       $debugprefix *debuglevel *DEBUG
                       shellquote printcmd messagequote);
     # implicitly uses $main::us
-    %EXPORT_TAGS = ( policyflags => [qw(NOFFCHECK FRESHREPO)] );
+    %EXPORT_TAGS = ( policyflags => [qw(NOFFCHECK FRESHREPO NOCOMMITCHECK)] );
     @EXPORT_OK   = @{ $EXPORT_TAGS{policyflags} };
 }
 
@@ -70,6 +71,7 @@ our $branchprefix = 'dgit';
 # dynamic loader, runtime, etc., failures, which report 127 or 255
 sub NOFFCHECK () { return 0x2; }
 sub FRESHREPO () { return 0x4; }
+sub NOCOMMITCHECK () { return 0x8; }
 
 our $debugprefix;
 our $debuglevel = 0;
@@ -144,16 +146,22 @@ sub debugcmd {
     printcmd(\*DEBUG,$debugprefix.$extraprefix,@_) if $debuglevel>0;
 }
 
+sub dep14_version_mangle ($) {
+    my ($v) = @_;
+    # DEP-14 patch proposed 2016-11-09  "Version Mangling"
+    $v =~ y/~:/_%/;
+    $v =~ s/\.(?=\.|$|lock$)/.#/g;
+    return $v;
+}
+
 sub debiantag_old ($$) { 
     my ($v,$distro) = @_;
-    $v =~ y/~:/_%/;
-    return "$distro/$v";
+    return "$distro/". dep14_version_mangle $v;
 }
 
 sub debiantag_new ($$) { 
     my ($v,$distro) = @_;
-    $v =~ y/~:/_%/;
-    return "archive/$distro/$v";
+    return "archive/$distro/".dep14_version_mangle $v;
 }
 
 sub debiantags ($$) {
@@ -282,7 +290,9 @@ sub link_ltarget ($$) {
     if (-l _) {
        $old = cmdoutput qw(realpath  --), $old;
     }
-    link $old, $new or die "link $old $new: $!";
+    my $r = link $old, $new;
+    $r = symlink $old, $new if !$r && $!==EXDEV;
+    $r or die "(sym)link $old $new: $!";
 }
 
 sub hashfile ($) {