X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=infra%2Fdgit-repos-server;h=1492794e4088b0154820d557305dbbd3c9c424d9;hp=551efff9fb5f466ec716dbd0d951fd83040443dd;hb=881383cd6717e22293b0c2a912afba2c6b421a94;hpb=4487fc3517fb6db0dd8f25199cc0654c026d203d diff --git a/infra/dgit-repos-server b/infra/dgit-repos-server index 551efff9..1492794e 100755 --- a/infra/dgit-repos-server +++ b/infra/dgit-repos-server @@ -2,8 +2,14 @@ # dgit-repos-server # # usages: -# .../dgit-repos-server DISTRO SUITES KEYRING-AUTH-SPEC \ -# DGIT-REPOS-DIR POLICY-HOOK-SCRIPT --ssh +# dgit-repos-server DISTRO DISTRO-DIR AUTH-SPEC [] --ssh +# dgit-repos-server DISTRO DISTRO-DIR AUTH-SPEC [] --cron +# settings +# --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 and to pass to policy hook) # internal usage: # .../dgit-repos-server --pre-receive-hook PACKAGE # @@ -14,15 +20,41 @@ # SUITES is the name of a file which lists the permissible suites # one per line (#-comments and blank lines ignored) # -# KEYRING-AUTH-SPEC is a :-separated list of +# AUTH-SPEC is a :-separated list of # KEYRING.GPG,AUTH-SPEC # where AUTH-SPEC is one of # a # mDM.TXT +# (With --cron AUTH-SPEC is not used and may be the empty string.) use strict; +$SIG{__WARN__} = sub { die $_[0]; }; -# What we do is this: +# DGIT-REPOS-DIR contains: +# git tree (or other object) lock (in acquisition order, outer first) +# +# _tmp/PACKAGE_prospective ! } SAME.lock, held during receive-pack +# +# _tmp/PACKAGE_incoming$$ ! } SAME.lock, held during receive-pack +# _tmp/PACKAGE_incoming$$_fresh ! } +# +# PACKAGE.git } PACKAGE.git.lock +# PACKAGE_garbage } (also covers executions of +# PACKAGE_garbage-old } policy hook script for PACKAGE) +# PACKAGE_garbage-tmp } +# policy* } (for policy hook script, covered by +# } lock only when invoked for a package) +# +# leaf locks, held during brief operaton only: +# +# _empty } SAME.lock +# _empty.new } +# +# _template } SAME.lock +# +# locks marked ! may be held during client data transfer + +# What we do on push is this: # - extract the destination repo name # - make a hardlink clone of the destination repo # - provide the destination with a stunt pre-receive hook @@ -44,13 +76,16 @@ use strict; # + verify the signature on the signed tag # and if necessary check that the keyid and package are listed in dm.txt # + check various correspondences: -# * the suite is one of those permitted # * the signed tag must refer to a commit # * the signed tag commit must be the refs/dgit value # * the name in the signed tag must correspond to its ref name # * the tag name must be debian/ (massaged as needed) +# * the suite is one of those permitted # * the signed tag has a suitable name -# * the commit is a fast forward +# * run the "push" policy hook +# * replay prevention for --deliberately-not-fast-forward +# * check the commit is a fast forward +# * handle a request from the policy hook for a fresh repo # + push the signed tag and new dgit branch to the actual repo # # If the destination repo does not already exist, we need to make @@ -63,8 +98,6 @@ use strict; # of _template # - we use the prospective new destination repo instead of the # actual new destination repo (since the latter doesn't exist) -# - we set up a post-receive hook as well, which -# + touches a stamp file # - after git-receive-pack exits, we # + check that the prospective repo contains a tag and head # + rename the prospective destination repo into place @@ -82,47 +115,95 @@ use strict; # the corresponding temporary tree, as the lockfile is also # a stampfile whose presence indicates that there may be # cleanup to do +# +# Policy hook script is invoked like this: +# POLICY-HOOK-SCRIPT DISTRO DGIT-REPOS-DIR DGIT-LIVE-DIR DISTRO-DIR ACTION... +# ie. +# POLICY-HOOK-SCRIPT ... check-list [...] +# POLICY-HOOK-SCRIPT ... check-package PACKAGE [...] +# POLICY-HOOK-SCRIPT ... push PACKAGE \ +# VERSION SUITE TAGNAME DELIBERATELIES [...] +# POLICY-HOOK-SCRIPT ... push-confirm PACKAGE \ +# VERSION SUITE TAGNAME DELIBERATELIES FRESH-REPO|'' [...] +# +# Exit status is a bitmask. Bit weight constants are defined in Dgit.pm. +# NOFFCHECK (2) +# suppress dgit-repos-server's fast-forward check ("push" only) +# FRESHREPO (4) +# blow away repo right away (ie, as if before push or fetch) +# ("check-package" and "push" only) +# any unexpected bits mean failure, and then known set bits are ignored +# if no unexpected bits set, operation continues (subject to meaning +# of any expected bits set). So, eg, exit 0 means "continue normally" +# and would be appropriate for an unknown action. +# +# cwd for push and push-confirm is a temporary repo where the +# to-be-pushed objects have been received; TAGNAME is the +# version-based tag +# +# FRESH-REPO is '' iff the repo for this package already existed, or +# the pathname of the newly-created repo which will be renamed into +# place if everything goes well. (NB that this is generally not the +# same repo as the cwd, because the objects are first received into a +# temporary repo so they can be examined.) +# +# if push requested FRESHREPO, push-confirm happens in said fresh repo +# and FRESH-REPO is guaranteed not to be ''. +# +# policy hook for a particular package will be invoked only once at +# a time - (see comments about DGIT-REPOS-DIR, above) +# +# check-list and check-package are invoked via the --cron option. +# First, without any locking, check-list is called. It should produce +# a list of package names (one per line). 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; use Fcntl qw(:flock); use File::Path qw(rmtree); +use File::Temp qw(tempfile); use Debian::Dgit qw(:DEFAULT :policyflags); -open DEBUG, ">/dev/null" or die $!; +initdebug(''); our $func; our $dgitrepos; our $package; +our $distro; our $suitesfile; our $policyhook; -our $realdestrepo; +our $dgitlive; +our $distrodir; our $destrepo; our $workrepo; our $keyrings; our @lockfhs; -our $debug=''; + our @deliberatelies; our %supersedes; our $policy; #----- utilities ----- -sub debug { - print DEBUG "$debug @_\n"; -} +sub realdestrepo () { "$dgitrepos/$package.git"; } sub acquirelock ($$) { my ($lock, $must) = @_; my $fh; - printf DEBUG "$debug locking %s %d\n", $lock, $must; + printdebug sprintf "locking %s %d\n", $lock, $must; for (;;) { close $fh if $fh; $fh = new IO::File $lock, ">" or die "open $lock: $!"; my $ok = flock $fh, $must ? LOCK_EX : (LOCK_EX|LOCK_NB); if (!$ok) { die "flock $lock: $!" if $must; - debug " locking $lock failed"; + printdebug " locking $lock failed\n"; return undef; } next unless stat_exists $lock; @@ -134,7 +215,7 @@ sub acquirelock ($$) { return $fh; } -sub acquiretree ($$) { +sub acquirermtree ($$) { my ($tree, $must) = @_; my $fh = acquirelock("$tree.lock", $must); if ($fh) { @@ -144,6 +225,15 @@ sub acquiretree ($$) { return $fh; } +sub locksometree ($) { + my ($tree) = @_; + acquirelock("$tree.lock", 1); +} + +sub lockrealtree () { + locksometree(realdestrepo); +} + sub mkrepotmp () { my $tmpdir = "$dgitrepos/_tmp"; return if mkdir $tmpdir; @@ -170,31 +260,24 @@ sub reject ($) { die "dgit-repos-server: reject: $why\n"; } -sub debugcmd { - if ($debug) { - use Data::Dumper; - local $Data::Dumper::Indent = 0; - local $Data::Dumper::Terse = 1; - debug "|".Dumper(\@_); - } -} - sub runcmd { - debugcmd @_; + debugcmd '+',@_; $!=0; $?=0; my $r = system @_; - die "@_ $? $!" if $r; + die (shellquote @_)." $? $!" if $r; } sub policyhook { my ($policyallowbits, @polargs) = @_; - # => ($exitstatuspolicybitmap, $policylockfh); + # => ($exitstatuspolicybitmap); die if $policyallowbits & ~0x3e; - my @cmd = ($policyhook,$distro,$repos,@polargs); - debugcmd @_; - my $r = system @_; + my @cmd = ($policyhook,$distro,$dgitrepos,$dgitlive,$distrodir,@polargs); + debugcmd '+',@cmd; + my $r = system @cmd; die "system: $!" if $r < 0; - die "hook (@cmd) failed ($?)" if $r & ~($policyallowbits << 8); + die "hook (".(shellquote @cmd).") failed ($?)" + if $r & ~($policyallowbits << 8); + printdebug sprintf "hook => %#x\n", $r; return $r >> 8; } @@ -206,41 +289,47 @@ sub mkemptyrepo ($$) { sub mkrepo_fromtemplate ($) { my ($dir) = @_; my $template = "$dgitrepos/_template"; - debug "copy tempalate $template -> $dir"; + locksometree($template); + printdebug "copy template $template -> $dir\n"; my $r = system qw(cp -a --), $template, $dir; !$r or die "create new repo $dir failed: $r $!"; } sub movetogarbage () { + # realdestrepo must have been locked my $garbagerepo = "$dgitrepos/${package}_garbage"; - my $lfh =acquiretree($garbagerepo,1); # We arrange to always keep at least one old tree, for anti-rewind # purposes (and, I guess, recovery from mistakes). This is either # $garbage or $garbage-old. if (stat_exists "$garbagerepo") { + printdebug "movetogarbage: rmtree $garbagerepo-tmp\n"; rmtree "$garbagerepo-tmp"; if (rename "$garbagerepo-old", "$garbagerepo-tmp") { + printdebug "movetogarbage: $garbagerepo-old -> -tmp, rmtree\n"; rmtree "$garbagerepo-tmp"; } else { die "$garbagerepo $!" unless $!==ENOENT; + printdebug "movetogarbage: $garbagerepo-old -> -tmp\n"; } + printdebug "movetogarbage: $garbagerepo -> -old\n"; rename "$garbagerepo", "$garbagerepo-old" or die "$garbagerepo $!"; } - rename $realdestrepo, $garbagerepo + my $real = realdestrepo; + printdebug "movetogarbage: $real -> $garbagerepo\n"; + rename $real, $garbagerepo or $! == ENOENT or die "$garbagerepo $!"; - close $lfh; } -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 $!"; +sub policy_checkpackage () { + my $lfh = lockrealtree(); + + $policy = policyhook(FRESHREPO,'check-package',$package); + if ($policy & FRESHREPO) { + movetogarbage(); + } + + close $lfh; } #----- git-receive-pack ----- @@ -248,15 +337,17 @@ sub onwardpush () { sub fixmissing__git_receive_pack () { mkrepotmp(); $destrepo = "$dgitrepos/_tmp/${package}_prospective"; - acquiretree($destrepo, 1); + acquirermtree($destrepo, 1); mkrepo_fromtemplate($destrepo); } sub makeworkingclone () { mkrepotmp(); $workrepo = "$dgitrepos/_tmp/${package}_incoming$$"; - acquiretree($workrepo, 1); + acquirermtree($workrepo, 1); + my $lfh = lockrealtree(); runcmd qw(git clone -l -q --mirror), $destrepo, $workrepo; + close $lfh; rmtree "${workrepo}_fresh"; } @@ -272,7 +363,7 @@ END close $fh or die "$prerecv: $!"; $ENV{'DGIT_DRS_WORK'}= $workrepo; $ENV{'DGIT_DRS_DEST'}= $destrepo; - debug " stunt hook set up $prerecv"; + printdebug " stunt hook set up $prerecv\n"; } sub dealwithfreshrepo () { @@ -282,7 +373,7 @@ sub dealwithfreshrepo () { } sub maybeinstallprospective () { - return if $destrepo eq $realdestrepo; + return if $destrepo eq realdestrepo; if (open REJ, "<", "$workrepo/drs-error") { local $/ = undef; @@ -294,7 +385,7 @@ sub maybeinstallprospective () { $!==&ENOENT or die $!; } - debug " show-ref ($destrepo) ..."; + printdebug " show-ref ($destrepo) ...\n"; my $child = open SR, "-|"; defined $child or die $!; @@ -306,7 +397,7 @@ sub maybeinstallprospective () { my %got = qw(tag 0 head 0); while () { chomp or die; - debug " show-refs| $_"; + printdebug " show-refs| $_\n"; s/^\S*[1-9a-f]\S* (\S+)$/$1/ or die; my $wh = m{^refs/tags/} ? 'tag' : @@ -316,14 +407,18 @@ sub maybeinstallprospective () { } $!=0; $?=0; close SR or $?==256 or die "$? $!"; - debug "installprospective ?"; + printdebug "installprospective ?\n"; die Dumper(\%got)." -- missing refs in new repo" if grep { !$_ } values %got; - movetogarbage; # in case of FRESHREPO + lockrealtree(); + + if ($destrepo eq "${workrepo}_fresh") { + movetogarbage; + } - debug "install $destrepo => $realdestrepo"; - rename $destrepo, $realdestrepo or die $!; + printdebug "install $destrepo => ".realdestrepo."\n"; + rename $destrepo, realdestrepo or die $!; remove "$destrepo.lock" or die $!; } @@ -341,10 +436,10 @@ our ($tagname, $tagval, $suite, $oldcommit, $commit); our ($version, %tagh); sub readupdates () { - debug " updates ..."; + printdebug " updates ...\n"; while () { chomp or die; - debug " upd.| $_"; + printdebug " upd.| $_\n"; m/^(\S+) (\S+) (\S+)$/ or die "$_ ?"; my ($old, $sha1, $refname) = ($1, $2, $3); if ($refname =~ m{^refs/tags/(?=debian/)}) { @@ -367,11 +462,11 @@ sub readupdates () { reject "push is missing tag ref update" unless defined $tagname; reject "push is missing head ref update" unless defined $suite; - debug " updates ok."; + printdebug " updates ok.\n"; } sub parsetag () { - debug " parsetag..."; + printdebug " parsetag...\n"; open PT, ">dgit-tmp/plaintext" or die $!; open DS, ">dgit-tmp/plaintext.asc" or die $!; open T, "-|", qw(git cat-file tag), $tagval or die $!; @@ -394,12 +489,14 @@ sub parsetag () { $version = $2; die "$3 != $suite " unless $3 eq $suite; + my $copyl = $_; for (;;) { - print PT or die $!; + print PT $copyl or die $!; $!=0; $_=; defined or die "missing signature? $!"; + $copyl = $_; if (m/^\[dgit ([^"].*)\]$/) { # [dgit "something"] is for future $_ = $1." "; - for (;;) { + while (length) { if (s/^distro\=(\S+) //) { die "$1 != $distro" unless $1 eq $distro; } elsif (s/^(--deliberately-$package_re) //) { @@ -409,13 +506,14 @@ sub parsetag () { $supersedes{$1} = $2; } elsif (s/^[-+.=0-9a-z]\S* //) { } else { - die "unknown dgit info in tag"; + die "unknown dgit info in tag ($_)"; } } next; } last if m/^-----BEGIN PGP/; } + $_ = $copyl; for (;;) { print DS or die $!; $!=0; $_=; @@ -424,7 +522,7 @@ sub parsetag () { T->error and die $!; close PT or die $!; close DS or die $!; - debug " parsetag ok."; + printdebug " parsetag ok.\n"; } sub checksig_keyring ($) { @@ -435,12 +533,12 @@ sub checksig_keyring ($) { my $ok = undef; - debug " checksig keyring $keyringfile..."; + printdebug " checksig keyring $keyringfile...\n"; our @cmd = (qw(gpgv --status-fd=1 --keyring), $keyringfile, qw(dgit-tmp/plaintext.asc dgit-tmp/plaintext)); - debugcmd @cmd; + debugcmd '|',@cmd; open P, "-|", @cmd or die $!; @@ -448,7 +546,7 @@ sub checksig_keyring ($) { while (

) { next unless s/^\[GNUPG:\] //; chomp or die; - debug " checksig| $_"; + printdebug " checksig| $_\n"; my @l = split / /, $_; if ($l[0] eq 'NO_PUBKEY') { last; @@ -462,14 +560,14 @@ sub checksig_keyring ($) { } close P; - debug sprintf " checksig ok=%d", !!$ok; + printdebug sprintf " checksig ok=%d\n", !!$ok; return $ok; } sub dm_txt_check ($$) { my ($keyid, $dmtxtfn) = @_; - debug " dm_txt_check $keyid $dmtxtfn"; + printdebug " dm_txt_check $keyid $dmtxtfn\n"; open DT, '<', $dmtxtfn or die "$dmtxtfn $!"; while (

) { m/^fingerprint:\s+$keyid$/oi @@ -487,11 +585,11 @@ sub dm_txt_check ($$) { s/\([^()]+\)//; s/\,//; chomp or die; - debug " dm_txt_check allow| $_"; + printdebug " dm_txt_check allow| $_\n"; foreach my $p (split /\s+/) { if ($p eq $package) { # yay! - debug " dm_txt_check ok"; + printdebug " dm_txt_check ok\n"; return; } } @@ -503,16 +601,16 @@ sub dm_txt_check ($$) { sub verifytag () { foreach my $kas (split /:/, $keyrings) { - debug "verifytag $kas..."; + printdebug "verifytag $kas...\n"; $kas =~ s/^([^,]+),// or die; my $keyid = checksig_keyring $1; if (defined $keyid) { if ($kas =~ m/^a$/) { - debug "verifytag a ok"; + printdebug "verifytag a ok\n"; return; # yay } elsif ($kas =~ m/^m([^,]+)$/) { dm_txt_check($keyid, $1); - debug "verifytag m ok"; + printdebug "verifytag m ok\n"; return; } else { die; @@ -523,7 +621,7 @@ sub verifytag () { } sub checksuite () { - debug "checksuite ($suitesfile)"; + printdebug "checksuite ($suitesfile)\n"; open SUITES, "<", $suitesfile or die $!; while () { chomp; @@ -545,7 +643,7 @@ sub checktagnoreplay () { return unless $policy & (FRESHREPO|NOFFCHECK); my $garbagerepo = "$dgitrepos/${package}_garbage"; - acquiretree($garbagerepo,1); + lockrealtree(); local $ENV{GIT_DIR}; foreach my $garb ("$garbagerepo", "$garbagerepo-old") { @@ -557,7 +655,7 @@ sub checktagnoreplay () { if (!defined $ENV{GIT_DIR}) { # Nothing to overwrite so the FRESHREPO and NOFFCHECK were # pointless. Oh well. - debug "checktagnoreplay - no garbage, ok"; + printdebug "checktagnoreplay - no garbage, ok\n"; return; } @@ -570,20 +668,20 @@ sub checktagnoreplay () { $? and die "$branch $?"; if (!length) { # No such branch - NOFFCHECK was unnecessary. Oh well. - debug "checktagnoreplay - not FRESHREPO, new branch, ok"; + printdebug "checktagnoreplay - not FRESHREPO, new branch, ok\n"; return; } m/^(\w+)\n$/ or die "$branch $_ ?"; $onlyreferring = $1; - debug "checktagnoreplay - not FRESHREPO,". - " checking for overwriting refs/$branch=$onlyreferring"; + printdebug "checktagnoreplay - not FRESHREPO,". + " checking for overwriting refs/$branch=$onlyreferring\n"; } my @problems; - git_for_each_tag_referring($objreferring, sub { + git_for_each_tag_referring($onlyreferring, sub { my ($objid,$fullrefname,$tagname) = @_; - debug "checktagnoreplay - overwriting $fullrefname=$objid"; + printdebug "checktagnoreplay - overwriting $fullrefname=$objid\n"; my $supers = $supersedes{$fullrefname}; if (!defined $supers) { push @problems, "does not supersede $fullrefname"; @@ -601,7 +699,7 @@ sub checktagnoreplay () { join("; ", @problems). "\n"; } - debug "checktagnoreply - all ok" + printdebug "checktagnoreply - all ok\n" } sub tagh1 ($) { @@ -613,7 +711,7 @@ sub tagh1 ($) { } sub checks () { - debug "checks"; + printdebug "checks\n"; tagh1('type') eq 'commit' or reject "tag refers to wrong kind of object"; tagh1('object') eq $commit or reject "tag refers to wrong commit"; @@ -622,18 +720,20 @@ sub checks () { my $v = $version; $v =~ y/~:/_%/; - debug "translated version $v"; + printdebug "translated version $v\n"; $tagname eq "debian/$v" or die; - $policy = policyhook(NOFFCHECK|FRESHREPO, 'push',$package, - $version,$suite,$tagname, - join(",",@delberatelies)); + lockrealtree(); + + my @policy_args = ($package,$version,$suite,$tagname, + join(",",@deliberatelies)); + $policy = policyhook(NOFFCHECK|FRESHREPO, 'push', @policy_args); checktagnoreplay(); checksuite(); # check that our ref is being fast-forwarded - debug "oldcommit $oldcommit"; + printdebug "oldcommit $oldcommit\n"; if (!($policy & NOFFCHECK) && $oldcommit =~ m/[^0]/) { $?=0; $!=0; my $mb = `git merge-base $commit $oldcommit`; chomp $mb; @@ -656,10 +756,24 @@ sub checks () { $destrepo = "${workrepo}_fresh"; # workrepo lock covers mkrepo_fromtemplate $destrepo; } + + my $willinstall = ($destrepo eq realdestrepo ? '' : $destrepo); + policyhook(0, 'push-confirm', @policy_args, $willinstall); +} + +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 $!"; } sub stunthook () { - debug "stunthook"; + printdebug "stunthook in $workrepo\n"; chdir $workrepo or die "chdir $workrepo: $!"; mkdir "dgit-tmp" or $!==EEXIST or die $!; readupdates(); @@ -667,14 +781,14 @@ sub stunthook () { verifytag(); checks(); onwardpush(); - debug "stunthook done."; + printdebug "stunthook done.\n"; } #----- git-upload-pack ----- sub fixmissing__git_upload_pack () { $destrepo = "$dgitrepos/_empty"; - my $lfh = acquiretree($destrepo,1); + my $lfh = locksometree($destrepo); return if stat_exists $destrepo; rmtree "$destrepo.new"; mkemptyrepo "$destrepo.new", "0644"; @@ -684,7 +798,11 @@ sub fixmissing__git_upload_pack () { } sub main__git_upload_pack () { - runcmd qw(git upload-pack), $destrepo; + my $lfh = locksometree($destrepo); + printdebug "git-upload-pack in $destrepo\n"; + chdir $destrepo or die "$destrepo: $!"; + close $lfh; + runcmd qw(git upload-pack), "."; } #----- arg parsing and main program ----- @@ -696,46 +814,21 @@ sub argval () { return $v; } -sub parseargsdispatch () { - die unless @ARGV; - - delete $ENV{'GIT_DIR'}; # if not run via ssh, our parent git process - delete $ENV{'GIT_PREFIX'}; # sets these and they mess things up - - if ($ENV{'DGIT_DRS_DEBUG'}) { - $debug='='; - open DEBUG, ">&STDERR" or die $!; - } +our %indistrodir = ( + # keys are used for DGIT_DRS_XXX too + 'repos' => \$dgitrepos, + 'suites' => \$suitesfile, + 'policy-hook' => \$policyhook, + 'dgit-live' => \$dgitlive, + ); - if ($ARGV[0] eq '--pre-receive-hook') { - if ($debug) { $debug.="="; } - shift @ARGV; - @ARGV == 1 or die; - $package = shift @ARGV; - defined($distro = $ENV{'DGIT_DRS_DISTRO'}) or die; - defined($suitesfile = $ENV{'DGIT_DRS_SUITES'}) or die; - defined($workrepo = $ENV{'DGIT_DRS_WORK'}) or die; - defined($destrepo = $ENV{'DGIT_DRS_DEST'}) or die; - defined($keyrings = $ENV{'DGIT_DRS_KEYRINGS'}) or die $!; - defined($policyhook = $ENV{'DGIT_DRS_POLICYHOOK'}) or die $!; - open STDOUT, ">&STDERR" or die $!; - eval { - stunthook(); - }; - if ($@) { - recorderror "$@" or die; - die $@; - } - exit 0; - } +our @hookenvs = qw(distro suitesfile policyhook + dgitlive keyrings dgitrepos distrodir); - $ENV{'DGIT_DRS_DISTRO'} = argval(); - $ENV{'DGIT_DRS_SUITES'} = argval(); - $ENV{'DGIT_DRS_KEYRINGS'} = argval(); - $dgitrepos = argval(); - $ENV{'DGIT_DRS_POLICYHOOK'} = $policyhook = argval(); +# workrepo and destrepo handled ad-hoc - die unless @ARGV==1 && $ARGV[0] eq '--ssh'; +sub mode_ssh () { + die if @ARGV; my $cmd = $ENV{'SSH_ORIGINAL_COMMAND'}; $cmd =~ m{ @@ -750,7 +843,6 @@ sub parseargsdispatch () { or reject "command string not understood"; my $method = $1; $package = $2; - $realdestrepo = "$dgitrepos/$package.git"; my $funcn = $method; $funcn =~ y/-/_/; @@ -758,24 +850,100 @@ sub parseargsdispatch () { reject "unknown method" unless $mainfunc; - my ($policy, $pollock) = policyhook(FRESHREPO,'check-package',$package); - if ($policy & FRESHREPO) { - movetogarbage; - } - close $pollock or die $!; + policy_checkpackage(); - if (stat_exists $realdestrepo) { - $destrepo = $realdestrepo; + if (stat_exists realdestrepo) { + $destrepo = realdestrepo; } else { - debug " fixmissing $funcn"; + printdebug " fixmissing $funcn\n"; my $fixfunc = $main::{"fixmissing__$funcn"}; &$fixfunc; } - debug " running main $funcn"; + printdebug " running main $funcn\n"; &$mainfunc; } +sub mode_cron () { + die if @ARGV; + + my $listfh = tempfile(); + open STDOUT, ">&", $listfh or die $!; + policyhook(0,'check-list'); + open STDOUT, ">&STDERR" or die $!; + + seek $listfh, 0, 0 or die $!; + while (<$listfh>) { + chomp or die; + next if m/^\s*\#/; + next unless m/\S/; + die unless m/^($package_re)$/; + + $package = $1; + policy_checkpackage(); + } + die $! if $listfh->error; +} + +sub parseargsdispatch () { + die unless @ARGV; + + delete $ENV{'GIT_DIR'}; # if not run via ssh, our parent git process + delete $ENV{'GIT_PREFIX'}; # sets these and they mess things up + + if ($ENV{'DGIT_DRS_DEBUG'}) { + enabledebug(); + } + + if ($ARGV[0] eq '--pre-receive-hook') { + if ($debuglevel) { + $debugprefix.="="; + printdebug "in stunthook ".(shellquote @ARGV)."\n"; + foreach my $k (sort keys %ENV) { + printdebug "$k=$ENV{$k}\n" if $k =~ m/^DGIT/; + } + } + shift @ARGV; + @ARGV == 1 or die; + $package = shift @ARGV; + ${ $main::{$_} } = $ENV{"DGIT_DRS_\U$_"} foreach @hookenvs; + defined($workrepo = $ENV{'DGIT_DRS_WORK'}) or die; + defined($destrepo = $ENV{'DGIT_DRS_DEST'}) or die; + open STDOUT, ">&STDERR" or die $!; + eval { + stunthook(); + }; + if ($@) { + recorderror "$@" or die; + die $@; + } + exit 0; + } + + $distro = argval(); + $distrodir = argval(); + $keyrings = argval(); + + foreach my $dk (keys %indistrodir) { + ${ $indistrodir{$dk} } = "$distrodir/$dk"; + } + + while (@ARGV && $ARGV[0] =~ m/^--([-0-9a-z]+)=/ && $indistrodir{$1}) { + ${ $indistrodir{$1} } = $'; #'; + shift @ARGV; + } + + $ENV{"DGIT_DRS_\U$_"} = ${ $main::{$_} } foreach @hookenvs; + + die unless @ARGV==1; + + my $mode = shift @ARGV; + die unless $mode =~ m/^--(\w+)$/; + my $fn = ${*::}{"mode_$1"}; + die unless $fn; + $fn->(); +} + sub unlockall () { while (my $fh = pop @lockfhs) { close $fh; } } @@ -789,7 +957,7 @@ sub cleanup () { foreach my $lf (<*.lock>) { my $tree = $lf; $tree =~ s/\.lock$//; - next unless acquiretree($tree, 0); + next unless acquirermtree($tree, 0); remove $lf or warn $!; unlockall(); }