summaryrefslogtreecommitdiff
path: root/dgit-repos-server
diff options
context:
space:
mode:
Diffstat (limited to 'dgit-repos-server')
-rwxr-xr-x[-rw-r--r--]dgit-repos-server48
1 files changed, 27 insertions, 21 deletions
diff --git a/dgit-repos-server b/dgit-repos-server
index cbbfe1e..2a0bf40 100644..100755
--- a/dgit-repos-server
+++ b/dgit-repos-server
@@ -90,12 +90,12 @@ our $package_re = '[0-9a-z][-+.0-9a-z]+';
our $func;
our $dgitrepos;
-our $pkg;
+our $package;
our $suitesfile;
our $realdestrepo;
our $destrepo;
our $workrepo;
-our @keyrings;
+our $keyrings;
our @lockfhs;
#----- utilities -----
@@ -105,7 +105,7 @@ sub acquirelock ($$) {
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;
@@ -137,29 +137,35 @@ 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";
+ $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$$";
+ $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;
@@ -196,7 +202,7 @@ sub maybeinstallprospective () {
sub main__git_receive_pack () {
makeworkingclone();
setupstunthook();
- runcmd qw(git receive-pack), $destdir;
+ runcmd qw(git receive-pack), $destrepo;
maybeinstallprospective();
}
@@ -227,8 +233,8 @@ sub readupdates () {
}
STDIN->error and die $!;
- die unless defined $refname;
- die unless defined $branchname;
+ die unless defined $tagname;
+ die unless defined $suite;
}
sub parsetag () {
@@ -249,7 +255,7 @@ 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;
@@ -276,8 +282,8 @@ sub checksig_keyring ($) {
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 $!;
@@ -400,7 +406,7 @@ sub fixmissing__git_upload_pack () {
}
sub main__git_upload_pack () {
- runcmd qw(git upload-pack), $destdir;
+ runcmd qw(git upload-pack), $destrepo;
}
#----- arg parsing and main program -----
@@ -418,7 +424,7 @@ sub parseargsdispatch () {
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;
@@ -445,9 +451,9 @@ sub parseargsdispatch () {
$
}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/-/_/;
@@ -467,17 +473,17 @@ sub parseargsdispatch () {
}
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>) {
+ foreach my $lf (<*.lock>) {
my $tree = $lf;
$tree =~ s/\.lock$//;
next unless acquiretree($tree, 0);
- remove $lock or warn $!;
+ remove $lf or warn $!;
unlockall();
}
}