From 2711b56a97437d8260ccac48b0699a8bfe9764a1 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sat, 8 Nov 2014 21:53:33 +0000
Subject: [PATCH] infra/dgit-ssh-dispatch: New production infra script

---
 debian/changelog        |   3 +
 infra/dgit-ssh-dispatch | 138 ++++++++++++++++++++++++++++++++++++++++
 tests/lib               |   3 +-
 3 files changed, 143 insertions(+), 1 deletion(-)
 create mode 100755 infra/dgit-ssh-dispatch

diff --git a/debian/changelog b/debian/changelog
index 90adffb4..c1a5af21 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -24,6 +24,9 @@ dgit (0.23~) unstable; urgency=low
   * dgit-repos-server: Handle ' ' in SSH_ORIGINAL_COMMAND (which some
     git versions send, sigh).
 
+  * New dgit-ssh-dispatch infrastructure script for use on dgit repos
+    server as part of ssh forced command.
+
   * Test suite restructuring to support new tests.
 
  --
diff --git a/infra/dgit-ssh-dispatch b/infra/dgit-ssh-dispatch
new file mode 100755
index 00000000..bd8582aa
--- /dev/null
+++ b/infra/dgit-ssh-dispatch
@@ -0,0 +1,138 @@
+#!/usr/bin/perl -w
+
+use strict;
+use POSIX;
+
+open DEBUG, '>/dev/null' or die $!;
+if (@ARGV && $ARGV[0] eq '-D') {
+    shift @ARGV;
+    open DEBUG, '>&STDERR' or die $!;
+}
+
+die unless @ARGV>=1 && @ARGV<=2 && $ARGV[0] !~ m/^-/;
+our ($dispatchdir,$authrune) = @ARGV;
+
+$authrune //= join ':',
+    '@/keyrings/debian-keyring.gpg,a',
+    '@/keyrings/debian-maintainers.gpg,m@/dm.txt';
+
+our $lre = '[0-9a-z][-+.0-9a-z]*';
+our $qre = '["'."']?";
+
+# $dispatchdir should contain
+#    dgit-live   a clone of dgit
+#    repos/
+#    suites
+#    diverts
+# plus files required by the authrune (by default, keyrings/ and dm.txt)
+#
+# diverts should be list of
+#  <pat> [<divert-to>]
+# where <pat> is a package name pattern which may contain * or literals.
+
+our ($distro,$pkg);
+our ($dgitlive,$repos,$suites,$diverts,$repo);
+
+sub checkdivert ($) {
+    my ($df) = @_;
+    if (!open DIV, '<', $df) {
+	$!==ENOENT or die $!;
+	return undef;
+    } else {
+	while (<DIV>) {
+	    s/^\s+//; s/\s+$//;
+	    next unless m/\S/;
+	    next if m/^\#/;
+	    my $divert;
+	    if (s/\s+(\S+)$//) { $divert=$1; }
+	    s/[^-+._0-9a-zA-Z*]/\\$&/g;
+	    s/\*/.*/g;
+	    printf DEBUG 'DISPATCH DIVERT ^%s$ %s'."\n",
+	        $_, ($divert // '(undef)');
+	    if ($pkg =~ m/^$_$/) { return $divert; }
+	}
+	DIV->error and die $!;
+	close DIV;
+	return undef;
+    }
+}
+	
+sub finish () {
+    close STDOUT or die $!;
+    exit 0;
+}
+
+sub prl ($) {
+    print @_, "\n" or die $!;
+}
+	
+sub selectpackage ($$;$) {
+    my $divertfn;
+    ($distro,$pkg, $divertfn) = @_; # $distro,$pkg must have sane syntax
+
+    my $d = "$dispatchdir/distro=$distro";
+
+    if (!stat $d) {
+	die $! unless $!==ENOENT;
+	die "unknown distro ($distro)\n";
+    }
+
+    $dgitlive=    "$d/dgit-live";
+    $repos=       "$d/repos";
+    $suites=      "$d/suites";
+
+    $authrune =~ s/\@/$d/g;
+
+    my $divert = checkdivert("$d/diverts");
+    if (defined $divert) {
+	$divertfn //= sub {
+	    die "diverted to $divert incompletely or too late!\n";
+	};
+	$divertfn->($divert);
+	die;
+    }
+
+    $repo = "$repos/$pkg.git";
+
+    print DEBUG "DISPATCH DISTRO $distro PKG $pkg\n";
+}
+
+sub hasrepo () {
+    if (stat $repo) {
+	-d _ or die;
+	return 1;
+    } else {
+	$!==ENOENT or die $!;
+	return 0;
+    }
+}
+
+sub dispatch () {
+    local ($_) = $ENV{'SSH_ORIGINAL_COMMAND'};
+
+    if (m#^: dgit ($lre) git-check ($lre) ;#) {
+	selectpackage $1,$2, sub { prl "divert @_"; finish; };
+	prl hasrepo;
+	finish;
+    } elsif (
+        m#^${qre}git-([-a-z]+) ${qre}/dgit/($lre)/repos/($lre)\.git${qre}$#
+    ) {
+	my $cmd=$1;
+	selectpackage $2,$3;
+	if ($cmd eq 'receive-pack') {
+	    my $s = "$dgitlive/dgit-repos-server";
+	    exec $s, $suites, $authrune, $repos, qw(--ssh);
+	    die "exec $s: $!";
+	} elsif ($cmd eq 'upload-pack') {
+	    $repo='$repos/_empty' unless hasrepo;
+	    exec qw(git upload-pack --strict --timeout=1000), $repo;
+	    die "exec git: $!";
+	} else {
+	    die "unsupported git operation $cmd ($_)";
+	}
+    } else {
+	die "unsupported operation ($_)";
+    }
+}
+
+dispatch;
diff --git a/tests/lib b/tests/lib
index 7a5aa761..0073df41 100644
--- a/tests/lib
+++ b/tests/lib
@@ -6,7 +6,8 @@ set -x
 if [ "x$DGIT_TEST_INTREE" != x ]; then
 	: ${DGIT_TEST:=$DGIT_TEST_INTREE/dgit}
 	: ${DGIT_REPOS_SERVER_TEST:=$DGIT_TEST_INTREE/dgit-repos-server}
-	export DGIT_TEST DGIT_REPOS_SERVER_TEST
+	: ${DGIT_SSH_DISPATCH_TEST:=$DGIT_TEST_INTREE/infra/dgit-ssh-dispatch}
+	export DGIT_TEST DGIT_REPOS_SERVER_TEST DGIT_SSH_DISPATCH_TEST
 fi
 
 root=`pwd`
-- 
2.30.2