Two new utilities to monitor user accounts

* backend/accounts/sv_spamkill: New file.
* backend/accounts/sv_userstat: New file.
* backend/Makefile.PL: Add these.

3 files changed, 499 insertions, 0 deletions

diff --git a/backend/Makefile.PL b/backend/Makefile.PL
index a3d6ee4..fe097a8 100644
--- a/backend/Makefile.PL
+++ b/backend/Makefile.PL
@@ -16,6 +16,8 @@ WriteMakefile(
 	'accounts/sv_homedirs', 
 	'accounts/sv_authorized_keys',
 	'accounts/sv_cvsserver',
+	'accounts/sv_spamkill',
+	'accounts/sv_userstat',
 
 	'backup/sv_dumpdb',
 	'backup/sv_repo_backup',
diff --git a/backend/accounts/sv_spamkill b/backend/accounts/sv_spamkill
new file mode 100644
index 0000000..145c789
--- /dev/null
+++ b/backend/accounts/sv_spamkill
@@ -0,0 +1,168 @@
+#! /usr/bin/perl
+# Copyright (C) 2017 Sergey Poznyakoff <gray@gnu.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+use strict;
+use Getopt::Long;
+use Savane;
+use Savane::DB;
+use Savane::Backend;
+use Savane::Trackers;
+use Data::Dumper;
+use User::pwent;
+use POSIX qw(strftime);
+use Time::ParseDate;
+use utf8;
+
+my $minscore = 9;
+my $sys_cron = 0;
+my $mark_status = 'S';
+
+backend_setup(descr => "Clean up spammers",
+	      cron => $sys_cron,
+              options => {
+		  "score|s=n" => \$minscore,
+		  "delete|D" => sub { $mark_status = 'D' }
+	      });
+
+sub format_user {
+    my $user = shift;
+    $user->{user_name}.': "'.$user->{real_name}.'" <'.$user->{email}.'>';
+}
+
+my @users;	      
+
+AcquireReplicationLock('groups-users.lock');
+
+db_foreach(sub {
+    push @users, shift;
+	   },
+	   qq{
+SELECT user.user_id AS user_id,
+       user.user_name AS user_name,
+       user.realname AS real_name,
+       user.spamscore AS spamscore,
+       user.email AS email,
+       count(user_group.group_id) AS group_count
+FROM user
+LEFT JOIN user_group
+ON user.user_id = user_group.user_id
+WHERE user.status = 'A' AND user.spamscore > ?
+GROUP BY user_id},
+    $minscore);
+foreach my $user (@users) {
+    if ($user->{group_count}) {
+	logit('info', 'skipping user '.format_user($user).', score '.$user->{spamscore}.': member of '.$user->{group_count}.' projects');
+	next;
+    }
+    debug(format_user($user).': '.$user->{spamscore});
+    next if dry_run;
+    db_insert('email_black_list',
+	      email => $user->{email},
+	      reason => 'Blocked for spam ('.$user->{spamscore}.')');
+    db_modify("UPDATE user SET status=? WHERE user_id=?",
+	      $mark_status, $user->{user_id});
+}
+backend_done;
+
+=head1 NAME
+
+sv_spamkill - suspend spammers
+
+=head1 SYNOPSIS
+
+B<sv_spamkill>
+[B<-F> I<FACILITY>]]
+[B<-S> I<MINSCORE>]]    
+[B<-Ddn>]
+[B<--cron>]
+[B<--debug>]
+[B<--delete>]    
+[B<--dry-run>]
+[B<--facility=>I<FACILITY>]
+[B<--stderr>]
+[B<--syslog>]
+[B<--score=>I<MINSCORE>]]
+
+B<sv_spamkill> [B<-h>] [B<--help>] [B<--usage>]
+
+=head1 DESCRIPTION
+
+Suspends or deletes users with spamscore greater than I<MINSCORE> (default 9).
+
+=head1 OPTIONS
+
+=over 8
+
+=item B<-D>, B<--delete>
+
+Mark spammers as deleted instead of as suspended.
+
+=item B<-s>, B<--score=I<MINSCORE>>
+
+Set minimum spam score.
+
+=item B<-d>, B<--debug>
+
+Increase debugging level.
+
+=item B<-n>, B<--dry-run>
+
+Do nothing, print everything.  Implies B<--debug>.
+
+=item B<-F>, B<--facility=>I<NAME>
+
+Log to the syslog facility I<NAME>.  If I<NAME> begins with a slash,
+it is understood as the name of the file where to direct the logging
+output.
+
+=item B<--stderr>
+
+Log to standard error.  This is the default.
+    
+=item B<-h>
+
+Show a terse help summary and exit.
+
+=item B<--help>
+
+Prints the manual page and exits.
+
+=back
+
+=head1 CONFIGURATION VARIABLES
+
+=over 4
+    
+=item B<sql.database>
+
+=item B<sql.user>
+
+=item B<sql.password>
+
+=item B<sql.host>
+
+=item B<sql.params>
+
+Database credentials.    
+
+=back
+    
+=head1 AUTHOR
+
+Sergey Poznyakoff <gray@gnu.org>
+    
+=cut    
+    
diff --git a/backend/accounts/sv_userstat b/backend/accounts/sv_userstat
new file mode 100644
index 0000000..5e27050
--- /dev/null
+++ b/backend/accounts/sv_userstat
@@ -0,0 +1,329 @@
+#! /usr/bin/perl
+# Copyright (C) 2017 Sergey Poznyakoff <gray@gnu.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3, or (at your option)
+# any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+use strict;
+use Getopt::Long;
+use Savane;
+use Savane::DB;
+use Savane::Backend;
+use Savane::Trackers;
+use Data::Dumper;
+use User::pwent;
+use POSIX qw(strftime);
+use Time::ParseDate;
+use utf8;
+
+my $max_user_name = 8;
+my $max_real_name = 32;
+my $long_format;
+my $before_date;
+my $after_date;
+my $print_real_names;
+
+sub select_class {
+    my ($stk, $c) = @_;
+    my $user = pop @$stk;
+    return $user->{class}{$c}
+}
+
+my %seltab = (
+    system => sub { select_class(shift, 'SYSTEM') },
+    s => 'system',
+    active => sub { select_class(shift, 'ACTIVE') },
+    a => 'active',
+    reporter => sub { select_class(shift, 'REPORTER') },
+    r => 'reporter',
+    spammer => sub { select_class(shift, 'SPAMMER') },
+    S => 'spammer',
+    idle => sub {
+	my $stk = shift;
+	my $user = pop @$stk;
+	return !($user->{class}{SYSTEM} ||
+		 $user->{class}{ACTIVE} ||
+		 $user->{class}{REPORTER} ||
+		 $user->{class}{SPAMMER});
+    },
+    before => sub {
+	my $stk = shift;
+	my $user = pop @$stk;
+	return $user->{add_date} <= $before_date
+    },
+    after => sub {
+	my $stk = shift;
+	my $user = pop @$stk;
+	return $user->{add_date} >= $after_date
+    }
+    );
+
+sub f_push {
+    my ($stk) = @_;
+    return $_;
+}
+
+sub f_and {
+    my ($stk) = @_;
+    my $a = pop @$stk;
+    my $b = pop @$stk;
+    return 1 if $a && $b;
+}
+    
+sub f_negate {
+    my ($stk) = @_;
+    return ! pop @$stk;
+}
+
+sub findfun {
+    my ($ftab, $key) = @_;
+    my $neg;
+    my $fun;
+    
+    if ($key =~ m/[~!](.+)/) {
+	$neg = 1;
+	$key = $1;
+    }
+
+    while (exists($ftab->{$key})) {
+	if (ref($ftab->{$key}) eq 'CODE') {
+	    $fun = $ftab->{$key};
+	    last;
+	}
+	$key = $ftab->{$key};
+    }
+    abend(EX_USAGE, "unknown selector: $key")
+	unless defined $fun;
+    return ($neg,$fun);
+}
+
+my @selectors;
+
+sub usel {
+    return 1 unless @selectors;
+    my $user = shift;
+    my $retval = 0;
+    my @args;
+
+    foreach my $f (@selectors) {
+	local $_ = $user;
+	$retval = &{$f}(\@args);
+	last unless defined($retval);
+	push @args, $retval;
+    }
+    return $retval;
+}
+
+sub progsel {
+    my $val = shift;
+    my ($neg, $fun) = findfun(\%seltab, $val);
+
+    my $prev = @selectors;
+		      
+    push @selectors, \&f_push;
+    push @selectors, $fun;
+    push @selectors, \&f_negate if $neg;
+    push @selectors, \&f_and if $prev;
+}
+
+sub sort_class {
+    my $class = shift;
+    return $a->{class}{$class} <=> $b->{class}{$class};
+}
+
+my %sorttab = (
+    system => sub { sort_class('SYSTEM') },
+    s => 'system',
+    active => sub { sort_class('ACTIVE') },
+    a => 'active',
+    reporter => sub { sort_class('REPORTER') },
+    r => 'reporter',
+    spammer => sub { sort_class('SPAMMER') },
+    user => sub { $a->{user_name} cmp $b->{user_name} },
+    time => sub { $a->{add_date} cmp $b->{add_date} },
+    date => 'time',
+    groups => sub { $a->{group_count} cmp $b->{group_count} },
+    postings => sub { $a->{postings} cmp $b->{postings} },
+    comments => sub { $a->{comments} cmp $b->{comments} }
+);
+
+my @sortstk;
+
+sub usort {
+    foreach my $f (@sortstk) {
+	my $res = &{$f->{fun}};
+	$res = - $res if ($f->{neg});
+	return $res if $res;
+    }
+    return 0;
+}
+
+
+backend_setup(descr => "Show savane users' statistics",
+              options => {
+		  "long|l" => \$long_format,
+		  "select=s" => sub {
+		      foreach my $val (split /\s*,\s*/, $_[1]) {
+			  abend(EX_USAGE, "$val cannot be used as selector")
+			      if grep { $val eq $_ } qw(after before);
+			  progsel($val);
+		      }
+		  },
+		  "since|after=s" => sub {
+		      $after_date = parsedate($_[1]);
+		      progsel('after');
+		  },
+		  "before=s" => sub {
+		      $before_date = parsedate($_[1]);
+		      progsel('before');
+		  },
+		  "sort=s" => sub {
+		      my ($opt, $val) = @_;
+		      foreach my $val (split /\s*,\s*/, $_[1]) {
+			  my ($neg, $fun) = findfun(\%sorttab, $val);
+			  push @sortstk, { neg => $neg, fun => $fun };
+		      }
+		  },
+                  "real-names|N" => \$print_real_names
+	      });
+
+my $cond = 'user.user_id > 100 AND user.status=?';
+my @args = ('A');
+if ($#ARGV == -1) {
+} else {
+    my (@uids, @unames);
+    foreach my $arg (@ARGV) {
+	if ($arg =~ /^\+(\d+)$/) {
+	    push @uids, $1;
+	} else {
+	    push @unames, $arg;
+	}
+    }
+
+    $cond .= ' AND (';
+    
+    $cond .= "user.user_name in (".join(',', ('?') x @unames).")"
+	if (@unames);
+    
+    if ($#uids >= 0) {
+	$cond .= " OR " if defined($cond);
+	$cond .= "user.user_id in (".join(',', ('?') x @uids).")";
+    }
+    $cond .= ')';
+    push @args, @unames, @uids;
+}
+
+sub comment_count {
+    my $uref = shift;
+    my $postings = 0;
+    my $comments = 0;
+    
+    foreach my $tracker (TrackerNames()) {
+	db_foreach(
+	    sub {
+		my $x = shift;
+		$postings += $x->{n};
+	    },
+	    qq{
+SELECT count(*) AS n
+FROM $tracker tracker
+WHERE tracker.submitted_by=?},
+	    $uref->{user_id});
+	db_foreach(
+	    sub {
+		my $x = shift;
+		$comments += $x->{n};
+	    },
+	    qq{
+SELECT count(*) AS n
+FROM ${tracker}_history hist
+WHERE hist.field_name=? AND hist.mod_by=?},
+	    'details', $uref->{user_id});
+    }
+    $uref->{postings} = $postings;
+    $uref->{comments} = $comments;
+}
+
+sub user_class_str {
+    my $uref = shift;
+    return
+	($uref->{class}{SYSTEM} ? 's' : '-') .
+	($uref->{class}{ACTIVE} ? 'a' : '-') .
+	($uref->{class}{REPORTER} ? 'r' : '-') .
+	($uref->{class}{SPAMMER} ? 'S' : '-');
+}
+
+sub list_user {
+    my $uref = shift;
+    printf("%4s %-*s",
+	   user_class_str($uref),
+	   $max_user_name + 1, $uref->{user_name});
+    if ($print_real_names) {
+        printf(" %-*s", $max_real_name + 1, $uref->{real_name});
+    }
+    if ($long_format) {
+	printf("%s %2d %3d %3d",
+	   strftime('%Y-%m-%d %H:%M:%S', localtime $uref->{add_date}),
+	   $uref->{group_count},
+	   $uref->{postings},
+	   $uref->{comments}
+	);
+    }
+    print "\n";
+}
+
+my @userlist;
+db_foreach(
+    sub {
+        my $ref = shift;
+	if (my $pw = getpwnam($ref->{user_name})) {
+	    $ref->{system_account} = 1;
+	    $ref->{sys_uid} = $pw->uid;
+	    $ref->{sys_gid} = $pw->gid;
+	    $ref->{sys_shell} = $pw->shell;
+	    $ref->{sys_home} = $pw->dir;
+        }
+	comment_count($ref);
+
+	$ref->{class}{SPAMMER} = $ref->{spamscore} > 4;
+	$ref->{class}{SYSTEM} = $ref->{system_account};
+	$ref->{class}{ACTIVE} = $ref->{group_count} > 0;
+	$ref->{class}{REPORTER} = ($ref->{postings} + $ref->{comments} > 0);
+	
+	push @userlist, $ref;
+	$max_user_name = length($ref->{user_name}) if length($ref->{user_name}) > $max_user_name;
+	$max_real_name = length($ref->{real_name}) if length($ref->{real_name}) > $max_real_name;
+    },
+    qq{
+SELECT user.user_id AS user_id,
+       user.user_name AS user_name,
+       user.spamscore AS spamscore,
+       user.add_date AS add_date,
+       user.email AS email,
+       user.realname AS real_name,
+       user.authorized_keys_count AS authorized_keys_count,
+       user.people_view_skills AS people_view_skills,
+       count(user_group.group_id) AS group_count
+FROM user
+LEFT JOIN user_group
+ON user.user_id = user_group.user_id
+WHERE $cond
+GROUP BY user_name},
+    @args);
+
+foreach my $user (sort usort grep { usel($_) } @userlist) {
+    list_user($user);
+}
+    
+backend_done();
+