Maintenance scripts

diff --git a/scripts/gen_alias_list.pl b/scripts/gen_alias_list.pl
new file mode 100755 (executable)
index 0000000..477c058
--- /dev/null
+++ b/scripts/gen_alias_list.pl
@@ -0,0 +1,48 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use DBI;
+use Data::Dumper;
+use Getopt::Long;
+
+use vars qw($dbhost $dbname $dbuser $dbpass $dbport
+            $user_list_format
+);
+require "$ENV{BFConfDir}/BuildFarmWeb.pl";
+
+die "no dbname" unless $dbname;
+die "no dbuser" unless $dbuser;
+
+my %opts = ( outfile => "/etc/mail/lists/farmers" );
+GetOptions( \%opts,
+  'outfile:s',
+);
+
+my $dsn="dbi:Pg:dbname=$dbname";
+$dsn .= ";host=$dbhost" if $dbhost;
+$dsn .= ";port=$dbport" if $dbport;
+
+my $db = DBI->connect($dsn,$dbuser,$dbpass);
+
+die $DBI::errstr unless $db;
+
+my $sth = $db->prepare(q[ 
+       SELECT owner_email
+       FROM buildsystems AS b
+       ORDER BY owner_email ASC
+      ]);
+$sth->execute();
+
+my %list;
+while (my $row = $sth->fetchrow_hashref)
+{
+  $list{$row->{owner_email}}++;
+}
+$db->disconnect();
+
+open(my $fh, ">", $opts{outfile});
+if ($fh) {
+  print $fh (join "\n", (keys %list));
+}
+close $fh;

diff --git a/scripts/purge_old_logs.pl b/scripts/purge_old_logs.pl
new file mode 100755 (executable)
index 0000000..7182f0d
--- /dev/null
+++ b/scripts/purge_old_logs.pl
@@ -0,0 +1,44 @@
+#!/usr/bin/perl
+
+# Called by the user the web server runs as to clean up old database
+# records and old build logs
+
+use strict;
+use warnings;
+use DBI;
+use Data::Dumper;
+
+use vars qw($dbhost $dbname $dbuser $dbpass $dbport
+);
+require "$ENV{BFConfDir}/BuildFarmWeb.pl";
+
+die "no dbname" unless $dbname;
+die "no dbuser" unless $dbuser;
+
+my $dsn="dbi:Pg:dbname=$dbname";
+$dsn .= ";host=$dbhost" if $dbhost;
+$dsn .= ";port=$dbport" if $dbport;
+
+my $db = DBI->connect($dsn,$dbuser,$dbpass);
+
+die $DBI::errstr unless $db;
+
+my $del_sth = $db->prepare(q[
+       DELETE FROM build_status
+       WHERE snapshot < (now() - interval '3 months')
+      ]);
+my $del_recent_sth = $db->prepare(q[
+       DELETE FROM build_status_recent_500
+       WHERE snapshot < (now() - interval '3 months')
+      ]);
+
+$del_sth->execute();
+$del_recent_sth->execute();
+
+my $buildlogs = "$ENV{BFConfDir}/buildlogs";
+
+my @dirs = `find $buildlogs -mindepth 1 -type d -ctime +95`;
+foreach my $dir (@dirs) {
+  chomp $dir;
+  print `rm -rf $dir`;
+}