hostdb.pm

   1 #!/usr/bin/perl
   2
   3 # Samba.org buildfarm
   4 # Copyright (C) 2008 Andrew Bartlett <abartlet@samba.org>
   5 # Copyright (C) 2008 Jelmer Vernooij <jelmer@samba.org>
   6 #
   7 # This program is free software; you can redistribute it and/or modify
   8 # it under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # This program is distributed in the hope that it will be useful,
  13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19 #
  20
  21 package hostdb;
  22
  23 use DBI;
  24 use warnings;
  25 use strict;
  26
  27 sub new($)
  28  {
  29     my ($class, $filename) = @_;
  30
  31     my $dbh = DBI->connect("dbi:SQLite:$filename", "", "", {RaiseError => 1, PrintError => 0,
  32                          ShowErrorStatement => 1, AutoCommit => 0}) or return undef;
  33
  34     my $self = { filename => $filename, dbh => $dbh };
  35
  36     bless($self, $class);
  37 }
  38
  39 sub provision($)
  40 {
  41         my ($self) = @_;
  42         eval {
  43             $self->{dbh}->do("CREATE TABLE host ( name text, owner text, owner_email text, password text, ssh_access int, fqdn text, platform text, permission text, last_dead_mail int, join_time int );");
  44
  45             $self->{dbh}->do("CREATE UNIQUE INDEX unique_hostname ON host (name);");
  46
  47             $self->{dbh}->do("CREATE TABLE build ( id integer primary key autoincrement, tree text, revision text, host text, compiler text, checksum text, age int, status text, commit_revision text);");
  48             $self->{dbh}->do("CREATE UNIQUE INDEX unique_checksum ON build (checksum);");
  49
  50             $self->{dbh}->do("CREATE TABLE test_run ( build int, test text, result text, output text);");
  51             $self->{dbh}->commit();
  52         };
  53         if ($@) {
  54             local $self->{dbh}->{RaiseError} = 0;
  55             $self->{dbh}->rollback();
  56             print "DB Failure: $@";
  57             return 0;
  58         }
  59         return 1;
  60 }
  61
  62 sub createhost($$$$$$)
  63 {
  64         my ($self, $name, $platform, $owner, $owner_email, $password, $permission) = @_;
  65         my $sth = $self->{dbh}->prepare("INSERT INTO host (name, platform, owner, owner_email, password, permission, join_time) VALUES (?,?,?,?,?,?,?)");
  66
  67         eval {
  68             $sth->execute($name, $platform, $owner, $owner_email, $password, $permission, time());
  69             $self->{dbh}->commit();
  70         };
  71         if ($@) {
  72             local $self->{dbh}->{RaiseError} = 0;
  73             $self->{dbh}->rollback();
  74             print "DB Failure: $@";
  75             return 0;
  76         }
  77         return 1;
  78 }
  79
  80 sub deletehost($$)
  81 {
  82         my ($self, $name) = @_;
  83         my $ret;
  84         my $sth = $self->{dbh}->prepare("DELETE FROM host WHERE name = ?");
  85
  86         eval {
  87             $ret = $sth->execute($name);
  88             $self->{dbh}->commit();
  89         };
  90         if ($@) {
  91             local $self->{dbh}->{RaiseError} = 0;
  92             $self->{dbh}->rollback();
  93             print "DB Failure: $@";
  94             return 0;
  95         }
  96
  97         return ($ret == 1);
  98 }
  99
 100 sub hosts($)
 101 {
 102         my ($self) = @_;
 103
 104         return $self->{dbh}->selectall_arrayref("SELECT * FROM host ORDER BY name", { Slice => {} });
 105 }
 106
 107 sub dead_hosts($$)
 108 {
 109         my ($self, $age) = @_;
 110         my $dead_age = time() - $age;
 111         return $self->{dbh}->selectall_arrayref("SELECT host.name AS host, host.owner AS owner, host.owner_email AS owner_email, MAX(age) AS last_update FROM host LEFT JOIN build ON ( host.name == build.host) WHERE ifnull(last_dead_mail, 0) < $dead_age AND ifnull(join_time, 0) < $dead_age GROUP BY host.name having ifnull(MAX(age),0) < $dead_age", { Slice => {} });
 112 }
 113
 114 sub host_ages($)
 115 {
 116         my ($self) = @_;
 117         return $self->{dbh}->selectall_arrayref("SELECT host.name AS host, host.owner AS owner, host.owner_email AS owner_email, MAX(age) AS last_update FROM host LEFT JOIN build ON ( host.name == build.host) GROUP BY host.name ORDER BY age", { Slice => {} });
 118 }
 119
 120 sub sent_dead_mail($$)
 121 {
 122         my ($self, $host) = @_;
 123         my $changed;
 124         eval {
 125             $changed = $self->{dbh}->do("UPDATE host SET last_dead_mail = ? WHERE name = ?", undef,
 126                 (time(), $host));
 127             $self->{dbh}->commit();
 128         };
 129         if ($@) {
 130             local $self->{dbh}->{RaiseError} = 0;
 131             $self->{dbh}->rollback();
 132             print "DB Failure: $@";
 133             return 0;
 134         }
 135
 136         return ($changed == 1);
 137 }
 138
 139 sub host($$)
 140 {
 141         my ($self, $name) = @_;
 142
 143         my $hosts = $self->hosts();
 144
 145         foreach (@$hosts) {
 146                 return $_ if ($_->{name} eq $name);
 147         }
 148
 149         return undef;
 150 }
 151
 152 sub update_platform($$$)
 153 {
 154         my ($self, $name, $new_platform) = @_;
 155         my $changed;
 156
 157         eval {
 158             $changed = $self->{dbh}->do("UPDATE host SET platform = ? WHERE name = ?", undef,
 159                 ($new_platform, $name));
 160             $self->{dbh}->commit();
 161         };
 162         if ($@) {
 163             local $self->{dbh}->{RaiseError} = 0;
 164             $self->{dbh}->rollback();
 165             print "DB Failure: $@";
 166             return 0;
 167         }
 168
 169         return ($changed == 1);
 170 }
 171
 172 sub update_owner($$$$)
 173 {
 174         my ($self, $name, $new_owner, $new_owner_email) = @_;
 175         my $changed;
 176
 177         eval {
 178             $changed = $self->{dbh}->do("UPDATE host SET owner = ?, owner_email = ? WHERE name = ?",
 179                                        undef, ($new_owner, $new_owner_email, $name));
 180             $self->{dbh}->commit();
 181         };
 182         if ($@) {
 183             local $self->{dbh}->{RaiseError} = 0;
 184             $self->{dbh}->rollback();
 185             return 0;
 186         }
 187
 188         return ($changed == 1);
 189 }
 190
 191 # Write out the rsyncd.secrets
 192 sub create_rsync_secrets($)
 193 {
 194         my ($db) = @_;
 195
 196         my $hosts = $db->hosts();
 197
 198         my $res = "";
 199
 200         $res .= "# rsyncd.secrets file\n";
 201         $res .= "# automatically generated by textfiles.pl. DO NOT EDIT!\n\n";
 202
 203         foreach (@$hosts) {
 204                 $res .= "# $_->{name}";
 205                 if ($_->{owner}) {
 206                         $res .= ", owner: $_->{owner} <$_->{owner_email}>\n";
 207                 } else {
 208                         $res .= ", owner unknown\n";
 209                 }
 210                 if ($_->{password}) {
 211                         $res .= "$_->{name}:$_->{password}\n\n";
 212                 } else {
 213                         $res .= "# $->{name} password is unknown\n\n";
 214                 }
 215         }
 216
 217         return $res;
 218 }
 219
 220 # Write out the web/
 221 sub create_hosts_list($)
 222 {
 223         my ($self) = @_;
 224
 225         my $res = "";
 226
 227         my $hosts = $self->hosts();
 228
 229         foreach (@$hosts) {
 230                 $res .= "$_->{name}: $_->{platform}\n";
 231         }
 232
 233         return $res;
 234 }
 235
 236 1;