From 323e5e59ee548bf44cc2cb9a584cb1c3edcabe3f Mon Sep 17 00:00:00 2001 From: Ian Jackson Date: Sun, 19 Apr 2015 21:26:47 +0100 Subject: New policy admin script --- infra/dgit-repos-admin-debian | 199 +++++++++++++++++++++++++++++++++++++++++ infra/dgit-repos-policy-debian | 39 +------- 2 files changed, 201 insertions(+), 37 deletions(-) create mode 100755 infra/dgit-repos-admin-debian (limited to 'infra') 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 [] 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|] '' + untaint [--global|] +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(<do(<do(<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(<do(<do(<(); -- cgit v1.2.3