diff options
author | Ian Jackson <ijackson@chiark.greenend.org.uk> | 2015-04-19 21:26:47 +0100 |
---|---|---|
committer | Ian Jackson <ijackson@chiark.greenend.org.uk> | 2015-05-31 11:54:05 +0100 |
commit | 323e5e59ee548bf44cc2cb9a584cb1c3edcabe3f (patch) | |
tree | ee67cc6322666c2169647d5173f9640ca6a143ec /infra | |
parent | 637c65f6a92e5a8436661ef0898079c0c0a104b0 (diff) |
New policy admin script
Diffstat (limited to 'infra')
-rwxr-xr-x | infra/dgit-repos-admin-debian | 199 | ||||
-rwxr-xr-x | infra/dgit-repos-policy-debian | 39 |
2 files changed, 201 insertions, 37 deletions
diff --git a/infra/dgit-repos-admin-debian b/infra/dgit-repos-admin-debian new file mode 100755 index 0000000..10118c6 --- /dev/null +++ b/infra/dgit-repos-admin-debian @@ -0,0 +1,199 @@ +#!/usr/bin/perl -w +# dgit repos policy admin script for Debian + +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 strict; +use POSIX; +use DBI; + +use Debian::Dgit; +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 + $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 index 7e459cc..fa1d17d 100755 --- a/infra/dgit-repos-policy-debian +++ b/infra/dgit-repos-policy-debian @@ -7,13 +7,13 @@ use JSON; use File::Temp; use Debian::Dgit qw(:DEFAULT :policyflags); +use Debian::Dgit::Policy::Debian; our $distro = shift @ARGV // die "need DISTRO"; our $repos = shift @ARGV // die "need DGIT-REPOS-DIR"; our $action = shift @ARGV // die "need ACTION"; our $publicmode = 02775; -our $policydb = "dbi:SQLite:$repos/policy.sqlite3"; our $new_upload_propagation_slop = 3600*4 + 100; our $poldbh; @@ -71,41 +71,6 @@ our %deliberately; # - .dsc of NEW dgit package has corresponding dgit-repo but not # publicly readable -sub poldb_setup () { - $poldbh ||= DBI->connect($policydb,'','', { - RaiseError=>1, PrintError=>1, AutoCommit=>0 - }); - $poldbh->do("PRAGMA foreign_keys = ON"); - - $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_package - ON taints (package, gitobject) -END - # any one of of the listed deliberatelies will override its taint - $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 -} - sub apiquery ($) { my ($subpath) = @_; local $/=undef; @@ -391,7 +356,7 @@ if (!$fn) { my $sleepy=0; for (;;) { - poldb_setup(); + poldb_setup(poldb_path($repos)); $stderr = ''; my $rcode = $fn->(); |