infra/dgit-mirror-ssh-wrap

   1 #!/usr/bin/perl -w
   2
   3 # Intended to be used as a restricted command.
   4 # Usage:
   5 #    command="/path/to/dgit-mirror-ssh-wrap /srv/repos/ .git --"
   6 # or similar.  The two substantive arguments are literals.
   7 # The example permits writes to directories
   8 #    /srv/repos/$PACKAGE.git
   9 # where $PACKAGE has the syntax of a Debian package name.
  10
  11 use strict;
  12
  13 die 'bad usage' unless @ARGV==3 && $ARGV[2] eq '--';
  14 our ($prefix, $suffix) = @ARGV;
  15
  16 $prefix =~ s/\W/\\$&/g;
  17 $suffix =~ s/\W/\\$&/g;
  18
  19 my $package = qr{[0-9a-z][-+0-9a-z]*};
  20 my $d = qr{$prefix$package$suffix};
  21
  22 my $command = $ENV{SSH_ORIGINAL_COMMAND}
  23     // die "missing SSH_ORIGINAL_COMMAND";
  24
  25 #print STDERR ">$d<\n";
  26
  27 $command =~
  28
  29 m{^rsync --server -lHtre\.iLsfxC --timeout=\d+ --delete --safe-links \. $d$}
  30
  31 # To add a new command pattern, add || m{^ ... $} above.
  32 # The pattern should contain $d where the per-package destination
  33 # directory would go.
  34
  35 or die "unexpected command $command\n";
  36
  37 exec $& or die $!;