diff options
Diffstat (limited to 'infra')
| -rwxr-xr-x | infra/dgit-mirror-ssh-wrap | 9 | ||||
| -rwxr-xr-x | infra/dgit-repos-policy-debian | 186 | ||||
| -rwxr-xr-x | infra/dgit-repos-server | 26 | ||||
| -rwxr-xr-x | infra/dgit-ssh-dispatch | 20 | ||||
| -rwxr-xr-x | infra/get-dm-txt | 3 |
5 files changed, 191 insertions, 53 deletions
diff --git a/infra/dgit-mirror-ssh-wrap b/infra/dgit-mirror-ssh-wrap index 3feb6dc..afbbbbf 100755 --- a/infra/dgit-mirror-ssh-wrap +++ b/infra/dgit-mirror-ssh-wrap @@ -24,14 +24,19 @@ my $command = $ENV{SSH_ORIGINAL_COMMAND} #print STDERR ">$d<\n"; -$command =~ +$_ = $command; m{^rsync --server -lHtre\.iLsfxC --timeout=\d+ --delete --safe-links \. $d$} +|| +m{^rsync --server -lHtre\.iLsfxCIv --timeout=\d+ --delete --safe-links \. $d$} +|| +m{^rsync --server -lHtre\.iLsfxCIvu --timeout=\d+ --delete --safe-links \. $d$} # To add a new command pattern, add || m{^ ... $} above. # The pattern should contain $d where the per-package destination # directory would go. -or die "unexpected command $command\n"; +or die "dgit-mirror-ssh-wrap: unexpected command (rsync upgraded?): + $command\n"; exec $& or die $!; diff --git a/infra/dgit-repos-policy-debian b/infra/dgit-repos-policy-debian index ad21564..f15c742 100755 --- a/infra/dgit-repos-policy-debian +++ b/infra/dgit-repos-policy-debian @@ -182,7 +182,7 @@ sub statpackage () { } sub getpackage () { - die unless @ARGV >= 1; + die "need PACKAGE" unless @ARGV >= 1; $pkg = shift @ARGV; die unless $pkg =~ m/^$package_re$/; @@ -247,6 +247,21 @@ sub add_taint_by_tag ($$) { } sub check_package () { + # This is not read-only, but it is safe to call within a + # policy-client-query, because it will do one of the following: + # + # * Do nothing much. + # * Find that the package has been ACCEPTed, make it not secret, + # and mirror it. + # * Find that the package has been REJECTed and add some taints + # to the db. This may be rolled back, but that's OK because + # future calls will discover the same. + # + # (This is a consequence of this function being idempotent, + # cron-callable, and correct in the sense that it doesn't make + # wrongly-sequenced updates to both the DB and the FS.) + # + # An (often useful) side-effect is to chdir to the package repo. return 0 unless $pkg_exists; return 0 unless $pkg_secret; @@ -312,14 +327,54 @@ sub getpushinfo () { sub deliberately ($) { return $deliberately{"--deliberately-$_[0]"}; } +sub package_questionable_head_msg () { + # This lets us reuse some of the same code, and the same message, + # for checking during actual push, and for pre-push taint check. + # + # In principle it might be nicer to unify this code, with some + # kind of super realistic dry run push function. However, that + # dry run function would have to involve sending the client's git + # objects to the server. We wouldn't want to do that twice, so it + # would have to be cached somehow, but we don't want to allow + # un-signed things to lurk about on the server. (The super dry + # run mode would have to involve the server tolerating an unsigned + # tag, or something, but that would be OK in principle.) The dry + # run mode would have to be careful about what subsets of the + # actions it took. + # + # So instead we apply ad-hoc checks, with separate implementations + # for the push path, and the pre-push checks. The tainted-objects + # policy-client-query exists to support this: it allows the + # efficient reimplementation of the tainted objects check, without + # transferring the objects to the server. + + return undef unless $pkg_exists; + return undef unless $pkg_secret; + # TODO: ideally this would be translated at the client end but + # that would involve marking it i_ here (which is part of + # dgit-intrastructure.deb) and then having the string appear in + # the po for dgit.deb. + return <<END; +Package is in NEW and has not been accepted or rejected yet. +Unfortunately, we cannot determine automatically what should happen. +You will have to pass either --deliberately-not-fast-forward or +--deliberately-include-questionable-history to specify whether you are +keeping or discarding the previously pushed history. + +The choice is important, to ensure that your git history is both +suitable for public distribution and as useful as possible. Please +see the descriptions of these options in dgit(1). +END +} + sub action_push () { getpackage(); getpushinfo(); check_package(); # might make package public, or might add taints - return 0 unless $pkg_exists; - return 0 unless $pkg_secret; + my $questionable_head_msg = package_questionable_head_msg(); + return 0 unless defined $questionable_head_msg; # we suppose that NEW has a version which is already in our # history, as otherwise the repo would have been blown away @@ -334,19 +389,7 @@ sub action_push () { if (deliberately('include-questionable-history')) { return 0; } - die <<END; - -Package is in NEW and has not been accepted or rejected yet. -Unfortunately, we cannot determine automatically what should happen. -You will have to pass either --deliberately-not-fast-forward or ---deliberately-include-questionable-history to specify whether you are -keeping or discarding the previously pushed history. - -The choice is important, to ensure that your git history is both -suitable for public distribution and as useful as possible. Please -see the descriptions of these options in dgit(1). - -END + die "\n". $questionable_head_msg. "\n"; } sub action_push_confirm () { @@ -402,6 +445,7 @@ END END my $mustreject=0; + my %hinted; while (my $taintid = shift @taintids) { $!=0; $_ = <CHKOUT>; @@ -428,46 +472,33 @@ END my $ti = $taintinfoq->fetchrow_hashref(); die "($taintid)" unless $ti; - my $timeshow = defined $ti->{time} - ? " at time ".strftime("%Y-%m-%d %H:%M:%S Z", gmtime $ti->{time}) - : ""; - my $pkgshow = length $ti->{package} - ? "package $ti->{package}" - : "any package"; - - $stderr .= <<END; - -History contains tainted $objtype $objid -Taint recorded$timeshow for $pkgshow -Reason: $ti->{comment} -END - printdebug "SQL overrides: @overridesv $taintid /\n$overridesstmt\n"; $overridesq ||= $poldbh->prepare($overridesstmt); $overridesq->execute(@overridesv, $taintid); my ($ovwhy) = $overridesq->fetchrow_array(); + my $ovstatus; if (!defined $ovwhy) { $overridesanyq ||= $poldbh->prepare(<<END); SELECT 1 FROM taintoverrides WHERE taint_id = ? LIMIT 1 END $overridesanyq->execute($taintid); my ($ovany) = $overridesanyq->fetchrow_array(); - $stderr .= $ovany ? <<END : <<END; -Could be forced using --deliberately. Consult documentation. -END -Uncorrectable error. If confused, consult administrator. -END + $ovwhy = $ovany ? '' : undef; $mustreject = 1; } else { - $stderr .= <<END; -Forcing due to $ovwhy -END $untaintq ||= $poldbh->prepare(<<END); DELETE FROM taints WHERE taint_id = ? END $untaintq->execute($taintid); } + + $stderr .= tainted_objects_message({ + %$ti, + gitobjid => $objid, + gitobjtype => $objtype, + }, $ovstatus, \%hinted); + } close CHKOUT; @@ -512,11 +543,70 @@ sub action_check_list () { return 0; } -$action =~ y/-/_/; -my $fn = ${*::}{"action_$action"}; +sub polclqu_tainted_objects () { + check_package(); + my $suite = shift @ARGV // die "need SUITE"; + + my $topq = $poldbh->selectall_arrayref(<<END, + SELECT taint_id, gitobjtype, gitobjid, time, comment + FROM taints + WHERE (package = ? OR package = '') +END + { Slice => {} }, + $pkg); + foreach my $row (@$topq) { + my $delibs = $poldbh->selectall_arrayref(<<END, + SELECT deliberately + FROM taintoverrides + WHERE taint_id = ? +END + { }, + $row->{taint_id}); + $row->{overrides} = [ map { $_->[0] } @$delibs ]; + delete $row->{taint_id}; + # remove any undef entries, for nice json + foreach my $k (keys %$row) { + defined $row->{$k} or delete $row->{$k}; + } + } + if (defined(my $questionable_head_msg = package_questionable_head_msg())) { + # We would reject this in push. We need to arrange that the + # client will detect this. The object tainting mechanism can + # be (ab)used for this: we tell the client that HEAD is tainted. + my $head = git_rev_parse(server_ref($suite).'~0'); + push @$topq, { + gitobjtype => 'commit', + gitobjid => $head, + comment => 'Package is in NEW, need a --deliberately', + hint => $questionable_head_msg, + # If the client was told -d-i-q-h, then they can go ahead - + # our push will be placated. If the client was told -d-n-f-f + # then presumably they aren't sending the old HEAD, so there + # won't be a tainted object reachable from their head - so + # -d-n-f-f isn't listed here. After all, this is for controlling + # when the client will regard this as a blocking problem, not + # for advising the user about overriding options. + overrides => [qw(--deliberately-include-questionable-history)] + }; + } + print encode_json $topq, "\n" or die $!; +} + +my $fn_name; + +if ($action eq 'policy-client-query') { + getpackage(); + my $query = shift @ARGV // die "need QUERY-OP"; + $fn_name = "polclqu_$query"; +} else { + $fn_name = "action_$action"; +} +$fn_name =~ y/-/_/; +my $fn = ${*::}{$fn_name}; + if (!$fn) { - printdebug "dgit-repos-policy-debian: unknown action $action\n"; - exit 0; + printdebug "dgit-repos-policy-debian: unknown $fn_name\n"; + _exit 0; } my $sleepy=0; @@ -543,10 +633,16 @@ for (;;) { $stderr = ''; $rcode = $fn->(); - die unless defined $rcode; - $poldbh->commit; - printdebug "poldbh commit\n"; + if ($action eq 'policy-client-query') { + close STDOUT or die $!; + _exit 0; + } else { + die unless defined $rcode; + + $poldbh->commit; + printdebug "poldbh commit\n"; + } }; last unless length $@; die $@ unless ref $@ eq $db_busy_exception; diff --git a/infra/dgit-repos-server b/infra/dgit-repos-server index bbf1aa2..9c7e36d 100755 --- a/infra/dgit-repos-server +++ b/infra/dgit-repos-server @@ -154,8 +154,10 @@ setup_sigwarn(); # VERSION SUITE TAGNAME DELIBERATELIES [...] # POLICY-HOOK-SCRIPT ... push-confirm PACKAGE \ # VERSION SUITE TAGNAME DELIBERATELIES FRESH-REPO|'' [...] +# POLICY-HOOK-SCRIPT ... policy-client-query PACKAGE POL-CL-QUERY [...] # # DELIBERATELIES is like this: --deliberately-foo,--deliberately-bar,... +# POL-CL-QUERY is in the syntax of a package name # # Exit status of policy hook is a bitmask. # Bit weight constants are defined in Dgit.pm. @@ -200,6 +202,26 @@ setup_sigwarn(); # package), it should use DGIT-LIVE-DIR/dgit (etc.), or if that is # ENOENT, use the installed version. # +# POL-CL-QUERY is one of the following: +# +# tainted-objects SUITE +# => [ { "gitobjid": "sha", +# "comment": $string, # in server"s native language, UTF-8 +# "overrides": [ "--deliberately-include-q-h", ... ], +# # optional (may be absent, not null): +# "gitobjtype": "commit", # as from git-cat-file -t +# "time": $time_t, +# "hint": $string, # client should translate if it can +# } } +# +# Arguments after POL-CL-QUERY cannot contain `;` or whitespace; +# they are obtained by dgit-ssh-dispatch by naive whitespace-splitting +# a string from SSH_ORIGINAL_COMMAND. +# +# (Response value is JSON unless otherwise specified.) +# If POL-CL-QUERY is not supported, the server will exit successfully +# producing no output. +# # Mirror hook scripts are invoked like this: # MIRROR-HOOK-SCRIPT DISTRO-DIR ACTION... # and currently there is only one action invoked by dgit-repos-server: @@ -1106,7 +1128,7 @@ sub mode_tag2upload () { or $quit->("tag name not for us"); $version = $1; - $version =~ y/_\%\#/:~/d; + $version =~ y/_\%\#/~:/d; my $work = 'work'; @@ -1288,7 +1310,7 @@ END push @dgitcmd, "--upstream-commitish=refs/tags/$upstreamt"; } } - push @dgitcmd, qw(push-source --new --overwrite), $suite; + push @dgitcmd, qw(push-source --new --trust-changelog), $suite; runcmd @dgitcmd; diff --git a/infra/dgit-ssh-dispatch b/infra/dgit-ssh-dispatch index c5861d2..e63d4bf 100755 --- a/infra/dgit-ssh-dispatch +++ b/infra/dgit-ssh-dispatch @@ -137,6 +137,12 @@ sub serve_up ($) { die "exec git: $!"; } +sub perllib_local () { + $ENV{'PERLLIB'} //= ''; + $ENV{'PERLLIB'} =~ s#^(?=.)#:#; + $ENV{'PERLLIB'} =~ s#^# $ENV{DGIT_TEST_INTREE} // $dgitlive #e; +} + sub dispatch () { local ($_) = $ENV{'SSH_ORIGINAL_COMMAND'} // ''; @@ -150,9 +156,7 @@ sub dispatch () { my $cmd=$1; selectpackage $2,$3; if ($cmd eq 'receive-pack') { - $ENV{'PERLLIB'} //= ''; - $ENV{'PERLLIB'} =~ s#^(?=.)#:#; - $ENV{'PERLLIB'} =~ s#^# $ENV{DGIT_TEST_INTREE} // $dgitlive #e; + perllib_local(); my $s = "$dgitlive/infra/dgit-repos-server"; $s = "dgit-repos-server" if !stat_exists $s; exec $s, $distro, $d, $authrune, qw(--ssh); @@ -173,6 +177,16 @@ sub dispatch () { } elsif (m#^${qre}git-upload-pack\s#) { die "unknown repo to serve ($_). use dgit, or for server source ". "git clone here:/dgit/DISTRO/repos/_dgit-repos-server.git"; + } elsif (m#^: dgit ($lre) policy-client-query ($lre) ($lre) ([^;]*) ;#) { + my $query_op = $3; + my $query_args = $4; + selectpackage $1,$2; + my @cmd = ($policyhook,$distro,$repos,$dgitlive,$d, + 'policy-client-query', $pkg, $query_op, + split / /, $query_args); + perllib_local(); + exec @cmd;; + die "exec $cmd[0]: $!"; } else { die "unsupported operation ($_)"; } diff --git a/infra/get-dm-txt b/infra/get-dm-txt index 0b9ab10..edc435b 100755 --- a/infra/get-dm-txt +++ b/infra/get-dm-txt @@ -8,7 +8,8 @@ file=dm.txt server=ftp-master.debian.org path=$file -certargs=$(git config dgit-distro.debian.archive-query-tls-curl-ca-args \ +certargs=$(git config --default '' \ + dgit-distro.debian.archive-query-tls-curl-ca-args \ || (echo >&2 "git config failed"; exit 1)) with-lock-ex -f $file.lock sh -c " |