2 # dgit repos policy admin script for Debian
6 dgit-repos-admin-debian [<options>] operation...
8 --git-dir /path/to/git/repo/or/working/tree
9 --repos /path/to/dgit/repos/directory } alternatives
10 --db /path/to/dgit/repos/policy.sqlite3 }
11 (at least one of above required; if only one, cwd is used for other)
15 taint [--global|<package>] <gitobjid> '<comment>'
16 untaint [--global|<package>] <gitobjid>
24 use Debian::Dgit::Policy::Debian;
26 sub badusage ($) { die "bad usage: $_[0]\n$usage"; }
28 use Getopt::Long qw(:config posix_default gnu_compat bundling);
30 our ($git_dir,$repos_dir,$db_path);
32 GetOptions("git-dir=s" => \$git_dir,
33 "repos=s" => \$repos_dir,
37 $db_path //= poldb_path($repos_dir) if defined $repos_dir;
38 $db_path // $repos_dir ||
40 Must supply --git-dir and/or --repos (or --db instead of --repos).
41 If only one of --git-dir and --repos is supplied, other is taken to
42 be current working directory.
52 sub get_package_objid () {
53 $p = shift @ARGV; $p // badusage "operation needs package or --global";
54 if ($p eq '--global') {
57 $p =~ m/^$package_re$/ or badusage 'package name or --global needed';
59 $gitobjid = shift @ARGV;
60 $gitobjid // badusage "operation needs git object id";
61 $gitobjid =~ m/\W/ && badusage "invalid git object id";
64 sub sort_out_git_dir () {
65 foreach my $sfx ('/.git', '') {
66 my $path = "$git_dir/$sfx";
67 if (stat_exists "$path/objects") {
68 $ENV{GIT_DIR} = $git_dir = $path;
72 die "git directory $git_dir doesn't seem valid\n";
75 sub show_taints ($$@) {
76 my ($m, $cond, @condargs) = @_;
77 my $q = $poldbh->prepare
78 ("SELECT package,gitobjid,gitobjtype,time,comment, ".
79 " (gitobjdata IS NOT NULL) hasdata".
80 " FROM taints WHERE $cond".
81 " ORDER BY package, gitobjid, time");
82 $q->execute(@condargs);
83 print "$m:\n" or die $!;
85 while (my $row = $q->fetchrow_hashref) {
86 my $t = strftime "%Y-%m-%dT%H:%M:%S", gmtime $row->{time};
87 my $objinfo = $row->{gitobjtype}. ($row->{hasdata} ? '+' : ' ');
88 my $comment = $row->{comment};
89 $comment =~ s/\\/\\\\/g; $comment =~ s/\n/\\n/g;
90 printf(" %s %-30s %s %7s %s\n",
91 $t, $row->{package}, $row->{gitobjid},
92 $objinfo, $row->{comment})
99 sub cmd_list_taints ($) {
100 badusage "no args/options" if @ARGV;
101 my $count = show_taints("all taints","1");
102 printf "%d taints listed\n", $count or die $!;
105 sub cmd_create_db ($) {
106 badusage "no args/options" if @ARGV;
109 CREATE TABLE IF NOT EXISTS taints (
110 taint_id INTEGER NOT NULL PRIMARY KEY ASC AUTOINCREMENT,
111 package TEXT NOT NULL,
112 gitobjid TEXT NOT NULL,
113 comment TEXT NOT NULL,
120 CREATE INDEX IF NOT EXISTS taints_by_gitobjid
121 ON taints (gitobjid, package)
123 # any one of of the listed deliberatelies will override its taint
125 CREATE TABLE IF NOT EXISTS taintoverrides (
126 taint_id INTEGER NOT NULL
127 REFERENCES taints (taint_id)
130 DEFERRABLE INITIALLY DEFERRED,
131 deliberately TEXT NOT NULL,
132 PRIMARY KEY (taint_id, deliberately)
139 sub show_taints_bypackage ($) {
141 show_taints($m, "package = ?", $p);
144 sub show_taints_bygitobjid ($) {
146 show_taints($m, "gitobjid = ?", $gitobjid);
149 sub show_relevant_taints ($) {
151 show_taints_bypackage($p ? "$what taints for package $p"
152 : "$what global taints");
153 show_taints_bygitobjid("$what taints for object $gitobjid");
158 my $comment = shift @ARGV;
159 $comment // badusage "operation needs comment";
160 @ARGV && badusage "too many arguments to taint";
163 $!=0; $?=0; my $objtype = `git cat-file -t $gitobjid`;
164 chomp $objtype or die "$? $!";
166 $poldbh->do("INSERT INTO taints".
167 " (package, gitobjid, gitobjtype, time, comment)".
168 " VALUES (?,?,?,?,?)", {},
169 $p, $gitobjid, $objtype, time, $comment);
171 print "taint added\n" or die $!;
172 show_relevant_taints("resulting");
177 @ARGV && badusage "too many arguments to untaint";
179 show_relevant_taints("existing");
181 $poldbh->do("DELETE FROM taints".
182 " WHERE package = ? AND gitobjid = ?",
185 printf "%d taints removed\n", $affected or die $!;
186 exit $affected ? 0 : 1;
190 my $cmd = shift @ARGV;
191 $cmd // badusage "need operation";
194 my $fn = ${*::}{"cmd_$cmd"};
195 $fn or badusage "unknown operation $cmd";
197 poldb_setup($db_path);