From 0c10b5f444e5eb50dcf801a6a3a8aa10b3ad561b Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Sun, 19 Jan 2014 23:48:35 +0000 Subject: dgit-repos-server: fixes from testing --- dgit-repos-server | 48 +++++++++++++++++++++++++++--------------------- 1 file changed, 27 insertions(+), 21 deletions(-) mode change 100644 => 100755 dgit-repos-server (limited to 'dgit-repos-server') diff --git a/dgit-repos-server b/dgit-repos-server old mode 100644 new mode 100755 index cbbfe1e..2a0bf40 --- 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 <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; $_=; 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(); } } -- cgit v1.2.3