X-Git-Url: https://defaria.com/gitweb/?a=blobdiff_plain;f=lib%2FMachines.pm;h=76c1dfbef5dcb244b4db23cfdd4652df8d0bf3b3;hb=340b9e62b878286519daa08725f831868d4c00b9;hp=c872edaa7adc3766a92b18684312b50803e8cf7e;hpb=85a506f0983544ac5e06634fb6329a5fd9db4d01;p=clearscm.git diff --git a/lib/Machines.pm b/lib/Machines.pm index c872eda..76c1dfb 100644 --- a/lib/Machines.pm +++ b/lib/Machines.pm @@ -1,370 +1,357 @@ -=pod - -=head1 NAME $RCSfile: Machines.pm,v $ - -Abstraction of machines. - -=head1 VERSION - -=over - -=item Author - -Andrew DeFaria - -=item Revision - -$Revision: 1.4 $ - -=item Created - -Tue Jan 8 17:24:16 MST 2008 - -=item Modified - -$Date: 2011/11/16 19:46:13 $ - -=back - -=head1 SYNOPSIS - -This module handles the details of providing information about -machines while obscuring the mechanism for storing such information. - - my $machines = Machines->new; - - foreach ($machine->all) { - my %machine = %{$_}; - display "Machine: $machine{name}"; - disp.ay "Owner: $machine{owner}" - } # if - -=head1 DESCRIPTION - -This module provides information about machines - -=head1 ROUTINES - -The following routines are exported: - -=cut - -package Machines; - -use strict; -use warnings; - -use Carp; -use DBI; -use FindBin; - -use DateUtils; -use Display; -use GetConfig; - -our %MACHINESOPTS = GetConfig ("$FindBin::Bin/../etc/machines.conf"); - -my $defaultFilesystemThreshold = 90; -my $defaultFilesystemHist = '6 months'; -my $defaultLoadavgHist = '6 months'; - -# Internal methods -sub _dberror ($$) { - my ($self, $msg, $statement) = @_; - - my $dberr = $self->{db}->err; - my $dberrmsg = $self->{db}->errstr; - - $dberr ||= 0; - $dberrmsg ||= 'Success'; - - my $message = ''; - - if ($dberr) { - my $function = (caller (1)) [3]; - - $message = "$function: $msg\nError #$dberr: $dberrmsg\n" - . "SQL Statement: $statement"; - } # if - - return $dberr, $message; -} # _dberror - -sub _formatValues (@) { - my ($self, @values) = @_; - - my @returnValues; - - # Quote data values - push @returnValues, $_ eq '' ? 'null' : $self->{db}->quote ($_) - foreach (@values); - - return @returnValues; -} # _formatValues - -sub _formatNameValues (%) { - my ($self, %rec) = @_; - - my @nameValueStrs; - - push @nameValueStrs, "$_=" . $self->{db}->quote ($rec{$_}) - foreach (keys %rec); - - return @nameValueStrs; -} # _formatNameValues - -sub _error () { - my ($self) = @_; - - if ($self->{msg}) { - if ($self->{errno}) { - carp $self->{msg}; - } else { - cluck $self->{msg}; - } # if +=pod + +=head1 NAME $RCSfile: Machines.pm,v $ + +Object oriented interface to list of managed machines + +=head1 VERSION + +=over + +=item Author: + +Andrew DeFaria + +=item Revision: + +$Revision: 1.0 $ + +=item Created: + +Thu, Jul 12, 2018 5:11:44 PM + +=item Modified: + +$Date: $ + +=back + +=head1 SYNOPSIS + +Perl module to specify a list of managed machines for rexec.pl + + $machines = Machines->new (filename => "/opt/clearscm/data/machines"); + + my @machines = $machines->all; + + my @linux_machines = $machines->select(condition => 'OS = "linux"'); + +=head1 DESCRIPTION + +Machines is an OO interface to a list of managed machines. By default it parses +a file that contains machine names and other identifying information. + +=head1 ROUTINES + +The following routines are exported: + +=cut + +package Machines; + +use strict; +use warnings; + +use base 'Exporter'; + +use Carp; + +sub _parseFile() { + my ($self) = @_; + + my %machines; + + # Simple parse for now + open my $machineFile, '<', $self->{filename} + or croak "Unable to open $self->{filename} - $!"; + + while (<$machineFile>) { + chomp; + + next if /^#/; # Skip comments + + my ($name, $model, $os, $ccver, $owner, $usage) = split /:/; + + my %machineInfo = ( + model => $model, + os => $os, + ccver => $ccver, + owner => $owner, + usage => $usage, + ); + + $machines{$name} = \%machineInfo; + } # while + + close $machineFile; + + return \%machines; +} # _parseFile + +sub new(;%){ + my ($class, %parms) = @_; + +=pod + +=head2 new () + +Construct a new Machines object. The following OO style arguments are +supported: + +Parameters: + +=for html
+ +=over + +=item filename: + +Filename to parse + +=item path: + +Path where file resides + +=back + +=for html
+ +Returns:: + +=for html
+ +=over + +=item Machines object + +=back + +=for html
+ +=cut + + $parms{filename} ||= 'machines'; + + if (! -r $parms{filename}) { + croak "Unable to read $parms{filename}"; } # if -} # _error - -sub _addRecord ($%) { - my ($self, $table, %rec) = @_; - - my $statement = "insert into $table ("; - $statement .= join ',', keys %rec; - $statement .= ') values ('; - $statement .= join ',', $self->_formatValues (values %rec); - $statement .= ')'; - - my ($err, $msg); - - $self->{db}->do ($statement); - - return $self->_dberror ("Unable to add record to $table", $statement); -} # _addRecord - -sub _checkRequiredFields ($$) { - my ($fields, $rec) = @_; - - foreach my $fieldname (@$fields) { - my $found = 0; - - foreach (keys %$rec) { - if ($fieldname eq $_) { - $found = 1; - last; - } # if - } # foreach - - return "$fieldname is required" - unless $found; - } # foreach - - return; -} # _checkRequiredFields - -sub _connect (;$) { - my ($self, $dbserver) = @_; - - $dbserver ||= $MACHINESOPTS{MACHINES_SERVER}; - - my $dbname = 'machines'; - my $dbdriver = 'mysql'; - - $self->{db} = DBI->connect ( - "DBI:$dbdriver:$dbname:$dbserver", - $MACHINESOPTS{MACHINES_USERNAME}, - $MACHINESOPTS{MACHINES_PASSWORD}, - {PrintError => 0}, - ) or croak ( - "Couldn't connect to $dbname database " - . "as $MACHINESOPTS{MACHINESADM_USERNAME}\@$MACHINESOPTS{MACHINESADM_SERVER}" - ); - - $self->{dbserver} = $dbserver; - - return; -} # _connect - -sub _getRecords ($$) { - my ($self, $table, $condition) = @_; - - my ($err, $msg); - - my $statement = "select * from $table where $condition"; - - my $sth = $self->{db}->prepare ($statement); - - unless ($sth) { - ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement); - - croak $msg; - } # if - - my $attempts = 0; - my $maxAttempts = 3; - my $sleepTime = 30; - my $status; - - # We've been having the server going away. Supposedly it should reconnect so - # here we simply retry up to $maxAttempts times to re-execute the statement. - # (Are there other places where we need to do this?) - $err = 2006; - - while ($err == 2006 and $attempts++ < $maxAttempts) { - $status = $sth->execute; - - if ($status) { - $err = 0; - last; - } else { - ($err, $msg) = $self->_dberror ('Unable to execute statement', - $statement); - } # if - - last if $err == 0; - - croak $msg unless $err == 2006; - - my $timestamp = YMDHMS; - - $self->Error ("$timestamp: Unable to talk to DB server.\n\n$msg\n\n" - . "Will try again in $sleepTime seconds", -1); - - # Try to reconnect - $self->_connect ($self->{dbserver}); - - sleep $sleepTime; - } # while - - $self->Error ("After $maxAttempts attempts I could not connect to the database", $err) - if ($err == 2006 and $attempts > $maxAttempts); - - my @records; - - while (my $row = $sth->fetchrow_hashref) { - push @records, $row; - } # while - - return @records; -} # _getRecord - - -sub new { - my ($class, %parms) = @_; - -=pod - -=head2 new ($server) - -Construct a new Machines object. - -=cut - - # Merge %parms with %MACHINEOPTS - foreach (keys %parms) { - $MACHINESOPTS{$_} = $parms{$_}; - } # foreach; - - my $self = bless {}, $class; - - $self->_connect (); - - return $self; -} # new - -sub add (%) { - my ($self, %system) = @_; - - my @requiredFields = qw( - name - admin - type - ); - - my $result = _checkRequiredFields \@requiredFields, \%system; - - return -1, "add: $result" if $result; - - $system{loadavgHist} ||= $defaultLoadavgHist; - - return $self->_addRecord ('system', %system); -} # add - -sub delete ($) { - my ($self, $name) = @_; - - return $self->_deleteRecord ('system', "name='$name'"); -} # delete - -sub update ($%) { - my ($self, $name, %update) = @_; - - return $self->_updateRecord ('system', "name='$name'", %update); -} # update - -sub get ($) { - my ($self, $system) = @_; - - return unless $system; - - my @records = $self->_getRecords ( - 'system', - "name='$system' or alias like '%$system%'" - ); - - if ($records[0]) { - return %{$records[0]}; - } else { - return; - } # if -} # get - -sub find (;$) { - my ($self, $condition) = @_; - - return $self->_getRecords ('system', $condition); -} # find - -1; - -=pod - -=head1 CONFIGURATION AND ENVIRONMENT - -MACHINES: If set then points to a flat file containing machine -names. Note this is providied as a way to quickly use an alternate -"machine database". As such only minimal information is support. - -=head1 DEPENDENCIES - - Display - Rexec - -=head1 INCOMPATABILITIES - -None yet... - -=head1 BUGS AND LIMITATIONS - -There are no known bugs in this module. - -Please report problems to Andrew DeFaria . - -=head1 LICENSE AND COPYRIGHT - -This Perl Module is freely available; 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 2 of the -License, or (at your option) any later version. - -This Perl Module 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 (L) for more -details. - -You should have received a copy of the GNU General Public License -along with this Perl Module; if not, write to the Free Software Foundation, -Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -reserved. - -=cut + + my $self = bless { + filename => $parms{filename}, + }, $class; # bless + + # Parse file + $self->{machines} = $self->_parseFile; + + return $self; +} # new + +sub select(;$) { + my ($self, $condition) = @_; + +=pod + +=head3 select + +Return machines that qualify based on $condition + +Parameters: + +=for html
+ +=over + +=item $condition + +Condition to apply to machine list + +=back + +=for html
+ +Returns: + +=for html
+ +=over + +=item Array of qualifying machines + +=back + +=for html
+ +=cut + + $condition //= ''; + + if ($condition) { + croak "Not supporting conditions yet"; + } else { + return %{$self->{machines}}; + } # if +} # select + +sub GetSystem($) { + my ($self, $systemName) = @_; + + return; +} # getSystem + +sub AddSystem(%) { + my ($self, %system) = @_; + + return; +} # addSystem + +sub ChangeSystem(%){ + my ($self, %system) = @_; + + return; +} # changeSystem + +sub DeleteSystem($) { + my ($self, $systemName) = @_; + + return; +} # deleteSystem + +sub DumpSystems(;$) { + my ($self, $filename) = @_; + + $filename ||= 'machines'; + + open my $file, '>', $filename + or croak "Unable to open $filename for writing - $!"; + + # Write header + print $file <<"END"; +################################################################################ +# +# File: $filename +# Description: Dump of machines for use with rexec.pl +# Author: Andrew\@DeFaria.com +# +################################################################################ +# Column 1 Machine name +# Column 2 Alias +# Column 3 Active +# Column 4 Admin name +# Column 5 Admin email +# Column 6 OS version +# Column 7 OS Type +# Column 8 Last heard from +# Column 9 Description +END + + # Write out machine info + my @fields = qw(name alias active admin email os type lastheardfrom description); + + for my $record ($self->select) { + my %machine = %$record; + + for (@fields) { + print $file "$machine{$_}|" + } # for + + print $file "\n"; + } # for + + close $file; + + return; +} # DumpSystems + +sub ReadSystemsFile(;$) { + my ($self, $filename) = @_; + + $filename ||= 'machines'; + + open my $file, '<', $filename + or croak "Unable to open $filename - $!"; + + my @systems; + + while (<$file>) { + chomp; + + next if /^#/; + + my ($name, $model, $osver, $ccver, $owner, $usage) = split ':'; + my %system = ( + name => $name, + model => $model, + ccver => $ccver, + admin => $owner, + os => $osver, + type => 'Unix', + description => $usage, + ); + + push @systems, \%system; + } # while + + close $file; + + return @systems; +} # ReadSystemsFile + +1; + +=pod + +=head2 CONFIGURATION AND ENVIRONMENT + +DEBUG: If set then $debug in this module is set. + +VERBOSE: If set then $verbose in this module is set. + +=head2 DEPENDENCIES + +=head3 Perl Modules + +L + +L + +=head3 ClearSCM Perl Modules + +=for html

DateUtils

+ +=for html

Display

+ +=for html

Mail

+ +=for html

OSDep

+ +=for html

Utils

+ +=head2 INCOMPATABILITIES + +None yet... + +=head2 BUGS AND LIMITATIONS + +There are no known bugs in this module. + +Please report problems to Andrew DeFaria . + +=head2 LICENSE AND COPYRIGHT + +This Perl Module is freely available; 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 2 of the +License, or (at your option) any later version. + +This Perl Module 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 (L) for more +details. + +You should have received a copy of the GNU General Public License +along with this Perl Module; if not, write to the Free Software Foundation, +Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +reserved. + +=cut