# --repos=GIT-REPOS-DIR default DISTRO-DIR/repos/
# --suites=SUITES-FILE default DISTRO-DIR/suites
# --policy-hook=POLICY-HOOK default DISTRO-DIR/policy-hook
+# --dgit-live=DGIT-LIVE-DIR default DISTRO-DIR/dgit-live
# (DISTRO-DIR is not used other than as default)
# internal usage:
# .../dgit-repos-server --pre-receive-hook PACKAGE
# mDM.TXT
use strict;
+$SIG{__WARN__} = sub { die $_[0]; };
# DGIT-REPOS-DIR contains:
# git tree (or other object) lock (in acquisition order, outer first)
# cleanup to do
#
# Policy hook script is invoked like this:
-# POLICY-HOOK-SCRIPT DISTRO DGIT-REPOS-DIR ACTION...
+# POLICY-HOOK-SCRIPT DISTRO DGIT-REPOS-DIR DGIT-LIVE-DIR ACTION...
# ie.
# POLICY-HOOK-SCRIPT ... check-list [...]
# POLICY-HOOK-SCRIPT ... check-package PACKAGE [...]
# First, without any locking, check-list is called. It should produce
# a list of package names. Then check-package will be invoked for
# each named package, in each case after taking an appropriate lock.
+#
+# If policy hook wants to run dgit (or something else in the dgit
+# package), it should use DGIT-LIVE-DIR/dgit (etc.)
use POSIX;
our $distro;
our $suitesfile;
our $policyhook;
-our $realdestrepo;
+our $dgitlive;
our $destrepo;
our $workrepo;
our $keyrings;
print DEBUG "$debug @_\n";
}
+sub realdestrepo () { "$dgitrepos/$package.git"; }
+
sub acquirelock ($$) {
my ($lock, $must) = @_;
my $fh;
}
sub lockrealtree () {
- locksometree($realdestrepo);
+ locksometree(realdestrepo);
}
sub mkrepotmp () {
my ($policyallowbits, @polargs) = @_;
# => ($exitstatuspolicybitmap);
die if $policyallowbits & ~0x3e;
- my @cmd = ($policyhook,$distro,$dgitrepos,@polargs);
+ my @cmd = ($policyhook,$distro,$dgitrepos,$dgitlive,@polargs);
debugcmd @cmd;
my $r = system @cmd;
die "system: $!" if $r < 0;
die "hook (@cmd) failed ($?)" if $r & ~($policyallowbits << 8);
+ debug sprintf "hook (%s) => %#x", "@polargs", $r;
return $r >> 8;
}
}
sub movetogarbage () {
- # $realdestrepo must have been locked
+ # realdestrepo must have been locked
my $garbagerepo = "$dgitrepos/${package}_garbage";
# We arrange to always keep at least one old tree, for anti-rewind
# purposes (and, I guess, recovery from mistakes). This is either
}
rename "$garbagerepo", "$garbagerepo-old" or die "$garbagerepo $!";
}
- rename $realdestrepo, $garbagerepo
+ rename realdestrepo, $garbagerepo
or $! == ENOENT
or die "$garbagerepo $!";
}
}
sub maybeinstallprospective () {
- return if $destrepo eq $realdestrepo;
+ return if $destrepo eq realdestrepo;
if (open REJ, "<", "$workrepo/drs-error") {
local $/ = undef;
movetogarbage;
}
- debug "install $destrepo => $realdestrepo";
- rename $destrepo, $realdestrepo or die $!;
+ debug "install $destrepo => ".realdestrepo;
+ rename $destrepo, realdestrepo or die $!;
remove "$destrepo.lock" or die $!;
}
'repos' => \$dgitrepos,
'suites' => \$suitesfile,
'policy-hook' => \$policyhook,
+ 'dgit-live' => \$dgitlive,
);
-our @hookenvs = qw(distro suitesfile policyhook keyrings dgitrepos);
+our @hookenvs = qw(distro suitesfile policyhook dgitlive keyrings dgitrepos);
# workrepo and destrepo handled ad-hoc
sub mode_ssh () {
+ die if @ARGV;
+
my $cmd = $ENV{'SSH_ORIGINAL_COMMAND'};
$cmd =~ m{
^
or reject "command string not understood";
my $method = $1;
$package = $2;
- $realdestrepo = "$dgitrepos/$package.git";
my $funcn = $method;
$funcn =~ y/-/_/;
close $lfh;
- if (stat_exists $realdestrepo) {
- $destrepo = $realdestrepo;
+ if (stat_exists realdestrepo) {
+ $destrepo = realdestrepo;
} else {
debug " fixmissing $funcn";
my $fixfunc = $main::{"fixmissing__$funcn"};