#!/usr/bin/perl -w
-# dgit-repos-push-receiver
+# dgit-repos-server
#
# usages:
-# .../dgit-repos-push-receiver SUITES KEYRING-AUTH-SPEC DGIT-REPOS-DIR --ssh
+# .../dgit-repos-server SUITES KEYRING-AUTH-SPEC DGIT-REPOS-DIR --ssh
# internal usage:
-# .../dgit-repos-push-receiver --pre-receive-hook PACKAGE
+# .../dgit-repos-server --pre-receive-hook PACKAGE
#
# Invoked as the ssh restricted command
#
our $func;
our $dgitrepos;
-our $pkg;
+our $package;
our $suitesfile;
our $realdestrepo;
our $destrepo;
our $workrepo;
-our @keyrings;
+our $keyrings;
our @lockfhs;
#----- utilities -----
my $fh;
for (;;) {
close $fh if $fh;
- $fh = new IO::File, ">", $lock or die "open $lock: $!";
+ $fh = new IO::File $lock, ">" or die "open $lock: $!";
my $ok = flock $fh, $must ? LOCK_EX : (LOCK_EX|LOCK_NB);
if (!$ok) {
return undef unless $must;
return $fh;
}
+sub mkrepotmp () {
+ my $tmpdir = "$dgitrepos/_tmp";
+ return if mkdir $tmpdir;
+ return if $! == EEXIST;
+ die $!;
+}
+
sub reject ($) {
die "dgit-repos-server: reject: $_[0]\n";
}
+sub runcmd {
+ $!=0; $?=0;
+ my $r = system @_;
+ die "@_ $? $!" if $r;
+}
+
#----- git-receive-pack -----
sub fixmissing__git_receive_pack () {
- $destrepo = "$dgitrepos/_tmp/${pkg}_prospective";
+ mkrepotmp();
+ $destrepo = "$dgitrepos/_tmp/${package}_prospective";
acquiretree($destrepo, 1);
my $r = system qw(cp -a --), "$dgitrepos/_template", "$destrepo";
!$r or die "create new repo failed failed: $r $!";
}
sub makeworkingclone () {
- $workrepo = "$dgitrepos/_tmp/${pkg}_incoming$$";
+ mkrepotmp();
+ $workrepo = "$dgitrepos/_tmp/${package}_incoming$$";
acquiretree($workrepo, 1);
runcmd qw(git clone -l -q --mirror), $destrepo, $workrepo;
}
sub setupstunthook () {
my $prerecv = "$workrepo/hooks/pre-receive";
- my $fh = new IO::File, $prerecv, O_WRONLY|O_CREAT|O_TRUNC, 0777
+ my $fh = new IO::File $prerecv, O_WRONLY|O_CREAT|O_TRUNC, 0777
or die "$prerecv: $!";
print $fh <<END or die "$prerecv: $!";
#!/bin/sh
set -e
-exec $0 --pre-receive-hook $pkg
+exec $0 --pre-receive-hook $package
END
close $fh or die "$prerecv: $!";
$ENV{'DGIT_RPR_WORK'}= $workrepo;
sub main__git_receive_pack () {
makeworkingclone();
setupstunthook();
- runcmd qw(git receive-pack), $destdir;
+ runcmd qw(git receive-pack), $destrepo;
maybeinstallprospective();
}
}
STDIN->error and die $!;
- die unless defined $refname;
- die unless defined $branchname;
+ die unless defined $tagname;
+ die unless defined $suite;
}
sub parsetag () {
$!=0; $_=<T>; defined or die $!;
m/^($package_re) release (\S+) for (\S+) \[dgit\]$/ or die;
- die unless $1 eq $pkg;
+ die unless $1 eq $package;
$version = $2;
die unless $3 eq $suite;
my $ok = undef;
- open P, "-|", (qw(gpgv --status-fd=1),
- map { '--keyring', $_ }, @keyrings,
+ open P, "-|", (qw(gpgv --status-fd=1 --keyring),
+ $keyringfile,
qw(dgit-tmp/plaintext.asc dgit-tmp/plaintext))
or die $!;
onwardpush();
}
+#----- git-upload-pack -----
+
+sub fixmissing__git_upload_pack () {
+ $destrepo = "$dgitrepos/_empty";
+ my $lfh = acquiretree($destrepo,1);
+ return if stat $destrepo;
+ die $! unless $!==ENOENT;
+ rmtree "$destrepo.new";
+ umask 022;
+ runcmd qw(git init --bare --quiet), "$destrepo.new";
+ rename "$destrepo.new", $destrepo or die $!;
+ unlink "$destrepo.lock" or die $!;
+ close $lfh;
+}
+
+sub main__git_upload_pack () {
+ runcmd qw(git upload-pack), $destrepo;
+}
+
#----- arg parsing and main program -----
sub argval () {
if ($ARGV[0] eq '--pre-receive-hook') {
shift @ARGV;
@ARGV == 1 or die;
- $pkg = shift @ARGV;
+ $package = shift @ARGV;
defined($suitesfile = $ENV{'DGIT_RPR_SUITES'}) or die;
defined($workrepo = $ENV{'DGIT_RPR_WORK'}) or die;
defined($destrepo = $ENV{'DGIT_RPR_DEST'}) or die;
$
}ox
or reject "command string not understood";
- $method = $1;
- $pkg = $2;
- $realdestrepo = "$dgitrepos/$pkg.git";
+ my $method = $1;
+ $package = $2;
+ $realdestrepo = "$dgitrepos/$package.git";
my $funcn = $method;
$funcn =~ y/-/_/;
}
sub unlockall () {
- while (my $fh = pop $lockfhs) { close $fh; }
+ while (my $fh = pop @lockfhs) { close $fh; }
}
sub cleanup () {
unlockall();
- chdir "$dgitrepos/_tmp" or die $!;
- foreach my $lock (<*.lock>) {
+ if (!chdir "$dgitrepos/_tmp") {
+ $!==ENOENT or die $!;
+ return;
+ }
+ foreach my $lf (<*.lock>) {
my $tree = $lf;
$tree =~ s/\.lock$//;
next unless acquiretree($tree, 0);
- remove $lock or warn $!;
+ remove $lf or warn $!;
unlockall();
}
}