projtool.pl: do not attempt to check unset error codes
[girocco.git] / toolbox / sanity-check.pl
blobdbf5563ff0cbb150d234d550183eada1fac65faa
1 #!/usr/bin/perl
3 # sanity-check.pl - perform basic sanity checks
4 # Copyright (C) 2021 Kyle J. McKay.
5 # All rights reserved.
6 # License GPLv2+: GNU GPL version 2 or later.
7 # www.gnu.org/licenses/gpl-2.0.html
8 # This is free software: you are free to change and redistribute it.
9 # There is NO WARRANTY, to the extent permitted by law.
11 use strict;
12 use warnings;
13 use vars qw($VERSION);
14 BEGIN {*VERSION = \'1.0.1'}
15 use Scalar::Util qw(looks_like_number);
16 use File::Basename qw(basename);
17 use lib "__BASEDIR__";
18 use Girocco::Config;
19 use Girocco::Util;
20 use Girocco::CLIUtil;
21 use Girocco::User;
22 use Girocco::Project;
23 my $bn; BEGIN {$bn = basename(__FILE__)}
25 exit(&main(@ARGV)||0);
27 our $help;
28 BEGIN {$help = <<'HELP'}
29 Usage: %s [--help]
30 --help show this help
31 -P/--progress show progress on STDERR (default if STDERR is a tty)
33 Exit status will always be non-zero if any issues are detected.
34 HELP
36 my $show_progress;
37 my $progress;
38 END {$progress = undef}
39 my $errs;
41 sub ProgressInit {
42 my ($max, $title) = @_;
43 $show_progress or $max = 0;
44 if (ref($progress)) {
45 $progress->reset($max, $title);
46 } else {
47 $progress = Girocco::CLIUtil::Progress->new($max, $title);
49 $progress;
52 my %users;
54 sub check_users {
55 %users = map({($$_[0] => $_)} Girocco::User::get_full_list_extended());
56 my @users = sort({lc($a) cmp lc($b) || $a cmp $b} keys(%users));
57 ProgressInit(scalar(@users), "Checking users");
58 foreach (qw(everyone mob git)) {
59 exists($users{$_}) or $progress->emit("user: $_: missing");
61 my $cnt = 0;
62 foreach (@users) {
63 my @f = @{$users{$_}};
64 $f[0] eq $_ or die "programmer error";
65 $f[2] >= 65536 or next;
66 my @p = ();
67 @f == 7 or push(@p, "not-7-fields");
68 looks_like_number($f[3]) && $f[3] == int($f[3]) or do {
69 push(@p, "bad-group-num");
70 $f[3] = 0;
72 defined($f[4]) or $f[4] = '';
73 defined($f[5]) or $f[5] = '';
74 defined($f[6]) or $f[6] = '';
75 $f[4] ne "" or push(@p, "empty-desc");
76 $f[5] eq "/" or push(@p, "bad-home");
77 my $sk = jailed_file('/etc/sshkeys/'.$_);
78 -f $sk or push(@p, "missing-sshkeys-file");
79 if ($_ eq 'mob') {
80 -f $sk && ! -s _ or push(@p, "sshkeys-not-empty");
81 $f[1] eq "" or push(@p, "pw-not-empty");
82 $f[3] == $Girocco::Config::var_group_gid or push(@p, "wrong-gid");
83 $f[6] eq "/bin/git-shell-verify" or push(@p, "wrong-shell");
84 } elsif ($_ eq 'git') {
85 -f $sk && ! -s _ or push(@p, "sshkeys-not-empty");
86 $f[1] eq "" or push(@p, "pw-not-empty");
87 $f[3] != $Girocco::Config::var_group_gid or push(@p, "wrong-gid");
88 $f[6] eq "/bin/git-shell-verify" or push(@p, "wrong-shell");
89 } elsif ($_ eq 'everyone') {
90 -f $sk && ! -s _ or push(@p, "sshkeys-not-empty");
91 length($f[1]) == 1 or push(@p, "pw-not-disabled");
92 $f[3] == $Girocco::Config::var_group_gid or push(@p, "wrong-gid");
93 $f[6] eq "/bin/false" or push(@p, "wrong-shell");
94 } else {
95 $_ eq "root" and push(@p, "wrong-uid");
96 $_ eq $Girocco::Config::mirror_user and push(@p, "wrong-uid");
97 length($f[1]) == 1 or push(@p, "pw-not-disabled");
98 $f[3] == $Girocco::Config::var_group_gid or push(@p, "wrong-gid");
99 $f[6] eq "/bin/git-shell-verify" or push(@p, "wrong-shell");
100 my @g = split(/,/, $f[4], -1);
101 @g <= 3 or push(@p, "excess-desc-fields");
102 defined($g[1]) or $g[1] = '';
103 defined($g[2]) or $g[2] = '';
104 if ($g[0] eq "") {
105 push(@p, "missing-email");
106 } else {
107 my @e = split(/[@]/, $g[0], 2);
108 defined($e[1]) or $e[1] = '';
109 $e[0] ne "" or push(@p, "missing-email-user");
110 $e[1] ne "" or push(@p, "missing-email-host");
111 $e[0] ne "" && $e[1] ne "" && valid_email($g[0]) or
112 push(@p, "email-invalid");
114 if ($g[1] ne "") {
115 $g[1] =~ /^[0-9a-f]{8}-(?:[0-9a-f]{4}-){3}[0-9a-f]{12}$/ or
116 push(@p, "uuid-invalid");
118 if ($g[2] ne "") {
119 $g[2] =~ /^\d{8}_\d{6}$/ or push(@p, "creation-date-invalid");
121 eval {
122 my $u = Girocco::User->load($_);
123 ref($u);
124 } or push(@p, "unloadable");
126 @p and ++$errs;
127 @p and $progress->emit("user: $_: ".join(" ", @p));
128 } continue {$progress->update(++$cnt)}
131 my %projects;
133 sub check_projects {
134 %projects = map({($$_[0] => $_)} Girocco::Project::get_full_list_extended());
135 my @projects = sort({lc($a) cmp lc($b) || $a cmp $b} keys(%projects));
136 ProgressInit(scalar(@projects), "Checking projects");
137 my $bd = $Girocco::Config::reporoot . '/';
138 my $cnt = 0;
139 foreach (@projects) {
140 my @f = @{$projects{$_}};
141 $f[0] eq $_ or die "programmer error";
142 $f[2] >= 65536 or next;
143 my @p = ();
144 @f == 4 || @f == 5 or push(@p, "not-4-or-5-fields");
145 @f >= 5 && $f[4] ne "" and push(@p, "field-5-not-empty");
146 $f[1] ne "" or push(@p, "pw-empty");
147 if ($f[3] ne "") {
148 my $badusers = 0;
149 my $unknownusers = 0;
150 my @u = split(/,/, $f[3], -1);
151 foreach my $u (@u) {
152 if ($u =~ /^[a-zA-Z0-9][a-zA-Z0-9+._-]*$/) {
153 exists($users{$u}) or ++$unknownusers;
154 } else {
155 ++$badusers;
158 $badusers && push(@p, "bad-users");
159 $unknownusers && push(@p, "unknown-users");
161 my $pd = $bd . $_ . '.git';
162 if (! -d $pd) {
163 push(@p, "missing-gitdir");
164 } else {
165 if (@f == 4 || @f == 5) {
166 my $nofetch = -e "$pd/.nofetch";
167 (@f == 4 && !$nofetch) || (@f == 5 && $nofetch) and
168 push(@p, "nofetch-fieldcnt-mismatch");
170 my $p;
171 eval { $p = Girocco::Project->load($_) };
172 if (!ref($p)) {
173 push(@p, "unloadable");
174 } else {
175 if (-e "$pd/.delaygc" && ! -e "$pd/.allowgc" && ! -e "$pd/.clone_in_progress") {
176 !$p->is_empty and push(@p, "delaygc-not-empty");
178 my ($cnt, $err) = (0, "");
179 my $origreadme = $p->{README};
180 defined($origreadme) or $origreadme = "";
181 if (! eval { ($cnt, $err) = $p->_lint_readme(0); 1 }) {
182 push(@p, "readmefmt-died");
183 } else {
184 if ($cnt) {
185 push(@p, "readmefmt-failed");
186 } else {
187 my $readme = $p->{README};
188 defined($readme) or $readme = "";
189 chomp $origreadme;
190 chomp $readme;
191 $origreadme eq $readme or
192 push(@p, "readmefmt-mismatch");
197 @p and ++$errs;
198 @p and $progress->emit("project: $_: ".join(" ", @p));
199 } continue {$progress->update(++$cnt)}
202 sub dohelp {
203 my $fd = shift;
204 my $ec = shift;
205 printf $fd "%s version %s\n", $bn, $VERSION;
206 printf $fd $help, $bn;
207 exit $ec;
210 sub main {
211 local *ARGV = \@_;
212 my $help;
213 my $progress = -t STDERR;
215 shift, $help=1, redo if @ARGV && $ARGV[0] =~ /^(?:-h|--help)$/i;
216 shift, $progress=1, redo if @ARGV && $ARGV[0] =~ /^(?:-P|--progress)$/i;
217 shift, $progress=0, redo if @ARGV && $ARGV[0] =~ /^(?:--no-progress)$/i;
219 !@ARGV && !$help or dohelp($help ? \*STDOUT : \*STDERR, !$help);
220 $show_progress = $progress;
221 $errs = 0;
222 nice_me();
223 check_users;
224 check_projects;
225 print "User-count: ".scalar(keys(%users)).
226 " Project-count: ".scalar(keys(%projects)).
227 " Issues-found: $errs\n";
228 exit $errs ? 1 : 0;