chiark / gitweb /
New policy admin script
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Sun, 19 Apr 2015 20:26:47 +0000 (21:26 +0100)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Sun, 31 May 2015 10:54:05 +0000 (11:54 +0100)
Debian/Dgit/Policy/Debian.pm [new file with mode: 0644]
infra/dgit-repos-admin-debian [new file with mode: 0755]
infra/dgit-repos-policy-debian

diff --git a/Debian/Dgit/Policy/Debian.pm b/Debian/Dgit/Policy/Debian.pm
new file mode 100644 (file)
index 0000000..03118b1
--- /dev/null
@@ -0,0 +1,39 @@
+# -*- perl -*-
+
+package Debian::Dgit::Policy::Debian;
+
+use strict;
+use warnings;
+
+use POSIX;
+
+BEGIN {
+    use Exporter   ();
+    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
+
+    $VERSION     = 1.00;
+    @ISA         = qw(Exporter);
+    @EXPORT      = qw(poldb_path poldb_setup $poldbh);
+    %EXPORT_TAGS = ( );
+    @EXPORT_OK   = qw();
+}
+
+our @EXPORT_OK;
+
+our $poldbh;
+
+sub poldb_path ($) {
+    my ($repos) = @_;
+    return "$repos/policy.sqlite3";
+}
+
+sub poldb_setup ($) {
+    my ($policydb) = @_;
+
+    $poldbh ||= DBI->connect("dbi:SQLite:$policydb",'','', {
+       RaiseError=>1, PrintError=>1, AutoCommit=>0
+                          });
+    $poldbh->do("PRAGMA foreign_keys = ON");
+}
+
+1;
diff --git a/infra/dgit-repos-admin-debian b/infra/dgit-repos-admin-debian
new file mode 100755 (executable)
index 0000000..10118c6
--- /dev/null
@@ -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->();
index 7e459cc..fa1d17d 100755 (executable)
@@ -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->();