diff options
Diffstat (limited to 'infra')
| -rwxr-xr-x | infra/cgit-regen-config | 26 | ||||
| -rwxr-xr-x | infra/dgit-mirror-rsync | 171 | ||||
| -rwxr-xr-x | infra/dgit-repos-admin-debian | 220 | ||||
| -rwxr-xr-x | infra/dgit-repos-policy-debian | 553 | ||||
| -rwxr-xr-x | infra/dgit-repos-policy-trusting | 58 | ||||
| -rwxr-xr-x | infra/dgit-repos-server | 1178 | ||||
| -rwxr-xr-x | infra/dgit-ssh-dispatch | 181 | ||||
| -rwxr-xr-x | infra/drs-cron-wrap | 14 | ||||
| -rwxr-xr-x | infra/get-dm-txt | 21 | ||||
| -rwxr-xr-x | infra/get-suites | 26 | ||||
| -rwxr-xr-x | infra/ssh-wrap | 10 |
11 files changed, 2458 insertions, 0 deletions
diff --git a/infra/cgit-regen-config b/infra/cgit-regen-config new file mode 100755 index 0000000..36228a1 --- /dev/null +++ b/infra/cgit-regen-config @@ -0,0 +1,26 @@ +#!/bin/sh +set -e + +root=/srv/dgit.debian.org + +repos=$root/unpriv/repos +outfile=$root/etc/projects.cgit +lockfile=$outfile.lock +template=$root/config/cgit-template + +flock $lockfile -c ' + outfile='"$outfile"' + repos='"$repos"' + exec >"$outfile.tmp" + for ff in "$repos"/[0-9a-z]*.git; do + f=${ff##*/} + p=${f%.git} + cat <<END +repo.url=$f +repo.path=$repos/$f +END + sed "s/%PACKAGE%/$p/g" <'"$template"' + echo + done + mv -f "$outfile.tmp" "$outfile" +' diff --git a/infra/dgit-mirror-rsync b/infra/dgit-mirror-rsync new file mode 100755 index 0000000..9346489 --- /dev/null +++ b/infra/dgit-mirror-rsync @@ -0,0 +1,171 @@ +#!/bin/bash +# +# Mirror script for use as a dgit-repos-server mirror hook +# +# In addition to updated-hook (invoked by dgit-repos-server), +# this script also supports the following ACTIONs: +# MIRROR-HOOK-SCRIPT ... setup [...] create queue dir etc. +# MIRROR-HOOK-SCRIPT ... backlog [...] do all packages which need it +# MIRROR-HOOK-SCRIPT ... all [...] do all packages +# MIRROR-HOOK-SCRIPT ... mirror PACKAGE [...] do just that, longer timeout +# +# DISTRO-DIR must contain a file `mirror-settings' which is a bash +# script fragment assigning the following variables: +# remoterepos for rsync, in form user@host:/dir +# and optionally +# hooktimeout default 30 [sec] +# rsynctimeout default 900 [sec] +# rsyncssh default 'ssh -o batchmode=yes' +# rsync array, default (rsync -rltH --safe-links --delete) +# repos default DISTRO-DIR/repos +# (optional settings are all set before mirror-settings is included, +# so you can modify them with += or some such) + +set -e +set -o pipefail +shopt -s nullglob + +case "$DGIT_DRS_DEBUG" in +''|0|1) ;; +*) set -x ;; +esac + +fail () { + echo >&2 "dgit-mirror-rsync: $*"; exit 127 +} + +if [ $# -lt 2 ]; then fail "too few arguments"; fi + +self=$0 + +case "$self" in +/*) ;; +*/*) self="$PWD/$self" ;; +*) ;; +esac + +distrodir=$1; shift +action=$1; shift +package=$1 + +repos=$distrodir/repos + +rsync=(rsync -rltH --safe-links --delete) +hooktimeout=30 +rsynctimeout=900 +rsyncssh='ssh -o batchmode=yes' + +. $distrodir/mirror-settings + +# contents of $queue +# $queue/$package.n - mirror needed +# $queue/$package.a - being attempted, or attempt failed +# $queue/$package.lock - lock (with-lock-ex) +# $queue/$package.err - stderr from failed (or current) run +# $queue/$package.log - stderr from last successful run + +cd $repos +queue=_mirror-queue + +case "$remoterepos" in +*:/*|/*) ;; +'') fail "remoterepos config not set" ;; +*) fail "remoterepos config does not match *:/* or /*" ;; +esac + +actually () { + "${rsync[@]}" \ + --timeout=$rsynctimeout \ + -e "$rsyncssh" \ + "$repos/$package.git"/. \ + "$remoterepos/$package.git" +} + +reinvoke () { + newaction="$1"; shift + + exec \ + "$@" \ + "$self" "$distrodir" "reinvoke$newaction" "$package" +} + +check-package-mirrorable () { + local repo=$repos/$package.git + local mode; mode=$(stat -c%a "$repo") + case $mode in + *5) return 0 ;; + *0) return 1 ;; + *) echo >&2 "unexpected mode $mode for $repo"; return 1 ;; + esac +} + +lock-and-process () { + check-package-mirrorable || return 0 + reinvoke -locked with-lock-ex -w "$queue/$package.lock" +} + +attempt () { + exec 3>&2 >"$queue/$package.err" 2>&1 + if actually; then + rm -f "$queue/$package.a" + exec 2>&3 2>&1 + mv -f "$queue/$package.err" "$queue/$package.log" + if ! [ -s "$queue/$package.log" ]; then + rm "$queue/$package.log" + fi + rm "$queue/$package.lock" + else + cat >&3 "$queue/$package.err" + exit 127 + fi +} + +lock-and-process-baseof-f () { + package=${f##*/} + package=${package%.*} + lock-and-process +} + +case "$action" in + +updated-hook) + check-package-mirrorable || exit 0 + touch "$queue/$package.n" + reinvoke -timed timeout --foreground $hooktimeout + ;; + +reinvoke-timed) + (lock-and-process) >/dev/null 2>&1 + ;; + +mirror) + lock-and-process + ;; + +reinvoke-locked) + touch "$queue/$package.a" + rm -f "$queue/$package.n" + attempt + ;; + +backlog) + for f in $queue/*.[na]; do + (lock-and-process-baseof-f ||:) + done + ;; + +all) + for f in [a-z0-9]*.git; do + (lock-and-process-baseof-f) + done + ;; + +setup) + test -d "$queue" || mkdir "$queue" + ;; + +*) + fail "bad action $action" + ;; + +esac diff --git a/infra/dgit-repos-admin-debian b/infra/dgit-repos-admin-debian new file mode 100755 index 0000000..6d1e4d0 --- /dev/null +++ b/infra/dgit-repos-admin-debian @@ -0,0 +1,220 @@ +#!/usr/bin/perl -w +# dgit repos policy admin script for Debian +# +# Copyright (C) 2015-2016 Ian Jackson +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <http://www.gnu.org/licenses/>. + +use strict; + +use Debian::Dgit::Infra; # must precede Debian::Dgit; - can change @INC! +use Debian::Dgit; +setup_sigwarn(); + +our $usage = <<'END'; +usage: + dgit-repos-admin-debian [<options>] operation... +options: + --git-dir /path/to/git/repo/or/working/tree + --repos /path/to/dgit/repos/directory } alternatives + --db /path/to/dgit/repos/policy.sqlite3 } + (at least one of above required; if only one, cwd is used for other) +operations: + create-db + list-taints + taint [--global|<package>] <gitobjid> '<comment>' + untaint [--global|<package>] <gitobjid> +END + +use POSIX; +use DBI; + +use Debian::Dgit::Policy::Debian; + +sub badusage ($) { die "bad usage: $_[0]\n$usage"; } + +use Getopt::Long qw(:config posix_default gnu_compat bundling); + +our ($git_dir,$repos_dir,$db_path); + +GetOptions("git-dir=s" => \$git_dir, + "repos=s" => \$repos_dir, + "db=s" => \$db_path) + or die $usage; + +$db_path //= poldb_path($repos_dir) if defined $repos_dir; +$db_path // $repos_dir || + die <<'END'.$usage; +Must supply --git-dir and/or --repos (or --db instead of --repos). +If only one of --git-dir and --repos is supplied, other is taken to +be current working directory. +END +# / + +$git_dir //= '.'; +$repos_dir //= '.'; + +our $p; +our $gitobjid; + +sub get_package_objid () { + $p = shift @ARGV; $p // badusage "operation needs package or --global"; + if ($p eq '--global') { + $p = ''; + } else { + $p =~ m/^$package_re$/ or badusage 'package name or --global needed'; + } + $gitobjid = shift @ARGV; + $gitobjid // badusage "operation needs git object id"; + $gitobjid =~ m/\W/ && badusage "invalid git object id"; +} + +sub sort_out_git_dir () { + foreach my $sfx ('/.git', '') { + my $path = "$git_dir/$sfx"; + if (stat_exists "$path/objects") { + $ENV{GIT_DIR} = $git_dir = $path; + return; + } + } + die "git directory $git_dir doesn't seem valid\n"; +} + +sub show_taints ($$@) { + my ($m, $cond, @condargs) = @_; + my $q = $poldbh->prepare + ("SELECT package,gitobjid,gitobjtype,time,comment, ". + " (gitobjdata IS NOT NULL) hasdata". + " FROM taints WHERE $cond". + " ORDER BY package, gitobjid, time"); + $q->execute(@condargs); + print "$m:\n" or die $!; + my $count = 0; + while (my $row = $q->fetchrow_hashref) { + my $t = strftime "%Y-%m-%dT%H:%M:%S", gmtime $row->{time}; + my $objinfo = $row->{gitobjtype}. ($row->{hasdata} ? '+' : ' '); + my $comment = $row->{comment}; + $comment =~ s/\\/\\\\/g; $comment =~ s/\n/\\n/g; + printf(" %s %-30s %s %7s %s\n", + $t, $row->{package}, $row->{gitobjid}, + $objinfo, $row->{comment}) + or die $!; + $count++; + } + return $count; +} + +sub cmd_list_taints ($) { + badusage "no args/options" if @ARGV; + my $count = show_taints("all taints","1"); + printf "%d taints listed\n", $count or die $!; +} + +sub cmd_create_db ($) { + badusage "no args/options" if @ARGV; + + $poldbh->do(<<END); + CREATE TABLE IF NOT EXISTS taints ( + taint_id INTEGER NOT NULL PRIMARY KEY ASC AUTOINCREMENT, + package TEXT NOT NULL, + gitobjid TEXT NOT NULL, + comment TEXT NOT NULL, + time INTEGER, + gitobjtype TEXT, + gitobjdata TEXT + ) +END + $poldbh->do(<<END); + CREATE INDEX IF NOT EXISTS taints_by_gitobjid + ON taints (gitobjid, package) +END + # any one of of the listed deliberatelies will override its taint + # the field `deliberately' contains `--deliberately-blah-blah', + # not just `blah blah'. + $poldbh->do(<<END); + CREATE TABLE IF NOT EXISTS taintoverrides ( + taint_id INTEGER NOT NULL + REFERENCES taints (taint_id) + ON UPDATE RESTRICT + ON DELETE CASCADE + DEFERRABLE INITIALLY DEFERRED, + deliberately TEXT NOT NULL, + PRIMARY KEY (taint_id, deliberately) + ) +END + + $poldbh->commit; +} + +sub show_taints_bypackage ($) { + my ($m) = @_; + show_taints($m, "package = ?", $p); +} + +sub show_taints_bygitobjid ($) { + my ($m) = @_; + show_taints($m, "gitobjid = ?", $gitobjid); +} + +sub show_relevant_taints ($) { + my ($what) = @_; + show_taints_bypackage($p ? "$what taints for package $p" + : "$what global taints"); + show_taints_bygitobjid("$what taints for object $gitobjid"); +} + +sub cmd_taint () { + get_package_objid(); + my $comment = shift @ARGV; + $comment // badusage "operation needs comment"; + @ARGV && badusage "too many arguments to taint"; + + sort_out_git_dir(); + $!=0; $?=0; my $objtype = `git cat-file -t $gitobjid`; + chomp $objtype or die "$? $!"; + + $poldbh->do("INSERT INTO taints". + " (package, gitobjid, gitobjtype, time, comment)". + " VALUES (?,?,?,?,?)", {}, + $p, $gitobjid, $objtype, time, $comment); + $poldbh->commit; + print "taint added\n" or die $!; + show_relevant_taints("resulting"); +} + +sub cmd_untaint () { + get_package_objid(); + @ARGV && badusage "too many arguments to untaint"; + + show_relevant_taints("existing"); + my $affected = + $poldbh->do("DELETE FROM taints". + " WHERE package = ? AND gitobjid = ?", + {}, $p, $gitobjid); + $poldbh->commit; + printf "%d taints removed\n", $affected or die $!; + exit $affected ? 0 : 1; +} + + +my $cmd = shift @ARGV; +$cmd // badusage "need operation"; + +$cmd =~ y/-/_/; +my $fn = ${*::}{"cmd_$cmd"}; +$fn or badusage "unknown operation $cmd"; + +poldb_setup($db_path); + +$fn->(); diff --git a/infra/dgit-repos-policy-debian b/infra/dgit-repos-policy-debian new file mode 100755 index 0000000..990abd2 --- /dev/null +++ b/infra/dgit-repos-policy-debian @@ -0,0 +1,553 @@ +#!/usr/bin/perl -w +# dgit repos policy hook script for Debian +# +# Copyright (C) 2015-2016 Ian Jackson +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <http://www.gnu.org/licenses/>. + +use strict; + +use Debian::Dgit::Infra; # must precede Debian::Dgit; - can change @INC! +use Debian::Dgit qw(:DEFAULT :policyflags); +setup_sigwarn(); + +use POSIX; +use JSON; +use File::Temp qw(tempfile); +use DBI; +use IPC::Open2; +use Data::Dumper; + +use Debian::Dgit::Policy::Debian; + +initdebug('%'); +enabledebuglevel $ENV{'DGIT_DRS_DEBUG'}; + +END { $? = 127; } # deliberate exit uses _exit + +our $distro = shift @ARGV // die "need DISTRO"; +our $repos = shift @ARGV // die "need DGIT-REPOS-DIR"; +our $dgitlive = shift @ARGV // die "need DGIT-LIVE-DIR"; +our $distrodir = shift @ARGV // die "need DISTRO-DIR"; +our $action = shift @ARGV // die "need ACTION"; + +our $publicmode = 02775; +our $new_upload_propagation_slop = 3600*4 + 100;# fixme config; + +our $poldbh; +our $pkg; +our $pkgdir; +our ($pkg_exists,$pkg_secret); + +our $stderr; + +our ($version,$suite,$tagname); +our %deliberately; + +# We assume that it is not possible for NEW to have a version older +# than sid. + +# Whenever pushing, we check for +# source-package-local tainted history +# global tainted history +# can be overridden by --deliberately except for an admin prohib taint +# +# ALL of the following apply only if history is secret: +# +# if NEW has no version, or a version which is not in our history[1] +# (always) +# check all suites +# if any suite's version is in our history[1], publish our history +# otherwise discard our history, +# tainting --deliberately-include-questionable-history +# +# if NEW has a version which is in our history[1] +# (on push only) +# require explicit specification of one of +# --deliberately-include-questionable-history +# --deliberately-not-fast-forward +# (latter will taint old NEW version --d-i-q-h) +# (otherwise) +# leave it be +# +# [1] looking for the relevant git tag for the version number and not +# caring what that tag refers to. +# +# When we are doing a push to a fresh repo, any version will do: in +# this case, this is the first dgit upload of an existing package, +# and we trust that the uploader hasn't included in their git +# history any previous non-dgit uploads. +# +# A wrinkle: if we approved a push recently, we treat NEW as having +# a version which is in our history. This is because the package may +# still be being uploaded. (We record this using the timestamp of the +# package's git repo directory.) + +# We aim for the following invariants and properties: +# +# - .dsc of published dgit package will have corresponding publicly +# visible dgit-repo (soon) +# +# - when a new package is rejected we help maintainer avoid +# accidentally including bad objects in published dgit history +# +# - .dsc of NEW dgit package has corresponding dgit-repo but not +# publicly readable + +sub apiquery ($) { + my ($subpath) = @_; + local $/=undef; + my $dgit = "$dgitlive/dgit"; + $dgit = "dgit" if !stat_exists $dgit; + my $cmd = "$dgit -d$distro \$DGIT_TEST_OPTS"; + $cmd .= " -".("D" x $debuglevel) if $debuglevel; + $cmd .= " archive-api-query $subpath"; + printdebug "apiquery $cmd\n"; + $!=0; $?=0; my $json = `$cmd`; + defined $json && !$? or die "$subpath $! $?"; + my $r = decode_json $json; + my $d = new Data::Dumper([$r], [qw(r)]); + printdebug "apiquery $subpath | ", $d->Dump() if $debuglevel>=2; + return $r; +} + +sub vsn_in_our_history ($) { + my ($vsn) = @_; + + # Eventually, when we withdraw support for old-format (DEP-14 + # namespace) tags, we will need to change this to only look + # for debiantag_new. See the commit + # "Tag change: Update dgit-repos-policy-debian" + # (reverting which is a good start for that change). + + my @tagrefs = map { "refs/tags/".$_ } debiantags $vsn, $distro; + printdebug " checking history vsn=$vsn tagrefs=@tagrefs\n"; + open F, "-|", qw(git for-each-ref), @tagrefs; + $_ = <F>; + close F; + return 1 if defined && m/\S/; + die "$pkg tagrefs @tagrefs $? $!" if $?; + return 0; +} + +sub specific_suite_has_suitable_vsn ($$) { + my ($suite, $vsn_check) = @_; # tests $vsn_check->($version) + my $in_suite = apiquery "dsc_in_suite/$suite/$pkg"; + foreach my $entry (@$in_suite) { + my $vsn = $entry->{version}; + die "$pkg ?" unless defined $vsn; + printdebug " checking history found suite=$suite vsn=$vsn\n"; + return 1 if $vsn_check->($vsn); + } + return 0; +} + +sub new_has_vsn_in_our_history () { + return specific_suite_has_suitable_vsn('new', \&vsn_in_our_history); +} + +sub good_suite_has_suitable_vsn ($) { + my ($vsn_check) = @_; # as for specific_suite_has_specific_vsn + my $suites = apiquery "suites"; + foreach my $suitei (@$suites) { + my $suite = $suitei->{name}; + die unless defined $suite; + next if $suite =~ m/\bnew$/; + return 1 if specific_suite_has_suitable_vsn($suite, $vsn_check); + } + return 0; +} + +sub statpackage () { + $pkgdir = "$repos/$pkg.git"; + if (!stat_exists $pkgdir) { + printdebug "statpackage $pkg => ENOENT\n"; + $pkg_exists = 0; + } else { + $pkg_exists = 1; + $pkg_secret = !!(~(stat _)[2] & 05); + printdebug "statpackage $pkg => exists, secret=$pkg_secret.\n"; + } +} + +sub getpackage () { + die unless @ARGV >= 1; + $pkg = shift @ARGV; + die unless $pkg =~ m/^$package_re$/; + + statpackage(); +} + +sub add_taint ($$) { + my ($refobj, $reason) = @_; + + printdebug "TAINTING $refobj\n", + (map { "\%| $_" } split "\n", $reason), + "\n"; + + my $tf = new File::Temp or die $!; + print $tf "$refobj^0\n" or die $!; + flush $tf or die $!; + seek $tf,0,0 or die $!; + + my $gcfpid = open GCF, "-|"; + defined $gcfpid or die $!; + if (!$gcfpid) { + open STDIN, "<&", $tf or die $!; + exec 'git', 'cat-file', '--batch'; + die $!; + } + + close $tf or die $!; + $_ = <GCF>; + defined $_ or die; + m/^(\w+) (\w+) (\d+)\n/ or die "$_ ?"; + my $gitobjid = $1; + my $gitobjtype = $2; + my $bytes = $3; + + my $gitobjdata; + if ($gitobjtype eq 'commit' or $gitobjtype eq 'tag') { + $!=0; read GCF, $gitobjdata, $bytes == $bytes + or die "$gitobjid $bytes $!"; + } + close GCF; + + $poldbh->do("INSERT INTO taints". + " (package, gitobjid, gitobjtype, gitobjdata, time, comment)". + " VALUES (?,?,?,?,?,?)", {}, + $pkg, $gitobjid, $gitobjtype, $gitobjdata, time, $reason); + + my $taint_id = $poldbh->last_insert_id(undef,undef,"taints","taint_id"); + die unless defined $taint_id; + + $poldbh->do("INSERT INTO taintoverrides". + " (taint_id, deliberately)". + " VALUES (?, '--deliberately-include-questionable-history')", + {}, $taint_id); +} + +sub add_taint_by_tag ($$) { + my ($tagname,$refobjid) = @_; + add_taint($refobjid, + "tag $tagname referred to this object in git tree but all". + " previously pushed versions were found to have been". + " removed from NEW (ie, rejected) (or never arrived)"); +} + +sub check_package () { + return 0 unless $pkg_exists; + return 0 unless $pkg_secret; + + printdebug "check_package\n"; + + chdir $pkgdir or die "$pkgdir $!"; + + stat '.' or die "$pkgdir $!"; + my $mtime = ((stat _)[9]); + my $age = time - $mtime; + printdebug "check_package age=$age\n"; + + if (good_suite_has_suitable_vsn(\&vsn_in_our_history)) { + chmod $publicmode, "." or die $!; + $pkg_secret = 0; + eval { + my $mirror_hook = "$distrodir/mirror-hook"; + if (stat_exists $mirror_hook) { + my @mirror_cmd = + ($mirror_hook, $distrodir, "updated-hook", $pkg); + debugcmd " (mirror)",@mirror_cmd; + system @mirror_cmd and failedcmd @mirror_cmd; + } + }; + if (length $@) { + chomp $@; + print STDERR "policy hook: warning:". + " failed to mirror publication of \`$pkg':". + " $@\n"; + } + return 0; + } + + return 0 if $age < $new_upload_propagation_slop; + + return 0 if new_has_vsn_in_our_history(); + + printdebug "check_package secret, deleted, tainting\n"; + + git_for_each_ref('refs/tags', sub { + my ($objid,$objtype,$fullrefname,$tagname) = @_; + add_taint_by_tag($tagname,$objid); + }); + + return FRESHREPO; +} + +sub action_check_package () { + getpackage(); + return check_package(); +} + +sub getpushinfo () { + die unless @ARGV >= 4; + $version = shift @ARGV; + $suite = shift @ARGV; + $tagname = shift @ARGV; + my $delibs = shift @ARGV; + foreach my $delib (split /\,/, $delibs) { + $deliberately{$delib} = 1; + } +} + +sub deliberately ($) { return $deliberately{"--deliberately-$_[0]"}; } + +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; + + # we suppose that NEW has a version which is already in our + # history, as otherwise the repo would have been blown away + + if (deliberately('not-fast-forward')) { + add_taint(server_ref($suite), + "rewound suite $suite; --deliberately-not-fast-forward". + " specified in signed tag $tagname for upload of". + " version $version"); + return NOFFCHECK|FRESHREPO; + } + if (deliberately('include-questionable-history')) { + return 0; + } + die "\nPackage is in NEW and has not been accepted or rejected yet;". + " use a --deliberately option to specify whether you are". + " keeping or discarding the previously pushed history. ". + " Please RTFM dgit(1).\n\n"; +} + +sub action_push_confirm () { + getpackage(); + getpushinfo(); + die unless @ARGV >= 1; + my $freshrepo = shift @ARGV; + + my $initq = $poldbh->prepare(<<END); + SELECT taint_id, gitobjid FROM taints t + WHERE (package = ? OR package = '') +END + $initq->execute($pkg); + + my @objscatcmd = qw(git); + push @objscatcmd, qw(--git-dir), $freshrepo if length $freshrepo; + push @objscatcmd, qw(cat-file --batch); + debugcmd '|',@objscatcmd if $debuglevel>=2; + + my @taintids; + my $chkinput = tempfile(); + while (my $taint = $initq->fetchrow_hashref()) { + push @taintids, $taint->{taint_id}; + print $chkinput $taint->{gitobjid}, "\n" or die $!; + printdebug '|> ', $taint->{gitobjid}, "\n" if $debuglevel>=2; + } + flush $chkinput or die $!; + seek $chkinput,0,0 or die $!; + + my $checkpid = open CHKOUT, "-|" // die $!; + if (!$checkpid) { + open STDIN, "<&", $chkinput or die $!; + delete $ENV{GIT_ALTERNATE_OBJECT_DIRECTORIES}; + # ^ recent versions of git set this in the environment of + # receive hooks. This can cause us to see things which + # the user is trying to abolish. + exec @objscatcmd or die $!; + } + + my ($taintinfoq,$overridesanyq,$untaintq,$overridesq); + + my $overridesstmt = <<END; + SELECT deliberately FROM taintoverrides WHERE ( + 1=0 +END + my @overridesv = sort keys %deliberately; + $overridesstmt .= <<END foreach @overridesv; + OR deliberately = ? +END + $overridesstmt .= <<END; + ) AND taint_id = ? + ORDER BY deliberately ASC +END + + my $mustreject=0; + + while (my $taintid = shift @taintids) { + $!=0; $_ = <CHKOUT>; + die "($taintid @objscatcmd) $!" unless defined $_; + printdebug "|< ", $_ if $debuglevel>=2; + + next if m/^\w+ missing$/; + die "($taintid @objscatcmd) $_ ?" unless m/^(\w+) (\w+) (\d+)\s/; + my ($objid,$objtype,$nbytes) = ($1,$2,$3); + + my $drop; + (read CHKOUT, $drop, $nbytes) == $nbytes + or die "($taintid @objscatcmd) $!"; + + $!=0; $_ = <CHKOUT>; + die "($taintid @objscatcmd) $!" unless defined $_; + die "($taintid @objscatcmd) $_ ?" if m/\S/; + + $taintinfoq ||= $poldbh->prepare(<<END); + SELECT package, time, comment FROM taints WHERE taint_id = ? +END + $taintinfoq->execute($taintid); + + 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(); + 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 + $mustreject = 1; + } else { + $stderr .= <<END; +Forcing due to --deliberately-$ovwhy +END + $untaintq ||= $poldbh->prepare(<<END); + DELETE FROM taints WHERE taint_id = ? +END + $untaintq->execute($taintid); + } + } + close CHKOUT; + + if ($mustreject) { + $stderr .= <<END; + +Rejecting push due to questionable history. +END + return 1; + } + + if (length $freshrepo) { + if (!good_suite_has_suitable_vsn(sub { 1; })) { + stat $freshrepo or die "$freshrepo $!"; + my $oldmode = ((stat _)[2]); + my $oldwrites = $oldmode & 0222; + # remove r and x bits which have corresponding w bits clear + my $newmode = $oldmode & + (~0555 | ($oldwrites << 1) | ($oldwrites >> 1)); + printdebug sprintf "chmod %#o (was %#o) %s\n", + $newmode, $oldmode, $freshrepo; + chmod $newmode, $freshrepo or die $!; + utime undef, undef, $freshrepo or die $!; + } + } + + return 0; +} + +sub action_check_list () { + opendir L, "$repos" or die "$repos $!"; + while (defined (my $dent = readdir L)) { + next unless $dent =~ m/^($package_re)\.git$/; + $pkg = $1; + statpackage(); + next unless $pkg_exists; + next unless $pkg_secret; + print "$pkg\n" or die $!; + } + closedir L or die $!; + close STDOUT or die $!; + return 0; +} + +$action =~ y/-/_/; +my $fn = ${*::}{"action_$action"}; +if (!$fn) { + printdebug "dgit-repos-policy-debian: unknown action $action\n"; + exit 0; +} + +my $sleepy=0; +my $rcode; + +my $db_busy_exception= 'Debian::Dgit::Policy::Debian::DB_BUSY'; + +my @orgargv = @ARGV; + +for (;;) { + @ARGV = @orgargv; + eval { + poldb_setup(poldb_path($repos), sub { + $poldbh->{HandleError} = sub { + return 0 unless $poldbh->err == 5; # SQLITE_BUSY, not in .pm :-( + die bless { }, $db_busy_exception; + }; + + eval ($ENV{'DGIT_RPD_TEST_DBLOOP_HOOK'}//''); + die $@ if length $@; + # used by tests/tests/debpolicy-dbretry + }); + + $stderr = ''; + + $rcode = $fn->(); + die unless defined $rcode; + + $poldbh->commit; + }; + last unless length $@; + die $@ unless ref $@ eq $db_busy_exception; + + die if $sleepy >= 20; + $sleepy++; + print STDERR "[policy database busy, retrying (${sleepy}s)]\n"; + + eval { $poldbh->rollback; }; +} + +print STDERR $stderr or die $!; +flush STDERR or die $!; +_exit $rcode; diff --git a/infra/dgit-repos-policy-trusting b/infra/dgit-repos-policy-trusting new file mode 100755 index 0000000..b551d50 --- /dev/null +++ b/infra/dgit-repos-policy-trusting @@ -0,0 +1,58 @@ +#!/bin/bash +# +# This is a genuine policy, not just one for testing. +# +# It allows anyone authorised to push to also, on demand: +# - wipe the repo and replace it with a new one +# (with --deliberately-fresh-repo) +# - do non-fast-forward pushes +# (with --deliberately-not-fast-forward) + +set -e + +case "$DGIT_DRS_DEBUG" in +''|0) exec 3>/dev/null ;; +1) exec 3>&2 ;; +*) exec 3>&2; set -x ;; +esac + +distro=$1 ; shift +reposdir=$1 ; shift +livedir=$1 ; shift +distrodir=$1 ; shift +action=$1 ; shift + +echo >&3 "dgit-repos-policy-trusting: action=$action" + +case "$action" in +push|push-confirm) ;; +*) exit 0 ;; +esac + +package=$1 ; shift +version=$1 ; shift +suite=$1 ; shift +tagname=$1 ; shift +delibs=$1 ; shift + +bitmask=0 + +policyflags () { + perl -e ' + use Debian::Dgit::Infra; + use Debian::Dgit qw(:policyflags); print '$1',"\n" + ' +} + +set -e + +case "$action//,$delibs," in +push//*,--deliberately-fresh-repo,*) + bitmask=$(( bitmask | `policyflags 'NOFFCHECK|FRESHREPO'` )) + ;; +push//*,--deliberately-not-fast-forward,*) + bitmask=$(( bitmask | `policyflags 'NOFFCHECK'` )) + ;; +esac + +exit $bitmask diff --git a/infra/dgit-repos-server b/infra/dgit-repos-server new file mode 100755 index 0000000..6131774 --- /dev/null +++ b/infra/dgit-repos-server @@ -0,0 +1,1178 @@ +#!/usr/bin/perl -w +# dgit-repos-server +# +# git protocol proxy to check dgit pushes etc. +# +# Copyright (C) 2014-2016 Ian Jackson +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <http://www.gnu.org/licenses/>. + +# usages: +# dgit-repos-server DISTRO DISTRO-DIR AUTH-SPEC [<settings>] --ssh +# dgit-repos-server DISTRO DISTRO-DIR AUTH-SPEC [<settings>] --cron +# settings +# --repos=GIT-REPOS-DIR default DISTRO-DIR/repos/ +# --suites=SUITES-FILE default DISTRO-DIR/suites +# --suites-master=SUITES-FILE default DISTRO-DIR/suites-master +# --policy-hook=POLICY-HOOK default DISTRO-DIR/policy-hook +# --mirror-hook=MIRROR-HOOK default DISTRO-DIR/mirror-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 +# and mirror hooks) +# internal usage: +# .../dgit-repos-server --pre-receive-hook PACKAGE +# +# Invoked as the ssh restricted command +# +# Works like git-receive-pack +# +# SUITES-FILE is the name of a file which lists the permissible suites +# one per line (#-comments and blank lines ignored). For --suites-master +# it is a list of the suite(s) which should, when pushed to, update +# `master' on the server (if fast forward). +# +# 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; + +use Debian::Dgit::Infra; # must precede Debian::Dgit; - can change @INC! +use Debian::Dgit qw(:DEFAULT :policyflags); +setup_sigwarn(); + +# 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 +# - run actual git-receive-pack with that new destination +# as a result of this the stunt pre-receive hook runs; it does this: +# + understand what refs we are allegedly updating and +# check some correspondences: +# * we are updating only refs/tags/[archive/]DISTRO/* and refs/dgit/* +# * and only one of each +# * and the tag does not already exist +# and +# * recover the suite name from the destination refs/dgit/ ref +# + disassemble the signed tag into its various fields and signature +# including: +# * parsing the first line of the tag message to recover +# the package name, version and suite +# * checking that the package name corresponds to the dest repo name +# * checking that the suite name is as recovered above +# + 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 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 [archive/]debian/<version> (massaged as needed) +# * the suite is one of those permitted +# * the signed tag has a suitable name +# * 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 +# sure that we create it reasonably atomically, and also that +# we don't every have a destination repo containing no refs at all +# (because such a thing causes git-fetch-pack to barf). So then we +# do as above, except: +# - before starting, we take out our own lock for the destination repo +# - we create a prospective new destination repo by making a copy +# of _template +# - we use the prospective new destination repo instead of the +# actual new destination repo (since the latter doesn't exist) +# - after git-receive-pack exits, we +# + check that the prospective repo contains a tag and head +# + rename the prospective destination repo into place +# +# Cleanup strategy: +# - We are crash-only +# - Temporary working trees and their locks are cleaned up +# opportunistically by a program which tries to take each lock and +# if successful deletes both the tree and the lockfile +# - Prospective working trees and their locks are cleaned up by +# a program which tries to take each lock and if successful +# deletes any prospective working tree and the lock (but not +# of course any actual tree) +# - It is forbidden to _remove_ the lockfile without removing +# the corresponding temporary tree, as the lockfile is also +# a stampfile whose presence indicates that there may be +# cleanup to do +# +# Policy hook scripts are 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|'' [...] +# +# DELIBERATELIES is like this: --deliberately-foo,--deliberately-bar,... +# +# Exit status of policy hook 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) +# NOCOMMITCHECK (8) +# suppress dgit-repos-server's check that commits do +# not lack "committer" info (eg as produced by #849041) +# ("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 incoming +# 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.) In this case FRESH-REPO +# contains exactly the objects and refs that will appear in the +# destination if push-confirm approves. +# +# if push requested FRESHREPO, push-confirm happens in the old working +# 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.), or if that is +# ENOENT, use the installed version. +# +# 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: +# MIRROR-HOOK-SCRIPT DISTRO-DIR updated-hook PACKAGE [...] +# +# Exit status of the mirror hook is advisory only. The mirror hook +# runs too late to do anything useful about a problem, so the only +# effect of a mirror hook exiting nonzero is a warning message to +# stderr (which the pushing user should end up seeing). +# +# If the mirror hook does not exist, it is silently skipped. + +use POSIX; +use Fcntl qw(:flock); +use File::Path qw(rmtree); +use File::Temp qw(tempfile); + +initdebug(''); + +our $func; +our $dgitrepos; +our $package; +our $distro; +our $suitesfile; +our $suitesformasterfile; +our $policyhook; +our $mirrorhook; +our $dgitlive; +our $distrodir; +our $destrepo; +our $workrepo; +our $keyrings; +our @lockfhs; + +our @deliberatelies; +our %previously; +our $policy; +our @policy_args; + +#----- utilities ----- + +sub realdestrepo () { "$dgitrepos/$package.git"; } + +sub acquirelock ($$) { + my ($lock, $must) = @_; + my $fh; + 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; + printdebug " locking $lock failed\n"; + return undef; + } + next unless stat_exists $lock; + my $want = (stat _)[1]; + stat $fh or die $!; + my $got = (stat _)[1]; + last if $got == $want; + } + return $fh; +} + +sub acquirermtree ($$) { + my ($tree, $must) = @_; + my $fh = acquirelock("$tree.lock", $must); + if ($fh) { + push @lockfhs, $fh; + rmtree $tree; + } + return $fh; +} + +sub locksometree ($) { + my ($tree) = @_; + acquirelock("$tree.lock", 1); +} + +sub lockrealtree () { + locksometree(realdestrepo); +} + +sub mkrepotmp () { ensuredir "$dgitrepos/_tmp" }; + +sub removedtagsfile () { "$dgitrepos/_removed-tags/$package"; } + +sub recorderror ($) { + my ($why) = @_; + my $w = $ENV{'DGIT_DRS_WORK'}; # we are in stunthook + if (defined $w) { + chomp $why; + open ERR, ">", "$w/drs-error" or die $!; + print ERR $why, "\n" or die $!; + close ERR or die $!; + return 1; + } + return 0; +} + +sub reject ($) { + my ($why) = @_; + recorderror "reject: $why"; + die "\ndgit-repos-server: reject: $why\n\n"; +} + +sub runcmd { + debugcmd '+',@_; + $!=0; $?=0; + my $r = system @_; + die (shellquote @_)." $? $!" if $r; +} + +sub policyhook { + my ($policyallowbits, @polargs) = @_; + # => ($exitstatuspolicybitmap); + die if $policyallowbits & ~0x3e; + my @cmd = ($policyhook,$distro,$dgitrepos,$dgitlive,$distrodir,@polargs); + debugcmd '+M',@cmd; + my $r = system @cmd; + die "system: $!" if $r < 0; + die "dgit-repos-server: policy hook failed (or rejected) ($?)\n" + if $r & ~($policyallowbits << 8); + printdebug sprintf "hook => %#x\n", $r; + 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"; + my $templatelock = 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 $!"; + close $templatelock; +} + +sub movetogarbage () { + # realdestrepo must have been locked + + my $real = realdestrepo; + return unless stat_exists $real; + + my $garbagerepo = "$dgitrepos/${package}_garbage"; + # We arrange to always keep at least one old tree, for 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 $!"; + } + + ensuredir "$dgitrepos/_removed-tags"; + open PREVIOUS, ">>", removedtagsfile or die removedtagsfile." $!"; + git_for_each_ref([ map { 'refs/tags/'.$_ } debiantags('*',$distro) ], + sub { + my ($objid,$objtype,$fullrefname,$reftail) = @_; + print PREVIOUS "\n$objid $reftail .\n" or die $!; + }, $real); + close PREVIOUS or die $!; + + printdebug "movetogarbage: $real -> $garbagerepo\n"; + rename $real, $garbagerepo + or $! == ENOENT + or die "$garbagerepo $!"; +} + +sub policy_checkpackage () { + my $lfh = lockrealtree(); + + $policy = policyhook(FRESHREPO,'check-package',$package); + if ($policy & FRESHREPO) { + movetogarbage(); + } + + close $lfh; +} + +#----- git-receive-pack ----- + +sub fixmissing__git_receive_pack () { + mkrepotmp(); + $destrepo = "$dgitrepos/_tmp/${package}_prospective"; + acquirermtree($destrepo, 1); + mkrepo_fromtemplate($destrepo); +} + +sub makeworkingclone () { + mkrepotmp(); + $workrepo = "$dgitrepos/_tmp/${package}_incoming$$"; + acquirermtree($workrepo, 1); + my $lfh = lockrealtree(); + runcmd qw(git clone -l -q --mirror), $destrepo, $workrepo; + close $lfh; + rmtree "${workrepo}_fresh"; +} + +sub setupstunthook () { + my $prerecv = "$workrepo/hooks/pre-receive"; + my $fh = new IO::File $prerecv, O_WRONLY|O_CREAT|O_TRUNC, 0777 + or die "$prerecv: $!"; + print $fh <<END or die "$prerecv: $!"; +#!/bin/sh +set -e +exec $0 --pre-receive-hook $package +END + close $fh or die "$prerecv: $!"; + $ENV{'DGIT_DRS_WORK'}= $workrepo; + $ENV{'DGIT_DRS_DEST'}= $destrepo; + printdebug " stunt hook set up $prerecv\n"; +} + +sub dealwithfreshrepo () { + my $freshrepo = "${workrepo}_fresh"; + return unless stat_exists $freshrepo; + $destrepo = $freshrepo; +} + +sub mirrorhook { + my @cmd = ($mirrorhook,$distrodir,@_); + debugcmd '+',@cmd; + return unless stat_exists $mirrorhook; + my $r = system @cmd; + if ($r) { + printf STDERR <<END, +dgit-repos-server: warning: mirror hook failed: %s +dgit-repos-server: push complete but may not fully visible. +END + ($r < 0 ? "exec: $!" : + $r == (124 << 8) ? "exited status 124 (timeout?)" : + !($r & ~0xff00) ? "exited ".($? >> 8) : + "wait status $?"); + } +} + +sub maybeinstallprospective () { + return if $destrepo eq realdestrepo; + + if (open REJ, "<", "$workrepo/drs-error") { + local $/ = undef; + my $msg = <REJ>; + REJ->error and die $!; + print STDERR $msg; + exit 1; + } else { + $!==&ENOENT or die $!; + } + + printdebug " show-ref ($destrepo) ...\n"; + + my $child = open SR, "-|"; + defined $child or die $!; + if (!$child) { + chdir $destrepo or die $!; + exec qw(git show-ref); + die $!; + } + my %got = qw(newtag 0 omtag 0 head 0); + while (<SR>) { + chomp or die; + printdebug " show-refs| $_\n"; + s/^\S*[1-9a-f]\S* (\S+)$/$1/ or die; + next if m{^refs/heads/master$}; + my $wh = + m{^refs/tags/archive/} ? 'newtag' : + m{^refs/tags/} ? 'omtag' : + m{^refs/dgit/} ? 'head' : + die; + use Data::Dumper; + die if $got{$wh}++; + } + $!=0; $?=0; close SR or $?==256 or die "$? $!"; + + printdebug "installprospective ?\n"; + die Dumper(\%got)." -- missing refs in new repo" + unless $got{head} && grep { m/tag$/ && $got{$_} } keys %got; + + lockrealtree(); + + if ($destrepo eq "${workrepo}_fresh") { + movetogarbage; + } + + printdebug "install $destrepo => ".realdestrepo."\n"; + rename $destrepo, realdestrepo or die $!; + remove realdestrepo.".lock" or die $!; +} + +sub main__git_receive_pack () { + makeworkingclone(); + setupstunthook(); + runcmd qw(git receive-pack), $workrepo; + dealwithfreshrepo(); + maybeinstallprospective(); + mirrorhook('updated-hook', $package); +} + +#----- stunt post-receive hook ----- + +our ($tagname, $tagval, $suite, $oldcommit, $commit); +our ($version, %tagh); +our ($maint_tagname, $maint_tagval); + +our ($tagexists_error); + +sub readupdates () { + printdebug " updates ...\n"; + my %tags; + while (<STDIN>) { + chomp or die; + printdebug " upd.| $_\n"; + m/^(\S+) (\S+) (\S+)$/ or die "$_ ?"; + my ($old, $sha1, $refname) = ($1, $2, $3); + if ($refname =~ m{^refs/tags/(?=(?:archive/)?$distro/)}) { + my $tn = $'; #'; + $tags{$tn} = $sha1; + $tagexists_error= "tag $tn already exists -". + " not replacing previously-pushed version" + if $old =~ m/[^0]/; + } elsif ($refname =~ m{^refs/dgit/}) { + reject "pushing multiple heads!" if defined $suite; + $suite = $'; #'; + $oldcommit = $old; + $commit = $sha1; + } else { + reject "pushing unexpected ref!"; + } + } + STDIN->error and die $!; + + reject "push is missing tag ref update" unless %tags; + my @newtags = grep { m#^archive/# } keys %tags; + my @omtags = grep { !m#^archive/# } keys %tags; + reject "pushing too many similar tags" if @newtags>1 || @omtags>1; + if (@newtags) { + ($tagname) = @newtags; + ($maint_tagname) = @omtags; + } else { + ($tagname) = @omtags or die; + } + $tagval = $tags{$tagname}; + $maint_tagval = $tags{$maint_tagname // ''}; + + reject "push is missing head ref update" unless defined $suite; + printdebug " updates ok.\n"; +} + +sub 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 $!; + for (;;) { + $!=0; $_=<T>; defined or die $!; + print PT or die $!; + if (m/^(\S+) (.*)/) { + push @{ $tagh{$1} }, $2; + } elsif (!m/\S/) { + last; + } else { + die; + } + } + $!=0; $_=<T>; defined or die $!; + m/^($package_re) release (\S+) for \S+ \((\S+)\) \[dgit\]$/ or + reject "tag message not in expected format"; + + die unless $1 eq $package; + $version = $2; + die "$3 != $suite " unless $3 eq $suite; + + my $copyl = $_; + for (;;) { + print PT $copyl or die $!; + $!=0; $_=<T>; defined or die "missing signature? $!"; + $copyl = $_; + if (m/^\[dgit ([^"].*)\]$/) { # [dgit "something"] is for future + $_ = $1." "; + while (length) { + if (s/^distro\=(\S+) //) { + die "$1 != $distro" unless $1 eq $distro; + } elsif (s/^(--deliberately-$deliberately_re) //) { + push @deliberatelies, $1; + } elsif (s/^previously:(\S+)=(\w+) //) { + die "previously $1 twice" if defined $previously{$1}; + $previously{$1} = $2; + } elsif (s/^[-+.=0-9a-z]\S* //) { + } else { + die "unknown dgit info in tag ($_)"; + } + } + next; + } + last if m/^-----BEGIN PGP/; + } + $_ = $copyl; + for (;;) { + print DS or die $!; + $!=0; $_=<T>; + last if !defined; + } + T->error and die $!; + close PT or die $!; + close DS or die $!; + printdebug " parsetag ok.\n"; +} + +sub checksig_keyring ($) { + my ($keyringfile) = @_; + # returns primary-keyid if signed by a key in this keyring + # or undef if not + # or dies on other errors + + my $ok = undef; + + printdebug " checksig keyring $keyringfile...\n"; + + our @cmd = (qw(gpgv --status-fd=1 --keyring), + $keyringfile, + qw(dgit-tmp/plaintext.asc dgit-tmp/plaintext)); + debugcmd '|',@cmd; + + open P, "-|", @cmd + or die $!; + + while (<P>) { + next unless s/^\[GNUPG:\] //; + chomp or die; + printdebug " checksig| $_\n"; + my @l = split / /, $_; + if ($l[0] eq 'NO_PUBKEY') { + last; + } elsif ($l[0] eq 'VALIDSIG') { + my $sigtype = $l[9]; + $sigtype eq '00' or reject "signature is not of type 00!"; + $ok = $l[10]; + die unless defined $ok; + last; + } + } + close P; + + printdebug sprintf " checksig ok=%d\n", !!$ok; + + return $ok; +} + +sub dm_txt_check ($$) { + my ($keyid, $dmtxtfn) = @_; + printdebug " dm_txt_check $keyid $dmtxtfn\n"; + open DT, '<', $dmtxtfn or die "$dmtxtfn $!"; + while (<DT>) { + m/^fingerprint:\s+\Q$keyid\E$/oi + ..0 or next; + if (s/^allow:/ /i..0) { + } else { + m/^./ + or reject "key $keyid missing Allow section in permissions!"; + next; + } + # in right stanza... + s/^[ \t]+// + or reject "package $package not allowed for key $keyid"; + # in allow field... + s/\([^()]+\)//; + s/\,//; + chomp or die; + printdebug " dm_txt_check allow| $_\n"; + foreach my $p (split /\s+/) { + if ($p eq $package) { + # yay! + printdebug " dm_txt_check ok\n"; + return; + } + } + } + DT->error and die $!; + close DT or die $!; + reject "key $keyid not in permissions list although in keyring!"; +} + +sub verifytag () { + foreach my $kas (split /:/, $keyrings) { + printdebug "verifytag $kas...\n"; + $kas =~ s/^([^,]+),// or die; + my $keyid = checksig_keyring $1; + if (defined $keyid) { + if ($kas =~ m/^a$/) { + printdebug "verifytag a ok\n"; + return; # yay + } elsif ($kas =~ m/^m([^,]+)$/) { + dm_txt_check($keyid, $1); + printdebug "verifytag m ok\n"; + return; + } else { + die; + } + } + } + reject "key not found in keyrings"; +} + +sub suite_is_in ($) { + my ($sf) = @_; + printdebug "suite_is_in ($sf)\n"; + if (!open SUITES, "<", $sf) { + $!==ENOENT or die $!; + return 0; + } + while (<SUITES>) { + chomp; + next unless m/\S/; + next if m/^\#/; + s/\s+$//; + return 1 if $_ eq $suite; + } + die $! if SUITES->error; + return 0; +} + +sub checksuite () { + printdebug "checksuite ($suitesfile)\n"; + return if suite_is_in $suitesfile; + reject "unknown suite"; +} + +sub checktagnoreplay () { + # We need to prevent a replay attack using an earlier signed tag. + # We also want to archive in the history the object ids of + # anything we remove, even if we get rid of the actual objects. + # + # So, we check that the signed tag mentions the name and tag + # object id of: + # + # (a) In the case of FRESHREPO: all tags and refs/heads/* in + # the repo. That is, effectively, all the things we are + # deleting. + # + # This prevents any tag implying a FRESHREPO push + # being replayed into a different state of the repo. + # + # There is still the folowing risk: If a non-ff push is of a + # head which is an ancestor of a previous ff-only push, the + # previous push can be replayed. + # + # So we keep a separate list, as a file in the repo, of all + # the tag object ids we have ever seen and removed. Any such + # tag object id will be rejected even for ff-only pushes. + # + # (b) In the case of just NOFFCHECK: all tags referring to the + # current head for the suite (there must be at least one). + # + # This prevents any tag implying a NOFFCHECK push being + # replayed to rewind from a different head. + # + # The possibility of an earlier ff-only push being replayed is + # eliminated as follows: the tag from such a push would still + # be in our repo, and therefore the replayed push would be + # rejected because the set of refs being updated would be + # wrong. + + if (!open PREVIOUS, "<", removedtagsfile) { + die removedtagsfile." $!" unless $!==ENOENT; + } else { + # Protocol for updating this file is to append to it, not + # write-new-and-rename. So all updates are prefixed with \n + # and suffixed with " .\n" so that partial writes can be + # ignored. + while (<PREVIOUS>) { + next unless m/^(\w+) (.*) \.\n/; + next unless $1 eq $tagval; + reject "Replay of previously-rewound upload ($tagval $2)"; + } + die removedtagsfile." $!" if PREVIOUS->error; + close PREVIOUS; + } + + return unless $policy & (FRESHREPO|NOFFCHECK); + + my $garbagerepo = "$dgitrepos/${package}_garbage"; + lockrealtree(); + + my $nchecked = 0; + my @problems; + + my $check_ref_previously= sub { + my ($objid,$objtype,$fullrefname,$reftail) = @_; + my $supkey = $fullrefname; + $supkey =~ s{^refs/}{} or die "$supkey $objid ?"; + my $supobjid = $previously{$supkey}; + if (!defined $supobjid) { + printdebug "checktagnoreply - missing\n"; + push @problems, "does not declare previously $supkey"; + } elsif ($supobjid ne $objid) { + push @problems, "declared previously $supkey=$supobjid". + " but actually previously $supkey=$objid"; + } else { + $nchecked++; + } + }; + + if ($policy & FRESHREPO) { + foreach my $kind (qw(tags heads)) { + git_for_each_ref("refs/$kind", $check_ref_previously); + } + } else { + my $branch= server_branch($suite); + my $branchhead= git_get_ref(server_ref($suite)); + if (!length $branchhead) { + # No such branch - NOFFCHECK was unnecessary. Oh well. + printdebug "checktagnoreplay - not FRESHREPO, new branch, ok\n"; + } else { + printdebug "checktagnoreplay - not FRESHREPO,". + " checking for overwriting refs/$branch=$branchhead\n"; + git_for_each_tag_referring($branchhead, sub { + my ($tagobjid,$refobjid,$fullrefname,$tagname) = @_; + $check_ref_previously->($tagobjid,undef,$fullrefname,undef); + }); + printdebug "checktagnoreplay - not FRESHREPO, nchecked=$nchecked"; + push @problems, "does not declare previously any tag". + " referring to branch head $branch=$branchhead" + unless $nchecked; + } + } + + if (@problems) { + reject "replay attack prevention check failed:". + " signed tag for $version: ". + join("; ", @problems). + "\n"; + } + printdebug "checktagnoreplay - all ok ($tagval)\n" +} + +sub tagh1 ($) { + my ($tag) = @_; + my $vals = $tagh{$tag}; + reject "missing header $tag in signed tag object" unless $vals; + reject "multiple headers $tag in signed tag object" unless @$vals == 1; + return $vals->[0]; +} + +sub 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"; + tagh1('tag') eq $tagname or reject "tag name in tag is wrong"; + + my @expecttagnames = debiantags($version, $distro); + printdebug "expected tag @expecttagnames\n"; + grep { $tagname eq $_ } @expecttagnames or die; + + foreach my $othertag (grep { $_ ne $tagname } @expecttagnames) { + reject "tag $othertag (pushed with differing dgit version)". + " already exists -". + " not replacing previously-pushed version" + if git_get_ref "refs/tags/".$othertag; + } + + lockrealtree(); + + @policy_args = ($package,$version,$suite,$tagname, + join(",",@deliberatelies)); + $policy = policyhook(NOFFCHECK|FRESHREPO|NOCOMMITCHECK, 'push', @policy_args); + + if (defined $tagexists_error) { + if ($policy & FRESHREPO) { + printdebug "ignoring tagexists_error: $tagexists_error\n"; + } else { + reject $tagexists_error; + } + } + + checktagnoreplay(); + checksuite(); + + # check that our ref is being fast-forwarded + printdebug "oldcommit $oldcommit\n"; + 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"; + } + + # defend against commits generated by #849041 + if (!($policy & NOCOMMITCHECK)) { + my @checks = qw(%ae %at + %ce %ct); + my @chk = qw(git log -z); + push @chk, '--pretty=tformat:%H%n'. + (join "", map { $_, '%n' } @checks); + push @chk, "^$oldcommit" if $oldcommit =~ m/[^0]/; + push @chk, $commit;; + printdebug " ~NOCOMMITCHECK @chk\n"; + open CHK, "-|", @chk or die $!; + local $/ = "\0"; + while (<CHK>) { + next unless m/^$/m; + m/^\w+(?=\n)/ or die; + reject "corrupted object $& (missing metadata)"; + } + $!=0; $?=0; close CHK or $?==256 or die "$? $!"; + } + + if ($policy & FRESHREPO) { + # It's a bit late to be discovering this here, isn't it ? + # + # What we do is: Generate a fresh destination repo right now, + # and arrange to treat it from now on as if it were a + # prospective repo. + # + # The presence of this fresh destination repo is detected by + # the parent, which responds by making a fresh master repo + # from the template. (If the repo didn't already exist then + # $destrepo was _prospective, and we change it here. This is + # OK because the parent's check for _fresh persuades it not to + # use _prospective.) + # + $destrepo = "${workrepo}_fresh"; # workrepo lock covers + mkrepo_fromtemplate $destrepo; + } +} + +sub onwardpush () { + my @cmdbase = (qw(git send-pack), $destrepo); + push @cmdbase, qw(--force) if $policy & NOFFCHECK; + + my @cmd = @cmdbase; + push @cmd, "$commit:refs/dgit/$suite", + "$tagval:refs/tags/$tagname"; + push @cmd, "$maint_tagval:refs/tags/$maint_tagname" + if defined $maint_tagname; + debugcmd '+',@cmd; + $!=0; + my $r = system @cmd; + !$r or die "onward push to $destrepo failed: $r $!"; + + if (suite_is_in $suitesformasterfile) { + @cmd = @cmdbase; + push @cmd, "$commit:refs/heads/master"; + debugcmd '+', @cmd; + $!=0; my $r = system @cmd; + # tolerate errors (might be not ff) + !($r & ~0xff00) or die + "onward push to $destrepo#master failed: $r $!"; + } +} + +sub finalisepush () { + if ($destrepo eq realdestrepo) { + policyhook(0, 'push-confirm', @policy_args, ''); + onwardpush(); + } else { + # We are to receive the push into a new repo (perhaps + # because the policy push hook asked us to with FRESHREPO, or + # perhaps because the repo didn't exist before). + # + # We want to provide the policy push-confirm hook with a repo + # which looks like the one which is going to be installed. + # The working repo is no good because it might contain + # previous history. + # + # So we push the objects into the prospective new repo right + # away. If the hook declines, we decline, and the prospective + # repo is never installed. + onwardpush(); + policyhook(0, 'push-confirm', @policy_args, $destrepo); + } +} + +sub stunthook () { + printdebug "stunthook in $workrepo\n"; + chdir $workrepo or die "chdir $workrepo: $!"; + mkdir "dgit-tmp" or $!==EEXIST or die $!; + readupdates(); + parsetag(); + verifytag(); + checks(); + finalisepush(); + printdebug "stunthook done.\n"; +} + +#----- git-upload-pack ----- + +sub fixmissing__git_upload_pack () { + $destrepo = "$dgitrepos/_empty"; + my $lfh = locksometree($destrepo); + return if stat_exists $destrepo; + rmtree "$destrepo.new"; + mkemptyrepo "$destrepo.new", "0644"; + rename "$destrepo.new", $destrepo or die $!; + unlink "$destrepo.lock" or die $!; + close $lfh; +} + +sub main__git_upload_pack () { + 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 ----- + +sub argval () { + die unless @ARGV; + my $v = shift @ARGV; + die if $v =~ m/^-/; + return $v; +} + +our %indistrodir = ( + # keys are used for DGIT_DRS_XXX too + 'repos' => \$dgitrepos, + 'suites' => \$suitesfile, + 'suites-master' => \$suitesformasterfile, + 'policy-hook' => \$policyhook, + 'mirror-hook' => \$mirrorhook, + 'dgit-live' => \$dgitlive, + ); + +our @hookenvs = qw(distro suitesfile suitesformasterfile policyhook + mirrorhook dgitlive keyrings dgitrepos distrodir); + +# workrepo and destrepo handled ad-hoc + +sub mode_ssh () { + die if @ARGV; + + my $cmd = $ENV{'SSH_ORIGINAL_COMMAND'}; + $cmd =~ m{ + ^ + (?: \S* / )? + ( [-0-9a-z]+ ) + \s+ + '? (?: \S* / )? + ($package_re) \.git + '?$ + }ox + or reject "command string not understood"; + my $method = $1; + $package = $2; + + my $funcn = $method; + $funcn =~ y/-/_/; + my $mainfunc = $main::{"main__$funcn"}; + + reject "unknown method" unless $mainfunc; + + policy_checkpackage(); + + if (stat_exists realdestrepo) { + $destrepo = realdestrepo; + } else { + printdebug " fixmissing $funcn\n"; + my $fixfunc = $main::{"fixmissing__$funcn"}; + &$fixfunc; + } + + 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; } +} + +sub cleanup () { + unlockall(); + if (!chdir "$dgitrepos/_tmp") { + $!==ENOENT or die $!; + return; + } + foreach my $lf (<*.lock>) { + my $tree = $lf; + $tree =~ s/\.lock$//; + next unless acquirermtree($tree, 0); + remove $lf or warn $!; + unlockall(); + } +} + +parseargsdispatch(); +cleanup(); diff --git a/infra/dgit-ssh-dispatch b/infra/dgit-ssh-dispatch new file mode 100755 index 0000000..c5861d2 --- /dev/null +++ b/infra/dgit-ssh-dispatch @@ -0,0 +1,181 @@ +#!/usr/bin/perl -w +# wrapper to dispatch git ssh service requests +# +# Copyright (C) 2015-2016 Ian Jackson +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <http://www.gnu.org/licenses/>. + +use strict; + +use Debian::Dgit::Infra; # must precede Debian::Dgit; - can change @INC! +use Debian::Dgit; +setup_sigwarn(); + +use POSIX; + +open DEBUG, '>/dev/null' or die $!; +if (@ARGV && $ARGV[0] eq '-D') { + shift @ARGV; + open DEBUG, '>&STDERR' or die $!; +} + +die unless @ARGV>=1 && @ARGV<=2 && $ARGV[0] !~ m/^-/; +our ($dispatchdir,$authrune) = @ARGV; + +$authrune //= join ':', + '@/keyrings/debian-keyring.gpg,a', + '@/keyrings/debian-maintainers.gpg,m@/dm.txt'; + +our $lre = $package_re; +our $qre = '["'."']?"; + +# $dispatchdir/distro=DISTRO should contain +# dgit-live a clone of dgit (only if not using installed vsns) +# diverts +# repos/ } by virtue of +# suites } dgit-repos-server's defaults relating to +# policy-hook } dispatch-dir +# plus files required by the authrune (by default, keyrings/ and dm.txt) +# +# diverts should be list of +# <pat> [<divert-to>] +# where <pat> is a package name pattern which may contain * or literals. +# <divert-to> is for `git config dgit-distro.DISTRO.diverts.<divert-to>' + +our ($distro,$pkg, $d); +our ($dgitlive,$repos,$suites,$diverts,$policyhook,$repo); + +sub checkdivert ($) { + my ($df) = @_; + if (!open DIV, '<', $df) { + $!==ENOENT or die $!; + return undef; + } else { + while (<DIV>) { + s/^\s+//; s/\s+$//; + next unless m/\S/; + next if m/^\#/; + my $divert; + if (s/\s+(\S+)$//) { $divert=$1; } + s/[^-+._0-9a-zA-Z*]/\\$&/g; + s/\*/.*/g; + printf DEBUG 'DISPATCH DIVERT ^%s$ %s'."\n", + $_, ($divert // '(undef)'); + if ($pkg =~ m/^$_$/) { return $divert; } + } + DIV->error and die $!; + close DIV; + return undef; + } +} + +sub finish () { + close STDOUT or die $!; + exit 0; +} + +sub prl ($) { + print @_, "\n" or die $!; +} + +sub selectpackage ($$;$) { + my $divertfn; + ($distro,$pkg, $divertfn) = @_; # $distro,$pkg must have sane syntax + + $d = "$dispatchdir/distro=$distro"; + + if (!stat $d) { + die $! unless $!==ENOENT; + die "unknown distro ($distro)\n"; + } + + $dgitlive= "$d/dgit-live"; + $repos= "$d/repos"; + $suites= "$d/suites"; + $policyhook= "$d/policy-hook"; + + $authrune =~ s/\@/$d/g; + + my $divert = checkdivert("$d/diverts"); + if (defined $divert) { + $divertfn //= sub { + die "diverted to $divert incompletely or too late!\n"; + }; + $divertfn->($divert); + die; + } + + $repo = "$repos/$pkg.git"; + + print DEBUG "DISPATCH DISTRO $distro PKG $pkg\n"; +} + +sub hasrepo () { + if (stat $repo) { + -d _ or die; + return 1; + } else { + $!==ENOENT or die $!; + return 0; + } +} + +sub serve_up ($) { + my ($repo) = @_; + exec qw(git upload-pack --strict --timeout=1000), $repo; + die "exec git: $!"; +} + +sub dispatch () { + local ($_) = $ENV{'SSH_ORIGINAL_COMMAND'} // ''; + + if (m#^: dgit ($lre) git-check ($lre) ;#) { + selectpackage $1,$2, sub { prl "divert @_"; finish; }; + prl hasrepo; + finish; + } elsif ( + m#^${qre}git-([-a-z]+) ${qre}/dgit/($lre)/repos/($lre)\.git${qre}$# + ) { + 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; + my $s = "$dgitlive/infra/dgit-repos-server"; + $s = "dgit-repos-server" if !stat_exists $s; + exec $s, $distro, $d, $authrune, qw(--ssh); + die "exec $s: $!"; + } elsif ($cmd eq 'upload-pack') { + $repo='$repos/_empty' unless hasrepo; + serve_up $repo; + } else { + die "unsupported git operation $cmd ($_)"; + } + } elsif ( + m#^${qre}git-upload-pack ${qre}/dgit/($lre)/(?:repos/)?_dgit-repos-server\.git${qre}$# + ) { + my $distro= $1; + # if running installed packages, source code should come + # some other way + serve_up("$dispatchdir/distro=$1/dgit-live/.git"); + } 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"; + } else { + die "unsupported operation ($_)"; + } +} + +dispatch; diff --git a/infra/drs-cron-wrap b/infra/drs-cron-wrap new file mode 100755 index 0000000..52e819b --- /dev/null +++ b/infra/drs-cron-wrap @@ -0,0 +1,14 @@ +#!/bin/sh +set -e +umask 002 + +distro=$1; shift + +srvdir=/srv/dgit.debian.org +dispatchdir=$srvdir/dispatch-dir +dgitlive=$srvdir/dgit-live + +distrodir=$dispatchdir/distro=$distro + +PERLLIB="$dgitlive${PERLLIB+:}${PERLLIB}" \ +exec $dgitlive/infra/dgit-repos-server $distro $distrodir '' --cron diff --git a/infra/get-dm-txt b/infra/get-dm-txt new file mode 100755 index 0000000..0b9ab10 --- /dev/null +++ b/infra/get-dm-txt @@ -0,0 +1,21 @@ +#!/bin/sh +set -e + +cd ${DGIT_INFRA_GETDMTXT_DATADIR-/srv/dgit.debian.org/data} +${DGIT_INFRA_GETDMTXT_UMASK-umask 002} + +file=dm.txt +server=ftp-master.debian.org +path=$file + +certargs=$(git config dgit-distro.debian.archive-query-tls-curl-ca-args \ + || (echo >&2 "git config failed"; exit 1)) + +with-lock-ex -f $file.lock sh -c " + if ! curl $certargs \ + >$file.new https://$server/$path 2>$file.stderr; then + cat $file.stderr >&2 + exit 127 + fi + mv -f $file.new $file +" diff --git a/infra/get-suites b/infra/get-suites new file mode 100755 index 0000000..c5a4c56 --- /dev/null +++ b/infra/get-suites @@ -0,0 +1,26 @@ +#!/bin/bash +set -e +set -o pipefail + +srvdir=/srv/dgit.debian.org +dgitlive=${DGIT_TEST_INTREE-$srvdir/dgit-live} +output=${DGIT_GETSUITES_OUTPUT-$srvdir/data/suites} + +export PERLLIB="$dgitlive${PERLLIB+:}${PERLLIB}" + +$dgitlive/dgit archive-api-query /suites | perl -we ' + use strict; + use JSON; + undef $/; + my $json = <STDIN>; + die $! if STDIN->error; + my $items = decode_json $json; + foreach my $item (@$items) { + next unless ($item->{archive}//"") eq "ftp-master"; + next unless ($item->{codename}); + print $item->{codename}, "\n" or die $!; + } + flush STDOUT or die $!; +' >$output.new + +mv -f $output.new $output diff --git a/infra/ssh-wrap b/infra/ssh-wrap new file mode 100755 index 0000000..deccc38 --- /dev/null +++ b/infra/ssh-wrap @@ -0,0 +1,10 @@ +#!/bin/sh +set -e +umask 002 + +srvdir=/srv/dgit.debian.org +dispatchdir=$srvdir/dispatch-dir +dgitlive=$srvdir/dgit-live + +PERLLIB="$dgitlive${PERLLIB+:}${PERLLIB}" \ +exec $dgitlive/infra/dgit-ssh-dispatch $dispatchdir |