X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?a=blobdiff_plain;f=infra%2Fdgit-repos-server;h=74cbff32fa12c2f116fe0c6d61410d4c151dfa3b;hb=a095d9f6fdf2aa56fae21997baa4e965071f0f77;hp=c20eb68f54bbca1f5dde6dfbc14ae9f12d44950a;hpb=772fdc0dc3733838b2efdf0c9af7252c2eafafd8;p=dgit.git diff --git a/infra/dgit-repos-server b/infra/dgit-repos-server index c20eb68f..74cbff32 100755 --- a/infra/dgit-repos-server +++ b/infra/dgit-repos-server @@ -87,9 +87,9 @@ use POSIX; use Fcntl qw(:flock); use File::Path qw(rmtree); -open DEBUG, ">/dev/null" or die $!; +use Debian::Dgit qw(:DEFAULT :policyflags); -our $package_re = '[0-9a-z][-+.0-9a-z]+'; +open DEBUG, ">/dev/null" or die $!; our $func; our $dgitrepos; @@ -188,16 +188,58 @@ sub runcmd { die "@_ $? $!" if $r; } +sub policyhook { + my ($policyallowbits, @polargs) = @_; + # => ($exitstatuspolicybitmap, $policylockfh); + die if $policyallowbits & ~0x3e; + my @cmd = ($policyhook,$distro,$repos,@polargs); + debugcmd @_; + my $r = system @_; + die "system: $!" if $r < 0; + die "hook (@cmd) failed ($?)" if $r & ~($policyallowbits << 8); + return $r >> 8; +} + +sub mkemptyrepo ($$) { + my ($dir,$sharedperm) = @_; + runcmd qw(git init --bare --quiet), "--shared=$sharedperm", $dir; +} + +sub mkrepo_fromtemplate ($) { + my ($dir) = @_; + my $template = "$dgitrepos/_template"; + debug "copy tempalate $template -> $dir"; + my $r = system qw(cp -a --), $template, $dir; + !$r or die "create new repo $dir failed: $r $!"; +} + +sub movetogarbage () { + my $garbagerepo = "$dgitrepos/_tmp/${package}_garbage"; + acquiretree($garbagerepo,1); + rmtree $garbagerepo; + rename $realdestrepo, $garbagerepo + or $! == ENOENT + or die "rename repo $realdestrepo to $garbagerepo: $!"; +} + +sub onwardpush () { + my @cmd = (qw(git send-pack), $destrepo); + push @cmd, qw(--force) if $policy & NOFFCHECK; + push @cmd, "$commit:refs/dgit/$suite", + "$tagval:refs/tags/$tagname"); + debugcmd @cmd; + $!=0; + my $r = system @cmd; + !$r or die "onward push to $destrepo failed: $r $!"; +} + #----- git-receive-pack ----- sub fixmissing__git_receive_pack () { mkrepotmp(); $destrepo = "$dgitrepos/_tmp/${package}_prospective"; acquiretree($destrepo, 1); - my $template = "$dgitrepos/_template"; - debug "fixmissing copy tempalate $template -> $destrepo"; - my $r = system qw(cp -a --), $template, $destrepo; - !$r or die "create new repo failed failed: $r $!"; + mkrepo_fromtemplate($destrepo); } sub makeworkingclone () { @@ -492,27 +534,21 @@ sub checks () { debug "translated version $v"; $tagname eq "debian/$v" or die; + my ($policy) = policyhook(NOFFCHECK, 'push',$package, + $version,$suite,$tagname, + join(",",@delberatelies)); + checksuite(); # check that our ref is being fast-forwarded debug "oldcommit $oldcommit"; - if ($oldcommit =~ m/[^0]/) { + if (!($policy & NOFFCHECK) && $oldcommit =~ m/[^0]/) { $?=0; $!=0; my $mb = `git merge-base $commit $oldcommit`; chomp $mb; $mb eq $oldcommit or reject "not fast forward on dgit branch"; } } -sub onwardpush () { - my @cmd = (qw(git send-pack), $destrepo, - "$commit:refs/dgit/$suite", - "$tagval:refs/tags/$tagname"); - debugcmd @cmd; - $!=0; - my $r = system @cmd; - !$r or die "onward push failed: $r $!"; -} - sub stunthook () { debug "stunthook"; chdir $workrepo or die "chdir $workrepo: $!"; @@ -533,8 +569,7 @@ sub fixmissing__git_upload_pack () { return if stat $destrepo; die $! unless $!==ENOENT; rmtree "$destrepo.new"; - umask 022; - runcmd qw(git init --bare --quiet), "$destrepo.new"; + mkemptyrepo "$destrepo.new", "0644"; rename "$destrepo.new", $destrepo or die $!; unlink "$destrepo.lock" or die $!; close $lfh; @@ -615,6 +650,12 @@ sub parseargsdispatch () { reject "unknown method" unless $mainfunc; + my ($policy, $pollock) = policyhook(FRESHREPO,'check-package',$package); + if ($policy & FRESHREPO) { + movetogarbage; + } + close $pollock or die $!; + if (stat $realdestrepo) { $destrepo = $realdestrepo; } else {