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
124 # the field `deliberately' contains `--deliberately-blah-blah',
125 # not just `blah blah'.
127 CREATE TABLE IF NOT EXISTS taintoverrides (
128 taint_id INTEGER NOT NULL
129 REFERENCES taints (taint_id)
132 DEFERRABLE INITIALLY DEFERRED,
133 deliberately TEXT NOT NULL,
134 PRIMARY KEY (taint_id, deliberately)
141 sub show_taints_bypackage ($) {
143 show_taints($m, "package = ?", $p);
146 sub show_taints_bygitobjid ($) {
148 show_taints($m, "gitobjid = ?", $gitobjid);
151 sub show_relevant_taints ($) {
153 show_taints_bypackage($p ? "$what taints for package $p"
154 : "$what global taints");
155 show_taints_bygitobjid("$what taints for object $gitobjid");
160 my $comment = shift @ARGV;
161 $comment // badusage "operation needs comment";
162 @ARGV && badusage "too many arguments to taint";
165 $!=0; $?=0; my $objtype = `git cat-file -t $gitobjid`;
166 chomp $objtype or die "$? $!";
168 $poldbh->do("INSERT INTO taints".
169 " (package, gitobjid, gitobjtype, time, comment)".
170 " VALUES (?,?,?,?,?)", {},
171 $p, $gitobjid, $objtype, time, $comment);
173 print "taint added\n" or die $!;
174 show_relevant_taints("resulting");
179 @ARGV && badusage "too many arguments to untaint";
181 show_relevant_taints("existing");
183 $poldbh->do("DELETE FROM taints".
184 " WHERE package = ? AND gitobjid = ?",
187 printf "%d taints removed\n", $affected or die $!;
188 exit $affected ? 0 : 1;
192 my $cmd = shift @ARGV;
193 $cmd // badusage "need operation";
196 my $fn = ${*::}{"cmd_$cmd"};
197 $fn or badusage "unknown operation $cmd";
199 poldb_setup($db_path);