2 # dgit repos policy admin script for Debian
11 dgit-repos-admin-debian [<options>] operation...
13 --git-dir /path/to/git/repo/or/working/tree
14 --repos /path/to/dgit/repos/directory } alternatives
15 --db /path/to/dgit/repos/policy.sqlite3 }
16 (at least one of above required; if only one, cwd is used for other)
20 taint [--global|<package>] <gitobjid> '<comment>'
21 untaint [--global|<package>] <gitobjid>
27 use Debian::Dgit::Policy::Debian;
29 sub badusage ($) { die "bad usage: $_[0]\n$usage"; }
31 use Getopt::Long qw(:config posix_default gnu_compat bundling);
33 our ($git_dir,$repos_dir,$db_path);
35 GetOptions("git-dir=s" => \$git_dir,
36 "repos=s" => \$repos_dir,
40 $db_path //= poldb_path($repos_dir) if defined $repos_dir;
41 $db_path // $repos_dir ||
43 Must supply --git-dir and/or --repos (or --db instead of --repos).
44 If only one of --git-dir and --repos is supplied, other is taken to
45 be current working directory.
55 sub get_package_objid () {
56 $p = shift @ARGV; $p // badusage "operation needs package or --global";
57 if ($p eq '--global') {
60 $p =~ m/^$package_re$/ or badusage 'package name or --global needed';
62 $gitobjid = shift @ARGV;
63 $gitobjid // badusage "operation needs git object id";
64 $gitobjid =~ m/\W/ && badusage "invalid git object id";
67 sub sort_out_git_dir () {
68 foreach my $sfx ('/.git', '') {
69 my $path = "$git_dir/$sfx";
70 if (stat_exists "$path/objects") {
71 $ENV{GIT_DIR} = $git_dir = $path;
75 die "git directory $git_dir doesn't seem valid\n";
78 sub show_taints ($$@) {
79 my ($m, $cond, @condargs) = @_;
80 my $q = $poldbh->prepare
81 ("SELECT package,gitobjid,gitobjtype,time,comment, ".
82 " (gitobjdata IS NOT NULL) hasdata".
83 " FROM taints WHERE $cond".
84 " ORDER BY package, gitobjid, time");
85 $q->execute(@condargs);
86 print "$m:\n" or die $!;
88 while (my $row = $q->fetchrow_hashref) {
89 my $t = strftime "%Y-%m-%dT%H:%M:%S", gmtime $row->{time};
90 my $objinfo = $row->{gitobjtype}. ($row->{hasdata} ? '+' : ' ');
91 my $comment = $row->{comment};
92 $comment =~ s/\\/\\\\/g; $comment =~ s/\n/\\n/g;
93 printf(" %s %-30s %s %7s %s\n",
94 $t, $row->{package}, $row->{gitobjid},
95 $objinfo, $row->{comment})
102 sub cmd_list_taints ($) {
103 badusage "no args/options" if @ARGV;
104 my $count = show_taints("all taints","1");
105 printf "%d taints listed\n", $count or die $!;
108 sub cmd_create_db ($) {
109 badusage "no args/options" if @ARGV;
112 CREATE TABLE IF NOT EXISTS taints (
113 taint_id INTEGER NOT NULL PRIMARY KEY ASC AUTOINCREMENT,
114 package TEXT NOT NULL,
115 gitobjid TEXT NOT NULL,
116 comment TEXT NOT NULL,
123 CREATE INDEX IF NOT EXISTS taints_by_gitobjid
124 ON taints (gitobjid, package)
126 # any one of of the listed deliberatelies will override its taint
127 # the field `deliberately' contains `--deliberately-blah-blah',
128 # not just `blah blah'.
130 CREATE TABLE IF NOT EXISTS taintoverrides (
131 taint_id INTEGER NOT NULL
132 REFERENCES taints (taint_id)
135 DEFERRABLE INITIALLY DEFERRED,
136 deliberately TEXT NOT NULL,
137 PRIMARY KEY (taint_id, deliberately)
144 sub show_taints_bypackage ($) {
146 show_taints($m, "package = ?", $p);
149 sub show_taints_bygitobjid ($) {
151 show_taints($m, "gitobjid = ?", $gitobjid);
154 sub show_relevant_taints ($) {
156 show_taints_bypackage($p ? "$what taints for package $p"
157 : "$what global taints");
158 show_taints_bygitobjid("$what taints for object $gitobjid");
163 my $comment = shift @ARGV;
164 $comment // badusage "operation needs comment";
165 @ARGV && badusage "too many arguments to taint";
168 $!=0; $?=0; my $objtype = `git cat-file -t $gitobjid`;
169 chomp $objtype or die "$? $!";
171 $poldbh->do("INSERT INTO taints".
172 " (package, gitobjid, gitobjtype, time, comment)".
173 " VALUES (?,?,?,?,?)", {},
174 $p, $gitobjid, $objtype, time, $comment);
176 print "taint added\n" or die $!;
177 show_relevant_taints("resulting");
182 @ARGV && badusage "too many arguments to untaint";
184 show_relevant_taints("existing");
186 $poldbh->do("DELETE FROM taints".
187 " WHERE package = ? AND gitobjid = ?",
190 printf "%d taints removed\n", $affected or die $!;
191 exit $affected ? 0 : 1;
195 my $cmd = shift @ARGV;
196 $cmd // badusage "need operation";
199 my $fn = ${*::}{"cmd_$cmd"};
200 $fn or badusage "unknown operation $cmd";
202 poldb_setup($db_path);