seasharp
/
anvil
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

** Major Changes **

Browse Source 
We've decided to give up on trying to keep ScanCore, AN::Tools and Striker as three separate things. We had originally hoped to make ScanCore easily separatable from the Anvil!, but this was adding increasing complexity to the project and complexity is the enemy of reliability.

In this release, AN::Tools becomes Anvil::Tools, all configuration files move to /etc/anvil and all programs and data files move to /usr/sbin/anvil. Words files are now merged, as are SQL schemas (ScanCore agents will still maintain their own, later). The journald tag has changed from 'an-tools' to 'anvil'.

Other changes;
* Tools.t has been updated to handle existing tests. New methods and parameters still need to have tests added though.
* Added a simple test.pl script used for testing things outside the main program. It will be removed before final release.
* Added the simple 'watch_logs' bash script to more easily tail output.

Signed-off-by: Digimer <digimer@alteeve.ca>
main
Digimer 7 years ago
parent ee7b68bfb5
commit 1cb42080c3
33 changed files with 3854 additions and 3727 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 599
      AN/Tools.t
  2. 272
      Anvil/Tools.pm
  3. 0
      Anvil/Tools.sql
  4. 604
      Anvil/Tools.t
  5. 200
      Anvil/Tools/Alert.pm
  6. 98
      Anvil/Tools/Convert.pm
  7. 1616
      Anvil/Tools/Database.pm
  8. 186
      Anvil/Tools/Get.pm
  9. 157
      Anvil/Tools/Log.pm
  10. 242
      Anvil/Tools/Storage.pm
  11. 568
      Anvil/Tools/System.pm
  12. 107
      Anvil/Tools/Template.pm
  13. 158
      Anvil/Tools/Validate.pm
  14. 106
      Anvil/Tools/Words.pm
  15. 22
      Anvil/anvil-tools.xml
  16. 2
      Anvil/test.conf
  17. 4
      Anvil/tools.conf
  18. 116
      anvil.conf
  19. 796
      cgi-bin/home
  20. 100
      cgi-bin/words.xml
  21. 6
      notes
  22. 227
      scancore.sql
  23. 32
      striker.conf
  24. 15
      test.pl
  25. 373
      tools/an-prep-database
  26. 101
      tools/anvil-daemon
  27. 370
      tools/anvil-prep-database
  28. 70
      tools/anvil-update-states
  29. 230
      tools/anvil.sql
  30. 87
      tools/scancore-daemon
  31. 98
      tools/words.xml
  32. 4
      units/anvil-daemon.service
  33. 1
      watch_logs

599
AN/Tools.t
Unescape View File

@ -1,599 +0,0 @@
#!/usr/bin/perl
use strict;
use warnings;
use POSIX;
use Data::Dumper;
use utf8;
# Be nice and set a version number.
our $VERSION = "3.0.0";
our $THIS_FILE = "Tools.t";
# Call in the test module, telling it how many tests to expect to run.
use Test::More tests => 199;
# Load my module via 'use_ok' test.
BEGIN
{
print "Beginning tests of the AN::Tools suite of modules.\n";
use_ok('AN::Tools', 3.0.0);
}
### Core tests
my $an = AN::Tools->new();
like($an, qr/^AN::Tools=HASH\(0x\w+\)$/, "Verifying that AN::Tools object is valid.");
like($an->data, qr/^HASH\(0x\w+\)$/, "Verifying that 'data' is a hash reference.");
is($an->environment, "cli", "Verifying that environment initially reports 'cli'.");
$an->environment('html');
is($an->environment, "html", "Verifying that environment was properly set to 'html'.");
$an->environment('cli');
is($an->environment, "cli", "Verifying that environment was properly reset back to 'cli'.");
# Test handles to child modules.
like($an->Alert, qr/^AN::Tools::Alert=HASH\(0x\w+\)$/, "Verifying that 'Alert' is a handle to AN::Tools::Alert.");
like($an->Convert, qr/^AN::Tools::Convert=HASH\(0x\w+\)$/, "Verifying that 'Convert' is a handle to AN::Tools::Convert.");
like($an->Database, qr/^AN::Tools::Database=HASH\(0x\w+\)$/, "Verifying that 'Database' is a handle to AN::Tools::Database.");
like($an->Get, qr/^AN::Tools::Get=HASH\(0x\w+\)$/, "Verifying that 'Get' is a handle to AN::Tools::Get.");
like($an->Log, qr/^AN::Tools::Log=HASH\(0x\w+\)$/, "Verifying that 'Log' is a handle to AN::Tools::Log.");
like($an->Storage, qr/^AN::Tools::Storage=HASH\(0x\w+\)$/, "Verifying that 'Storage' is a handle to AN::Tools::Storage.");
like($an->System, qr/^AN::Tools::System=HASH\(0x\w+\)$/, "Verifying that 'System' is a handle to AN::Tools::System.");
like($an->Template, qr/^AN::Tools::Template=HASH\(0x\w+\)$/, "Verifying that 'Template' is a handle to AN::Tools::Template.");
like($an->Validate, qr/^AN::Tools::Validate=HASH\(0x\w+\)$/, "Verifying that 'Validate' is a handle to AN::Tools::Validate.");
like($an->Words, qr/^AN::Tools::Words=HASH\(0x\w+\)$/, "Verifying that 'Words' is a handle to AN::Tools::Words.");
### Special
# We log a note telling the user to ignore log entries caused by this test suite. We'll then read it back and
# make sure it logged properly
$an->Log->entry({level => 0, priority => "alert", key => "log_0048"});
my $message = $an->Words->string({key => "log_0048"});
my $last_log = $an->System->call({shell_call => $an->data->{path}{exe}{journalctl}." -t an-tools --lines 1 --full --output cat --no-pager"});
is($last_log, $message, "Verified that we could write a log entry to journalctl by warning the user of incoming warnings and errors.");
### AN::Tools::Alert tests
# <none yet>
### AN::Tools::Convert tests
# cidr tests
is($an->Convert->cidr({cidr => "fake"}), "", "Verifying that Convert->cidr properly returned an empty string for a bad 'cidr' parameter.");
is($an->Convert->cidr({cidr => "0"}), "0.0.0.0", "Verifying that Convert->cidr properly returned '0.0.0.0' when given a 'cidr' parameter of '0'.");
is($an->Convert->cidr({cidr => "1"}), "128.0.0.0", "Verifying that Convert->cidr properly returned '128.0.0.0' when given a 'cidr' parameter of '1'.");
is($an->Convert->cidr({cidr => "2"}), "192.0.0.0", "Verifying that Convert->cidr properly returned '192.0.0.0' when given a 'cidr' parameter of '2'.");
is($an->Convert->cidr({cidr => "3"}), "224.0.0.0", "Verifying that Convert->cidr properly returned '224.0.0.0' when given a 'cidr' parameter of '3'.");
is($an->Convert->cidr({cidr => "4"}), "240.0.0.0", "Verifying that Convert->cidr properly returned '240.0.0.0' when given a 'cidr' parameter of '4'.");
is($an->Convert->cidr({cidr => "5"}), "248.0.0.0", "Verifying that Convert->cidr properly returned '248.0.0.0' when given a 'cidr' parameter of '5'.");
is($an->Convert->cidr({cidr => "6"}), "252.0.0.0", "Verifying that Convert->cidr properly returned '252.0.0.0' when given a 'cidr' parameter of '6'.");
is($an->Convert->cidr({cidr => "7"}), "254.0.0.0", "Verifying that Convert->cidr properly returned '254.0.0.0' when given a 'cidr' parameter of '7'.");
is($an->Convert->cidr({cidr => "8"}), "255.0.0.0", "Verifying that Convert->cidr properly returned '255.0.0.0' when given a 'cidr' parameter of '8'.");
is($an->Convert->cidr({cidr => "9"}), "255.128.0.0", "Verifying that Convert->cidr properly returned '255.128.0.0' when given a 'cidr' parameter of '9'.");
is($an->Convert->cidr({cidr => "10"}), "255.192.0.0", "Verifying that Convert->cidr properly returned '255.192.0.0' when given a 'cidr' parameter of '10'.");
is($an->Convert->cidr({cidr => "11"}), "255.224.0.0", "Verifying that Convert->cidr properly returned '255.224.0.0' when given a 'cidr' parameter of '11'.");
is($an->Convert->cidr({cidr => "12"}), "255.240.0.0", "Verifying that Convert->cidr properly returned '255.240.0.0' when given a 'cidr' parameter of '12'.");
is($an->Convert->cidr({cidr => "13"}), "255.248.0.0", "Verifying that Convert->cidr properly returned '255.248.0.0' when given a 'cidr' parameter of '13'.");
is($an->Convert->cidr({cidr => "14"}), "255.252.0.0", "Verifying that Convert->cidr properly returned '255.252.0.0' when given a 'cidr' parameter of '14'.");
is($an->Convert->cidr({cidr => "15"}), "255.254.0.0", "Verifying that Convert->cidr properly returned '255.254.0.0' when given a 'cidr' parameter of '15'.");
is($an->Convert->cidr({cidr => "16"}), "255.255.0.0", "Verifying that Convert->cidr properly returned '255.255.0.0' when given a 'cidr' parameter of '16'.");
is($an->Convert->cidr({cidr => "17"}), "255.255.128.0", "Verifying that Convert->cidr properly returned '255.255.128.0' when given a 'cidr' parameter of '17'.");
is($an->Convert->cidr({cidr => "18"}), "255.255.192.0", "Verifying that Convert->cidr properly returned '255.255.192.0' when given a 'cidr' parameter of '18'.");
is($an->Convert->cidr({cidr => "19"}), "255.255.224.0", "Verifying that Convert->cidr properly returned '255.255.224.0' when given a 'cidr' parameter of '19'.");
is($an->Convert->cidr({cidr => "20"}), "255.255.240.0", "Verifying that Convert->cidr properly returned '255.255.240.0' when given a 'cidr' parameter of '20'.");
is($an->Convert->cidr({cidr => "21"}), "255.255.248.0", "Verifying that Convert->cidr properly returned '255.255.248.0' when given a 'cidr' parameter of '21'.");
is($an->Convert->cidr({cidr => "22"}), "255.255.252.0", "Verifying that Convert->cidr properly returned '255.255.252.0' when given a 'cidr' parameter of '22'.");
is($an->Convert->cidr({cidr => "23"}), "255.255.254.0", "Verifying that Convert->cidr properly returned '255.255.254.0' when given a 'cidr' parameter of '23'.");
is($an->Convert->cidr({cidr => "24"}), "255.255.255.0", "Verifying that Convert->cidr properly returned '255.255.255.0' when given a 'cidr' parameter of '24'.");
is($an->Convert->cidr({cidr => "25"}), "255.255.255.128", "Verifying that Convert->cidr properly returned '255.255.255.128' when given a 'cidr' parameter of '25'.");
is($an->Convert->cidr({cidr => "26"}), "255.255.255.192", "Verifying that Convert->cidr properly returned '255.255.255.192' when given a 'cidr' parameter of '26'.");
is($an->Convert->cidr({cidr => "27"}), "255.255.255.224", "Verifying that Convert->cidr properly returned '255.255.255.224' when given a 'cidr' parameter of '27'.");
is($an->Convert->cidr({cidr => "28"}), "255.255.255.240", "Verifying that Convert->cidr properly returned '255.255.255.240' when given a 'cidr' parameter of '28'.");
is($an->Convert->cidr({cidr => "29"}), "255.255.255.248", "Verifying that Convert->cidr properly returned '255.255.255.248' when given a 'cidr' parameter of '29'.");
is($an->Convert->cidr({cidr => "30"}), "255.255.255.252", "Verifying that Convert->cidr properly returned '255.255.255.252' when given a 'cidr' parameter of '30'.");
is($an->Convert->cidr({cidr => "31"}), "255.255.255.254", "Verifying that Convert->cidr properly returned '255.255.255.254' when given a 'cidr' parameter of '31'.");
is($an->Convert->cidr({cidr => "32"}), "255.255.255.255", "Verifying that Convert->cidr properly returned '255.255.255.255' when given a 'cidr' parameter of '32'.");
is($an->Convert->cidr({subnet => "fake"}), "", "Verifying that Convert->cidr properly returned an empty string for a bad 'subnet' parameter.");
is($an->Convert->cidr({subnet => "0.0.0.0"}), "0", "Verifying that Convert->cidr properly returned '0' when given a 'subnet' parameter of '0.0.0.0'.");
is($an->Convert->cidr({subnet => "128.0.0.0"}), "1", "Verifying that Convert->cidr properly returned '1' when given a 'subnet' parameter of '128.0.0.0'.");
is($an->Convert->cidr({subnet => "192.0.0.0"}), "2", "Verifying that Convert->cidr properly returned '2' when given a 'subnet' parameter of '192.0.0.0'.");
is($an->Convert->cidr({subnet => "224.0.0.0"}), "3", "Verifying that Convert->cidr properly returned '3' when given a 'subnet' parameter of '224.0.0.0'.");
is($an->Convert->cidr({subnet => "240.0.0.0"}), "4", "Verifying that Convert->cidr properly returned '4' when given a 'subnet' parameter of '240.0.0.0'.");
is($an->Convert->cidr({subnet => "248.0.0.0"}), "5", "Verifying that Convert->cidr properly returned '5' when given a 'subnet' parameter of '248.0.0.0'.");
is($an->Convert->cidr({subnet => "252.0.0.0"}), "6", "Verifying that Convert->cidr properly returned '6' when given a 'subnet' parameter of '252.0.0.0'.");
is($an->Convert->cidr({subnet => "254.0.0.0"}), "7", "Verifying that Convert->cidr properly returned '7' when given a 'subnet' parameter of '254.0.0.0'.");
is($an->Convert->cidr({subnet => "255.0.0.0"}), "8", "Verifying that Convert->cidr properly returned '8' when given a 'subnet' parameter of '255.0.0.0'.");
is($an->Convert->cidr({subnet => "255.128.0.0"}), "9", "Verifying that Convert->cidr properly returned '9' when given a 'subnet' parameter of '255.128.0.0'.");
is($an->Convert->cidr({subnet => "255.192.0.0"}), "10", "Verifying that Convert->cidr properly returned '10' when given a 'subnet' parameter of '255.192.0.0'.");
is($an->Convert->cidr({subnet => "255.224.0.0"}), "11", "Verifying that Convert->cidr properly returned '11' when given a 'subnet' parameter of '255.224.0.0'.");
is($an->Convert->cidr({subnet => "255.240.0.0"}), "12", "Verifying that Convert->cidr properly returned '12' when given a 'subnet' parameter of '255.240.0.0'.");
is($an->Convert->cidr({subnet => "255.248.0.0"}), "13", "Verifying that Convert->cidr properly returned '13' when given a 'subnet' parameter of '255.248.0.0'.");
is($an->Convert->cidr({subnet => "255.252.0.0"}), "14", "Verifying that Convert->cidr properly returned '14' when given a 'subnet' parameter of '255.252.0.0'.");
is($an->Convert->cidr({subnet => "255.254.0.0"}), "15", "Verifying that Convert->cidr properly returned '15' when given a 'subnet' parameter of '255.254.0.0'.");
is($an->Convert->cidr({subnet => "255.255.0.0"}), "16", "Verifying that Convert->cidr properly returned '16' when given a 'subnet' parameter of '255.255.0.0'.");
is($an->Convert->cidr({subnet => "255.255.128.0"}), "17", "Verifying that Convert->cidr properly returned '17' when given a 'subnet' parameter of '255.255.128.0'.");
is($an->Convert->cidr({subnet => "255.255.192.0"}), "18", "Verifying that Convert->cidr properly returned '18' when given a 'subnet' parameter of '255.255.192.0'.");
is($an->Convert->cidr({subnet => "255.255.224.0"}), "19", "Verifying that Convert->cidr properly returned '19' when given a 'subnet' parameter of '255.255.224.0'.");
is($an->Convert->cidr({subnet => "255.255.240.0"}), "20", "Verifying that Convert->cidr properly returned '20' when given a 'subnet' parameter of '255.255.240.0'.");
is($an->Convert->cidr({subnet => "255.255.248.0"}), "21", "Verifying that Convert->cidr properly returned '21' when given a 'subnet' parameter of '255.255.248.0'.");
is($an->Convert->cidr({subnet => "255.255.252.0"}), "22", "Verifying that Convert->cidr properly returned '22' when given a 'subnet' parameter of '255.255.252.0'.");
is($an->Convert->cidr({subnet => "255.255.254.0"}), "23", "Verifying that Convert->cidr properly returned '23' when given a 'subnet' parameter of '255.255.254.0'.");
is($an->Convert->cidr({subnet => "255.255.255.0"}), "24", "Verifying that Convert->cidr properly returned '24' when given a 'subnet' parameter of '255.255.255.0'.");
is($an->Convert->cidr({subnet => "255.255.255.128"}), "25", "Verifying that Convert->cidr properly returned '25' when given a 'subnet' parameter of '255.255.255.128'.");
is($an->Convert->cidr({subnet => "255.255.255.192"}), "26", "Verifying that Convert->cidr properly returned '26' when given a 'subnet' parameter of '255.255.255.192'.");
is($an->Convert->cidr({subnet => "255.255.255.224"}), "27", "Verifying that Convert->cidr properly returned '27' when given a 'subnet' parameter of '255.255.255.224'.");
is($an->Convert->cidr({subnet => "255.255.255.240"}), "28", "Verifying that Convert->cidr properly returned '28' when given a 'subnet' parameter of '255.255.255.240'.");
is($an->Convert->cidr({subnet => "255.255.255.248"}), "29", "Verifying that Convert->cidr properly returned '29' when given a 'subnet' parameter of '255.255.255.248'.");
is($an->Convert->cidr({subnet => "255.255.255.252"}), "30", "Verifying that Convert->cidr properly returned '30' when given a 'subnet' parameter of '255.255.255.252'.");
is($an->Convert->cidr({subnet => "255.255.255.254"}), "31", "Verifying that Convert->cidr properly returned '31' when given a 'subnet' parameter of '255.255.255.254'.");
is($an->Convert->cidr({subnet => "255.255.255.255"}), "32", "Verifying that Convert->cidr properly returned '32' when given a 'subnet' parameter of '255.255.255.255'.");
### AN::Tools::Database tests
# <none yet>
### AN::Tools::Get tests
# date_and_time
like($an->Get->date_and_time(), qr/^\d\d\d\d\/\d\d\/\d\d \d\d:\d\d:\d\d$/, "Verifying the current date and time is returned.");
like($an->Get->date_and_time({date_only => 1}), qr/^\d\d\d\d\/\d\d\/\d\d$/, "Verifying the current date alone is returned.");
like($an->Get->date_and_time({time_only => 1}), qr/^\d\d:\d\d:\d\d$/, "Verifying the current time alone is returned.");
like($an->Get->date_and_time({file_name => 1}), qr/^\d\d\d\d-\d\d-\d\d_\d\d-\d\d-\d\d$/, "Verifying the current date and time is returned in a file-friendly format.");
like($an->Get->date_and_time({file_name => 1, date_only => 1}), qr/^\d\d\d\d-\d\d-\d\d$/, "Verifying the current date only is returned in a file-friendly format.");
like($an->Get->date_and_time({file_name => 1, time_only => 1}), qr/^\d\d-\d\d-\d\d$/, "Verifying the current time only is returned in a file-friendly format.");
# We can't be too specific because the user's TZ will shift the results
like($an->Get->date_and_time({use_time => 1234567890}), qr/2009\/02\/1[34] \d\d:\d\d:\d\d$/, "Verified that a specific unixtime returned the expected date.");
like($an->Get->date_and_time({use_time => 1234567890, offset => 31536000}), qr/2010\/02\/1[34] \d\d:\d\d:\d\d$/, "Verified that a specific unixtime with a one year in the future offset returned the expected date.");
like($an->Get->date_and_time({use_time => 1234567890, offset => -31536000}), qr/2008\/02\/1[34] \d\d:\d\d:\d\d$/, "Verified that a specific unixtime with a one year in the past offset returned the expected date.");
# host_uuid
like($an->Get->host_uuid, qr/^[a-f0-9]{8}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{12}$/, "Verifying ability to read host uuid.");
### TODO: How to test Get->switches?
# uuid
like($an->Get->uuid, qr/^[a-f0-9]{8}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{12}$/, "Verifying ability to generate a random uuid.");
### AN::Tools::Log tests
# entry is tested at the start of this test suite.
# language
is($an->Log->language, "en_CA", "Verifying the default log language is 'en_CA'.");
$an->Log->language({set => "jp"});
is($an->Log->language, "jp", "Verifying the log language was changed to 'jp'.");
$an->Log->language({set => "en_CA"});
is($an->Log->language, "en_CA", "Verifying the log language is back to 'en_CA'.");
# log_level
is($an->Log->level, "1", "Verifying the default log level is '1'.");
$an->Log->level({set => 0});
is($an->Log->level, "0", "Verifying the log level changed to '0'.");
$an->Log->level({set => 1});
is($an->Log->level, "1", "Verifying the log level changed to '1'.");
$an->Log->level({set => 2});
is($an->Log->level, "2", "Verifying the log level changed to '2'.");
$an->Log->level({set => 3});
is($an->Log->level, "3", "Verifying the log level changed to '3'.");
$an->Log->level({set => 4});
is($an->Log->level, "4", "Verifying the log level changed to '4'.");
$an->Log->level({set => "foo"});
is($an->Log->level, "4", "Verifying the log level stayed at '4' with bad input.");
$an->Log->level({set => 1});
is($an->Log->level, "1", "Verifying the log level changed back to '1'.");
# secure
is($an->Log->secure, "0", "Verifying that logging secure messages is disabled by default.");
$an->Log->secure({set => "foo"});
is($an->Log->secure, "0", "Verifying that logging secure messages stayed disabled on bad input.");
$an->Log->secure({set => 1});
is($an->Log->secure, "1", "Verifying that logging secure messages was enabled.");
$an->Log->secure({set => 0});
is($an->Log->secure, "0", "Verifying that logging secure messages was disabled again.");
# variables
$an->Log->variables({level => 0, list => { a => "1" }});
my $list_a = $an->System->call({shell_call => $an->data->{path}{exe}{journalctl}." -t an-tools --lines 1 --full --output cat --no-pager"});
is($list_a, "a: [1]", "Verified that we could log a list of variables (1 entry).");
$an->Log->variables({level => 0, list => { a => "1", b => "2" }});
my $list_b = $an->System->call({shell_call => $an->data->{path}{exe}{journalctl}." -t an-tools --lines 1 --full --output cat --no-pager"});
is($list_b, "a: [1], b: [2]", "Verified that we could log a list of variables (2 entries).");
$an->Log->variables({level => 0, list => { a => "1", b => "2", c => "3" }});
my $list_c = $an->System->call({shell_call => $an->data->{path}{exe}{journalctl}." -t an-tools --lines 1 --full --output cat --no-pager"});
is($list_c, "a: [1], b: [2], c: [3]", "Verified that we could log a list of variables (3 entries).");
$an->Log->variables({level => 0, list => { a => "1", b => "2", c => "3", d => "4" }});
my $list_d = $an->System->call({shell_call => $an->data->{path}{exe}{journalctl}." -t an-tools --lines 1 --full --output cat --no-pager"});
is($list_d, "a: [1], b: [2], c: [3], d: [4]", "Verified that we could log a list of variables (4 entries).");
$an->Log->variables({level => 0, list => { a => "1", b => "2", c => "3", d => "4", e => "5" }});
my $list_e = $an->System->call({shell_call => $an->data->{path}{exe}{journalctl}." -t an-tools --lines 1 --full --output cat --no-pager"});
my $say_variables = $an->Words->key({key => "log_0019"});
my $expect_e = "$say_variables
|- a: [1]
|- b: [2]
|- c: [3]
|- d: [4]
\\- e: [5]";
is($list_e, $expect_e, "Verified that we could log a list of variables (5 entries, line wrapping).");
# _adjust_log_level - We're simulating switches to test Log->_adjust_log_level
$an->data->{switches}{V} = "#!set!#";
$an->data->{switches}{v} = "";
$an->data->{switches}{vv} = "";
$an->data->{switches}{vvv} = "";
$an->data->{switches}{vvvv} = "";
$an->Log->_adjust_log_level;
is($an->Log->level, "0", "Verifying the log level was set to '0' with Log->_adjust_log_leve() with 'V' switch set.");
$an->data->{switches}{V} = "";
$an->data->{switches}{v} = "#!set!#";
$an->Log->_adjust_log_level;
is($an->Log->level, "1", "Verifying the log level was set to '1' with Log->_adjust_log_leve() with 'v' switch set.");
$an->data->{switches}{v} = "";
$an->data->{switches}{vv} = "#!set!#";
$an->Log->_adjust_log_level;
is($an->Log->level, "2", "Verifying the log level was set to '2' with Log->_adjust_log_leve() with 'vv' switch set.");
$an->data->{switches}{vv} = "";
$an->data->{switches}{vvv} = "#!set!#";
$an->Log->_adjust_log_level;
is($an->Log->level, "3", "Verifying the log level was set to '3' with Log->_adjust_log_leve() with 'vvv' switch set.");
$an->data->{switches}{vvv} = "";
$an->data->{switches}{vvvv} = "#!set!#";
$an->Log->_adjust_log_level;
is($an->Log->level, "4", "Verifying the log level was set to '4' with Log->_adjust_log_leve() with 'vvvv' switch set.");
$an->data->{switches}{vvvv} = "";
$an->data->{switches}{v} = "#!set!#";
$an->Log->_adjust_log_level;
is($an->Log->level, "1", "Verifying the log level was set back to '1' with Log->_adjust_log_leve() with 'v' switch set.");
### AN::Tools::Storage tests - These happen a little out of order.
# We need to pick a user name and group name to use for these tests. So we'll start by reading in passwd.
my $passwd = $an->Storage->read_file({file => "/etc/passwd"});
my $group = $an->Storage->read_file({file => "/etc/group"});
my $read_ok = 0;
my $use_user = "";
my $use_group = "";
foreach my $line (split/\n/, $passwd)
{
if ($line =~ /^root:/)
{
$read_ok = 1;
}
elsif ($line =~ /^(\w+):x:\d/)
{
$use_user = $1;
last;
}
}
foreach my $line (split/\n/, $group)
{
if ($line =~ /^root:/)
{
# skip
}
elsif ($line =~ /^(\w+):x:\d/)
{
$use_group = $1;
last;
}
}
# print "[ Debug ] - Using the user: [$use_user] and the group: [$use_group] for testing.\n";
is($read_ok, "1", "Verified that 'Storage->read_file' could read a file.");
# Write a file /tmp/foo
my $body = "This is a test file created as part of the AN::Tools test suite.\nYou can safely delete it if you wish.\n";
my $test_file = "/tmp/an-tools.test";
if (-e $test_file)
{
# remove the old test file.
unlink $test_file or die "The test file: [$test_file] exists (from a previous run?) and can't be removed. The error was: $!\n";
}
$an->Storage->write_file({body => $body, file => $test_file, group => $use_group, user => $use_user, mode => "0666"});
my $write_ok = 0;
if (-e $test_file)
{
$write_ok = 1;
}
is($write_ok, "1", "Verifying that 'Storage->write_file' could write a file (tested writing to: [$test_file]).");
my $mode = $an->Storage->read_mode({target => $test_file});
my ($uid, $gid) = (stat($test_file))[4,5];
my $file_user_name = getpwuid($uid);
my $file_group_name = getgrgid($gid);
#print "[ Debug ] - test_file: [$test_file], mode: [$mode], owning user: [$file_user_name ($uid)], owning group: [$file_group_name ($gid)]\n";
is($mode, "0666", "Verifying that 'Storage->write_file' set the mode correctly when writing a file.");
is($file_user_name, $use_user, "Verifying that 'Storage->write_file' set the user name properly when the file was written.");
is($file_group_name, $use_group, "Verifying that 'Storage->write_file' set the group name properly when the file was written.");
# change_mode
$an->Storage->change_mode({target => $test_file, mode => "4755"});
$mode = $an->Storage->read_mode({target => $test_file});
is($mode, "4755", "Verifying that 'Storage->change_mode' was able to change the mode of the test file (including setting the setuid and setgid sticky bits).");
$an->Storage->change_mode({target => $test_file, mode => "644"});
$mode = $an->Storage->read_mode({target => $test_file});
is($mode, "0644", "Verifying that 'Storage->change_mode' was able to change the mode of the test file using three digits instead of four.");
# change_owner
$an->Storage->change_owner({target => $test_file, user => 0});
$file_user_name = "";
$file_group_name = "";
($uid, $gid) = (stat($test_file))[4,5];
$file_user_name = getpwuid($uid);
$file_group_name = getgrgid($gid);
is($file_user_name, "root", "Verifying that 'Storage->change_user', when passed only a user ID, changed the user.");
is($file_group_name, $use_group, "Verifying that 'Storage->change_user', when passed only a user ID, did not change the group.");
$an->Storage->change_owner({target => $test_file, user => $use_user});
$file_user_name = "";
$file_group_name = "";
($uid, $gid) = (stat($test_file))[4,5];
$file_user_name = getpwuid($uid);
$file_group_name = getgrgid($gid);
is($file_user_name, $use_user, "Verifying that 'Storage->change_user', when passed only a user name, changed the user.");
is($file_group_name, $use_group, "Verifying that 'Storage->change_user', when passed only a user ID, did not change the group.");
$an->Storage->change_owner({target => $test_file, group => 0});
$file_user_name = "";
$file_group_name = "";
($uid, $gid) = (stat($test_file))[4,5];
$file_user_name = getpwuid($uid);
$file_group_name = getgrgid($gid);
is($file_user_name, $use_user, "Verifying that 'Storage->change_user', when passed only a group ID, did not change the user.");
is($file_group_name, "root", "Verifying that 'Storage->change_user', when passed only a group ID, changed the group.");
$an->Storage->change_owner({target => $test_file, group => $use_group});
$file_user_name = "";
$file_group_name = "";
($uid, $gid) = (stat($test_file))[4,5];
$file_user_name = getpwuid($uid);
$file_group_name = getgrgid($gid);
is($file_user_name, $use_user, "Verifying that 'Storage->change_user', when passed only a group name, did not change the user.");
is($file_group_name, $use_group, "Verifying that 'Storage->change_user', when passed only a group name, changed the group.");
$an->Storage->change_owner({target => $test_file, user => "root", group => "root"});
$file_user_name = "";
$file_group_name = "";
($uid, $gid) = (stat($test_file))[4,5];
$file_user_name = getpwuid($uid);
$file_group_name = getgrgid($gid);
is($file_user_name, "root", "Verifying that 'Storage->change_user', when passed both a user and group name, changed the user.");
is($file_group_name, "root", "Verifying that 'Storage->change_user', when passed both a user and group name, changed the group.");
my $change_owner_rc = $an->Storage->change_owner({target => "", user => "root", group => "root"});
is($change_owner_rc, "1", "Verifying that 'Storage->change_user', when passed no target, returned '1'.");
$change_owner_rc = "";
$change_owner_rc = $an->Storage->change_owner({target => "/fake/file", user => "root", group => "root"});
is($change_owner_rc, "1", "Verifying that 'Storage->change_user', when passed a bad file, returned '1'.");
# copy_file
my $copy_file = "/tmp/an-tools.copy";
my $copied_ok = 0;
if (-e $copy_file)
{
unlink $copy_file or die "The test copy file: [$copy_file] exists (from a previous run?) and can't be removed. The error was: $!\n";
}
$an->Storage->copy_file({source => $test_file, target => $copy_file});
if (-e $copy_file)
{
$copied_ok = 1;
}
is($copied_ok, "1", "Verifying that 'Storage->copy_file' was able to copy the test file.");
my $copy_rc = $an->Storage->copy_file({target => $copy_file});
is($copy_rc, "1", "Verifying that 'Storage->copy_file' returned '1' when no source file was passed.");
$copy_rc = "";
$copy_rc = $an->Storage->copy_file({source => $test_file});
is($copy_rc, "2", "Verifying that 'Storage->copy_file' returned '2' when no target file was passed.");
$copy_rc = "";
$copy_rc = $an->Storage->copy_file({source => $test_file, target => $copy_file});
is($copy_rc, "3", "Verifying that 'Storage->copy_file' returned '3' when the target file already exists.");
$copy_rc = "";
$copy_rc = $an->Storage->copy_file({source => $test_file, target => $copy_file, overwrite => 1});
is($copy_rc, "0", "Verifying that 'Storage->copy_file' returned '0' when the target file already exists and overwrite was set.");
$copy_rc = "";
$copy_rc = $an->Storage->copy_file({source => "/fake/file", target => $copy_file});
is($copy_rc, "4", "Verifying that 'Storage->copy_file' returned '4' when the target file is passed but doesn't exist.");
# find
my $test_path = $an->Storage->find({ file => "AN/Tools.t" });
is($test_path, "/usr/share/perl5/AN/Tools.t", "Verifying that Storage->find successfully found 'AN/Tools.t'.");
my $bad_path = $an->Storage->find({ file => "AN/wa.t" });
is($bad_path, "#!not_found!#", "Verifying that Storage->find properly returned '#!not_found!#' for a non-existed file.");
# make_directory
my $test_directory = "/tmp/an-tools/test/directory";
if (-d $test_directory)
{
foreach my $this_directory ("/tmp/an-tools/test/directory", "/tmp/an-tools/test", "/tmp/an-tools")
{
rmdir $this_directory or die "Failed to remove the test directory: [$this_directory] (from a previous test?). The error was: $!\n";
}
}
# This uses an odd mode on purpose
$an->Storage->make_directory({directory => $test_directory, group => $use_group, user => $use_user, mode => "0757"});
my $created_directory = 0;
if (-d $test_directory)
{
$created_directory = 1;
}
is($created_directory, "1", "Verifying that 'Storage->create_directory' created a directory and its parents.");
my $directory_mode = $an->Storage->read_mode({target => $test_directory});
($uid, $gid) = (stat($test_directory))[4,5];
my $directory_user_name = getpwuid($uid);
my $directory_group_name = getgrgid($gid);
is($directory_mode, "0757", "Verifying that 'Storage->create_directory' created a directory with the requested mode.");
is($directory_user_name, $use_user, "Verifying that 'Storage->create_directory' created a directory with the requested owner.");
is($directory_group_name, $use_group, "Verifying that 'Storage->create_directory' created a directory with the requested group.");
# read_config
$an->data->{foo}{bar}{a} = "test";
is($an->Storage->read_config({ file => "AN/test.conf" }), 0, "Verifying that 'Storage->read_config' successfully found 'AN/test.conf'.");
is($an->Storage->read_config({ file => "" }), 1, "Verifying that 'Storage->read_config' returns '1' when called without a 'file' parameter being set.");
is($an->Storage->read_config({ file => "AN/moo.conf" }), 2, "Verifying that 'Storage->read_config' returns '2' when the non-existent 'AN/moo.conf' is passed.");
cmp_ok($an->data->{foo}{bar}{a}, 'eq', 'I am "a"', "Verifying that 'AN/test.conf's 'foo::bar::a' overwrote an earlier set value.");
cmp_ok($an->data->{foo}{bar}{b}, 'eq', 'I am "b", split with tabs and having trailing spaces.', "Verifying that 'AN/test.conf's 'foo::bar::b' has whitespaces removed as expected.");
cmp_ok($an->data->{foo}{baz}{1}, 'eq', 'This is \'1\' with no spaces', "Verifying that 'AN/test.conf's 'foo::baz::1' parsed without spaces around '='.");
cmp_ok($an->data->{foo}{baz}{2}, 'eq', 'I had a $dollar = sign and split with tabs.', "Verifying that 'AN/test.conf's 'foo::baz::2' had no trouble with a '\$' and '=' characters in the string.");
# read_file was tested earlier.
# read_mode was tested earlier.
# search_directories
my $array1 = $an->Storage->search_directories;
my $a1_count = @{$array1};
cmp_ok($a1_count, '>', 0, "Verifying that Storage->search_directories has at least one entry. Found: [$a1_count] directories.");
$an->Storage->search_directories({directories => "/root,/usr/bin,/some/fake/directory"});
my $array2 = $an->Storage->search_directories;
my $a2_count = @{$array2};
cmp_ok($a2_count, '==', 2, "Verifying that Storage->search_directories now has 2 entries from a passed in CSV, testing that the list changed and a fake directory was dropped.");
$an->Storage->search_directories({directories => ["/usr/bin", "/tmp", "/home"] });
my $array3 = $an->Storage->search_directories;
my $a3_count = @{$array3};
cmp_ok($a3_count, '==', 3, "Verifying that Storage->search_directories now has 3 entries from a passed in array reference, verifying that the list changed again.");
$an->Storage->search_directories({directories => "invalid" });
my $array4 = $an->Storage->search_directories;
my $a4_count = @{$array4};
cmp_ok($a4_count, '==', $a1_count, "Verifying that Storage->search_directories has the original number of directories: [$a4_count] after being called with an invalid 'directories' parameter, showing that it reset properly.");
# write_file was tested earlier
# Cleanup.
unlink $test_file;
unlink $copy_file;
foreach my $this_directory ("/tmp/an-tools/test/directory", "/tmp/an-tools/test", "/tmp/an-tools")
{
rmdir $this_directory or die "Failed to remove the test directory: [$this_directory] (from a previous test?). The error was: $!\n";
}
### AN::Tools::System tests
# call was tested during the Log->entry test and will be tested further below.
# Daemon tests require that we create a test daemon and a unit for it...
my $test_daemon_file = "/tmp/an-tools-test.daemon";
my $test_daemon_body = q|#!/usr/bin/perl
# This is a test daemon created for the AN::Tools test suite. It can safely be deleted.
use strict;
use warnings;
use AN::Tools;
my $an = AN::Tools->new();
$an->Log->entry({level => 1, priority => "info", raw => "AN::Tools Test daemon started."});
while(1)
{
sleep 2;
$an->Log->entry({level => 1, priority => "info", raw => "AN::Tools Test daemon looped..."});
}
exit;
|;
$an->Storage->write_file({body => $test_daemon_body, file => $test_daemon_file, group => "root", user => "root", mode => "755", overwrite => 1});
my $test_service_name = "an-tools-test.service";
my $test_service_file = "/usr/lib/systemd/system/".$test_service_name;
my $test_service_body = "[Unit]
Description=Test daemon used by AN::Tools test suite. It can safely be ignored/deleted.
[Service]
Type=simple
ExecStart=$test_daemon_file
ExecStop=/bin/kill -WINCH \${MAINPID}
";
$an->Storage->write_file({body => $test_service_body, file => $test_service_file, group => "root", user => "root", mode => "644", overwrite => 1});
$an->System->call({shell_call => $an->data->{path}{exe}{systemctl}." daemon-reload"});
$an->System->stop_daemon({daemon => $test_service_name}); # Just in case...
# check_daemon
my $test_daemon_rc = $an->System->check_daemon({daemon => $test_service_name});
is($test_daemon_rc, "0", "Verifying that 'System->check_daemon' was able to confirm that the test service: [".$test_service_name."] was stopped.");
$test_daemon_rc = "";
$test_daemon_rc = $an->System->start_daemon({daemon => $test_service_name});
is($test_daemon_rc, "0", "Verifying that 'System->start_daemon' was able to start the test service: [".$test_service_name."].");
$test_daemon_rc = "";
$test_daemon_rc = $an->System->check_daemon({daemon => $test_service_name});
is($test_daemon_rc, "1", "Verifying that 'System->check_daemon' was able to confirm that the test service: [".$test_service_name."] is now running.");
$test_daemon_rc = "";
$test_daemon_rc = $an->System->stop_daemon({daemon => $test_service_name});
is($test_daemon_rc, "0", "Verifying that 'System->stop_daemon' was able to stop the test service: [".$test_service_name."].");
$test_daemon_rc = "";
$test_daemon_rc = $an->System->check_daemon({daemon => $test_service_name});
is($test_daemon_rc, "0", "Verifying that 'System->check_daemon' was able to confirm that the test service: [".$test_service_name."] was stopped.");
# Cleanup
unlink $test_service_file;
unlink $test_daemon_file;
$an->System->call({shell_call => $an->data->{path}{exe}{systemctl}." daemon-reload"});
### AN::Tools::Template tests
# We're going to need a fake template file to test.
my $test_template_file = "/tmp/an-tools.html";
my $test_template_body = '<!-- start test1 -->
This is test template #1.
<!-- end test1 -->
<!-- start test2 -->
This is test template #2. It has a replacement: [#!variable!test!#].
<!-- end test2 -->
';
$an->Storage->write_file({body => $test_template_body, file => $test_template_file, mode => "644", overwrite => 1});
# get
my $test1_template = $an->Template->get({file => $test_template_file, name => "test1"});
is($test1_template, "This is test template #1.\n", "Verifying that 'Template->get' was able to read a test template.");
my $test2_template = $an->Template->get({file => $test_template_file, name => "test2", variables => { test => "boo!" }});
is($test2_template, "This is test template #2. It has a replacement: [boo!].\n", "Verifying that 'Template->get' was able to read a test template with a variable insertion.");
is($an->Template->skin, "alteeve", "Verifying that 'Template->skin' is initially set to 'alteeve'.");
$an->Template->skin({fatal => 0, set => "test"}); # We disable fatal because there may be no skin directory yet.
is($an->Template->skin, "test", "Verifying that 'Template->skin' was changed to 'test'.");
$an->Template->skin({fatal => 0, set => "alteeve"});
is($an->Template->skin, "alteeve", "Verifying that 'Template->skin' was changed back to 'alteeve'.");
# Clean up
unlink $test_template_file;
### AN::Tools::Validate tests
# is_ipv4
is($an->Validate->is_ipv4({ip => "0.0.0.0"}), "1", "Verifying that 'Validate->is_ipv4' recognizes '0.0.0.0' as a valid IP address.");
is($an->Validate->is_ipv4({ip => "255.255.255.255"}), "1", "Verifying that 'Validate->is_ipv4' recognizes '255.255.255.255' as a valid IP address.");
is($an->Validate->is_ipv4({ip => "256.255.255.255"}), "0", "Verifying that 'Validate->is_ipv4' recognizes '256.255.255.255' as an invalid IP address.");
is($an->Validate->is_ipv4({ip => "alteeve.com"}), "0", "Verifying that 'Validate->is_ipv4' recognizes 'alteeve.com' as an invalid IP address.");
is($an->Validate->is_ipv4({ip => "::1"}), "0", "Verifying that 'Validate->is_ipv4' recognizes '::1' as an invalid IP address.");
my $test_uuid = $an->Get->uuid;
is($an->Validate->is_uuid({uuid => $test_uuid}), "1", "Verifying that 'Validate->is_uuid' recognized: [".$test_uuid."] as a valid UUID.");
my $bad_uuid_1 = $test_uuid;
$bad_uuid_1 =~ s/-//g;
is($an->Validate->is_uuid({uuid => $bad_uuid_1}), "0", "Verifying that 'Validate->is_uuid' recognized: [".$bad_uuid_1."] as an invalid UUID.");
my $bad_uuid_2 = uc($test_uuid);
is($an->Validate->is_uuid({uuid => $bad_uuid_2}), "0", "Verifying that 'Validate->is_uuid' recognized: [".$bad_uuid_2."] as an invalid UUID.");
my $bad_uuid_3 = $test_uuid."toolong";
is($an->Validate->is_uuid({uuid => $bad_uuid_3}), "0", "Verifying that 'Validate->is_uuid' recognized: [".$bad_uuid_3."] as an invalid UUID.");
### AN::Tools::Words tests
# clean_spaces
my $clean_string1 = " A line with spaces all over ";
my $clean_string2 = "A line with spaces at the end only ";
my $clean_string3 = " A line with spaces in the front only";
my $clean_string4 = "A line with spaces in the middle only";
is($an->Words->clean_spaces({string => $clean_string1}), "A line with spaces all over", "Verifying that 'Words->clean_spaces' cleaned up a string with random spaces.");
is($an->Words->clean_spaces({string => $clean_string2}), "A line with spaces at the end only", "Verifying that 'Words->clean_spaces' cleaned up a string spaces at the end of a string.");
is($an->Words->clean_spaces({string => $clean_string3}), "A line with spaces in the front only", "Verifying that 'Words->clean_spaces' cleaned up a string with spaces in the front only.");
is($an->Words->clean_spaces({string => $clean_string4}), "A line with spaces in the middle only", "Verifying that 'Words->clean_spaces' cleaned up a string with spaces in the middle only.");
# key
is($an->Words->key({key => "t_0001"}), "Test replace: [#!variable!test!#].", "Verifying that 'Words->key' returned the Canadian English 't_0001' string.");
is($an->Words->key({key => "t_0001", language => "jp"}), "テスト いれかえる: [#!variable!test!#]。", "Verifying that 'Words->read' returned the Japanese 't_0001' string.");
is($an->Words->key({key => "bad_key"}), "#!not_found!#", "Verified that 'Words->key' returns '#!not_found!#' for a bad key.");
is($an->Words->key({key => "t_0003", language => "jp"}), "#!not_found!#", "Verifying that 'Words->read' returned '#!not_found!#' for the missing 't_0003' key.");
# language
is($an->Words->language, "en_CA", "Verifying the default words language is 'en_CA'.");
$an->Words->language({set => "jp"});
is($an->Words->language, "jp", "Verifying the words language was changed to 'jp'.");
$an->Words->language({set => "en_CA"});
is($an->Words->language, "en_CA", "Verifying the words language is back to 'en_CA'.");
# read
### NOTE: At this time, we don't test for unreadable files (rc = 3) or general read faults as set by XML::Simple (rc = 4).
is($an->Words->read({file => $an->data->{path}{words}{'an-tools.xml'}}), 0, "Verifying that 'Words->read' properly returned '0' when asked to read the AN::Tools's words file.");
is($an->Words->read({file => ''}), 1, "Verifying that 'Words->read' properly returned '1' when asked to read a works file without a file being passed.");
is($an->Words->read({file => '/tmp/dummy.xml'}), 2, "Verifying that 'Words->read' properly returned '2' when asked to read a non-existent file.");
# string
my $test_string1 = $an->Words->string({
key => "t_0005",
variables => {
test => "result!",
first => "1st",
second => "2nd",
},
});
is($test_string1, "
This is a multi-line test string with various items to insert.
It also has some #!invalid!# replacement #!keys!# to test the escaping and restoring.
Here is the default output language: [en_CA]
Here we will inject 't_0000': [Test replace: [result!].]
Here we will inject 't_0002' with its embedded variables: [Test Out of order: [2nd] replace: [1st].]
Here we will inject 't_0006', which injects 't_0001' which has a variable: [This string embeds 't_0001': [Test replace: [result!].]].
", "Verifying string processing in the default (Canadian English) language.");
my $test_string2 = $an->Words->string({
language => "jp",
key => "t_0005",
variables => {
test => "result!",
first => "1st",
second => "2nd",
},
});
is($test_string2, "
これは、挿入するさまざまな項目を含む複数行のテスト文字列です。
#!無効#!な置換!#キー!#を使ってエスケープとリストアをテストすることもできます。
デフォルトの出力言語は次のとおりです：「en_CA」
ここで、「t_0000」を挿入します：[テスト いれかえる: [result!]。]
ここでは、 「t_0002」に埋め込み変数を挿入します：「テスト、 整理: [2nd]/[1st]。」
ここでは変数 「この文字列には「t_0001」が埋め込まれています：「テスト いれかえる: [result!]。」」を持つ 「t_0001」を注入する 「t_0006」を注入します。
", "Verifying string processing in Japanese.");
### DONE!
# Tell the user that we're done making noise in their logs
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0049"});

272
AN/Tools.pm → Anvil/Tools.pm
Unescape View File

@ -1,4 +1,4 @@
package AN::Tools; package Anvil::Tools;
# #
# This is the "root" package that manages the sub modules and controls access to their methods. # This is the "root" package that manages the sub modules and controls access to their methods.
# #
@ -35,17 +35,17 @@ binmode(STDOUT, ':encoding(utf-8)');
# I intentionally don't use EXPORT, @ISA and the like because I want my "subclass"es to be accessed in a # I intentionally don't use EXPORT, @ISA and the like because I want my "subclass"es to be accessed in a
# somewhat more OO style. I know some may wish to strike me down for this, but I like the idea of accessing # somewhat more OO style. I know some may wish to strike me down for this, but I like the idea of accessing
# methods via their containing module's name. (A La: C<< $an->Module->method >> rather than C<< $an->method >>). # methods via their containing module's name. (A La: C<< $anvil->Module->method >> rather than C<< $anvil->method >>).
use AN::Tools::Alert; use Anvil::Tools::Alert;
use AN::Tools::Database; use Anvil::Tools::Database;
use AN::Tools::Convert; use Anvil::Tools::Convert;
use AN::Tools::Get; use Anvil::Tools::Get;
use AN::Tools::Log; use Anvil::Tools::Log;
use AN::Tools::Storage; use Anvil::Tools::Storage;
use AN::Tools::System; use Anvil::Tools::System;
use AN::Tools::Template; use Anvil::Tools::Template;
use AN::Tools::Words; use Anvil::Tools::Words;
use AN::Tools::Validate; use Anvil::Tools::Validate;
=pod =pod
@ -53,19 +53,19 @@ use AN::Tools::Validate;
=head1 NAME =head1 NAME
AN::Tools Anvil::Tools
Provides a common oject handle to all AN::Tools::* module methods and handles invocation configuration. Provides a common oject handle to all Anvil::Tools::* module methods and handles invocation configuration.
=head1 SYNOPSIS =head1 SYNOPSIS
use AN::Tools; use Anvil::Tools;
# Get a common object handle on all AN::Tools::* modules. # Get a common object handle on all Anvil::Tools::* modules.
my $an = AN::Tools->new(); my $anvil = Anvil::Tools->new();
# Again, but this time sets some initial values in the '$an->data' hash. # Again, but this time sets some initial values in the '$anvil->data' hash.
my $an = AN::Tools->new( my $anvil = Anvil::Tools->new(
{ {
data => { data => {
foo => "", foo => "",
@ -77,7 +77,7 @@ Provides a common oject handle to all AN::Tools::* module methods and handles in
# This example gets the handle and also sets the default user and log # This example gets the handle and also sets the default user and log
# languages as Japanese, sets a custom log file and sets the log level to # languages as Japanese, sets a custom log file and sets the log level to
# '2'. # '2'.
my $an = AN::Tools->new( my $anvil = Anvil::Tools->new(
{ {
'Log' => { 'Log' => {
user_language => "jp", user_language => "jp",
@ -88,7 +88,7 @@ Provides a common oject handle to all AN::Tools::* module methods and handles in
=head1 DESCRIPTION =head1 DESCRIPTION
The AN::Tools module and all sub-modules are designed for use by Alteeve-based applications. It can be used as a general framework by anyone interested. The Anvil::Tools module and all sub-modules are designed for use by Alteeve-based applications. It can be used as a general framework by anyone interested.
Core features are; Core features are;
@ -110,16 +110,16 @@ sub new
my $parameter = shift; my $parameter = shift;
my $self = { my $self = {
HANDLE => { HANDLE => {
ALERT => AN::Tools::Alert->new(), ALERT => Anvil::Tools::Alert->new(),
DATABASE => AN::Tools::Database->new(), DATABASE => Anvil::Tools::Database->new(),
CONVERT => AN::Tools::Convert->new(), CONVERT => Anvil::Tools::Convert->new(),
GET => AN::Tools::Get->new(), GET => Anvil::Tools::Get->new(),
LOG => AN::Tools::Log->new(), LOG => Anvil::Tools::Log->new(),
STORAGE => AN::Tools::Storage->new(), STORAGE => Anvil::Tools::Storage->new(),
SYSTEM => AN::Tools::System->new(), SYSTEM => Anvil::Tools::System->new(),
TEMPLATE => AN::Tools::Template->new(), TEMPLATE => Anvil::Tools::Template->new(),
WORDS => AN::Tools::Words->new(), WORDS => Anvil::Tools::Words->new(),
VALIDATE => AN::Tools::Validate->new(), VALIDATE => Anvil::Tools::Validate->new(),
}, },
DATA => {}, DATA => {},
ENV_VALUES => { ENV_VALUES => {
@ -135,62 +135,62 @@ sub new
bless $self, $class; bless $self, $class;
# This isn't needed, but it makes the code below more consistent with and portable to other modules. # This isn't needed, but it makes the code below more consistent with and portable to other modules.
my $an = $self; my $anvil = $self;
weaken($an); # Helps avoid memory leaks. See Scalar::Utils weaken($anvil); # Helps avoid memory leaks. See Scalar::Utils
# Record the start time. # Record the start time.
$an->data->{ENV_VALUES}{START_TIME} = Time::HiRes::time; $anvil->data->{ENV_VALUES}{START_TIME} = Time::HiRes::time;
# Get a handle on the various submodules # Get a handle on the various submodules
$an->Alert->parent($an); $anvil->Alert->parent($anvil);
$an->Database->parent($an); $anvil->Database->parent($anvil);
$an->Convert->parent($an); $anvil->Convert->parent($anvil);
$an->Get->parent($an); $anvil->Get->parent($anvil);
$an->Log->parent($an); $anvil->Log->parent($anvil);
$an->Storage->parent($an); $anvil->Storage->parent($anvil);
$an->System->parent($an); $anvil->System->parent($anvil);
$an->Template->parent($an); $anvil->Template->parent($anvil);
$an->Words->parent($an); $anvil->Words->parent($anvil);
$an->Validate->parent($an); $anvil->Validate->parent($anvil);
# Set some system paths and system default variables # Set some system paths and system default variables
$an->_set_paths; $anvil->_set_paths;
$an->_set_defaults; $anvil->_set_defaults;
# This will help clean up if we catch a signal. # This will help clean up if we catch a signal.
$SIG{INT} = sub { $an->catch_sig({signal => "INT"}); }; $SIG{INT} = sub { $anvil->catch_sig({signal => "INT"}); };
$SIG{TERM} = sub { $an->catch_sig({signal => "TERM"}); }; $SIG{TERM} = sub { $anvil->catch_sig({signal => "TERM"}); };
# This sets the environment this program is running in. # This sets the environment this program is running in.
if ($ENV{SERVER_NAME}) if ($ENV{SERVER_NAME})
{ {
$an->environment("html"); $anvil->environment("html");
# There is no PWD environment variable, so we'll use 'DOCUMENT_ROOT' as 'PWD' # There is no PWD environment variable, so we'll use 'DOCUMENT_ROOT' as 'PWD'
$ENV{PWD} = $ENV{DOCUMENT_ROOT}; $ENV{PWD} = $ENV{DOCUMENT_ROOT};
} }
else else
{ {
$an->environment("cli"); $anvil->environment("cli");
} }
# Setup my '$an->data' hash right away so that I have a place to store the strings hash. # Setup my '$anvil->data' hash right away so that I have a place to store the strings hash.
$an->data($parameter->{data}) if $parameter->{data}; $anvil->data($parameter->{data}) if $parameter->{data};
# Initialize the list of directories to seach. # Initialize the list of directories to seach.
$an->Storage->search_directories({initialize => 1}); $anvil->Storage->search_directories({initialize => 1});
# I need to read the initial words early. # I need to read the initial words early.
$an->Words->read({file => $an->data->{path}{words}{'an-tools.xml'}}); $anvil->Words->read({file => $anvil->data->{path}{words}{'words.xml'}});
# If the local './tools.conf' file exists, read it in. # If the local './tools.conf' file exists, read it in.
if (-r "./tools.conf") if (-r $anvil->data->{path}{configs}{'anvil.conf'})
{ {
$an->Storage->read_config({file => "./tools.conf"}); $anvil->Storage->read_config({file => $anvil->data->{path}{configs}{'anvil.conf'}});
} }
# Read in any command line switches. # Read in any command line switches.
$an->Get->switches; $anvil->Get->switches;
# Set passed parameters if needed. # Set passed parameters if needed.
if (ref($parameter) eq "HASH") if (ref($parameter) eq "HASH")
@ -201,7 +201,7 @@ sub new
elsif($parameter) elsif($parameter)
{ {
# Um... # Um...
print $THIS_FILE." ".__LINE__."; AN::Tools->new() invoked with an invalid parameter. Expected a hash reference, but got: [$parameter]\n"; print $THIS_FILE." ".__LINE__."; Anvil::Tools->new() invoked with an invalid parameter. Expected a hash reference, but got: [$parameter]\n";
exit(1); exit(1);
} }
@ -217,18 +217,18 @@ sub new
This is the method used to access the main hash reference that all user-accessible values are stored in. This includes words, configuration file variables and so forth. This is the method used to access the main hash reference that all user-accessible values are stored in. This includes words, configuration file variables and so forth.
When called without an argument, it returns the existing '$an->data' hash reference. When called without an argument, it returns the existing '$anvil->data' hash reference.
my $an = $an->data(); my $anvil = $anvil->data();
When called with a hash reference as the argument, it sets '$an->data' to the new hash. When called with a hash reference as the argument, it sets '$anvil->data' to the new hash.
my $some_hash = {}; my $some_hash = {};
my $an = $an->data($some_hash); my $anvil = $anvil->data($some_hash);
Data can be entered into or access by treating '$an->data' as a normal hash reference. Data can be entered into or access by treating '$anvil->data' as a normal hash reference.
my $an = AN::Tools->new( my $anvil = Anvil::Tools->new(
{ {
data => { data => {
foo => "", foo => "",
@ -241,22 +241,22 @@ Data can be entered into or access by treating '$an->data' as a normal hash refe
}); });
# Copy the 'Cat' value into the $animal variable. # Copy the 'Cat' value into the $animal variable.
my $animal = $an->data->{baz}{animal}; my $animal = $anvil->data->{baz}{animal};
# Set 'A thing' in 'foo'. # Set 'A thing' in 'foo'.
$an->data->{foo} = "A thing"; $anvil->data->{foo} = "A thing";
The C<$an> variable is set inside all modules and acts as shared storage for variables, values and references in all modules. It acts as the core storage for most applications using AN::Tools. The C<$an> variable is set inside all modules and acts as shared storage for variables, values and references in all modules. It acts as the core storage for most applications using Anvil::Tools.
=cut =cut
sub data sub data
{ {
my ($an) = shift; my ($anvil) = shift;
# Pick up the passed in hash, if any. # Pick up the passed in hash, if any.
$an->{DATA} = shift if $_[0]; $anvil->{DATA} = shift if $_[0];
return ($an->{DATA}); return ($anvil->{DATA});
} }
=head2 environment =head2 environment
@ -265,32 +265,32 @@ This is the method used to check or set whether the program is outputting to com
When called without an argument, it returns the current environment. When called without an argument, it returns the current environment.
if ($an->environment() eq "cli") if ($anvil->environment() eq "cli")
{ {
# format for STDOUT # format for STDOUT
} }
elsif ($an->environment() eq "html") elsif ($anvil->environment() eq "html")
{ {
# Use the template system to output HTML # Use the template system to output HTML
} }
When called with a string as the argument, that string will be set as the environment string. When called with a string as the argument, that string will be set as the environment string.
$an->environment("cli"); $anvil->environment("cli");
Technically, any string can be used, however only 'cli' or 'html' are used by convention. Technically, any string can be used, however only 'cli' or 'html' are used by convention.
=cut =cut
sub environment sub environment
{ {
my ($an) = shift; my ($anvil) = shift;
weaken($an); weaken($anvil);
# Pick up the passed in delimiter, if any. # Pick up the passed in delimiter, if any.
if ($_[0]) if ($_[0])
{ {
$an->{ENV_VALUES}{ENVIRONMENT} = shift; $anvil->{ENV_VALUES}{ENVIRONMENT} = shift;
if ($an->{ENV_VALUES}{ENVIRONMENT} eq "html") if ($anvil->{ENV_VALUES}{ENVIRONMENT} eq "html")
{ {
# Load the CGI stuff if we're in a browser # Load the CGI stuff if we're in a browser
use CGI; use CGI;
@ -298,7 +298,7 @@ sub environment
} }
} }
return ($an->{ENV_VALUES}{ENVIRONMENT}); return ($anvil->{ENV_VALUES}{ENVIRONMENT});
} }
=head2 nice_exit =head2 nice_exit
@ -316,22 +316,22 @@ sub nice_exit
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self; my $anvil = $self;
my $exit_code = defined $parameter->{exit_code} ? $parameter->{exit_code} : 0; my $exit_code = defined $parameter->{exit_code} ? $parameter->{exit_code} : 0;
# Close database connections (if any). # Close database connections (if any).
$an->Database->disconnect(); $anvil->Database->disconnect();
# Report the runtime. # Report the runtime.
my $end_time = Time::HiRes::time; my $end_time = Time::HiRes::time;
my $run_time = $end_time - $an->data->{ENV_VALUES}{START_TIME}; my $run_time = $end_time - $anvil->data->{ENV_VALUES}{START_TIME};
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => {
's1:ENV_VALUES::START_TIME' => $an->data->{ENV_VALUES}{START_TIME}, 's1:ENV_VALUES::START_TIME' => $anvil->data->{ENV_VALUES}{START_TIME},
's2:end_time' => $end_time, 's2:end_time' => $end_time,
's3:run_time' => $run_time, 's3:run_time' => $run_time,
}}); }});
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0135", variables => { runtime => $run_time }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0135", variables => { runtime => $run_time }});
exit($exit_code); exit($exit_code);
} }
@ -343,13 +343,13 @@ sub nice_exit
=head1 Submodule Access Methods =head1 Submodule Access Methods
The methods below are used to access methods of submodules using 'C<< $an->Module->method() >>'. The methods below are used to access methods of submodules using 'C<< $anvil->Module->method() >>'.
=cut =cut
=head2 Alert =head2 Alert
Access the C<Alert.pm> methods via 'C<< $an->Alert->method >>'. Access the C<Alert.pm> methods via 'C<< $anvil->Alert->method >>'.
=cut =cut
sub Alert sub Alert
@ -361,7 +361,7 @@ sub Alert
=head2 Database =head2 Database
Access the C<Database.pm> methods via 'C<< $an->Database->method >>'. Access the C<Database.pm> methods via 'C<< $anvil->Database->method >>'.
=cut =cut
sub Database sub Database
@ -373,7 +373,7 @@ sub Database
=head2 Convert =head2 Convert
Access the C<Convert.pm> methods via 'C<< $an->Convert->method >>'. Access the C<Convert.pm> methods via 'C<< $anvil->Convert->method >>'.
=cut =cut
sub Convert sub Convert
@ -385,7 +385,7 @@ sub Convert
=head2 Get =head2 Get
Access the C<Get.pm> methods via 'C<< $an->Get->method >>'. Access the C<Get.pm> methods via 'C<< $anvil->Get->method >>'.
=cut =cut
sub Get sub Get
@ -397,7 +397,7 @@ sub Get
=head2 Log =head2 Log
Access the C<Log.pm> methods via 'C<< $an->Log->method >>'. Access the C<Log.pm> methods via 'C<< $anvil->Log->method >>'.
=cut =cut
sub Log sub Log
@ -409,7 +409,7 @@ sub Log
=head2 Storage =head2 Storage
Access the C<Storage.pm> methods via 'C<< $an->Storage->method >>'. Access the C<Storage.pm> methods via 'C<< $anvil->Storage->method >>'.
=cut =cut
sub Storage sub Storage
@ -421,7 +421,7 @@ sub Storage
=head2 System =head2 System
Access the C<System.pm> methods via 'C<< $an->System->method >>'. Access the C<System.pm> methods via 'C<< $anvil->System->method >>'.
=cut =cut
sub System sub System
@ -433,7 +433,7 @@ sub System
=head2 Template =head2 Template
Access the C<Template.pm> methods via 'C<< $an->Template->method >>'. Access the C<Template.pm> methods via 'C<< $anvil->Template->method >>'.
=cut =cut
sub Template sub Template
@ -445,7 +445,7 @@ sub Template
=head2 Words =head2 Words
Access the C<Words.pm> methods via 'C<< $an->Words->method >>'. Access the C<Words.pm> methods via 'C<< $anvil->Words->method >>'.
=cut =cut
sub Words sub Words
@ -457,7 +457,7 @@ sub Words
=head2 Validate =head2 Validate
Access the C<Validate.pm> methods via 'C<< $an->Validate->method >>'. Access the C<Validate.pm> methods via 'C<< $anvil->Validate->method >>'.
=cut =cut
sub Validate sub Validate
@ -470,7 +470,7 @@ sub Validate
=head1 Private Functions; =head1 Private Functions;
These methods generally should never be called from a program using AN::Tools. However, we are not your boss. These methods generally should never be called from a program using Anvil::Tools. However, we are not your boss.
=cut =cut
@ -480,7 +480,7 @@ These methods generally should never be called from a program using AN::Tools. H
=head2 _add_hash_reference =head2 _add_hash_reference
This is a helper to the '$an->_make_hash_reference' method. It is called each time a new string is to be created as a new hash key in the passed hash reference. This is a helper to the '$anvil->_make_hash_reference' method. It is called each time a new string is to be created as a new hash key in the passed hash reference.
NOTE: Contributed by Shaun Fryer and Viktor Pavlenko by way of Toronto Perl Mongers. NOTE: Contributed by Shaun Fryer and Viktor Pavlenko by way of Toronto Perl Mongers.
@ -512,7 +512,7 @@ This returns the (full) hostname for the machine this is running on.
sub _hostname sub _hostname
{ {
my $self = shift; my $self = shift;
my $an = $self; my $anvil = $self;
my $hostname = ""; my $hostname = "";
if ($ENV{HOSTNAME}) if ($ENV{HOSTNAME})
@ -523,7 +523,7 @@ sub _hostname
else else
{ {
# The environment variable isn't set. Call 'hostname' on the command line. # The environment variable isn't set. Call 'hostname' on the command line.
$hostname = $an->System->call({shell_call => $an->data->{path}{exe}{hostname}}); $hostname = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{hostname}});
} }
return($hostname); return($hostname);
@ -531,12 +531,12 @@ sub _hostname
=head2 _get_hash_reference =head2 _get_hash_reference
This is called when we need to parse a double-colon separated string into two or more elements which represent keys in the 'C<< $an->data >>' hash. Once suitably split up, the value is read and returned. This is called when we need to parse a double-colon separated string into two or more elements which represent keys in the 'C<< $anvil->data >>' hash. Once suitably split up, the value is read and returned.
For example; For example;
$an->data->{foo}{bar} = "baz"; $anvil->data->{foo}{bar} = "baz";
my $value = $an->_get_hash_reference({ key => "foo::bar" }); my $value = $anvil->_get_hash_reference({ key => "foo::bar" });
The 'C<< $value >>' now contains "C<< baz >>". The 'C<< $value >>' now contains "C<< baz >>".
@ -554,7 +554,7 @@ sub _get_hash_reference
# 'href' is the hash reference I am working on. # 'href' is the hash reference I am working on.
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self; my $anvil = $self;
#print "$THIS_FILE ".__LINE__."; hash: [".$an."], key: [$parameter->{key}]\n"; #print "$THIS_FILE ".__LINE__."; hash: [".$an."], key: [$parameter->{key}]\n";
die "$THIS_FILE ".__LINE__."; The hash key string: [$parameter->{key}] doesn't seem to be valid. It should be a string in the format 'foo::bar::baz'.\n" if $parameter->{key} !~ /::/; die "$THIS_FILE ".__LINE__."; The hash key string: [$parameter->{key}] doesn't seem to be valid. It should be a string in the format 'foo::bar::baz'.\n" if $parameter->{key} !~ /::/;
@ -568,7 +568,7 @@ sub _get_hash_reference
my $last_key = pop @keys; my $last_key = pop @keys;
# Re-order the array. # Re-order the array.
my $current_hash_ref = $an->data; my $current_hash_ref = $anvil->data;
foreach my $key (@keys) foreach my $key (@keys)
{ {
$current_hash_ref = $current_hash_ref->{$key}; $current_hash_ref = $current_hash_ref->{$key};
@ -614,9 +614,9 @@ This sets default variable values for the program.
=cut =cut
sub _set_defaults sub _set_defaults
{ {
my ($an) = shift; my ($anvil) = shift;
$an->data->{sys} = { $anvil->data->{sys} = {
daemons => { daemons => {
restart_firewalld => 1, restart_firewalld => 1,
}, },
@ -624,18 +624,22 @@ sub _set_defaults
archive => { archive => {
compress => 1, compress => 1,
count => 50000, count => 50000,
directory => "/usr/local/an-tools/archives/", directory => "/usr/local/anvil/archives/",
division => 6000, division => 6000,
trigger => 100000, trigger => 100000,
}, },
# grep 'CREATE TABLE' tools/anvil.sql | grep -v history. | awk '{print $3}' | sort
core_tables => [ core_tables => [
"hosts",
"host_variable",
"alerts", "alerts",
"variables",
"alert_sent", "alert_sent",
"bonds",
"bridges",
"hosts",
"host_variable",
"network_interfaces",
"states", "states",
"updated", "updated",
"variables",
], ],
local_lock_active => 0, local_lock_active => 0,
locking_reap_age => 300, locking_reap_age => 300,
@ -645,7 +649,7 @@ sub _set_defaults
host_type => "", host_type => "",
use_base2 => 1, use_base2 => 1,
}; };
$an->data->{defaults} = { $anvil->data->{defaults} = {
database => { database => {
locking => { locking => {
reap_age => 300, reap_age => 300,
@ -657,7 +661,7 @@ sub _set_defaults
}, },
limits => { limits => {
# This is the maximum number of times we're allow to loop when injecting variables # This is the maximum number of times we're allow to loop when injecting variables
# into a string being processed in AN::Tools::Words->string(); # into a string being processed in Anvil::Tools::Words->string();
string_loops => 1000, string_loops => 1000,
}, },
'log' => { 'log' => {
@ -667,7 +671,7 @@ sub _set_defaults
level => 1, level => 1,
secure => 0, secure => 0,
server => "", server => "",
tag => "an-tools", tag => "anvil",
}, },
sql => { sql => {
test_table => "hosts", test_table => "hosts",
@ -687,17 +691,17 @@ This sets default paths to many system commands, checking to make sure the binar
=cut =cut
sub _set_paths sub _set_paths
{ {
my ($an) = shift; my ($anvil) = shift;
# Executables # Executables
$an->data->{path} = { $anvil->data->{path} = {
configs => { configs => {
'firewalld.conf' => "/etc/firewalld/firewalld.conf", 'firewalld.conf' => "/etc/firewalld/firewalld.conf",
'journald_an' => "/etc/systemd/journald.conf.d/an.conf", 'journald_an' => "/etc/systemd/journald.conf.d/an.conf",
'pg_hba.conf' => "/var/lib/pgsql/data/pg_hba.conf", 'pg_hba.conf' => "/var/lib/pgsql/data/pg_hba.conf",
'postgresql.conf' => "/var/lib/pgsql/data/postgresql.conf", 'postgresql.conf' => "/var/lib/pgsql/data/postgresql.conf",
ssh_config => "/etc/ssh/ssh_config", ssh_config => "/etc/ssh/ssh_config",
'striker.conf' => "/etc/striker/striker.conf", 'anvil.conf' => "/etc/anvil/anvil.conf",
}, },
data => { data => {
group => "/etc/group", group => "/etc/group",
@ -705,17 +709,18 @@ sub _set_paths
passwd => "/etc/passwd", passwd => "/etc/passwd",
}, },
directories => { directories => {
backups => "/usr/sbin/striker/backups", backups => "/usr/sbin/anvil/backups",
'cgi-bin' => "/var/www/cgi-bin", 'cgi-bin' => "/var/www/cgi-bin",
firewalld_services => "/usr/lib/firewalld/services", firewalld_services => "/usr/lib/firewalld/services",
firewalld_zones => "/etc/firewalld/zones", firewalld_zones => "/etc/firewalld/zones",
html => "/var/www/html", html => "/var/www/html",
skins => "/var/www/html/skins", skins => "/var/www/html/skins",
tools => "/usr/sbin/striker", tools => "/usr/sbin/anvil",
units => "/usr/lib/systemd/system", units => "/usr/lib/systemd/system",
}, },
exe => { exe => {
'an-report-memory' => "/usr/sbin/an-report-memory", 'anvil-update-states' => "/sbin/anvil/anvil-update-states",
'anvil-report-memory' => "/usr/sbin/anvil-report-memory",
'chmod' => "/usr/bin/chmod", 'chmod' => "/usr/bin/chmod",
'chown' => "/usr/bin/chown", 'chown' => "/usr/bin/chown",
cp => "/usr/bin/cp", cp => "/usr/bin/cp",
@ -736,7 +741,6 @@ sub _set_paths
pgrep => "/usr/bin/pgrep", pgrep => "/usr/bin/pgrep",
psql => "/usr/bin/psql", psql => "/usr/bin/psql",
'postgresql-setup' => "/usr/bin/postgresql-setup", 'postgresql-setup' => "/usr/bin/postgresql-setup",
'scancore-update-states' => "/sbin/striker/scancore-update-states",
su => "/usr/bin/su", su => "/usr/bin/su",
systemctl => "/usr/bin/systemctl", systemctl => "/usr/bin/systemctl",
touch => "/usr/bin/touch", touch => "/usr/bin/touch",
@ -744,7 +748,7 @@ sub _set_paths
uuidgen => "/usr/bin/uuidgen", uuidgen => "/usr/bin/uuidgen",
}, },
'lock' => { 'lock' => {
database => "/tmp/an-tools.database.lock", database => "/tmp/anvil-tools.database.lock",
}, },
secure => { secure => {
postgres_pgpass => "/var/lib/pgsql/.pgpass", postgres_pgpass => "/var/lib/pgsql/.pgpass",
@ -753,29 +757,29 @@ sub _set_paths
network_interfaces => "/sys/class/net", network_interfaces => "/sys/class/net",
}, },
sql => { sql => {
'Tools.sql' => "/usr/share/perl5/AN/Tools.sql", 'anvil.sql' => "/usr/sbin/anvil/anvil.sql",
}, },
urls => { urls => {
skins => "/skins", skins => "/skins",
}, },
words => { words => {
'an-tools.xml' => "/usr/share/perl5/AN/an-tools.xml", 'words.xml' => "/usr/sbin/anvil/words.xml",
}, },
}; };
# Make sure we actually have the requested files. # Make sure we actually have the requested files.
foreach my $type (sort {$a cmp $b} keys %{$an->data->{path}}) foreach my $type (sort {$a cmp $b} keys %{$anvil->data->{path}})
{ {
# We don't look for urls because they're relative to the domain. # We don't look for urls because they're relative to the domain.
next if $type eq "urls"; next if $type eq "urls";
foreach my $file (sort {$a cmp $b} keys %{$an->data->{path}{$type}}) foreach my $file (sort {$a cmp $b} keys %{$anvil->data->{path}{$type}})
{ {
if (not -e $an->data->{path}{$type}{$file}) if (not -e $anvil->data->{path}{$type}{$file})
{ {
my $full_path = $an->Storage->find({file => $file}); my $full_path = $anvil->Storage->find({file => $file});
if (($full_path) && ($full_path ne "#!not_found!#")) if (($full_path) && ($full_path ne "#!not_found!#"))
{ {
$an->data->{path}{$type}{$file} = $full_path; $anvil->data->{path}{$type}{$file} = $full_path;
} }
} }
} }
@ -792,9 +796,9 @@ This returns the short hostname for the machine this is running on. That is to s
sub _short_hostname sub _short_hostname
{ {
my $self = shift; my $self = shift;
my $an = $self; my $anvil = $self;
my $short_host_name = $an->_hostname; my $short_host_name = $anvil->_hostname;
$short_host_name =~ s/\..*$//; $short_host_name =~ s/\..*$//;
return($short_host_name); return($short_host_name);
@ -804,11 +808,11 @@ sub _short_hostname
=head2 C<1> =head2 C<1>
AN::Tools->new() passed something other than a hash reference. Anvil::Tools->new() passed something other than a hash reference.
=head2 C<2> =head2 C<2>
Failed to find the requested file in C<< AN::Tools::Storage->find >> and 'fatal' was set. Failed to find the requested file in C<< Anvil::Tools::Storage->find >> and 'fatal' was set.
=head1 Requirements =head1 Requirements
@ -837,14 +841,14 @@ sub catch_sig
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self; my $anvil = $self;
my $signal = $parameter->{signal} ? $parameter->{signal} : ""; my $signal = $parameter->{signal} ? $parameter->{signal} : "";
if ($signal) if ($signal)
{ {
print "Process with PID: [$$] exiting on SIG".$signal.".\n"; print "Process with PID: [$$] exiting on SIG".$signal.".\n";
} }
$an->nice_exit({code => 255}); $anvil->nice_exit({code => 255});
} }

0
Anvil/Tools.sql
Unescape View File

604
Anvil/Tools.t
Unescape View File

@ -0,0 +1,604 @@
#!/usr/bin/perl
use strict;
use warnings;
use POSIX;
use Data::Dumper;
use utf8;
# Be nice and set a version number.
our $VERSION = "3.0.0";
our $THIS_FILE = "Tools.t";
# Call in the test module, telling it how many tests to expect to run.
use Test::More tests => 200;
# Load my module via 'use_ok' test.
BEGIN
{
print "Beginning tests of the Anvil::Tools suite of modules.\n";
use_ok('Anvil::Tools', 3.0.0);
}
### Core tests
my $anvil = Anvil::Tools->new();
like($anvil, qr/^Anvil::Tools=HASH\(0x\w+\)$/, "Verifying that Anvil::Tools object is valid.");
like($anvil->data, qr/^HASH\(0x\w+\)$/, "Verifying that 'data' is a hash reference.");
is($anvil->environment, "cli", "Verifying that environment initially reports 'cli'.");
$anvil->environment('html');
is($anvil->environment, "html", "Verifying that environment was properly set to 'html'.");
$anvil->environment('cli');
is($anvil->environment, "cli", "Verifying that environment was properly reset back to 'cli'.");
# Test handles to child modules.
like($anvil->Alert, qr/^Anvil::Tools::Alert=HASH\(0x\w+\)$/, "Verifying that 'Alert' is a handle to Anvil::Tools::Alert.");
like($anvil->Convert, qr/^Anvil::Tools::Convert=HASH\(0x\w+\)$/, "Verifying that 'Convert' is a handle to Anvil::Tools::Convert.");
like($anvil->Database, qr/^Anvil::Tools::Database=HASH\(0x\w+\)$/, "Verifying that 'Database' is a handle to Anvil::Tools::Database.");
like($anvil->Get, qr/^Anvil::Tools::Get=HASH\(0x\w+\)$/, "Verifying that 'Get' is a handle to Anvil::Tools::Get.");
like($anvil->Log, qr/^Anvil::Tools::Log=HASH\(0x\w+\)$/, "Verifying that 'Log' is a handle to Anvil::Tools::Log.");
like($anvil->Storage, qr/^Anvil::Tools::Storage=HASH\(0x\w+\)$/, "Verifying that 'Storage' is a handle to Anvil::Tools::Storage.");
like($anvil->System, qr/^Anvil::Tools::System=HASH\(0x\w+\)$/, "Verifying that 'System' is a handle to Anvil::Tools::System.");
like($anvil->Template, qr/^Anvil::Tools::Template=HASH\(0x\w+\)$/, "Verifying that 'Template' is a handle to Anvil::Tools::Template.");
like($anvil->Validate, qr/^Anvil::Tools::Validate=HASH\(0x\w+\)$/, "Verifying that 'Validate' is a handle to Anvil::Tools::Validate.");
like($anvil->Words, qr/^Anvil::Tools::Words=HASH\(0x\w+\)$/, "Verifying that 'Words' is a handle to Anvil::Tools::Words.");
### Special
# We log a note telling the user to ignore log entries caused by this test suite. We'll then read it back and
# make sure it logged properly
$anvil->Log->entry({level => 0, priority => "alert", key => "log_0048"});
my $message = $anvil->Words->string({key => "log_0048"});
my $last_log = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{journalctl}." -t anvil --lines 1 --full --output cat --no-pager"});
is($last_log, $message, "Verified that we could write a log entry to journalctl by warning the user of incoming warnings and errors.");
### Anvil::Tools::Alert tests
# <none yet>
### Anvil::Tools::Convert tests
# cidr tests
is($anvil->Convert->cidr({cidr => "fake"}), "", "Verifying that Convert->cidr properly returned an empty string for a bad 'cidr' parameter.");
is($anvil->Convert->cidr({cidr => "0"}), "0.0.0.0", "Verifying that Convert->cidr properly returned '0.0.0.0' when given a 'cidr' parameter of '0'.");
is($anvil->Convert->cidr({cidr => "1"}), "128.0.0.0", "Verifying that Convert->cidr properly returned '128.0.0.0' when given a 'cidr' parameter of '1'.");
is($anvil->Convert->cidr({cidr => "2"}), "192.0.0.0", "Verifying that Convert->cidr properly returned '192.0.0.0' when given a 'cidr' parameter of '2'.");
is($anvil->Convert->cidr({cidr => "3"}), "224.0.0.0", "Verifying that Convert->cidr properly returned '224.0.0.0' when given a 'cidr' parameter of '3'.");
is($anvil->Convert->cidr({cidr => "4"}), "240.0.0.0", "Verifying that Convert->cidr properly returned '240.0.0.0' when given a 'cidr' parameter of '4'.");
is($anvil->Convert->cidr({cidr => "5"}), "248.0.0.0", "Verifying that Convert->cidr properly returned '248.0.0.0' when given a 'cidr' parameter of '5'.");
is($anvil->Convert->cidr({cidr => "6"}), "252.0.0.0", "Verifying that Convert->cidr properly returned '252.0.0.0' when given a 'cidr' parameter of '6'.");
is($anvil->Convert->cidr({cidr => "7"}), "254.0.0.0", "Verifying that Convert->cidr properly returned '254.0.0.0' when given a 'cidr' parameter of '7'.");
is($anvil->Convert->cidr({cidr => "8"}), "255.0.0.0", "Verifying that Convert->cidr properly returned '255.0.0.0' when given a 'cidr' parameter of '8'.");
is($anvil->Convert->cidr({cidr => "9"}), "255.128.0.0", "Verifying that Convert->cidr properly returned '255.128.0.0' when given a 'cidr' parameter of '9'.");
is($anvil->Convert->cidr({cidr => "10"}), "255.192.0.0", "Verifying that Convert->cidr properly returned '255.192.0.0' when given a 'cidr' parameter of '10'.");
is($anvil->Convert->cidr({cidr => "11"}), "255.224.0.0", "Verifying that Convert->cidr properly returned '255.224.0.0' when given a 'cidr' parameter of '11'.");
is($anvil->Convert->cidr({cidr => "12"}), "255.240.0.0", "Verifying that Convert->cidr properly returned '255.240.0.0' when given a 'cidr' parameter of '12'.");
is($anvil->Convert->cidr({cidr => "13"}), "255.248.0.0", "Verifying that Convert->cidr properly returned '255.248.0.0' when given a 'cidr' parameter of '13'.");
is($anvil->Convert->cidr({cidr => "14"}), "255.252.0.0", "Verifying that Convert->cidr properly returned '255.252.0.0' when given a 'cidr' parameter of '14'.");
is($anvil->Convert->cidr({cidr => "15"}), "255.254.0.0", "Verifying that Convert->cidr properly returned '255.254.0.0' when given a 'cidr' parameter of '15'.");
is($anvil->Convert->cidr({cidr => "16"}), "255.255.0.0", "Verifying that Convert->cidr properly returned '255.255.0.0' when given a 'cidr' parameter of '16'.");
is($anvil->Convert->cidr({cidr => "17"}), "255.255.128.0", "Verifying that Convert->cidr properly returned '255.255.128.0' when given a 'cidr' parameter of '17'.");
is($anvil->Convert->cidr({cidr => "18"}), "255.255.192.0", "Verifying that Convert->cidr properly returned '255.255.192.0' when given a 'cidr' parameter of '18'.");
is($anvil->Convert->cidr({cidr => "19"}), "255.255.224.0", "Verifying that Convert->cidr properly returned '255.255.224.0' when given a 'cidr' parameter of '19'.");
is($anvil->Convert->cidr({cidr => "20"}), "255.255.240.0", "Verifying that Convert->cidr properly returned '255.255.240.0' when given a 'cidr' parameter of '20'.");
is($anvil->Convert->cidr({cidr => "21"}), "255.255.248.0", "Verifying that Convert->cidr properly returned '255.255.248.0' when given a 'cidr' parameter of '21'.");
is($anvil->Convert->cidr({cidr => "22"}), "255.255.252.0", "Verifying that Convert->cidr properly returned '255.255.252.0' when given a 'cidr' parameter of '22'.");
is($anvil->Convert->cidr({cidr => "23"}), "255.255.254.0", "Verifying that Convert->cidr properly returned '255.255.254.0' when given a 'cidr' parameter of '23'.");
is($anvil->Convert->cidr({cidr => "24"}), "255.255.255.0", "Verifying that Convert->cidr properly returned '255.255.255.0' when given a 'cidr' parameter of '24'.");
is($anvil->Convert->cidr({cidr => "25"}), "255.255.255.128", "Verifying that Convert->cidr properly returned '255.255.255.128' when given a 'cidr' parameter of '25'.");
is($anvil->Convert->cidr({cidr => "26"}), "255.255.255.192", "Verifying that Convert->cidr properly returned '255.255.255.192' when given a 'cidr' parameter of '26'.");
is($anvil->Convert->cidr({cidr => "27"}), "255.255.255.224", "Verifying that Convert->cidr properly returned '255.255.255.224' when given a 'cidr' parameter of '27'.");
is($anvil->Convert->cidr({cidr => "28"}), "255.255.255.240", "Verifying that Convert->cidr properly returned '255.255.255.240' when given a 'cidr' parameter of '28'.");
is($anvil->Convert->cidr({cidr => "29"}), "255.255.255.248", "Verifying that Convert->cidr properly returned '255.255.255.248' when given a 'cidr' parameter of '29'.");
is($anvil->Convert->cidr({cidr => "30"}), "255.255.255.252", "Verifying that Convert->cidr properly returned '255.255.255.252' when given a 'cidr' parameter of '30'.");
is($anvil->Convert->cidr({cidr => "31"}), "255.255.255.254", "Verifying that Convert->cidr properly returned '255.255.255.254' when given a 'cidr' parameter of '31'.");
is($anvil->Convert->cidr({cidr => "32"}), "255.255.255.255", "Verifying that Convert->cidr properly returned '255.255.255.255' when given a 'cidr' parameter of '32'.");
is($anvil->Convert->cidr({subnet => "fake"}), "", "Verifying that Convert->cidr properly returned an empty string for a bad 'subnet' parameter.");
is($anvil->Convert->cidr({subnet => "0.0.0.0"}), "0", "Verifying that Convert->cidr properly returned '0' when given a 'subnet' parameter of '0.0.0.0'.");
is($anvil->Convert->cidr({subnet => "128.0.0.0"}), "1", "Verifying that Convert->cidr properly returned '1' when given a 'subnet' parameter of '128.0.0.0'.");
is($anvil->Convert->cidr({subnet => "192.0.0.0"}), "2", "Verifying that Convert->cidr properly returned '2' when given a 'subnet' parameter of '192.0.0.0'.");
is($anvil->Convert->cidr({subnet => "224.0.0.0"}), "3", "Verifying that Convert->cidr properly returned '3' when given a 'subnet' parameter of '224.0.0.0'.");
is($anvil->Convert->cidr({subnet => "240.0.0.0"}), "4", "Verifying that Convert->cidr properly returned '4' when given a 'subnet' parameter of '240.0.0.0'.");
is($anvil->Convert->cidr({subnet => "248.0.0.0"}), "5", "Verifying that Convert->cidr properly returned '5' when given a 'subnet' parameter of '248.0.0.0'.");
is($anvil->Convert->cidr({subnet => "252.0.0.0"}), "6", "Verifying that Convert->cidr properly returned '6' when given a 'subnet' parameter of '252.0.0.0'.");
is($anvil->Convert->cidr({subnet => "254.0.0.0"}), "7", "Verifying that Convert->cidr properly returned '7' when given a 'subnet' parameter of '254.0.0.0'.");
is($anvil->Convert->cidr({subnet => "255.0.0.0"}), "8", "Verifying that Convert->cidr properly returned '8' when given a 'subnet' parameter of '255.0.0.0'.");
is($anvil->Convert->cidr({subnet => "255.128.0.0"}), "9", "Verifying that Convert->cidr properly returned '9' when given a 'subnet' parameter of '255.128.0.0'.");
is($anvil->Convert->cidr({subnet => "255.192.0.0"}), "10", "Verifying that Convert->cidr properly returned '10' when given a 'subnet' parameter of '255.192.0.0'.");
is($anvil->Convert->cidr({subnet => "255.224.0.0"}), "11", "Verifying that Convert->cidr properly returned '11' when given a 'subnet' parameter of '255.224.0.0'.");
is($anvil->Convert->cidr({subnet => "255.240.0.0"}), "12", "Verifying that Convert->cidr properly returned '12' when given a 'subnet' parameter of '255.240.0.0'.");
is($anvil->Convert->cidr({subnet => "255.248.0.0"}), "13", "Verifying that Convert->cidr properly returned '13' when given a 'subnet' parameter of '255.248.0.0'.");
is($anvil->Convert->cidr({subnet => "255.252.0.0"}), "14", "Verifying that Convert->cidr properly returned '14' when given a 'subnet' parameter of '255.252.0.0'.");
is($anvil->Convert->cidr({subnet => "255.254.0.0"}), "15", "Verifying that Convert->cidr properly returned '15' when given a 'subnet' parameter of '255.254.0.0'.");
is($anvil->Convert->cidr({subnet => "255.255.0.0"}), "16", "Verifying that Convert->cidr properly returned '16' when given a 'subnet' parameter of '255.255.0.0'.");
is($anvil->Convert->cidr({subnet => "255.255.128.0"}), "17", "Verifying that Convert->cidr properly returned '17' when given a 'subnet' parameter of '255.255.128.0'.");
is($anvil->Convert->cidr({subnet => "255.255.192.0"}), "18", "Verifying that Convert->cidr properly returned '18' when given a 'subnet' parameter of '255.255.192.0'.");
is($anvil->Convert->cidr({subnet => "255.255.224.0"}), "19", "Verifying that Convert->cidr properly returned '19' when given a 'subnet' parameter of '255.255.224.0'.");
is($anvil->Convert->cidr({subnet => "255.255.240.0"}), "20", "Verifying that Convert->cidr properly returned '20' when given a 'subnet' parameter of '255.255.240.0'.");
is($anvil->Convert->cidr({subnet => "255.255.248.0"}), "21", "Verifying that Convert->cidr properly returned '21' when given a 'subnet' parameter of '255.255.248.0'.");
is($anvil->Convert->cidr({subnet => "255.255.252.0"}), "22", "Verifying that Convert->cidr properly returned '22' when given a 'subnet' parameter of '255.255.252.0'.");
is($anvil->Convert->cidr({subnet => "255.255.254.0"}), "23", "Verifying that Convert->cidr properly returned '23' when given a 'subnet' parameter of '255.255.254.0'.");
is($anvil->Convert->cidr({subnet => "255.255.255.0"}), "24", "Verifying that Convert->cidr properly returned '24' when given a 'subnet' parameter of '255.255.255.0'.");
is($anvil->Convert->cidr({subnet => "255.255.255.128"}), "25", "Verifying that Convert->cidr properly returned '25' when given a 'subnet' parameter of '255.255.255.128'.");
is($anvil->Convert->cidr({subnet => "255.255.255.192"}), "26", "Verifying that Convert->cidr properly returned '26' when given a 'subnet' parameter of '255.255.255.192'.");
is($anvil->Convert->cidr({subnet => "255.255.255.224"}), "27", "Verifying that Convert->cidr properly returned '27' when given a 'subnet' parameter of '255.255.255.224'.");
is($anvil->Convert->cidr({subnet => "255.255.255.240"}), "28", "Verifying that Convert->cidr properly returned '28' when given a 'subnet' parameter of '255.255.255.240'.");
is($anvil->Convert->cidr({subnet => "255.255.255.248"}), "29", "Verifying that Convert->cidr properly returned '29' when given a 'subnet' parameter of '255.255.255.248'.");
is($anvil->Convert->cidr({subnet => "255.255.255.252"}), "30", "Verifying that Convert->cidr properly returned '30' when given a 'subnet' parameter of '255.255.255.252'.");
is($anvil->Convert->cidr({subnet => "255.255.255.254"}), "31", "Verifying that Convert->cidr properly returned '31' when given a 'subnet' parameter of '255.255.255.254'.");
is($anvil->Convert->cidr({subnet => "255.255.255.255"}), "32", "Verifying that Convert->cidr properly returned '32' when given a 'subnet' parameter of '255.255.255.255'.");
### Anvil::Tools::Database tests
# <none yet>
### Anvil::Tools::Get tests
# date_and_time
like($anvil->Get->date_and_time(), qr/^\d\d\d\d\/\d\d\/\d\d \d\d:\d\d:\d\d$/, "Verifying the current date and time is returned.");
like($anvil->Get->date_and_time({date_only => 1}), qr/^\d\d\d\d\/\d\d\/\d\d$/, "Verifying the current date alone is returned.");
like($anvil->Get->date_and_time({time_only => 1}), qr/^\d\d:\d\d:\d\d$/, "Verifying the current time alone is returned.");
like($anvil->Get->date_and_time({file_name => 1}), qr/^\d\d\d\d-\d\d-\d\d_\d\d-\d\d-\d\d$/, "Verifying the current date and time is returned in a file-friendly format.");
like($anvil->Get->date_and_time({file_name => 1, date_only => 1}), qr/^\d\d\d\d-\d\d-\d\d$/, "Verifying the current date only is returned in a file-friendly format.");
like($anvil->Get->date_and_time({file_name => 1, time_only => 1}), qr/^\d\d-\d\d-\d\d$/, "Verifying the current time only is returned in a file-friendly format.");
# We can't be too specific because the user's TZ will shift the results
like($anvil->Get->date_and_time({use_time => 1234567890}), qr/2009\/02\/1[34] \d\d:\d\d:\d\d$/, "Verified that a specific unixtime returned the expected date.");
like($anvil->Get->date_and_time({use_time => 1234567890, offset => 31536000}), qr/2010\/02\/1[34] \d\d:\d\d:\d\d$/, "Verified that a specific unixtime with a one year in the future offset returned the expected date.");
like($anvil->Get->date_and_time({use_time => 1234567890, offset => -31536000}), qr/2008\/02\/1[34] \d\d:\d\d:\d\d$/, "Verified that a specific unixtime with a one year in the past offset returned the expected date.");
# host_uuid
like($anvil->Get->host_uuid, qr/^[a-f0-9]{8}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{12}$/, "Verifying ability to read host uuid.");
### TODO: How to test Get->switches?
# uuid
like($anvil->Get->uuid, qr/^[a-f0-9]{8}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{4}-[a-f0-9]{12}$/, "Verifying ability to generate a random uuid.");
### Anvil::Tools::Log tests
# entry is tested at the start of this test suite.
# language
is($anvil->Log->language, "en_CA", "Verifying the default log language is 'en_CA'.");
$anvil->Log->language({set => "jp"});
is($anvil->Log->language, "jp", "Verifying the log language was changed to 'jp'.");
$anvil->Log->language({set => "en_CA"});
is($anvil->Log->language, "en_CA", "Verifying the log language is back to 'en_CA'.");
# log_level
is($anvil->Log->level, "1", "Verifying the default log level is '1'.");
$anvil->Log->level({set => 0});
is($anvil->Log->level, "0", "Verifying the log level changed to '0'.");
$anvil->Log->level({set => 1});
is($anvil->Log->level, "1", "Verifying the log level changed to '1'.");
$anvil->Log->level({set => 2});
is($anvil->Log->level, "2", "Verifying the log level changed to '2'.");
$anvil->Log->level({set => 3});
is($anvil->Log->level, "3", "Verifying the log level changed to '3'.");
$anvil->Log->level({set => 4});
is($anvil->Log->level, "4", "Verifying the log level changed to '4'.");
$anvil->Log->level({set => "foo"});
is($anvil->Log->level, "4", "Verifying the log level stayed at '4' with bad input.");
$anvil->Log->level({set => 1});
is($anvil->Log->level, "1", "Verifying the log level changed back to '1'.");
# secure
is($anvil->Log->secure, "0", "Verifying that logging secure messages is disabled by default.");
$anvil->Log->secure({set => "foo"});
is($anvil->Log->secure, "0", "Verifying that logging secure messages stayed disabled on bad input.");
$anvil->Log->secure({set => 1});
is($anvil->Log->secure, "1", "Verifying that logging secure messages was enabled.");
$anvil->Log->secure({set => 0});
is($anvil->Log->secure, "0", "Verifying that logging secure messages was disabled again.");
# variables
$anvil->Log->variables({level => 0, list => { a => "1" }});
my $list_a = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{journalctl}." -t anvil --lines 1 --full --output cat --no-pager"});
is($list_a, "a: [1]", "Verified that we could log a list of variables (1 entry).");
$anvil->Log->variables({level => 0, list => { a => "1", b => "2" }});
my $list_b = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{journalctl}." -t anvil --lines 1 --full --output cat --no-pager"});
is($list_b, "a: [1], b: [2]", "Verified that we could log a list of variables (2 entries).");
$anvil->Log->variables({level => 0, list => { a => "1", b => "2", c => "3" }});
my $list_c = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{journalctl}." -t anvil --lines 1 --full --output cat --no-pager"});
is($list_c, "a: [1], b: [2], c: [3]", "Verified that we could log a list of variables (3 entries).");
$anvil->Log->variables({level => 0, list => { a => "1", b => "2", c => "3", d => "4" }});
my $list_d = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{journalctl}." -t anvil --lines 1 --full --output cat --no-pager"});
is($list_d, "a: [1], b: [2], c: [3], d: [4]", "Verified that we could log a list of variables (4 entries).");
$anvil->Log->variables({level => 0, list => { a => "1", b => "2", c => "3", d => "4", e => "5" }});
my $list_e = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{journalctl}." -t anvil --lines 1 --full --output cat --no-pager"});
my $say_variables = $anvil->Words->key({key => "log_0019"});
my $expect_e = "$say_variables
|- a: [1]
|- b: [2]
|- c: [3]
|- d: [4]
\\- e: [5]";
is($list_e, $expect_e, "Verified that we could log a list of variables (5 entries, line wrapping).");
# _adjust_log_level - We're simulating switches to test Log->_adjust_log_level
$anvil->data->{switches}{V} = "#!set!#";
$anvil->data->{switches}{v} = "";
$anvil->data->{switches}{vv} = "";
$anvil->data->{switches}{vvv} = "";
$anvil->data->{switches}{vvvv} = "";
$anvil->Log->_adjust_log_level;
is($anvil->Log->level, "0", "Verifying the log level was set to '0' with Log->_adjust_log_leve() with 'V' switch set.");
$anvil->data->{switches}{V} = "";
$anvil->data->{switches}{v} = "#!set!#";
$anvil->Log->_adjust_log_level;
is($anvil->Log->level, "1", "Verifying the log level was set to '1' with Log->_adjust_log_leve() with 'v' switch set.");
$anvil->data->{switches}{v} = "";
$anvil->data->{switches}{vv} = "#!set!#";
$anvil->Log->_adjust_log_level;
is($anvil->Log->level, "2", "Verifying the log level was set to '2' with Log->_adjust_log_leve() with 'vv' switch set.");
$anvil->data->{switches}{vv} = "";
$anvil->data->{switches}{vvv} = "#!set!#";
$anvil->Log->_adjust_log_level;
is($anvil->Log->level, "3", "Verifying the log level was set to '3' with Log->_adjust_log_leve() with 'vvv' switch set.");
$anvil->data->{switches}{vvv} = "";
$anvil->data->{switches}{vvvv} = "#!set!#";
$anvil->Log->_adjust_log_level;
is($anvil->Log->level, "4", "Verifying the log level was set to '4' with Log->_adjust_log_leve() with 'vvvv' switch set.");
$anvil->data->{switches}{vvvv} = "";
$anvil->data->{switches}{v} = "#!set!#";
$anvil->Log->_adjust_log_level;
is($anvil->Log->level, "1", "Verifying the log level was set back to '1' with Log->_adjust_log_leve() with 'v' switch set.");
### Anvil::Tools::Storage tests - These happen a little out of order.
# We need to pick a user name and group name to use for these tests. So we'll start by reading in passwd.
my $passwd = $anvil->Storage->read_file({file => "/etc/passwd"});
my $group = $anvil->Storage->read_file({file => "/etc/group"});
my $read_ok = 0;
my $use_user = "";
my $use_group = "";
foreach my $line (split/\n/, $passwd)
{
if ($line =~ /^root:/)
{
$read_ok = 1;
}
elsif ($line =~ /^(\w+):x:\d/)
{
$use_user = $1;
last;
}
}
foreach my $line (split/\n/, $group)
{
if ($line =~ /^root:/)
{
# skip
}
elsif ($line =~ /^(\w+):x:\d/)
{
$use_group = $1;
last;
}
}
# print "[ Debug ] - Using the user: [$use_user] and the group: [$use_group] for testing.\n";
is($read_ok, "1", "Verified that 'Storage->read_file' could read a file.");
# Write a file /tmp/foo
my $body = "This is a test file created as part of the Anvil::Tools test suite.\nYou can safely delete it if you wish.\n";
my $test_file = "/tmp/anvil.test";
if (-e $test_file)
{
# remove the old test file.
unlink $test_file or die "The test file: [$test_file] exists (from a previous run?) and can't be removed. The error was: $!\n";
}
$anvil->Storage->write_file({body => $body, file => $test_file, group => $use_group, user => $use_user, mode => "0666"});
my $write_ok = 0;
if (-e $test_file)
{
$write_ok = 1;
}
is($write_ok, "1", "Verifying that 'Storage->write_file' could write a file (tested writing to: [$test_file]).");
my $mode = $anvil->Storage->read_mode({target => $test_file});
my ($uid, $gid) = (stat($test_file))[4,5];
my $file_user_name = getpwuid($uid);
my $file_group_name = getgrgid($gid);
#print "[ Debug ] - test_file: [$test_file], mode: [$mode], owning user: [$file_user_name ($uid)], owning group: [$file_group_name ($gid)]\n";
is($mode, "0666", "Verifying that 'Storage->write_file' set the mode correctly when writing a file.");
is($file_user_name, $use_user, "Verifying that 'Storage->write_file' set the user name properly when the file was written.");
is($file_group_name, $use_group, "Verifying that 'Storage->write_file' set the group name properly when the file was written.");
# change_mode
$anvil->Storage->change_mode({target => $test_file, mode => "4755"});
$mode = $anvil->Storage->read_mode({target => $test_file});
is($mode, "4755", "Verifying that 'Storage->change_mode' was able to change the mode of the test file (including setting the setuid and setgid sticky bits).");
$anvil->Storage->change_mode({target => $test_file, mode => "644"});
$mode = $anvil->Storage->read_mode({target => $test_file});
is($mode, "0644", "Verifying that 'Storage->change_mode' was able to change the mode of the test file using three digits instead of four.");
# change_owner
$anvil->Storage->change_owner({target => $test_file, user => 0});
$file_user_name = "";
$file_group_name = "";
($uid, $gid) = (stat($test_file))[4,5];
$file_user_name = getpwuid($uid);
$file_group_name = getgrgid($gid);
is($file_user_name, "root", "Verifying that 'Storage->change_user', when passed only a user ID, changed the user.");
is($file_group_name, $use_group, "Verifying that 'Storage->change_user', when passed only a user ID, did not change the group.");
$anvil->Storage->change_owner({target => $test_file, user => $use_user});
$file_user_name = "";
$file_group_name = "";
($uid, $gid) = (stat($test_file))[4,5];
$file_user_name = getpwuid($uid);
$file_group_name = getgrgid($gid);
is($file_user_name, $use_user, "Verifying that 'Storage->change_user', when passed only a user name, changed the user.");
is($file_group_name, $use_group, "Verifying that 'Storage->change_user', when passed only a user ID, did not change the group.");
$anvil->Storage->change_owner({target => $test_file, group => 0});
$file_user_name = "";
$file_group_name = "";
($uid, $gid) = (stat($test_file))[4,5];
$file_user_name = getpwuid($uid);
$file_group_name = getgrgid($gid);
is($file_user_name, $use_user, "Verifying that 'Storage->change_user', when passed only a group ID, did not change the user.");
is($file_group_name, "root", "Verifying that 'Storage->change_user', when passed only a group ID, changed the group.");
$anvil->Storage->change_owner({target => $test_file, group => $use_group});
$file_user_name = "";
$file_group_name = "";
($uid, $gid) = (stat($test_file))[4,5];
$file_user_name = getpwuid($uid);
$file_group_name = getgrgid($gid);
is($file_user_name, $use_user, "Verifying that 'Storage->change_user', when passed only a group name, did not change the user.");
is($file_group_name, $use_group, "Verifying that 'Storage->change_user', when passed only a group name, changed the group.");
$anvil->Storage->change_owner({target => $test_file, user => "root", group => "root"});
$file_user_name = "";
$file_group_name = "";
($uid, $gid) = (stat($test_file))[4,5];
$file_user_name = getpwuid($uid);
$file_group_name = getgrgid($gid);
is($file_user_name, "root", "Verifying that 'Storage->change_user', when passed both a user and group name, changed the user.");
is($file_group_name, "root", "Verifying that 'Storage->change_user', when passed both a user and group name, changed the group.");
my $change_owner_rc = $anvil->Storage->change_owner({target => "", user => "root", group => "root"});
is($change_owner_rc, "1", "Verifying that 'Storage->change_user', when passed no target, returned '1'.");
$change_owner_rc = "";
$change_owner_rc = $anvil->Storage->change_owner({target => "/fake/file", user => "root", group => "root"});
is($change_owner_rc, "1", "Verifying that 'Storage->change_user', when passed a bad file, returned '1'.");
# copy_file
my $copy_file = "/tmp/anvil.copy";
my $copied_ok = 0;
if (-e $copy_file)
{
unlink $copy_file or die "The test copy file: [$copy_file] exists (from a previous run?) and can't be removed. The error was: $!\n";
}
$anvil->Storage->copy_file({source => $test_file, target => $copy_file});
if (-e $copy_file)
{
$copied_ok = 1;
}
is($copied_ok, "1", "Verifying that 'Storage->copy_file' was able to copy the test file.");
my $copy_rc = $anvil->Storage->copy_file({target => $copy_file});
is($copy_rc, "1", "Verifying that 'Storage->copy_file' returned '1' when no source file was passed.");
$copy_rc = "";
$copy_rc = $anvil->Storage->copy_file({source => $test_file});
is($copy_rc, "2", "Verifying that 'Storage->copy_file' returned '2' when no target file was passed.");
$copy_rc = "";
$copy_rc = $anvil->Storage->copy_file({source => $test_file, target => $copy_file});
is($copy_rc, "3", "Verifying that 'Storage->copy_file' returned '3' when the target file already exists.");
$copy_rc = "";
$copy_rc = $anvil->Storage->copy_file({source => $test_file, target => $copy_file, overwrite => 1});
is($copy_rc, "0", "Verifying that 'Storage->copy_file' returned '0' when the target file already exists and overwrite was set.");
$copy_rc = "";
$copy_rc = $anvil->Storage->copy_file({source => "/fake/file", target => $copy_file});
is($copy_rc, "4", "Verifying that 'Storage->copy_file' returned '4' when the target file is passed but doesn't exist.");
# find
my $test_path = $anvil->Storage->find({ file => "Anvil/Tools.t" });
is($test_path, "/usr/share/perl5/Anvil/Tools.t", "Verifying that Storage->find successfully found 'Anvil/Tools.t'.");
my $bad_path = $anvil->Storage->find({ file => "Anvil/wa.t" });
is($bad_path, "#!not_found!#", "Verifying that Storage->find properly returned '#!not_found!#' for a non-existed file.");
# make_directory
my $test_directory = "/tmp/anvil/test/directory";
if (-d $test_directory)
{
foreach my $this_directory ("/tmp/anvil/test/directory", "/tmp/anvil/test", "/tmp/anvil")
{
rmdir $this_directory or die "Failed to remove the test directory: [$this_directory] (from a previous test?). The error was: $!\n";
}
}
# This uses an odd mode on purpose
$anvil->Storage->make_directory({directory => $test_directory, group => $use_group, user => $use_user, mode => "0757"});
my $created_directory = 0;
if (-d $test_directory)
{
$created_directory = 1;
}
is($created_directory, "1", "Verifying that 'Storage->create_directory' created a directory and its parents.");
my $directory_mode = $anvil->Storage->read_mode({target => $test_directory});
($uid, $gid) = (stat($test_directory))[4,5];
my $directory_user_name = getpwuid($uid);
my $directory_group_name = getgrgid($gid);
is($directory_mode, "0757", "Verifying that 'Storage->create_directory' created a directory with the requested mode.");
is($directory_user_name, $use_user, "Verifying that 'Storage->create_directory' created a directory with the requested owner.");
is($directory_group_name, $use_group, "Verifying that 'Storage->create_directory' created a directory with the requested group.");
# read_config
$anvil->data->{foo}{bar}{a} = "test";
is($anvil->Storage->read_config({ file => "Anvil/test.conf" }), 0, "Verifying that 'Storage->read_config' successfully found 'Anvil/test.conf'.");
is($anvil->Storage->read_config({ file => "" }), 1, "Verifying that 'Storage->read_config' returns '1' when called without a 'file' parameter being set.");
is($anvil->Storage->read_config({ file => "Anvil/moo.conf" }), 2, "Verifying that 'Storage->read_config' returns '2' when the non-existent 'Anvil/moo.conf' is passed.");
cmp_ok($anvil->data->{foo}{bar}{a}, 'eq', 'I am "a"', "Verifying that 'Anvil/test.conf's 'foo::bar::a' overwrote an earlier set value.");
cmp_ok($anvil->data->{foo}{bar}{b}, 'eq', 'I am "b", split with tabs and having trailing spaces.', "Verifying that 'Anvil/test.conf's 'foo::bar::b' has whitespaces removed as expected.");
cmp_ok($anvil->data->{foo}{baz}{1}, 'eq', 'This is \'1\' with no spaces', "Verifying that 'Anvil/test.conf's 'foo::baz::1' parsed without spaces around '='.");
cmp_ok($anvil->data->{foo}{baz}{2}, 'eq', 'I had a $dollar = sign and split with tabs.', "Verifying that 'Anvil/test.conf's 'foo::baz::2' had no trouble with a '\$' and '=' characters in the string.");
# read_file was tested earlier.
# read_mode was tested earlier.
# search_directories
my $array1 = $anvil->Storage->search_directories;
my $a1_count = @{$array1};
cmp_ok($a1_count, '>', 0, "Verifying that Storage->search_directories has at least one entry. Found: [$a1_count] directories.");
$anvil->Storage->search_directories({directories => "/root,/usr/bin,/some/fake/directory"});
my $array2 = $anvil->Storage->search_directories;
my $a2_count = @{$array2};
cmp_ok($a2_count, '==', 2, "Verifying that Storage->search_directories now has 2 entries from a passed in CSV, testing that the list changed and a fake directory was dropped.");
$anvil->Storage->search_directories({directories => ["/usr/bin", "/tmp", "/home"] });
my $array3 = $anvil->Storage->search_directories;
my $a3_count = @{$array3};
cmp_ok($a3_count, '==', 3, "Verifying that Storage->search_directories now has 3 entries from a passed in array reference, verifying that the list changed again.");
$anvil->Storage->search_directories({directories => "invalid" });
my $array4 = $anvil->Storage->search_directories;
my $a4_count = @{$array4};
cmp_ok($a4_count, '==', $a1_count, "Verifying that Storage->search_directories has the original number of directories: [$a4_count] after being called with an invalid 'directories' parameter, showing that it reset properly.");
# write_file was tested earlier
# Cleanup.
unlink $test_file;
unlink $copy_file;
foreach my $this_directory ("/tmp/anvil/test/directory", "/tmp/anvil/test", "/tmp/anvil")
{
rmdir $this_directory or die "Failed to remove the test directory: [$this_directory] (from a previous test?). The error was: $!\n";
}
### Anvil::Tools::System tests
# call was tested during the Log->entry test and will be tested further below.
# Daemon tests require that we create a test daemon and a unit for it...
my $test_daemon_file = "/tmp/anvil-test.daemon";
my $test_daemon_body = q|#!/usr/bin/perl
# This is a test daemon created for the Anvil::Tools test suite. It can safely be deleted.
use strict;
use warnings;
use Anvil::Tools;
my $anvil->= Anvil::Tools->new();
$anvil->Log->entry({level => 1, priority => "info", raw => "Anvil::Tools Test daemon started."});
while(1)
{
sleep 2;
$anvil->Log->entry({level => 1, priority => "info", raw => "Anvil::Tools Test daemon looped..."});
}
exit;
|;
$anvil->Storage->write_file({body => $test_daemon_body, file => $test_daemon_file, group => "root", user => "root", mode => "755", overwrite => 1});
my $test_service_name = "anvil-test.service";
my $test_service_file = "/usr/lib/systemd/system/".$test_service_name;
my $test_service_body = "[Unit]
Description=Test daemon used by Anvil::Tools test suite. It can safely be ignored/deleted.
[Service]
Type=simple
ExecStart=$test_daemon_file
ExecStop=/bin/kill -WINCH \${MAINPID}
";
$anvil->Storage->write_file({body => $test_service_body, file => $test_service_file, group => "root", user => "root", mode => "644", overwrite => 1});
$anvil->System->call({shell_call => $anvil->data->{path}{exe}{systemctl}." daemon-reload"});
$anvil->System->stop_daemon({daemon => $test_service_name}); # Just in case...
# check_daemon
my $test_daemon_rc = $anvil->System->check_daemon({daemon => $test_service_name});
is($test_daemon_rc, "0", "Verifying that 'System->check_daemon' was able to confirm that the test service: [".$test_service_name."] was stopped.");
$test_daemon_rc = "";
$test_daemon_rc = $anvil->System->start_daemon({daemon => $test_service_name});
is($test_daemon_rc, "0", "Verifying that 'System->start_daemon' was able to start the test service: [".$test_service_name."].");
$test_daemon_rc = "";
$test_daemon_rc = $anvil->System->check_daemon({daemon => $test_service_name});
is($test_daemon_rc, "1", "Verifying that 'System->check_daemon' was able to confirm that the test service: [".$test_service_name."] is now running.");
$test_daemon_rc = "";
$test_daemon_rc = $anvil->System->stop_daemon({daemon => $test_service_name});
is($test_daemon_rc, "0", "Verifying that 'System->stop_daemon' was able to stop the test service: [".$test_service_name."].");
$test_daemon_rc = "";
$test_daemon_rc = $anvil->System->check_daemon({daemon => $test_service_name});
is($test_daemon_rc, "0", "Verifying that 'System->check_daemon' was able to confirm that the test service: [".$test_service_name."] was stopped.");
# Cleanup
unlink $test_service_file;
unlink $test_daemon_file;
$anvil->System->call({shell_call => $anvil->data->{path}{exe}{systemctl}." daemon-reload"});
### Anvil::Tools::Template tests
# We're going to need a fake template file to test.
my $test_template_file = "/tmp/anvil.html";
my $test_template_body = '<!-- start test1 -->
This is test template #1.
<!-- end test1 -->
<!-- start test2 -->
This is test template #2. It has a replacement: [#!variable!test!#].
<!-- end test2 -->
';
$anvil->Storage->write_file({body => $test_template_body, file => $test_template_file, mode => "644", overwrite => 1});
# get
my $test1_template = $anvil->Template->get({file => $test_template_file, name => "test1"});
is($test1_template, "This is test template #1.\n", "Verifying that 'Template->get' was able to read a test template.");
my $test2_template = $anvil->Template->get({file => $test_template_file, name => "test1", show_name => 1});
is($test2_template, "<!-- start: [/tmp/anvil.html] -> [test1] -->\nThis is test template #1.\n<!-- end: [/tmp/anvil.html] -> [test1] -->\n", "Verifying that 'Template->get' was able to read a test template with the source in HTML comments.");
my $test3_template = $anvil->Template->get({file => $test_template_file, name => "test2", variables => { test => "boo!" }});
is($test3_template, "This is test template #2. It has a replacement: [boo!].\n", "Verifying that 'Template->get' was able to read a test template with a variable insertion.");
is($anvil->Template->skin, "alteeve", "Verifying that 'Template->skin' is initially set to 'alteeve'.");
$anvil->Template->skin({fatal => 0, set => "test"}); # We disable fatal because there may be no skin directory yet.
is($anvil->Template->skin, "test", "Verifying that 'Template->skin' was changed to 'test'.");
$anvil->Template->skin({fatal => 0, set => "alteeve"});
is($anvil->Template->skin, "alteeve", "Verifying that 'Template->skin' was changed back to 'alteeve'.");
# Clean up
unlink $test_template_file;
### Anvil::Tools::Validate tests
# is_ipv4
is($anvil->Validate->is_ipv4({ip => "0.0.0.0"}), "1", "Verifying that 'Validate->is_ipv4' recognizes '0.0.0.0' as a valid IP address.");
is($anvil->Validate->is_ipv4({ip => "255.255.255.255"}), "1", "Verifying that 'Validate->is_ipv4' recognizes '255.255.255.255' as a valid IP address.");
is($anvil->Validate->is_ipv4({ip => "256.255.255.255"}), "0", "Verifying that 'Validate->is_ipv4' recognizes '256.255.255.255' as an invalid IP address.");
is($anvil->Validate->is_ipv4({ip => "alteeve.com"}), "0", "Verifying that 'Validate->is_ipv4' recognizes 'alteeve.com' as an invalid IP address.");
is($anvil->Validate->is_ipv4({ip => "::1"}), "0", "Verifying that 'Validate->is_ipv4' recognizes '::1' as an invalid IP address.");
my $test_uuid = $anvil->Get->uuid;
is($anvil->Validate->is_uuid({uuid => $test_uuid}), "1", "Verifying that 'Validate->is_uuid' recognized: [".$test_uuid."] as a valid UUID.");
my $bad_uuid_1 = $test_uuid;
$bad_uuid_1 =~ s/-//g;
is($anvil->Validate->is_uuid({uuid => $bad_uuid_1}), "0", "Verifying that 'Validate->is_uuid' recognized: [".$bad_uuid_1."] as an invalid UUID.");
my $bad_uuid_2 = uc($test_uuid);
is($anvil->Validate->is_uuid({uuid => $bad_uuid_2}), "0", "Verifying that 'Validate->is_uuid' recognized: [".$bad_uuid_2."] as an invalid UUID.");
my $bad_uuid_3 = $test_uuid."toolong";
is($anvil->Validate->is_uuid({uuid => $bad_uuid_3}), "0", "Verifying that 'Validate->is_uuid' recognized: [".$bad_uuid_3."] as an invalid UUID.");
### Anvil::Tools::Words tests
# clean_spaces
my $clean_string1 = " A line with spaces all over ";
my $clean_string2 = "A line with spaces at the end only ";
my $clean_string3 = " A line with spaces in the front only";
my $clean_string4 = "A line with spaces in the middle only";
is($anvil->Words->clean_spaces({string => $clean_string1}), "A line with spaces all over", "Verifying that 'Words->clean_spaces' cleaned up a string with random spaces.");
is($anvil->Words->clean_spaces({string => $clean_string2}), "A line with spaces at the end only", "Verifying that 'Words->clean_spaces' cleaned up a string spaces at the end of a string.");
is($anvil->Words->clean_spaces({string => $clean_string3}), "A line with spaces in the front only", "Verifying that 'Words->clean_spaces' cleaned up a string with spaces in the front only.");
is($anvil->Words->clean_spaces({string => $clean_string4}), "A line with spaces in the middle only", "Verifying that 'Words->clean_spaces' cleaned up a string with spaces in the middle only.");
# key
is($anvil->Words->key({key => "t_0001"}), "Test replace: [#!variable!test!#].", "Verifying that 'Words->key' returned the Canadian English 't_0001' string.");
is($anvil->Words->key({key => "t_0001", language => "jp"}), "テスト いれかえる: [#!variable!test!#]。", "Verifying that 'Words->read' returned the Japanese 't_0001' string.");
is($anvil->Words->key({key => "bad_key"}), "#!not_found!#", "Verified that 'Words->key' returns '#!not_found!#' for a bad key.");
is($anvil->Words->key({key => "t_0003", language => "jp"}), "#!not_found!#", "Verifying that 'Words->read' returned '#!not_found!#' for the missing 't_0003' key.");
# language
is($anvil->Words->language, "en_CA", "Verifying the default words language is 'en_CA'.");
$anvil->Words->language({set => "jp"});
is($anvil->Words->language, "jp", "Verifying the words language was changed to 'jp'.");
$anvil->Words->language({set => "en_CA"});
is($anvil->Words->language, "en_CA", "Verifying the words language is back to 'en_CA'.");
# read
### NOTE: At this time, we don't test for unreadable files (rc = 3) or general read faults as set by XML::Simple (rc = 4).
is($anvil->Words->read({file => $anvil->data->{path}{words}{'words.xml'}}), 0, "Verifying that 'Words->read' properly returned '0' when asked to read the Anvil::Tools's words file.");
is($anvil->Words->read({file => ''}), 1, "Verifying that 'Words->read' properly returned '1' when asked to read a works file without a file being passed.");
is($anvil->Words->read({file => '/tmp/dummy.xml'}), 2, "Verifying that 'Words->read' properly returned '2' when asked to read a non-existent file.");
# string
my $test_string1 = $anvil->Words->string({
key => "t_0005",
variables => {
test => "result!",
first => "1st",
second => "2nd",
},
});
is($test_string1, "
This is a multi-line test string with various items to insert.
It also has some #!invalid!# replacement #!keys!# to test the escaping and restoring.
Here is the default output language: [en_CA]
Here we will inject 't_0000': [Test replace: [result!].]
Here we will inject 't_0002' with its embedded variables: [Test Out of order: [2nd] replace: [1st].]
Here we will inject 't_0006', which injects 't_0001' which has a variable: [This string embeds 't_0001': [Test replace: [result!].]].
", "Verifying string processing in the default (Canadian English) language.");
my $test_string2 = $anvil->Words->string({
language => "jp",
key => "t_0005",
variables => {
test => "result!",
first => "1st",
second => "2nd",
},
});
is($test_string2, "
これは、挿入するさまざまな項目を含む複数行のテスト文字列です。
#!無効#!な置換!#キー!#を使ってエスケープとリストアをテストすることもできます。
デフォルトの出力言語は次のとおりです：「en_CA」
ここで、「t_0000」を挿入します：[テスト いれかえる: [result!]。]
ここでは、 「t_0002」に埋め込み変数を挿入します：「テスト、 整理: [2nd]/[1st]。」
ここでは変数 「この文字列には「t_0001」が埋め込まれています：「テスト いれかえる: [result!]。」」を持つ 「t_0001」を注入する 「t_0006」を注入します。
", "Verifying string processing in Japanese.");
### DONE!
# Tell the user that we're done making noise in their logs
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0049"});

200
AN/Tools/Alert.pm → Anvil/Tools/Alert.pm
Unescape View File

@ -1,4 +1,4 @@
package AN::Tools::Alert; package Anvil::Tools::Alert;
# #
# This module contains methods used to handle alerts and errors. # This module contains methods used to handle alerts and errors.
# #
@ -21,19 +21,19 @@ my $THIS_FILE = "Alert.pm";
=head1 NAME =head1 NAME
AN::Tools::Alert Anvil::Tools::Alert
Provides all methods related warnings and alerts. Provides all methods related warnings and alerts.
=head1 SYNOPSIS =head1 SYNOPSIS
use AN::Tools; use Anvil::Tools;
# Get a common object handle on all AN::Tools modules. # Get a common object handle on all Anvil::Tools modules.
my $an = AN::Tools->new(); my $anvil = Anvil::Tools->new();
# Access to methods using '$an->Alert->X'. Example using 'find'; # Access to methods using '$anvil->Alert->X'. Example using 'find';
my $foo_path = $an->Storage->find({file => "foo"}); my $foo_path = $anvil->Storage->find({file => "foo"});
=head1 METHODS =head1 METHODS
@ -51,7 +51,7 @@ sub new
return ($self); return ($self);
} }
# Get a handle on the AN::Tools object. I know that technically that is a sibling module, but it makes more # Get a handle on the Anvil::Tools object. I know that technically that is a sibling module, but it makes more
# sense in this case to think of it as a parent. # sense in this case to think of it as a parent.
sub parent sub parent
{ {
@ -112,14 +112,14 @@ sub check_alert_sent
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $modified_date = $parameter->{modified_date} ? $parameter->{modified_date} : $an->data->{sys}{db_timestamp}; my $modified_date = $parameter->{modified_date} ? $parameter->{modified_date} : $anvil->data->{sys}{db_timestamp};
my $name = $parameter->{name} ? $parameter->{name} : ""; my $name = $parameter->{name} ? $parameter->{name} : "";
my $record_locator = $parameter->{record_locator} ? $parameter->{record_locator} : ""; my $record_locator = $parameter->{record_locator} ? $parameter->{record_locator} : "";
my $set_by = $parameter->{set_by} ? $parameter->{set_by} : ""; my $set_by = $parameter->{set_by} ? $parameter->{set_by} : "";
my $type = $parameter->{type} ? $parameter->{type} : ""; my $type = $parameter->{type} ? $parameter->{type} : "";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
modified_date => $modified_date, modified_date => $modified_date,
name => $name, name => $name,
record_locator => $record_locator, record_locator => $record_locator,
@ -131,7 +131,7 @@ sub check_alert_sent
if (not $modified_date) if (not $modified_date)
{ {
# Nope # Nope
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0093"}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0093"});
return("!!error!!"); return("!!error!!");
} }
@ -139,7 +139,7 @@ sub check_alert_sent
if (not $name) if (not $name)
{ {
# Nope # Nope
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Alert->check_alert_sent()", parameter => "name" }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Alert->check_alert_sent()", parameter => "name" }});
return("!!error!!"); return("!!error!!");
} }
@ -147,7 +147,7 @@ sub check_alert_sent
if (not $record_locator) if (not $record_locator)
{ {
# Nope # Nope
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Alert->check_alert_sent()", parameter => "record_locator" }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Alert->check_alert_sent()", parameter => "record_locator" }});
return("!!error!!"); return("!!error!!");
} }
@ -155,7 +155,7 @@ sub check_alert_sent
if (not $set_by) if (not $set_by)
{ {
# Nope # Nope
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Alert->check_alert_sent()", parameter => "set_by" }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Alert->check_alert_sent()", parameter => "set_by" }});
return("!!error!!"); return("!!error!!");
} }
@ -163,7 +163,7 @@ sub check_alert_sent
if (not $type) if (not $type)
{ {
# Neither... # Neither...
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0097"}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0097"});
return("!!error!!"); return("!!error!!");
} }
@ -176,20 +176,20 @@ SELECT
FROM FROM
alert_sent alert_sent
WHERE WHERE
alert_sent_host_uuid = ".$an->data->{sys}{use_db_fh}->quote($an->data->{sys}{host_uuid})." alert_sent_host_uuid = ".$anvil->data->{sys}{use_db_fh}->quote($anvil->data->{sys}{host_uuid})."
AND AND
alert_set_by = ".$an->data->{sys}{use_db_fh}->quote($set_by)." alert_set_by = ".$anvil->data->{sys}{use_db_fh}->quote($set_by)."
AND AND
alert_record_locator = ".$an->data->{sys}{use_db_fh}->quote($record_locator)." alert_record_locator = ".$anvil->data->{sys}{use_db_fh}->quote($record_locator)."
AND AND
alert_name = ".$an->data->{sys}{use_db_fh}->quote($name)." alert_name = ".$anvil->data->{sys}{use_db_fh}->quote($name)."
;"; ;";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { query => $query }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { query => $query }});
# Now, if this is type=set, register the alert if it doesn't exist. If it is type=clear, remove the # Now, if this is type=set, register the alert if it doesn't exist. If it is type=clear, remove the
# alert if it exists. # alert if it exists.
my $count = $an->Database->query({query => $query, source => $THIS_FILE, line => __LINE__})->[0]->[0]; my $count = $anvil->Database->query({query => $query, source => $THIS_FILE, line => __LINE__})->[0]->[0];
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
type => $type, type => $type,
count => $count, count => $count,
}}); }});
@ -199,7 +199,7 @@ AND
# Make sure this host is in the database... It might not be on the very first run of ScanCore # Make sure this host is in the database... It might not be on the very first run of ScanCore
# before the peer exists (tried to connect to the peer, fails, tries to send an alert, but # before the peer exists (tried to connect to the peer, fails, tries to send an alert, but
# this host hasn't been added because it is the very first attempt to connect...) # this host hasn't been added because it is the very first attempt to connect...)
if (not $an->data->{sys}{host_is_in_db}) if (not $anvil->data->{sys}{host_is_in_db})
{ {
my $query = " my $query = "
SELECT SELECT
@ -207,17 +207,17 @@ SELECT
FROM FROM
hosts hosts
WHERE WHERE
host_uuid = ".$an->data->{sys}{use_db_fh}->quote($an->data->{sys}{host_uuid})." host_uuid = ".$anvil->data->{sys}{use_db_fh}->quote($anvil->data->{sys}{host_uuid})."
;"; ;";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { query => $query }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { query => $query }});
my $count = $an->Database->query({query => $query, source => $THIS_FILE, line => __LINE__})->[0]->[0]; my $count = $anvil->Database->query({query => $query, source => $THIS_FILE, line => __LINE__})->[0]->[0];
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { count => $count }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { count => $count }});
if (not $count) if (not $count)
{ {
# Too early, we can't set an alert. # Too early, we can't set an alert.
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0098", variables => { $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0098", variables => {
type => $type, type => $type,
set_by => $set_by, set_by => $set_by,
record_locator => $record_locator, record_locator => $record_locator,
@ -228,8 +228,8 @@ WHERE
} }
else else
{ {
$an->data->{sys}{host_is_in_db} = 1; $anvil->data->{sys}{host_is_in_db} = 1;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { 'sys::host_is_in_db' => $an->data->{sys}{host_is_in_db} }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { 'sys::host_is_in_db' => $anvil->data->{sys}{host_is_in_db} }});
} }
} }
@ -244,18 +244,18 @@ INSERT INTO
alert_name, alert_name,
modified_date modified_date
) VALUES ( ) VALUES (
".$an->data->{sys}{use_db_fh}->quote($an->data->{sys}{host_uuid}).", ".$anvil->data->{sys}{use_db_fh}->quote($anvil->data->{sys}{host_uuid}).",
".$an->data->{sys}{use_db_fh}->quote($set_by).", ".$anvil->data->{sys}{use_db_fh}->quote($set_by).",
".$an->data->{sys}{use_db_fh}->quote($record_locator).", ".$anvil->data->{sys}{use_db_fh}->quote($record_locator).",
".$an->data->{sys}{use_db_fh}->quote($name).", ".$anvil->data->{sys}{use_db_fh}->quote($name).",
".$an->data->{sys}{use_db_fh}->quote($an->data->{sys}{db_timestamp})." ".$anvil->data->{sys}{use_db_fh}->quote($anvil->data->{sys}{db_timestamp})."
); );
"; ";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
query => $query, query => $query,
set => $set, set => $set,
}}); }});
$an->Database->write({query => $query, source => $THIS_FILE, line => __LINE__}); $anvil->Database->write({query => $query, source => $THIS_FILE, line => __LINE__});
} }
elsif (($type eq "clear") && ($count)) elsif (($type eq "clear") && ($count))
{ {
@ -265,22 +265,22 @@ INSERT INTO
DELETE FROM DELETE FROM
alert_sent alert_sent
WHERE WHERE
alert_sent_host_uuid = ".$an->data->{sys}{use_db_fh}->quote($an->data->{sys}{host_uuid})." alert_sent_host_uuid = ".$anvil->data->{sys}{use_db_fh}->quote($anvil->data->{sys}{host_uuid})."
AND AND
alert_set_by = ".$an->data->{sys}{use_db_fh}->quote($set_by)." alert_set_by = ".$anvil->data->{sys}{use_db_fh}->quote($set_by)."
AND AND
alert_record_locator = ".$an->data->{sys}{use_db_fh}->quote($record_locator)." alert_record_locator = ".$anvil->data->{sys}{use_db_fh}->quote($record_locator)."
AND AND
alert_name = ".$an->data->{sys}{use_db_fh}->quote($name)." alert_name = ".$anvil->data->{sys}{use_db_fh}->quote($name)."
;"; ;";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
query => $query, query => $query,
set => $set, set => $set,
}}); }});
$an->Database->write({query => $query, source => $THIS_FILE, line => __LINE__}); $anvil->Database->write({query => $query, source => $THIS_FILE, line => __LINE__});
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { set => $set }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { set => $set }});
return($set); return($set);
} }
@ -295,7 +295,7 @@ sub register_alert
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $header = defined $parameter->{header} ? $parameter->{header} : 1; my $header = defined $parameter->{header} ? $parameter->{header} : 1;
my $level = defined $parameter->{level} ? $parameter->{level} : "warning"; my $level = defined $parameter->{level} ? $parameter->{level} : "warning";
@ -305,7 +305,7 @@ sub register_alert
my $sort = defined $parameter->{'sort'} ? $parameter->{'sort'} : 9999; my $sort = defined $parameter->{'sort'} ? $parameter->{'sort'} : 9999;
my $title_key = defined $parameter->{title_key} ? $parameter->{title_key} : "title_0003"; my $title_key = defined $parameter->{title_key} ? $parameter->{title_key} : "title_0003";
my $title_variables = defined $parameter->{title_variables} ? $parameter->{title_variables} : ""; my $title_variables = defined $parameter->{title_variables} ? $parameter->{title_variables} : "";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => {
header => $header, header => $header,
level => $level, level => $level,
message_key => $message_key, message_key => $message_key,
@ -318,23 +318,23 @@ sub register_alert
if (not $set_by) if (not $set_by)
{ {
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Alert->register_alert()", parameter => "set_by" }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Alert->register_alert()", parameter => "set_by" }});
return("!!error!!"); return("!!error!!");
} }
if (not $message_key) if (not $message_key)
{ {
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Alert->register_alert()", parameter => "message_key" }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Alert->register_alert()", parameter => "message_key" }});
return("!!error!!"); return("!!error!!");
} }
if (($header) && (not $title_key)) if (($header) && (not $title_key))
{ {
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0101"}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0101"});
return("!!error!!"); return("!!error!!");
} }
# zero-pad sort numbers so that they sort properly. # zero-pad sort numbers so that they sort properly.
$sort = sprintf("%04d", $sort); $sort = sprintf("%04d", $sort);
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { alert_sort => $sort }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { alert_sort => $sort }});
# Convert the hash of title variables and message variables into '!!x!y!!,!!a!b!!,...' strings. # Convert the hash of title variables and message variables into '!!x!y!!,!!a!b!!,...' strings.
if (ref($title_variables) eq "HASH") if (ref($title_variables) eq "HASH")
@ -361,43 +361,43 @@ sub register_alert
# 5 == debug # 5 == debug
# 1 == critical # 1 == critical
my $lowest_log_level = 5; my $lowest_log_level = 5;
foreach my $integer (sort {$a cmp $b} keys %{$an->data->{alerts}{recipient}}) foreach my $integer (sort {$a cmp $b} keys %{$anvil->data->{alerts}{recipient}})
{ {
# We want to know the alert level, regardless of whether the recipient is an email of file # We want to know the alert level, regardless of whether the recipient is an email of file
# target. # target.
my $this_level; my $this_level;
if ($an->data->{alerts}{recipient}{$integer}{email}) if ($anvil->data->{alerts}{recipient}{$integer}{email})
{ {
# Email recipient # Email recipient
$this_level = ($an->data->{alerts}{recipient}{$integer}{email} =~ /level="(.*?)"/)[0]; $this_level = ($anvil->data->{alerts}{recipient}{$integer}{email} =~ /level="(.*?)"/)[0];
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { this_level => $this_level }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { this_level => $this_level }});
} }
elsif ($an->data->{alerts}{recipient}{$integer}{file}) elsif ($anvil->data->{alerts}{recipient}{$integer}{file})
{ {
# File target # File target
$this_level = ($an->data->{alerts}{recipient}{$integer}{file} =~ /level="(.*?)"/)[0]; $this_level = ($anvil->data->{alerts}{recipient}{$integer}{file} =~ /level="(.*?)"/)[0];
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { this_level => $this_level }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { this_level => $this_level }});
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { this_level => $this_level }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { this_level => $this_level }});
if ($this_level) if ($this_level)
{ {
$this_level = $an->Alert->convert_level_name_to_number({level => $this_level}); $this_level = $anvil->Alert->convert_level_name_to_number({level => $this_level});
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => {
this_level => $this_level, this_level => $this_level,
lowest_log_level => $lowest_log_level, lowest_log_level => $lowest_log_level,
}}); }});
if ($this_level < $lowest_log_level) if ($this_level < $lowest_log_level)
{ {
$lowest_log_level = $this_level; $lowest_log_level = $this_level;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { lowest_log_level => $lowest_log_level }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { lowest_log_level => $lowest_log_level }});
} }
} }
} }
# Now get the numeric value of this alert and return if it is higher. # Now get the numeric value of this alert and return if it is higher.
my $this_level = $an->Alert->convert_level_name_to_number({level => $level}); my $this_level = $anvil->Alert->convert_level_name_to_number({level => $level});
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => {
alert_level => $level, alert_level => $level,
this_level => $this_level, this_level => $this_level,
lowest_log_level => $lowest_log_level, lowest_log_level => $lowest_log_level,
@ -405,7 +405,7 @@ sub register_alert
if ($this_level > $lowest_log_level) if ($this_level > $lowest_log_level)
{ {
# Return. # Return.
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 2, key => "log_0102", variables => { message_key => $message_key }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 2, key => "log_0102", variables => { message_key => $message_key }});
return(0); return(0);
} }
@ -426,21 +426,21 @@ INSERT INTO
alert_header, alert_header,
modified_date modified_date
) VALUES ( ) VALUES (
".$an->data->{sys}{use_db_fh}->quote($an->Get->uuid()).", ".$anvil->data->{sys}{use_db_fh}->quote($anvil->Get->uuid()).",
".$an->data->{sys}{use_db_fh}->quote($an->data->{sys}{host_uuid}).", ".$anvil->data->{sys}{use_db_fh}->quote($anvil->data->{sys}{host_uuid}).",
".$an->data->{sys}{use_db_fh}->quote($set_by).", ".$anvil->data->{sys}{use_db_fh}->quote($set_by).",
".$an->data->{sys}{use_db_fh}->quote($level).", ".$anvil->data->{sys}{use_db_fh}->quote($level).",
".$an->data->{sys}{use_db_fh}->quote($title_key).", ".$anvil->data->{sys}{use_db_fh}->quote($title_key).",
".$an->data->{sys}{use_db_fh}->quote($title_variables).", ".$anvil->data->{sys}{use_db_fh}->quote($title_variables).",
".$an->data->{sys}{use_db_fh}->quote($message_key).", ".$anvil->data->{sys}{use_db_fh}->quote($message_key).",
".$an->data->{sys}{use_db_fh}->quote($message_variables).", ".$anvil->data->{sys}{use_db_fh}->quote($message_variables).",
".$an->data->{sys}{use_db_fh}->quote($sort).", ".$anvil->data->{sys}{use_db_fh}->quote($sort).",
".$an->data->{sys}{use_db_fh}->quote($header).", ".$anvil->data->{sys}{use_db_fh}->quote($header).",
".$an->data->{sys}{use_db_fh}->quote($an->data->{sys}{db_timestamp})." ".$anvil->data->{sys}{use_db_fh}->quote($anvil->data->{sys}{db_timestamp})."
); );
"; ";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { query => $query }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { query => $query }});
$an->Database->write({query => $query, source => $THIS_FILE, line => __LINE__}); $anvil->Database->write({query => $query, source => $THIS_FILE, line => __LINE__});
return(0); return(0);
} }
@ -454,23 +454,23 @@ sub error
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
# $an->Log->entry({log_level => 2, title_key => "tools_log_0001", title_variables => { function => "error" }, message_key => "tools_log_0002", file => $THIS_FILE, line => __LINE__}); # $anvil->Log->entry({log_level => 2, title_key => "tools_log_0001", title_variables => { function => "error" }, message_key => "tools_log_0002", file => $THIS_FILE, line => __LINE__});
# #
# # Setup default values # # Setup default values
# my $title_key = $parameter->{title_key} ? $parameter->{title_key} : $an->String->get({key => "an_0004"}); # my $title_key = $parameter->{title_key} ? $parameter->{title_key} : $anvil->String->get({key => "an_0004"});
# my $title_variables = $parameter->{title_variables} ? $parameter->{title_variables} : ""; # my $title_variables = $parameter->{title_variables} ? $parameter->{title_variables} : "";
# my $message_key = $parameter->{message_key} ? $parameter->{message_key} : $an->String->get({key => "an_0005"}); # my $message_key = $parameter->{message_key} ? $parameter->{message_key} : $anvil->String->get({key => "an_0005"});
# my $message_variables = $parameter->{message_variables} ? $parameter->{message_variables} : ""; # my $message_variables = $parameter->{message_variables} ? $parameter->{message_variables} : "";
# my $code = $parameter->{code} ? $parameter->{code} : 1; # my $code = $parameter->{code} ? $parameter->{code} : 1;
# my $file = $parameter->{file} ? $parameter->{file} : $an->String->get({key => "an_0006"}); # my $file = $parameter->{file} ? $parameter->{file} : $anvil->String->get({key => "an_0006"});
# my $line = $parameter->{line} ? $parameter->{line} : ""; # my $line = $parameter->{line} ? $parameter->{line} : "";
# #print "$THIS_FILE ".__LINE__."; title_key: [$title_key], title_variables: [$title_variables], message_key: [$message_key], message_variables: [$message_variables], code: [$code], file: [$file], line: [$line]\n"; # #print "$THIS_FILE ".__LINE__."; title_key: [$title_key], title_variables: [$title_variables], message_key: [$message_key], message_variables: [$message_variables], code: [$code], file: [$file], line: [$line]\n";
# #
# # It is possible for this to become a run-away call, so this helps # # It is possible for this to become a run-away call, so this helps
# # catch when that happens. # # catch when that happens.
# $an->_error_count($an->_error_count + 1); # $anvil->_error_count($anvil->_error_count + 1);
# if ($an->_error_count > $an->_error_limit) # if ($anvil->_error_count > $anvil->_error_limit)
# { # {
# print "Infinite loop detected while trying to print an error:\n"; # print "Infinite loop detected while trying to print an error:\n";
# print "- title_key: [$title_key]\n"; # print "- title_key: [$title_key]\n";
@ -496,7 +496,7 @@ sub error
# #print "$THIS_FILE ".__LINE__."; title_key: [$title_key]\n"; # #print "$THIS_FILE ".__LINE__."; title_key: [$title_key]\n";
# if ($title_key =~ /\w+_\d+$/) # if ($title_key =~ /\w+_\d+$/)
# { # {
# $title_key = $an->String->get({ # $title_key = $anvil->String->get({
# key => $title_key, # key => $title_key,
# variables => $title_variables, # variables => $title_variables,
# }); # });
@ -507,7 +507,7 @@ sub error
# #print "$THIS_FILE ".__LINE__."; message_key: [$message_key]\n"; # #print "$THIS_FILE ".__LINE__."; message_key: [$message_key]\n";
# if ($message_key =~ /\w+_\d+$/) # if ($message_key =~ /\w+_\d+$/)
# { # {
# $message_key = $an->String->get({ # $message_key = $anvil->String->get({
# key => $message_key, # key => $message_key,
# variables => $message_variables, # variables => $message_variables,
# }); # });
@ -515,15 +515,15 @@ sub error
# } # }
# #
# # Set my error string # # Set my error string
# my $fatal_heading = $an->String->get({key => "an_0002"}); # my $fatal_heading = $anvil->String->get({key => "an_0002"});
# #print "$THIS_FILE ".__LINE__."; fatal_heading: [$fatal_heading]\n"; # #print "$THIS_FILE ".__LINE__."; fatal_heading: [$fatal_heading]\n";
# #
# my $readable_line = $an->Readable->comma($line); # my $readable_line = $anvil->Readable->comma($line);
# #print "$THIS_FILE ".__LINE__."; readable_line: [$readable_line]\n"; # #print "$THIS_FILE ".__LINE__."; readable_line: [$readable_line]\n";
# #
# ### TODO: Copy this to 'warning'. # ### TODO: Copy this to 'warning'.
# # At this point, the title and message keys are the actual messages. # # At this point, the title and message keys are the actual messages.
# my $error = "\n".$an->String->get({ # my $error = "\n".$anvil->String->get({
# key => "an_0007", # key => "an_0007",
# variables => { # variables => {
# code => $code, # code => $code,
@ -537,37 +537,37 @@ sub error
# #print "$THIS_FILE ".__LINE__."; error: [$error]\n"; # #print "$THIS_FILE ".__LINE__."; error: [$error]\n";
# #
# # Set the internal error flags # # Set the internal error flags
# $an->Alert->_set_error($error); # $anvil->Alert->_set_error($error);
# $an->Alert->_set_error_code($code); # $anvil->Alert->_set_error_code($code);
# #
# # Append "exiting" to the error string if it is fatal. # # Append "exiting" to the error string if it is fatal.
# $error .= $an->String->get({key => "an_0008"})."\n"; # $error .= $anvil->String->get({key => "an_0008"})."\n";
# #
# # Write a copy of the error to the log. # # Write a copy of the error to the log.
# $an->Log->entry({file => $THIS_FILE, level => 0, raw => $error}); # $anvil->Log->entry({file => $THIS_FILE, level => 0, raw => $error});
# #
# # If this is a browser calling us, print the footer so that the loading pinwheel goes away. # # If this is a browser calling us, print the footer so that the loading pinwheel goes away.
# if ($ENV{'HTTP_REFERER'}) # if ($ENV{'HTTP_REFERER'})
# { # {
# $an->Striker->_footer(); # $anvil->Striker->_footer();
# } # }
# #
# # Don't actually die, but do print the error, if fatal errors have been globally disabled (as is done # # Don't actually die, but do print the error, if fatal errors have been globally disabled (as is done
# # in the tests). # # in the tests).
# if (not $an->Alert->no_fatal_errors) # if (not $anvil->Alert->no_fatal_errors)
# { # {
# if ($ENV{'HTTP_REFERER'}) # if ($ENV{'HTTP_REFERER'})
# { # {
# print "<pre>\n"; # print "<pre>\n";
# print "$error\n" if not $an->Alert->no_fatal_errors; # print "$error\n" if not $anvil->Alert->no_fatal_errors;
# print "</pre>\n"; # print "</pre>\n";
# } # }
# else # else
# { # {
# print "$error\n" if not $an->Alert->no_fatal_errors; # print "$error\n" if not $anvil->Alert->no_fatal_errors;
# } # }
# $an->data->{sys}{footer_printed} = 1; # $anvil->data->{sys}{footer_printed} = 1;
# $an->nice_exit({exit_code => $code}); # $anvil->nice_exit({exit_code => $code});
# } # }
# #
# return ($code); # return ($code);

98
AN/Tools/Convert.pm → Anvil/Tools/Convert.pm
Unescape View File

@ -1,4 +1,4 @@
package AN::Tools::Convert; package Anvil::Tools::Convert;
# #
# This module contains methods used to convert data between types # This module contains methods used to convert data between types
# #
@ -26,21 +26,21 @@ my $THIS_FILE = "Convert.pm";
=head1 NAME =head1 NAME
AN::Tools::Convert Anvil::Tools::Convert
Provides all methods related to converting data. Provides all methods related to converting data.
=head1 SYNOPSIS =head1 SYNOPSIS
use AN::Tools; use Anvil::Tools;
# Get a common object handle on all AN::Tools modules. # Get a common object handle on all Anvil::Tools modules.
my $an = AN::Tools->new(); my $anvil = Anvil::Tools->new();
# Access to methods using '$an->Convert->X'. # Access to methods using '$anvil->Convert->X'.
# #
# Example using 'cidr()'; # Example using 'cidr()';
my $subnet = $an->Convert->codr({cidr => "24"}); my $subnet = $anvil->Convert->codr({cidr => "24"});
=head1 METHODS =head1 METHODS
@ -57,7 +57,7 @@ sub new
return ($self); return ($self);
} }
# Get a handle on the AN::Tools object. I know that technically that is a sibling module, but it makes more # Get a handle on the Anvil::Tools object. I know that technically that is a sibling module, but it makes more
# sense in this case to think of it as a parent. # sense in this case to think of it as a parent.
sub parent sub parent
{ {
@ -97,16 +97,16 @@ sub add_commas
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
# Now see if the user passed the values in a hash reference or directly. # Now see if the user passed the values in a hash reference or directly.
my $number = defined $parameter->{number} ? $parameter->{number} : ""; my $number = defined $parameter->{number} ? $parameter->{number} : "";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { number => $number }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { number => $number }});
# Remove any existing commands or leading '+' signs. # Remove any existing commands or leading '+' signs.
$number =~ s/,//g; $number =~ s/,//g;
$number =~ s/^\+//g; $number =~ s/^\+//g;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { number => $number }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { number => $number }});
# Split on the left-most period. # Split on the left-most period.
my ($whole, $decimal) = split/\./, $number, 2; my ($whole, $decimal) = split/\./, $number, 2;
@ -116,7 +116,7 @@ sub add_commas
# Now die if either number has a non-digit character in it. # Now die if either number has a non-digit character in it.
if (($whole =~ /\D/) or ($decimal =~ /\D/)) if (($whole =~ /\D/) or ($decimal =~ /\D/))
{ {
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { number => $number }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { number => $number }});
return ($number); return ($number);
} }
@ -128,7 +128,7 @@ sub add_commas
# Put it together # Put it together
$number = $decimal ? "$whole.$decimal" : $whole; $number = $decimal ? "$whole.$decimal" : $whole;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { number => $number }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { number => $number }});
return ($number); return ($number);
} }
@ -183,13 +183,13 @@ sub bytes_to_human_readable
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
# Now see if the user passed the values in a hash reference or directly. # Now see if the user passed the values in a hash reference or directly.
my $size = defined $parameter->{'bytes'} ? $parameter->{'bytes'} : 0; my $size = defined $parameter->{'bytes'} ? $parameter->{'bytes'} : 0;
my $unit = defined $parameter->{unit} ? uc($parameter->{unit}) : ""; my $unit = defined $parameter->{unit} ? uc($parameter->{unit}) : "";
my $base2 = defined $parameter->{base2} ? $parameter->{base2} : $an->data->{sys}{use_base2}; my $base2 = defined $parameter->{base2} ? $parameter->{base2} : $anvil->data->{sys}{use_base2};
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
size => $size, size => $size,
unit => $unit, unit => $unit,
base2 => $base2, base2 => $base2,
@ -224,7 +224,7 @@ sub bytes_to_human_readable
# Die if either the 'time' or 'float' has a non-digit character in it. # Die if either the 'time' or 'float' has a non-digit character in it.
if ($human_readable_size =~ /\D/) if ($human_readable_size =~ /\D/)
{ {
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0116", variables => { $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0116", variables => {
method => "Convert->bytes_to_human_readable()", method => "Convert->bytes_to_human_readable()",
parameter => "hostnmae", parameter => "hostnmae",
value => $human_readable_size, value => $human_readable_size,
@ -467,7 +467,7 @@ sub bytes_to_human_readable
} }
# If needed, insert commas # If needed, insert commas
$human_readable_size = $an->Convert->add_commas({number => $human_readable_size}); $human_readable_size = $anvil->Convert->add_commas({number => $human_readable_size});
# Restore the sign. # Restore the sign.
if ($sign) if ($sign)
@ -484,12 +484,12 @@ sub bytes_to_human_readable
This takes an IPv4 CIDR notation and returns the dotted-decimal subnet, or the reverse. This takes an IPv4 CIDR notation and returns the dotted-decimal subnet, or the reverse.
# Convert a CIDR notation to a subnet. # Convert a CIDR notation to a subnet.
my $subnet = $an->Convert->cidr({cidr => "24"}); my $subnet = $anvil->Convert->cidr({cidr => "24"});
In the other direction; In the other direction;
# Convert a subnet to a CIDR notation. # Convert a subnet to a CIDR notation.
my $cidr = $an->Convert->cidr({subnet => "255.255.255.0"}); my $cidr = $anvil->Convert->cidr({subnet => "255.255.255.0"});
If the input data is invalid, an empty string will be returned. If the input data is invalid, an empty string will be returned.
@ -510,12 +510,12 @@ sub cidr
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $cidr = defined $parameter->{cidr} ? $parameter->{cidr} : ""; my $cidr = defined $parameter->{cidr} ? $parameter->{cidr} : "";
my $subnet = defined $parameter->{subnet} ? $parameter->{subnet} : ""; my $subnet = defined $parameter->{subnet} ? $parameter->{subnet} : "";
my $output = ""; my $output = "";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
cidr => $cidr, cidr => $cidr,
subnet => $subnet, subnet => $subnet,
}}); }});
@ -557,7 +557,7 @@ sub cidr
elsif ($cidr eq "31") { $output = "255.255.255.254"; } elsif ($cidr eq "31") { $output = "255.255.255.254"; }
elsif ($cidr eq "32") { $output = "255.255.255.255"; } elsif ($cidr eq "32") { $output = "255.255.255.255"; }
} }
elsif ($an->Validate->is_ipv4({ip => $subnet})) elsif ($anvil->Validate->is_ipv4({ip => $subnet}))
{ {
if ($subnet eq "0.0.0.0" ) { $output = "0"; } if ($subnet eq "0.0.0.0" ) { $output = "0"; }
elsif ($subnet eq "128.0.0.0" ) { $output = "1"; } elsif ($subnet eq "128.0.0.0" ) { $output = "1"; }
@ -594,7 +594,7 @@ sub cidr
elsif ($subnet eq "255.255.255.255" ) { $output = "32"; } elsif ($subnet eq "255.255.255.255" ) { $output = "32"; }
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { output => $output }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { output => $output }});
return($output); return($output);
} }
@ -613,30 +613,30 @@ sub hostname_to_ip
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $hostname = defined $parameter->{hostname} ? $parameter->{hostname} : ""; my $hostname = defined $parameter->{hostname} ? $parameter->{hostname} : "";
my $ip = 0; my $ip = 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { hostname => $hostname }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { hostname => $hostname }});
if (not $hostname) if (not $hostname)
{ {
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Convert->hostname_to_ip()", parameter => "hostnmae" }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Convert->hostname_to_ip()", parameter => "hostnmae" }});
return($ip); return($ip);
} }
### TODO: Check local cached information later. ### TODO: Check local cached information later.
# Try to resolve it using 'gethostip'. # Try to resolve it using 'gethostip'.
my $output = $an->System->call({shell_call => $an->data->{path}{exe}{gethostip}." -d $hostname"}); my $output = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{gethostip}." -d $hostname"});
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { output => $output }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { output => $output }});
foreach my $line (split/\n/, $output) foreach my $line (split/\n/, $output)
{ {
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { line => $line }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { line => $line }});
if ($an->Validate->is_ipv4({ip => $line})) if ($anvil->Validate->is_ipv4({ip => $line}))
{ {
$ip = $line; $ip = $line;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { ip => $ip }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { ip => $ip }});
} }
} }
@ -676,13 +676,13 @@ sub human_readable_to_bytes
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $base2 = defined $parameter->{base2} ? $parameter->{base2} : 0; my $base2 = defined $parameter->{base2} ? $parameter->{base2} : 0;
my $base10 = defined $parameter->{base10} ? $parameter->{base10} : 0; my $base10 = defined $parameter->{base10} ? $parameter->{base10} : 0;
my $size = defined $parameter->{size} ? $parameter->{size} : 0; my $size = defined $parameter->{size} ? $parameter->{size} : 0;
my $type = defined $parameter->{type} ? $parameter->{type} : 0; my $type = defined $parameter->{type} ? $parameter->{type} : 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
base2 => $base2, base2 => $base2,
base10 => $base10, base10 => $base10,
size => $size, size => $size,
@ -693,7 +693,7 @@ sub human_readable_to_bytes
my $value = $size; my $value = $size;
$size =~ s/ //g; $size =~ s/ //g;
$type =~ s/ //g; $type =~ s/ //g;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { size => $size, value => $value }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { size => $size, value => $value }});
# Store and strip the sign, if passed # Store and strip the sign, if passed
my $sign = ""; my $sign = "";
@ -710,7 +710,7 @@ sub human_readable_to_bytes
# Strip any commas # Strip any commas
$size =~ s/,//g; $size =~ s/,//g;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { size => $size, sign => $sign }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { size => $size, sign => $sign }});
# If I don't have a passed type, see if there is a letter or letters after the size to hack off. # If I don't have a passed type, see if there is a letter or letters after the size to hack off.
if ((not $type) && ($size =~ /[a-zA-Z]$/)) if ((not $type) && ($size =~ /[a-zA-Z]$/))
@ -720,13 +720,13 @@ sub human_readable_to_bytes
} }
# Make the type lower close for simplicity. # Make the type lower close for simplicity.
$type = lc($type); $type = lc($type);
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { size => $size, type => $type }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { size => $size, type => $type }});
# Make sure that 'size' is now an integer or float. # Make sure that 'size' is now an integer or float.
if ($size !~ /\d+[\.\d+]?/) if ($size !~ /\d+[\.\d+]?/)
{ {
# Something illegal was passed. # Something illegal was passed.
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0117", variables => { $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0117", variables => {
size => $size, size => $size,
sign => $sign, sign => $sign,
type => $type, type => $type,
@ -743,7 +743,7 @@ sub human_readable_to_bytes
# Something illegal was passed. # Something illegal was passed.
if ($size =~ /\D/) if ($size =~ /\D/)
{ {
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0118", variables => { $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0118", variables => {
size => $size, size => $size,
sign => $sign, sign => $sign,
type => $type, type => $type,
@ -776,7 +776,7 @@ sub human_readable_to_bytes
# Clear up the last characters now. # Clear up the last characters now.
$type =~ s/^(\w).*/$1/; $type =~ s/^(\w).*/$1/;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { type => $type }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { type => $type }});
# Check if we have a valid type. # Check if we have a valid type.
if (($type ne "p") && if (($type ne "p") &&
@ -789,7 +789,7 @@ sub human_readable_to_bytes
($type ne "k")) ($type ne "k"))
{ {
# Poop # Poop
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0119", variables => { $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0119", variables => {
value => $value, value => $value,
size => $size, size => $size,
type => $type, type => $type,
@ -799,7 +799,7 @@ sub human_readable_to_bytes
# Now the magic... lame magic, true, but still. # Now the magic... lame magic, true, but still.
my $bytes = 0; my $bytes = 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { base2 => $base2, base10 => $base10 }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { base2 => $base2, base10 => $base10 }});
if ($base10) if ($base10)
{ {
if ($type eq "y") { $bytes = Math::BigInt->new('10')->bpow('24')->bmul($size); } # Yottabyte if ($type eq "y") { $bytes = Math::BigInt->new('10')->bpow('24')->bmul($size); } # Yottabyte
@ -810,7 +810,7 @@ sub human_readable_to_bytes
elsif ($type eq "g") { $bytes = ($size * (10 ** 9)) } # Gigabyte elsif ($type eq "g") { $bytes = ($size * (10 ** 9)) } # Gigabyte
elsif ($type eq "m") { $bytes = ($size * (10 ** 6)) } # Megabyte elsif ($type eq "m") { $bytes = ($size * (10 ** 6)) } # Megabyte
elsif ($type eq "k") { $bytes = ($size * (10 ** 3)) } # Kilobyte elsif ($type eq "k") { $bytes = ($size * (10 ** 3)) } # Kilobyte
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { 'bytes' => $bytes }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { 'bytes' => $bytes }});
} }
else else
{ {
@ -822,13 +822,13 @@ sub human_readable_to_bytes
elsif ($type eq "g") { $bytes = ($size * (2 ** 30)) } # Gibibyte elsif ($type eq "g") { $bytes = ($size * (2 ** 30)) } # Gibibyte
elsif ($type eq "m") { $bytes = ($size * (2 ** 20)) } # Mebibyte elsif ($type eq "m") { $bytes = ($size * (2 ** 20)) } # Mebibyte
elsif ($type eq "k") { $bytes = ($size * (2 ** 10)) } # Kibibyte elsif ($type eq "k") { $bytes = ($size * (2 ** 10)) } # Kibibyte
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { 'bytes' => $bytes }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { 'bytes' => $bytes }});
} }
# Last, round off the byte size if it is a float. # Last, round off the byte size if it is a float.
if ($bytes =~ /\./) if ($bytes =~ /\./)
{ {
$bytes = $an->Convert->round({ $bytes = $anvil->Convert->round({
number => $bytes, number => $bytes,
places => 0 places => 0
}); });
@ -839,7 +839,7 @@ sub human_readable_to_bytes
$bytes = $sign.$bytes; $bytes = $sign.$bytes;
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { 'bytes' => $bytes }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { 'bytes' => $bytes }});
return ($bytes); return ($bytes);
} }
@ -864,12 +864,12 @@ sub round
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
# Setup my numbers. # Setup my numbers.
my $number = $parameter->{number} ? $parameter->{number} : 0; my $number = $parameter->{number} ? $parameter->{number} : 0;
my $places = $parameter->{places} ? $parameter->{places} : 0; my $places = $parameter->{places} ? $parameter->{places} : 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => {
number => $number, number => $number,
places => $places, places => $places,
}}); }});
@ -893,7 +893,7 @@ sub round
# If there is anything other than one ',' and digits, error. # If there is anything other than one ',' and digits, error.
if (($real =~ /\D/) or ($decimal =~ /\D/)) if (($real =~ /\D/) or ($decimal =~ /\D/))
{ {
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0120", variables => { number => $number }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0120", variables => { number => $number }});
return ("!!error!!"); return ("!!error!!");
} }

1616
AN/Tools/Database.pm → Anvil/Tools/Database.pm
View File

File diff suppressed because it is too large Load Diff

186
AN/Tools/Get.pm → Anvil/Tools/Get.pm
Unescape View File

@ -1,4 +1,4 @@
package AN::Tools::Get; package Anvil::Tools::Get;
# #
# This module contains methods used to handle access to frequently used data. # This module contains methods used to handle access to frequently used data.
# #
@ -27,21 +27,21 @@ my $THIS_FILE = "Get.pm";
=head1 NAME =head1 NAME
AN::Tools::Get Anvil::Tools::Get
Provides all methods related to getting access to frequently used data. Provides all methods related to getting access to frequently used data.
=head1 SYNOPSIS =head1 SYNOPSIS
use AN::Tools; use Anvil::Tools;
# Get a common object handle on all AN::Tools modules. # Get a common object handle on all Anvil::Tools modules.
my $an = AN::Tools->new(); my $anvil = Anvil::Tools->new();
# Access to methods using '$an->Get->X'. # Access to methods using '$anvil->Get->X'.
# #
# Example using 'date_and_time()'; # Example using 'date_and_time()';
my $foo_path = $an->Get->date_and_time({...}); my $foo_path = $anvil->Get->date_and_time({...});
=head1 METHODS =head1 METHODS
@ -62,7 +62,7 @@ sub new
return ($self); return ($self);
} }
# Get a handle on the AN::Tools object. I know that technically that is a sibling module, but it makes more # Get a handle on the Anvil::Tools object. I know that technically that is a sibling module, but it makes more
# sense in this case to think of it as a parent. # sense in this case to think of it as a parent.
sub parent sub parent
{ {
@ -98,10 +98,10 @@ sub cgi
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
# This will store all of the CGI variables. # This will store all of the CGI variables.
$an->data->{sys}{cgi_string} = "?"; $anvil->data->{sys}{cgi_string} = "?";
# Needed to read in passed CGI variables # Needed to read in passed CGI variables
my $cgi = CGI->new(); my $cgi = CGI->new();
@ -112,16 +112,16 @@ sub cgi
if (defined $cgi->param("cgi_list")) if (defined $cgi->param("cgi_list"))
{ {
my $cgi_list = $cgi->param("cgi_list"); my $cgi_list = $cgi->param("cgi_list");
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { cgi_list => $cgi_list }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { cgi_list => $cgi_list }});
foreach my $variable (split/,/, $cgi_list) foreach my $variable (split/,/, $cgi_list)
{ {
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { variable => $variable }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { variable => $variable }});
push @{$cgis}, $variable; push @{$cgis}, $variable;
} }
$cgi_count = @{$cgis}; $cgi_count = @{$cgis};
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { cgi_count => $cgi_count }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { cgi_count => $cgi_count }});
} }
# If we don't have at least one variable, we're done. # If we don't have at least one variable, we're done.
@ -134,29 +134,29 @@ sub cgi
# Now read in the variables. # Now read in the variables.
foreach my $variable (sort {$a cmp $b} @{$cgis}) foreach my $variable (sort {$a cmp $b} @{$cgis})
{ {
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { variable => $variable }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { variable => $variable }});
$an->data->{cgi}{$variable}{value} = ""; $anvil->data->{cgi}{$variable}{value} = "";
$an->data->{cgi}{$variable}{mimetype} = "string"; $anvil->data->{cgi}{$variable}{mimetype} = "string";
$an->data->{cgi}{$variable}{filehandle} = ""; $anvil->data->{cgi}{$variable}{filehandle} = "";
$an->data->{cgi}{$variable}{alert} = 0; # This is set if a sanity check fails $anvil->data->{cgi}{$variable}{alert} = 0; # This is set if a sanity check fails
if ($variable eq "file") if ($variable eq "file")
{ {
if (not $cgi->upload($variable)) if (not $cgi->upload($variable))
{ {
# Empty file passed, looks like the user forgot to select a file to upload. # Empty file passed, looks like the user forgot to select a file to upload.
#$an->Log->entry({log_level => 3, message_key => "log_0016", file => $THIS_FILE, line => __LINE__}); #$anvil->Log->entry({log_level => 3, message_key => "log_0016", file => $THIS_FILE, line => __LINE__});
} }
else else
{ {
$an->data->{cgi}{$variable}{filehandle} = $cgi->upload($variable); $anvil->data->{cgi}{$variable}{filehandle} = $cgi->upload($variable);
my $file = $an->data->{cgi}{$variable}{filehandle}; my $file = $anvil->data->{cgi}{$variable}{filehandle};
$an->data->{cgi}{$variable}{mimetype} = $cgi->uploadInfo($file)->{'Content-Type'}; $anvil->data->{cgi}{$variable}{mimetype} = $cgi->uploadInfo($file)->{'Content-Type'};
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => {
variable => $variable, variable => $variable,
"cgi::${variable}::filehandle" => $an->data->{cgi}{$variable}{filehandle}, "cgi::${variable}::filehandle" => $anvil->data->{cgi}{$variable}{filehandle},
"cgi::${variable}::mimetype" => $an->data->{cgi}{$variable}{mimetype}, "cgi::${variable}::mimetype" => $anvil->data->{cgi}{$variable}{mimetype},
}}); }});
} }
} }
@ -166,17 +166,17 @@ sub cgi
# Make this UTF8 if it isn't already. # Make this UTF8 if it isn't already.
if (Encode::is_utf8($cgi->param($variable))) if (Encode::is_utf8($cgi->param($variable)))
{ {
$an->data->{cgi}{$variable}{value} = $cgi->param($variable); $anvil->data->{cgi}{$variable}{value} = $cgi->param($variable);
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { "cgi::${variable}::value" => $an->data->{cgi}{$variable}{value} }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { "cgi::${variable}::value" => $anvil->data->{cgi}{$variable}{value} }});
} }
else else
{ {
$an->data->{cgi}{$variable}{value} = Encode::decode_utf8($cgi->param($variable)); $anvil->data->{cgi}{$variable}{value} = Encode::decode_utf8($cgi->param($variable));
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { "cgi::${variable}::value" => $an->data->{cgi}{$variable}{value} }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { "cgi::${variable}::value" => $anvil->data->{cgi}{$variable}{value} }});
} }
# Append to 'sys::cgi_string' # Append to 'sys::cgi_string'
$an->data->{sys}{cgi_string} .= "$variable=".$an->data->{cgi}{$variable}{value}."&"; $anvil->data->{sys}{cgi_string} .= "$variable=".$anvil->data->{cgi}{$variable}{value}."&";
} }
} }
@ -184,12 +184,12 @@ sub cgi
# sorts out the longest variable name. Then it loops again, appending '.' to shorter ones so that # sorts out the longest variable name. Then it loops again, appending '.' to shorter ones so that
# everything is lined up in the logs. # everything is lined up in the logs.
my $debug = 2; my $debug = 2;
if ($an->Log->level >= $debug) if ($anvil->Log->level >= $debug)
{ {
my $longest_variable = 0; my $longest_variable = 0;
foreach my $variable (sort {$a cmp $b} keys %{$an->data->{cgi}}) foreach my $variable (sort {$a cmp $b} keys %{$anvil->data->{cgi}})
{ {
next if $an->data->{cgi}{$variable} eq ""; next if $anvil->data->{cgi}{$variable} eq "";
if (length($variable) > $longest_variable) if (length($variable) > $longest_variable)
{ {
$longest_variable = length($variable); $longest_variable = length($variable);
@ -199,7 +199,7 @@ sub cgi
# Now loop again in the order that the variables were passed is 'cgi_list'. # Now loop again in the order that the variables were passed is 'cgi_list'.
foreach my $variable (@{$cgis}) foreach my $variable (@{$cgis})
{ {
next if $an->data->{cgi}{$variable} eq ""; next if $anvil->data->{cgi}{$variable} eq "";
my $difference = $longest_variable - length($variable); my $difference = $longest_variable - length($variable);
my $say_value = "value"; my $say_value = "value";
if ($difference == 0) if ($difference == 0)
@ -224,15 +224,15 @@ sub cgi
} }
$say_value .= " "; $say_value .= " ";
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
"cgi::${variable}::$say_value" => $an->data->{cgi}{$variable}{value}, "cgi::${variable}::$say_value" => $anvil->data->{cgi}{$variable}{value},
}}); }});
} }
} }
# Clear the last & # Clear the last &
$an->data->{sys}{cgi_string} =~ s/&$//; $anvil->data->{sys}{cgi_string} =~ s/&$//;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { "sys::cgi_string" => $an->data->{sys}{cgi_string} }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { "sys::cgi_string" => $anvil->data->{sys}{cgi_string} }});
return(0); return(0);
} }
@ -270,7 +270,7 @@ sub date_and_time
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $offset = defined $parameter->{offset} ? $parameter->{offset} : 0; my $offset = defined $parameter->{offset} ? $parameter->{offset} : 0;
my $use_time = defined $parameter->{use_time} ? $parameter->{use_time} : time; my $use_time = defined $parameter->{use_time} ? $parameter->{use_time} : time;
@ -335,32 +335,32 @@ sub date_and_time
This returns the local host's system UUID (as reported by 'dmidecode'). This returns the local host's system UUID (as reported by 'dmidecode').
print "This host's UUID: [".$an->Get->host_uuid."]\n"; print "This host's UUID: [".$anvil->Get->host_uuid."]\n";
It is possible to override the local UUID, though it is not recommended. It is possible to override the local UUID, though it is not recommended.
$an->Get->host_uuid({set => "720a0509-533d-406b-8fc1-03aca3e75fa7"}) $anvil->Get->host_uuid({set => "720a0509-533d-406b-8fc1-03aca3e75fa7"})
=cut =cut
sub host_uuid sub host_uuid
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $set = defined $parameter->{set} ? $parameter->{set} : ""; my $set = defined $parameter->{set} ? $parameter->{set} : "";
if ($set) if ($set)
{ {
$an->data->{HOST}{UUID} = $set; $anvil->data->{HOST}{UUID} = $set;
} }
elsif (not $an->data->{HOST}{UUID}) elsif (not $anvil->data->{HOST}{UUID})
{ {
# Read dmidecode if I am root, and the cache if not. # Read dmidecode if I am root, and the cache if not.
my $uuid = ""; my $uuid = "";
if (($< == 0) or ($> == 0)) if (($< == 0) or ($> == 0))
{ {
my $shell_call = $an->data->{path}{exe}{dmidecode}." --string system-uuid"; my $shell_call = $anvil->data->{path}{exe}{dmidecode}." --string system-uuid";
#print $THIS_FILE." ".__LINE__."; [ Debug ] - shell_call: [$shell_call]\n"; #print $THIS_FILE." ".__LINE__."; [ Debug ] - shell_call: [$shell_call]\n";
open(my $file_handle, $shell_call." 2>&1 |") or warn $THIS_FILE." ".__LINE__."; [ Warning ] - Failed to call: [".$shell_call."], the error was: $!\n"; open(my $file_handle, $shell_call." 2>&1 |") or warn $THIS_FILE." ".__LINE__."; [ Warning ] - Failed to call: [".$shell_call."], the error was: $!\n";
while(<$file_handle>) while(<$file_handle>)
@ -376,45 +376,45 @@ sub host_uuid
{ {
# Not running as root, so I have to rely on the cache file, or die if it doesn't # Not running as root, so I have to rely on the cache file, or die if it doesn't
# exist. # exist.
if (not -e $an->data->{path}{data}{host_uuid}) if (not -e $anvil->data->{path}{data}{host_uuid})
{ {
# We're done. # We're done.
die $THIS_FILE." ".__LINE__."; UUID cache file: [".$an->data->{path}{data}{host_uuid}."] doesn't exists and we're not running as root. Unable to proceed.\n"; die $THIS_FILE." ".__LINE__."; UUID cache file: [".$anvil->data->{path}{data}{host_uuid}."] doesn't exists and we're not running as root. Unable to proceed.\n";
} }
else else
{ {
$uuid = $an->Storage->read_file({ file => $an->data->{path}{data}{host_uuid} }); $uuid = $anvil->Storage->read_file({ file => $anvil->data->{path}{data}{host_uuid} });
} }
} }
if ($an->Validate->is_uuid({uuid => $uuid})) if ($anvil->Validate->is_uuid({uuid => $uuid}))
{ {
$an->data->{HOST}{UUID} = $uuid; $anvil->data->{HOST}{UUID} = $uuid;
if (not -e $an->data->{path}{data}{host_uuid}) if (not -e $anvil->data->{path}{data}{host_uuid})
{ {
### TODO: This will need to set the proper SELinux context. ### TODO: This will need to set the proper SELinux context.
# Apache run scripts can't call the system UUID, so we'll write it to a text # Apache run scripts can't call the system UUID, so we'll write it to a text
# file. # file.
$an->Storage->write_file({ $anvil->Storage->write_file({
file => $an->data->{path}{data}{host_uuid}, file => $anvil->data->{path}{data}{host_uuid},
body => $uuid, body => $uuid,
user => "apache", user => "apache",
group => "apache", group => "apache",
mode => "0666", mode => "0666",
overwrite => 0, overwrite => 0,
}); });
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "message_0011", variables => { file => $an->data->{path}{configs}{'postgresql.conf'} }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "message_0011", variables => { file => $anvil->data->{path}{configs}{'postgresql.conf'} }});
} }
} }
else else
{ {
# Bad UUID. # Bad UUID.
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0134", variables => { uuid => $uuid }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0134", variables => { uuid => $uuid }});
$an->data->{HOST}{UUID} = ""; $anvil->data->{HOST}{UUID} = "";
} }
} }
return($an->data->{HOST}{UUID}); return($anvil->data->{HOST}{UUID});
} }
=head2 network_details =head2 network_details
@ -432,12 +432,12 @@ sub network_details
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $network = {}; my $network = {};
my $hostname = $an->System->call({shell_call => $an->data->{path}{exe}{hostname}}); my $hostname = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{hostname}});
my $ip_addr_list = $an->System->call({shell_call => $an->data->{path}{exe}{ip}." addr list"}); my $ip_addr_list = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{ip}." addr list"});
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
hostname => $hostname, hostname => $hostname,
ip_addr_list => $ip_addr_list, ip_addr_list => $ip_addr_list,
}}); }});
@ -448,13 +448,13 @@ sub network_details
my $subnet_mask = ""; my $subnet_mask = "";
foreach my $line (split/\n/, $ip_addr_list) foreach my $line (split/\n/, $ip_addr_list)
{ {
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { line => $line }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { line => $line }});
if ($line =~ /^\d+: (.*?):/) if ($line =~ /^\d+: (.*?):/)
{ {
$in_interface = $1; $in_interface = $1;
$ip_address = ""; $ip_address = "";
$subnet_mask = ""; $subnet_mask = "";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { in_interface => $in_interface }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { in_interface => $in_interface }});
next if $in_interface eq "lo"; next if $in_interface eq "lo";
$network->{interface}{$in_interface}{ip} = "--"; $network->{interface}{$in_interface}{ip} = "--";
$network->{interface}{$in_interface}{netmask} = "--"; $network->{interface}{$in_interface}{netmask} = "--";
@ -466,15 +466,15 @@ sub network_details
{ {
$ip_address = $1; $ip_address = $1;
$subnet_mask = $2; $subnet_mask = $2;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
ip_address => $ip_address, ip_address => $ip_address,
subnet_mask => $subnet_mask, subnet_mask => $subnet_mask,
}}); }});
if ((($subnet_mask =~ /^\d$/) or ($subnet_mask =~ /^\d\d$/)) && ($subnet_mask < 25)) if ((($subnet_mask =~ /^\d$/) or ($subnet_mask =~ /^\d\d$/)) && ($subnet_mask < 25))
{ {
$subnet_mask = $an->Convert->cidr({cidr => $subnet_mask}); $subnet_mask = $anvil->Convert->cidr({cidr => $subnet_mask});
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { subnet_mask => $subnet_mask }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { subnet_mask => $subnet_mask }});
} }
$network->{interface}{$in_interface}{ip} = $ip_address; $network->{interface}{$in_interface}{ip} = $ip_address;
$network->{interface}{$in_interface}{netmask} = $subnet_mask; $network->{interface}{$in_interface}{netmask} = $subnet_mask;
@ -489,11 +489,11 @@ sub network_details
This reads in the command line switches used to invoke the parent program. This reads in the command line switches used to invoke the parent program.
It takes no arguments, and data is stored in 'C<< $an->data->{switches}{x} >>', where 'x' is the switch used. It takes no arguments, and data is stored in 'C<< $anvil->data->{switches}{x} >>', where 'x' is the switch used.
Switches in the form 'C<< -x >>' and 'C<< --x >>' are treated the same and the corresponding 'C<< $an->data->{switches}{x} >>' will contain '#!set!#'. Switches in the form 'C<< -x >>' and 'C<< --x >>' are treated the same and the corresponding 'C<< $anvil->data->{switches}{x} >>' will contain '#!set!#'.
Switches in the form 'C<< -x foo >>', 'C<< --x foo >>', 'C<< -x=foo >>' and 'C<< --x=foo >>' are treated the same and the corresponding 'C<< $an->data->{switches}{x} >>' will contain 'foo'. Switches in the form 'C<< -x foo >>', 'C<< --x foo >>', 'C<< -x=foo >>' and 'C<< --x=foo >>' are treated the same and the corresponding 'C<< $anvil->data->{switches}{x} >>' will contain 'foo'.
The switches 'C<< -v >>', 'C<< -vv >>', 'C<< -vvv >>' and 'C<< -vvvv >>' will cause the active log level to automatically change to 1, 2, 3 or 4 respectively. Passing 'C<< -V >>' will set the log level to '0'. The switches 'C<< -v >>', 'C<< -vv >>', 'C<< -vvv >>' and 'C<< -vvvv >>' will cause the active log level to automatically change to 1, 2, 3 or 4 respectively. Passing 'C<< -V >>' will set the log level to '0'.
@ -503,7 +503,7 @@ Anything after 'C<< -- >>' is treated as a raw string and is not processed.
sub switches sub switches
{ {
my $self = shift; my $self = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $last_argument = ""; my $last_argument = "";
foreach my $argument (@ARGV) foreach my $argument (@ARGV)
@ -511,7 +511,7 @@ sub switches
if ($last_argument eq "raw") if ($last_argument eq "raw")
{ {
# Don't process anything. # Don't process anything.
$an->data->{switches}{raw} .= " $argument"; $anvil->data->{switches}{raw} .= " $argument";
} }
elsif ($argument =~ /^-/) elsif ($argument =~ /^-/)
{ {
@ -519,7 +519,7 @@ sub switches
if ($argument eq "--") if ($argument eq "--")
{ {
$last_argument = "raw"; $last_argument = "raw";
$an->data->{switches}{raw} = ""; $anvil->data->{switches}{raw} = "";
} }
else else
{ {
@ -528,11 +528,11 @@ sub switches
{ {
# Break up the variable/value. # Break up the variable/value.
($last_argument, my $value) = (split /=/, $last_argument, 2); ($last_argument, my $value) = (split /=/, $last_argument, 2);
$an->data->{switches}{$last_argument} = $value; $anvil->data->{switches}{$last_argument} = $value;
} }
else else
{ {
$an->data->{switches}{$last_argument} = "#!SET!#"; $anvil->data->{switches}{$last_argument} = "#!SET!#";
} }
} }
} }
@ -540,24 +540,24 @@ sub switches
{ {
if ($last_argument) if ($last_argument)
{ {
$an->data->{switches}{$last_argument} = $argument; $anvil->data->{switches}{$last_argument} = $argument;
$last_argument = ""; $last_argument = "";
} }
else else
{ {
# Got a value without an argument. # Got a value without an argument.
$an->data->{switches}{error} = 1; $anvil->data->{switches}{error} = 1;
} }
} }
} }
# Clean up the initial space added to 'raw'. # Clean up the initial space added to 'raw'.
if ($an->data->{switches}{raw}) if ($anvil->data->{switches}{raw})
{ {
$an->data->{switches}{raw} =~ s/^ //; $anvil->data->{switches}{raw} =~ s/^ //;
} }
# Adjust the log level if requested. # Adjust the log level if requested.
$an->Log->_adjust_log_level(); $anvil->Log->_adjust_log_level();
return(0); return(0);
} }
@ -577,44 +577,44 @@ sub users_home
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $home_directory = 0; my $home_directory = 0;
my $user = $parameter->{user} ? $parameter->{user} : ""; my $user = $parameter->{user} ? $parameter->{user} : "";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { user => $user }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { user => $user }});
# Make sure the user is only one digit. Sometimes $< (and others) will return multiple IDs. # Make sure the user is only one digit. Sometimes $< (and others) will return multiple IDs.
if ($user =~ /^\d+ \d$/) if ($user =~ /^\d+ \d$/)
{ {
$user =~ s/^(\d+)\s.*$/$1/; $user =~ s/^(\d+)\s.*$/$1/;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { user => $user }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { user => $user }});
} }
# If the user is numerical, convert it to a name. # If the user is numerical, convert it to a name.
if ($user =~ /^\d+$/) if ($user =~ /^\d+$/)
{ {
$user = getpwuid($user); $user = getpwuid($user);
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { user => $user }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { user => $user }});
} }
# Still don't have a name? fail... # Still don't have a name? fail...
if ($user eq "") if ($user eq "")
{ {
# No user? No bueno... # No user? No bueno...
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Get->users_home()", parameter => "user" }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Get->users_home()", parameter => "user" }});
return($home_directory); return($home_directory);
} }
my $body = $an->Storage->read_file({file => $an->data->{path}{data}{passwd}}); my $body = $anvil->Storage->read_file({file => $anvil->data->{path}{data}{passwd}});
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { body => $body }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { body => $body }});
foreach my $line (split /\n/, $body) foreach my $line (split /\n/, $body)
{ {
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { line => $line }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { line => $line }});
if ($line =~ /^$user:/) if ($line =~ /^$user:/)
{ {
$home_directory = (split/:/, $line)[5]; $home_directory = (split/:/, $line)[5];
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { home_directory => $home_directory }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { home_directory => $home_directory }});
last; last;
} }
} }
@ -622,10 +622,10 @@ sub users_home
# Do I have the a user's $HOME now? # Do I have the a user's $HOME now?
if (not $home_directory) if (not $home_directory)
{ {
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0061", variables => { user => $user }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0061", variables => { user => $user }});
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { home_directory => $home_directory }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { home_directory => $home_directory }});
return($home_directory); return($home_directory);
} }
@ -637,10 +637,10 @@ This method returns a new UUID (using 'uuidgen' from the system). It takes no pa
sub uuid sub uuid
{ {
my $self = shift; my $self = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $uuid = $an->System->call({shell_call => $an->data->{path}{exe}{uuidgen}." --random"}); my $uuid = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{uuidgen}." --random"});
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { uuid => $uuid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { uuid => $uuid }});
return($uuid); return($uuid);
} }

157
AN/Tools/Log.pm → Anvil/Tools/Log.pm
Unescape View File

@ -1,4 +1,4 @@
package AN::Tools::Log; package Anvil::Tools::Log;
# #
# This module contains methods used to handle logging related tasks # This module contains methods used to handle logging related tasks
# #
@ -28,21 +28,21 @@ my $THIS_FILE = "Log.pm";
=head1 NAME =head1 NAME
AN::Tools::Log Anvil::Tools::Log
Provides all methods related to logging. Provides all methods related to logging.
=head1 SYNOPSIS =head1 SYNOPSIS
use AN::Tools; use Anvil::Tools;
# Get a common object handle on all AN::Tools modules. # Get a common object handle on all Anvil::Tools modules.
my $an = AN::Tools->new(); my $anvil = Anvil::Tools->new();
# Access to methods using '$an->Log->X'. # Access to methods using '$anvil->Log->X'.
# #
# Example using 'entry()'; # Example using 'entry()';
my $foo_path = $an->Log->entry({...}); my $foo_path = $anvil->Log->entry({...});
=head1 METHODS =head1 METHODS
@ -63,7 +63,7 @@ sub new
return ($self); return ($self);
} }
# Get a handle on the AN::Tools object. I know that technically that is a sibling module, but it makes more # Get a handle on the Anvil::Tools object. I know that technically that is a sibling module, but it makes more
# sense in this case to think of it as a parent. # sense in this case to think of it as a parent.
sub parent sub parent
{ {
@ -92,13 +92,13 @@ This method writes an entry to the journald logs, provided the log entry's level
Here is a simple example of writing a simple log entry at log log level 1. Here is a simple example of writing a simple log entry at log log level 1.
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0001"}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0001"});
In the example above, the string will be written to the log file if the active log level is 'C<< 1 >>' or higher and it will use the 'C<< log::language >>' language to translate the string key. In the example above, the string will be written to the log file if the active log level is 'C<< 1 >>' or higher and it will use the 'C<< log::language >>' language to translate the string key.
Now a more complex example; Now a more complex example;
$an->Log->entry({ $anvil->Log->entry({
source => $THIS_FILE, source => $THIS_FILE,
line => __LINE__, line => __LINE__,
level => 2, level => 2,
@ -114,7 +114,7 @@ In the above example, the log level is set to 'C<< 2 >>' and the 'C<< secure >>'
Finally, it is possible to log pre-processed strings (as is done in 'Alert->warning()' and 'Alert->error()'). In this case, the 'C<< raw >>' parameter is used and it contains the processed string. Note that the source file and line number are still pre-pended to the raw message. Finally, it is possible to log pre-processed strings (as is done in 'Alert->warning()' and 'Alert->error()'). In this case, the 'C<< raw >>' parameter is used and it contains the processed string. Note that the source file and line number are still pre-pended to the raw message.
$an->Log->entry({ $anvil->Log->entry({
source => $THIS_FILE, source => $THIS_FILE,
line => __LINE__, line => __LINE__,
level => 2, level => 2,
@ -212,7 +212,7 @@ When set, the string is pre-pended to the log entry. This is generally set to 'C
=head3 tag (optional) =head3 tag (optional)
This is the tag given to the log entry. By default, it will be 'C<< an-tools >>'. This is the tag given to the log entry. By default, it will be 'C<< anvil >>'.
=head3 variables (optional) =head3 variables (optional)
@ -223,28 +223,28 @@ sub entry
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $key = defined $parameter->{key} ? $parameter->{key} : ""; my $key = defined $parameter->{key} ? $parameter->{key} : "";
my $language = defined $parameter->{language} ? $parameter->{language} : $an->Log->language; my $language = defined $parameter->{language} ? $parameter->{language} : $anvil->Log->language;
my $level = defined $parameter->{level} ? $parameter->{level} : 2; my $level = defined $parameter->{level} ? $parameter->{level} : 2;
my $line = defined $parameter->{line} ? $parameter->{line} : ""; my $line = defined $parameter->{line} ? $parameter->{line} : "";
my $facility = defined $parameter->{facility} ? $parameter->{facility} : $an->data->{defaults}{'log'}{facility}; my $facility = defined $parameter->{facility} ? $parameter->{facility} : $anvil->data->{defaults}{'log'}{facility};
my $priority = defined $parameter->{priority} ? $parameter->{priority} : ""; my $priority = defined $parameter->{priority} ? $parameter->{priority} : "";
my $raw = defined $parameter->{raw} ? $parameter->{raw} : ""; my $raw = defined $parameter->{raw} ? $parameter->{raw} : "";
my $secure = defined $parameter->{secure} ? $parameter->{secure} : 0; my $secure = defined $parameter->{secure} ? $parameter->{secure} : 0;
my $server = defined $parameter->{server} ? $parameter->{server} : $an->data->{defaults}{'log'}{server}; my $server = defined $parameter->{server} ? $parameter->{server} : $anvil->data->{defaults}{'log'}{server};
my $source = defined $parameter->{source} ? $parameter->{source} : ""; my $source = defined $parameter->{source} ? $parameter->{source} : "";
my $tag = defined $parameter->{tag} ? $parameter->{tag} : $an->data->{defaults}{'log'}{tag}; my $tag = defined $parameter->{tag} ? $parameter->{tag} : $anvil->data->{defaults}{'log'}{tag};
my $variables = defined $parameter->{variables} ? $parameter->{variables} : ""; my $variables = defined $parameter->{variables} ? $parameter->{variables} : "";
#print $THIS_FILE." ".__LINE__."; [ Debug ] - level: [$level], defaults::log::level: [".$an->Log->{defaults}{'log'}{level}."], logging secure? [".$an->Log->secure."]\n"; #print $THIS_FILE." ".__LINE__."; [ Debug ] - level: [$level], defaults::log::level: [".$anvil->Log->{defaults}{'log'}{level}."], logging secure? [".$anvil->Log->secure."]\n";
# Exit immediately if this isn't going to be logged # Exit immediately if this isn't going to be logged
if ($level > $an->Log->level) if ($level > $anvil->Log->level)
{ {
return(1); return(1);
} }
if (($secure) && (not $an->Log->secure)) if (($secure) && (not $anvil->Log->secure))
{ {
return(2); return(2);
} }
@ -291,7 +291,7 @@ sub entry
elsif ($key) elsif ($key)
{ {
# Build the string from the key/variables. # Build the string from the key/variables.
my $message .= $an->Words->string({ my $message .= $anvil->Words->string({
language => $language, language => $language,
key => $key, key => $key,
variables => $variables, variables => $variables,
@ -319,18 +319,18 @@ This sets or returns the log language ISO code.
Get the current log language; Get the current log language;
my $language = $an->Log->language; my $language = $anvil->Log->language;
Set the log langauge to Japanese; Set the log langauge to Japanese;
$an->Log->language({set => "jp"}); $anvil->Log->language({set => "jp"});
=cut =cut
sub language sub language
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $set = defined $parameter->{set} ? $parameter->{set} : ""; my $set = defined $parameter->{set} ? $parameter->{set} : "";
my $debug = 0; my $debug = 0;
@ -342,10 +342,10 @@ sub language
print $THIS_FILE." ".__LINE__."; LOG::LANGUAGE: [".$self->{LOG}{LANGUAGE}."]\n" if $debug; print $THIS_FILE." ".__LINE__."; LOG::LANGUAGE: [".$self->{LOG}{LANGUAGE}."]\n" if $debug;
} }
print $THIS_FILE." ".__LINE__."; LOG::LANGUAGE: [".$self->{LOG}{LANGUAGE}."], defaults::log::language: [".$an->data->{defaults}{'log'}{language}."]\n" if $debug; print $THIS_FILE." ".__LINE__."; LOG::LANGUAGE: [".$self->{LOG}{LANGUAGE}."], defaults::log::language: [".$anvil->data->{defaults}{'log'}{language}."]\n" if $debug;
if (not $self->{LOG}{LANGUAGE}) if (not $self->{LOG}{LANGUAGE})
{ {
$self->{LOG}{LANGUAGE} = $an->data->{defaults}{'log'}{language}; $self->{LOG}{LANGUAGE} = $anvil->data->{defaults}{'log'}{language};
print $THIS_FILE." ".__LINE__."; LOG::LANGUAGE: [".$self->{LOG}{LANGUAGE}."]\n" if $debug; print $THIS_FILE." ".__LINE__."; LOG::LANGUAGE: [".$self->{LOG}{LANGUAGE}."]\n" if $debug;
} }
@ -359,18 +359,18 @@ This sets or returns the active log level. Valid values are 0 to 4. See the 'ent
Check the current log level: Check the current log level:
print "Current log level: [".$an->Log->level."]\n"; print "Current log level: [".$anvil->Log->level."]\n";
Change the current log level to 'C<< 2 >>'; Change the current log level to 'C<< 2 >>';
$an->Log->level({set => 2}); $anvil->Log->level({set => 2});
=cut =cut
sub level sub level
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $set = defined $parameter->{set} ? $parameter->{set} : ""; my $set = defined $parameter->{set} ? $parameter->{set} : "";
my $debug = 0; my $debug = 0;
@ -380,44 +380,44 @@ sub level
{ {
if ($set == 0) if ($set == 0)
{ {
$an->data->{defaults}{'log'}{level} = 0; $anvil->data->{defaults}{'log'}{level} = 0;
print $THIS_FILE." ".__LINE__."; defaults::log::level: [".$an->data->{defaults}{'log'}{level}."]\n" if $debug; print $THIS_FILE." ".__LINE__."; defaults::log::level: [".$anvil->data->{defaults}{'log'}{level}."]\n" if $debug;
} }
elsif ($set == 1) elsif ($set == 1)
{ {
$an->data->{defaults}{'log'}{level} = 1; $anvil->data->{defaults}{'log'}{level} = 1;
print $THIS_FILE." ".__LINE__."; defaults::log::level: [".$an->data->{defaults}{'log'}{level}."]\n" if $debug; print $THIS_FILE." ".__LINE__."; defaults::log::level: [".$anvil->data->{defaults}{'log'}{level}."]\n" if $debug;
} }
elsif ($set == 2) elsif ($set == 2)
{ {
$an->data->{defaults}{'log'}{level} = 2; $anvil->data->{defaults}{'log'}{level} = 2;
print $THIS_FILE." ".__LINE__."; defaults::log::level: [".$an->data->{defaults}{'log'}{level}."]\n" if $debug; print $THIS_FILE." ".__LINE__."; defaults::log::level: [".$anvil->data->{defaults}{'log'}{level}."]\n" if $debug;
} }
elsif ($set == 3) elsif ($set == 3)
{ {
$an->data->{defaults}{'log'}{level} = 3; $anvil->data->{defaults}{'log'}{level} = 3;
print $THIS_FILE." ".__LINE__."; defaults::log::level: [".$an->data->{defaults}{'log'}{level}."]\n" if $debug; print $THIS_FILE." ".__LINE__."; defaults::log::level: [".$anvil->data->{defaults}{'log'}{level}."]\n" if $debug;
} }
elsif ($set == 4) elsif ($set == 4)
{ {
$an->data->{defaults}{'log'}{level} = 4; $anvil->data->{defaults}{'log'}{level} = 4;
print $THIS_FILE." ".__LINE__."; defaults::log::level: [".$an->data->{defaults}{'log'}{level}."]\n" if $debug; print $THIS_FILE." ".__LINE__."; defaults::log::level: [".$anvil->data->{defaults}{'log'}{level}."]\n" if $debug;
} }
} }
elsif ($set ne "") elsif ($set ne "")
{ {
# Invalid value passed. # Invalid value passed.
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0047", variables => { set => $set }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0047", variables => { set => $set }});
} }
if ((not defined $an->data->{defaults}{'log'}{level}) or ($an->data->{defaults}{'log'}{level} !~ /^\d$/) or ($an->data->{defaults}{'log'}{level} < 0) or ($an->data->{defaults}{'log'}{level} > 4)) if ((not defined $anvil->data->{defaults}{'log'}{level}) or ($anvil->data->{defaults}{'log'}{level} !~ /^\d$/) or ($anvil->data->{defaults}{'log'}{level} < 0) or ($anvil->data->{defaults}{'log'}{level} > 4))
{ {
$an->data->{defaults}{'log'}{level} = 1; $anvil->data->{defaults}{'log'}{level} = 1;
print $THIS_FILE." ".__LINE__."; defaults::log::level: [".$an->data->{defaults}{'log'}{level}."]\n" if $debug; print $THIS_FILE." ".__LINE__."; defaults::log::level: [".$anvil->data->{defaults}{'log'}{level}."]\n" if $debug;
} }
print $THIS_FILE." ".__LINE__."; defaults::log::level: [".$an->data->{defaults}{'log'}{level}."]\n" if $debug; print $THIS_FILE." ".__LINE__."; defaults::log::level: [".$anvil->data->{defaults}{'log'}{level}."]\n" if $debug;
return($an->data->{defaults}{'log'}{level}); return($anvil->data->{defaults}{'log'}{level});
} }
=head2 secure =head2 secure
@ -430,23 +430,23 @@ Passing 'C<< 0 >>' disables recording sensitive logs. Passing 'C<< 1 >>' enables
Enable logging of secure data; Enable logging of secure data;
$an->Log->secure({set => 1}); $anvil->Log->secure({set => 1});
if ($an->Log->secure) if ($anvil->Log->secure)
{ {
# Sensitive data logging is enabled. # Sensitive data logging is enabled.
} }
Disable sensitive log entry recording. Disable sensitive log entry recording.
$an->Log->secure({set => 0}); $anvil->Log->secure({set => 0});
=cut =cut
sub secure sub secure
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $set = defined $parameter->{set} ? $parameter->{set} : ""; my $set = defined $parameter->{set} ? $parameter->{set} : "";
my $debug = 0; my $debug = 0;
@ -455,15 +455,15 @@ sub secure
{ {
if ($set eq "0") if ($set eq "0")
{ {
$an->data->{defaults}{'log'}{secure} = 0; $anvil->data->{defaults}{'log'}{secure} = 0;
} }
elsif ($set eq "1") elsif ($set eq "1")
{ {
$an->data->{defaults}{'log'}{secure} = 1; $anvil->data->{defaults}{'log'}{secure} = 1;
} }
} }
return($an->data->{defaults}{'log'}{secure}); return($anvil->data->{defaults}{'log'}{secure});
} }
=head2 variables =head2 variables
@ -482,7 +482,7 @@ If the passed in number of entries is 5 or less, the output will all be on one l
To allow for sorting, if the key starts with 's#:', that part of the key will be removed in the log. For example; To allow for sorting, if the key starts with 's#:', that part of the key will be removed in the log. For example;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => {
"s1:i" => $i, "s1:i" => $i,
"s2:column_name" => $column_name, "s2:column_name" => $column_name,
"s3:column_value" => $column_value, "s3:column_value" => $column_value,
@ -492,7 +492,7 @@ To allow for sorting, if the key starts with 's#:', that part of the key will be
Would generate a sorted log entry that looks like: Would generate a sorted log entry that looks like:
Aug 20 13:10:28 m3-striker01.alteeve.com an-tools[9445]: Database.pm:2604; Variables: Aug 20 13:10:28 m3-striker01.alteeve.com anvil[9445]: Database.pm:2604; Variables:
|- i: [0] |- i: [0]
|- column_name: [host_name] |- column_name: [host_name]
|- column_value: [m3-striker01.alteeve.com] |- column_value: [m3-striker01.alteeve.com]
@ -506,33 +506,33 @@ sub variables
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $language = defined $parameter->{language} ? $parameter->{language} : $an->data->{defaults}{'log'}{language}; my $language = defined $parameter->{language} ? $parameter->{language} : $anvil->data->{defaults}{'log'}{language};
my $level = defined $parameter->{level} ? $parameter->{level} : 2; my $level = defined $parameter->{level} ? $parameter->{level} : 2;
my $line = defined $parameter->{line} ? $parameter->{line} : ""; my $line = defined $parameter->{line} ? $parameter->{line} : "";
my $list = defined $parameter->{list} ? $parameter->{list} : {}; my $list = defined $parameter->{list} ? $parameter->{list} : {};
my $facility = defined $parameter->{facility} ? $parameter->{facility} : $an->data->{defaults}{'log'}{facility}; my $facility = defined $parameter->{facility} ? $parameter->{facility} : $anvil->data->{defaults}{'log'}{facility};
my $priority = defined $parameter->{priority} ? $parameter->{priority} : ""; my $priority = defined $parameter->{priority} ? $parameter->{priority} : "";
my $secure = defined $parameter->{secure} ? $parameter->{secure} : 0; my $secure = defined $parameter->{secure} ? $parameter->{secure} : 0;
my $server = defined $parameter->{server} ? $parameter->{server} : $an->data->{defaults}{'log'}{server}; my $server = defined $parameter->{server} ? $parameter->{server} : $anvil->data->{defaults}{'log'}{server};
my $source = defined $parameter->{source} ? $parameter->{source} : ""; my $source = defined $parameter->{source} ? $parameter->{source} : "";
my $tag = defined $parameter->{tag} ? $parameter->{tag} : $an->data->{defaults}{'log'}{tag}; my $tag = defined $parameter->{tag} ? $parameter->{tag} : $anvil->data->{defaults}{'log'}{tag};
# Exit immediately if this isn't going to be logged # Exit immediately if this isn't going to be logged
if (not defined $level) if (not defined $level)
{ {
die $THIS_FILE." ".__LINE__."; Log->variables() called without 'level': [".$level."] defined from: [$source : $line]\n"; die $THIS_FILE." ".__LINE__."; Log->variables() called without 'level': [".$level."] defined from: [$source : $line]\n";
} }
elsif (not defined $an->Log->level) elsif (not defined $anvil->Log->level)
{ {
die $THIS_FILE." ".__LINE__."; Log->variables() called without Log->level: [".$an->Log->level."] defined from: [$source : $line]\n"; die $THIS_FILE." ".__LINE__."; Log->variables() called without Log->level: [".$anvil->Log->level."] defined from: [$source : $line]\n";
} }
if ($level > $an->Log->level) if ($level > $anvil->Log->level)
{ {
return(1); return(1);
} }
if (($secure) && (not $an->Log->secure)) if (($secure) && (not $anvil->Log->secure))
{ {
return(2); return(2);
} }
@ -552,7 +552,8 @@ sub variables
} }
} }
my $raw = ""; my $raw = "";
if ($entries <= 5) # NOTE: If you change this, be sure to update Tools.t
if ($entries <= 4)
{ {
# Put all the entries on one line. # Put all the entries on one line.
foreach my $key (sort {$a cmp $b} keys %{$list}) foreach my $key (sort {$a cmp $b} keys %{$list})
@ -567,7 +568,7 @@ sub variables
else else
{ {
# Put all the entries on their own line. # Put all the entries on their own line.
$raw .= $an->Words->string({key => "log_0019"})."\n"; $raw .= $anvil->Words->string({key => "log_0019"})."\n";
foreach my $key (sort {$a cmp $b} keys %{$list}) foreach my $key (sort {$a cmp $b} keys %{$list})
{ {
# Strip a leading 'sX:' in case the user is sorting the output. # Strip a leading 'sX:' in case the user is sorting the output.
@ -586,7 +587,7 @@ sub variables
} }
# Do the raw log entry. # Do the raw log entry.
$an->Log->entry({ $anvil->Log->entry({
language => $language, language => $language,
level => $level, level => $level,
line => $line, line => $line,
@ -616,34 +617,34 @@ sub variables
=head2 _adjust_log_level =head2 _adjust_log_level
This is a private method used by 'C<< $an->Get->switches >>' that automatically adjusts the active log level to 0 ~ 4. See 'C<< perldoc AN::Tools::Get >>' for more information. This is a private method used by 'C<< $anvil->Get->switches >>' that automatically adjusts the active log level to 0 ~ 4. See 'C<< perldoc Anvil::Tools::Get >>' for more information.
=cut =cut
sub _adjust_log_level sub _adjust_log_level
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
if ($an->data->{switches}{V}) if ($anvil->data->{switches}{V})
{ {
$an->Log->level({set => 0}); $anvil->Log->level({set => 0});
} }
elsif ($an->data->{switches}{v}) elsif ($anvil->data->{switches}{v})
{ {
$an->Log->level({set => 1}); $anvil->Log->level({set => 1});
} }
elsif ($an->data->{switches}{vv}) elsif ($anvil->data->{switches}{vv})
{ {
$an->Log->level({set => 2}); $anvil->Log->level({set => 2});
} }
elsif ($an->data->{switches}{vvv}) elsif ($anvil->data->{switches}{vvv})
{ {
$an->Log->level({set => 3}); $anvil->Log->level({set => 3});
} }
elsif ($an->data->{switches}{vvvv}) elsif ($anvil->data->{switches}{vvvv})
{ {
$an->Log->level({set => 4}); $anvil->Log->level({set => 4});
} }
return(0); return(0);

242
AN/Tools/Storage.pm → Anvil/Tools/Storage.pm
Unescape View File

@ -1,4 +1,4 @@
package AN::Tools::Storage; package Anvil::Tools::Storage;
# #
# This module contains methods used to handle storage related tasks # This module contains methods used to handle storage related tasks
# #
@ -29,21 +29,21 @@ my $THIS_FILE = "Storage.pm";
=head1 NAME =head1 NAME
AN::Tools::Storage Anvil::Tools::Storage
Provides all methods related to storage on a system. Provides all methods related to storage on a system.
=head1 SYNOPSIS =head1 SYNOPSIS
use AN::Tools; use Anvil::Tools;
# Get a common object handle on all AN::Tools modules. # Get a common object handle on all Anvil::Tools modules.
my $an = AN::Tools->new(); my $anvil = Anvil::Tools->new();
# Access to methods using '$an->Storage->X'. # Access to methods using '$anvil->Storage->X'.
# #
# Example using 'find()'; # Example using 'find()';
my $foo_path = $an->Storage->find({file => "foo"}); my $foo_path = $anvil->Storage->find({file => "foo"});
=head1 METHODS =head1 METHODS
@ -62,7 +62,7 @@ sub new
return ($self); return ($self);
} }
# Get a handle on the AN::Tools object. I know that technically that is a sibling module, but it makes more # Get a handle on the Anvil::Tools object. I know that technically that is a sibling module, but it makes more
# sense in this case to think of it as a parent. # sense in this case to think of it as a parent.
sub parent sub parent
{ {
@ -89,7 +89,7 @@ sub parent
This changes the mode of a file or directory. This changes the mode of a file or directory.
$an->Storage->change_mode({target => "/tmp/foo", mode => "0644"}); $anvil->Storage->change_mode({target => "/tmp/foo", mode => "0644"});
If it fails to write the file, an alert will be logged. If it fails to write the file, an alert will be logged.
@ -108,11 +108,11 @@ sub change_mode
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $target = defined $parameter->{target} ? $parameter->{target} : ""; my $target = defined $parameter->{target} ? $parameter->{target} : "";
my $mode = defined $parameter->{mode} ? $parameter->{mode} : ""; my $mode = defined $parameter->{mode} ? $parameter->{mode} : "";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
target => $target, target => $target,
mode => $mode, mode => $mode,
}}); }});
@ -121,32 +121,32 @@ sub change_mode
if (not $target) if (not $target)
{ {
# No target... # No target...
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->change_mode()", parameter => "target" }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->change_mode()", parameter => "target" }});
$error = 1; $error = 1;
} }
if (not $mode) if (not $mode)
{ {
# No mode... # No mode...
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->change_mode()", parameter => "mode" }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->change_mode()", parameter => "mode" }});
$error = 1; $error = 1;
} }
elsif (($mode !~ /^\d\d\d$/) && ($mode !~ /^\d\d\d\d$/)) elsif (($mode !~ /^\d\d\d$/) && ($mode !~ /^\d\d\d\d$/))
{ {
# Invalid mode # Invalid mode
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0038", variables => { mode => $mode }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0038", variables => { mode => $mode }});
$error = 1; $error = 1;
} }
if (not $error) if (not $error)
{ {
my $shell_call = $an->data->{path}{exe}{'chmod'}." $mode $target"; my $shell_call = $anvil->data->{path}{exe}{'chmod'}." $mode $target";
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0011", variables => { shell_call => $shell_call }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0011", variables => { shell_call => $shell_call }});
open (my $file_handle, $shell_call." 2>&1 |") or $an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0014", variables => { shell_call => $shell_call, error => $! }}); open (my $file_handle, $shell_call." 2>&1 |") or $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0014", variables => { shell_call => $shell_call, error => $! }});
while(<$file_handle>) while(<$file_handle>)
{ {
chomp; chomp;
my $line = $_; my $line = $_;
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0017", variables => { line => $line }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0017", variables => { line => $line }});
} }
close $file_handle; close $file_handle;
} }
@ -158,7 +158,7 @@ sub change_mode
This changes the owner and/or group of a file or directory. This changes the owner and/or group of a file or directory.
$an->Storage->change_owner({target => "/tmp/foo", mode => "0644"}); $anvil->Storage->change_owner({target => "/tmp/foo", mode => "0644"});
If it fails to write the file, an alert will be logged and 'C<< 1 >>' will be returned. Otherwise, 'C<< 0 >>' will be returned. If it fails to write the file, an alert will be logged and 'C<< 1 >>' will be returned. Otherwise, 'C<< 0 >>' will be returned.
@ -181,13 +181,13 @@ sub change_owner
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $target = defined $parameter->{target} ? $parameter->{target} : ""; my $target = defined $parameter->{target} ? $parameter->{target} : "";
my $group = defined $parameter->{group} ? $parameter->{group} : ""; my $group = defined $parameter->{group} ? $parameter->{group} : "";
my $user = defined $parameter->{user} ? $parameter->{user} : ""; my $user = defined $parameter->{user} ? $parameter->{user} : "";
my $debug = 3; my $debug = 3;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
target => $target, target => $target,
group => $group, group => $group,
user => $user, user => $user,
@ -196,7 +196,7 @@ sub change_owner
# Make sure the user and group and just one digit or word. # Make sure the user and group and just one digit or word.
$user =~ s/^(\S+)\s.*$/$1/; $user =~ s/^(\S+)\s.*$/$1/;
$group =~ s/^(\S+)\s.*$/$1/; $group =~ s/^(\S+)\s.*$/$1/;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
group => $group, group => $group,
user => $user, user => $user,
}}); }});
@ -206,40 +206,40 @@ sub change_owner
if (not $target) if (not $target)
{ {
# No target... # No target...
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->change_owner()", parameter => "target" }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->change_owner()", parameter => "target" }});
$error = 1; $error = 1;
} }
if (not -e $target) if (not -e $target)
{ {
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0051", variables => {target => $target }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0051", variables => {target => $target }});
$error = 1; $error = 1;
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { user => $user }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { user => $user }});
if ($user ne "") if ($user ne "")
{ {
$string = $user; $string = $user;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { string => $string }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { string => $string }});
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { group => $group }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { group => $group }});
if ($group ne "") if ($group ne "")
{ {
$string .= ":".$group; $string .= ":".$group;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { string => $string }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { string => $string }});
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { error => $error, string => $string }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { error => $error, string => $string }});
if ((not $error) && ($string ne "")) if ((not $error) && ($string ne ""))
{ {
my $shell_call = $an->data->{path}{exe}{'chown'}." $string $target"; my $shell_call = $anvil->data->{path}{exe}{'chown'}." $string $target";
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0011", variables => { shell_call => $shell_call }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0011", variables => { shell_call => $shell_call }});
open (my $file_handle, $shell_call." 2>&1 |") or $an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0014", variables => { shell_call => $shell_call, error => $! }}); open (my $file_handle, $shell_call." 2>&1 |") or $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0014", variables => { shell_call => $shell_call, error => $! }});
while(<$file_handle>) while(<$file_handle>)
{ {
chomp; chomp;
my $line = $_; my $line = $_;
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0017", variables => { line => $line }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0017", variables => { line => $line }});
} }
close $file_handle; close $file_handle;
} }
@ -252,7 +252,7 @@ sub change_owner
This copies a file, with a few additional checks like creating the target directory if it doesn't exist, aborting if the file has already been backed up before, etc. This copies a file, with a few additional checks like creating the target directory if it doesn't exist, aborting if the file has already been backed up before, etc.
# Example # Example
$an->Storage->copy_file({source => "/some/file", target => "/another/directory/file"}); $anvil->Storage->copy_file({source => "/some/file", target => "/another/directory/file"});
Parameters; Parameters;
@ -277,12 +277,12 @@ sub copy_file
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $overwrite = defined $parameter->{overwrite} ? $parameter->{overwrite} : 0; my $overwrite = defined $parameter->{overwrite} ? $parameter->{overwrite} : 0;
my $source = defined $parameter->{source} ? $parameter->{source} : ""; my $source = defined $parameter->{source} ? $parameter->{source} : "";
my $target = defined $parameter->{target} ? $parameter->{target} : ""; my $target = defined $parameter->{target} ? $parameter->{target} : "";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
overwrite => $overwrite, overwrite => $overwrite,
source => $source, source => $source,
target => $target, target => $target,
@ -291,18 +291,18 @@ sub copy_file
if (not $source) if (not $source)
{ {
# No source passed. # No source passed.
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->copy_file()", parameter => "source" }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->copy_file()", parameter => "source" }});
return(1); return(1);
} }
elsif (not -e $source) elsif (not -e $source)
{ {
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0052", variables => { source => $source }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0052", variables => { source => $source }});
return(4); return(4);
} }
if (not $target) if (not $target)
{ {
# No target passed. # No target passed.
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->copy_file()", parameter => "target" }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->copy_file()", parameter => "target" }});
return(2); return(2);
} }
@ -310,7 +310,7 @@ sub copy_file
if ((-e $target) && (not $overwrite)) if ((-e $target) && (not $overwrite))
{ {
# This isn't an error. # This isn't an error.
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0046", variables => { $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "log_0046", variables => {
source => $source, source => $source,
target => $target, target => $target,
}}); }});
@ -319,13 +319,13 @@ sub copy_file
# Make sure the target directory exists and create it, if not. # Make sure the target directory exists and create it, if not.
my ($directory, $file) = ($target =~ /^(.*)\/(.*)$/); my ($directory, $file) = ($target =~ /^(.*)\/(.*)$/);
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
directory => $directory, directory => $directory,
file => $file, file => $file,
}}); }});
if (not -e $directory) if (not -e $directory)
{ {
$an->Storage->make_directory({ $anvil->Storage->make_directory({
directory => $directory, directory => $directory,
group => $(, # Real UID group => $(, # Real UID
user => $<, # Real GID user => $<, # Real GID
@ -334,23 +334,23 @@ sub copy_file
} }
# Now backup the file. # Now backup the file.
my $output = $an->System->call({shell_call => $an->data->{path}{exe}{'cp'}." -af $source $target"}); my $output = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{'cp'}." -af $source $target"});
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { output => $output }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { output => $output }});
return(0); return(0);
} }
=head2 find =head2 find
This searches for the given file on the system. It will search in the directories returned by C<< $an->Storage->search_directories() >>. This searches for the given file on the system. It will search in the directories returned by C<< $anvil->Storage->search_directories() >>.
Example to search for 'C<< foo >>'; Example to search for 'C<< foo >>';
$an->Storage->find({file => "foo"}); $anvil->Storage->find({file => "foo"});
Same, but error out if the file isn't found. Same, but error out if the file isn't found.
$an->Storage->find({ $anvil->Storage->find({
file => "foo", file => "foo",
fatal => 1, fatal => 1,
}); });
@ -368,7 +368,7 @@ sub find
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
# WARNING: Don't call Log from here! It causes it to abort # WARNING: Don't call Log from here! It causes it to abort
my $debug = 0; my $debug = 0;
@ -379,7 +379,7 @@ sub find
my $full_path = "#!not_found!#"; my $full_path = "#!not_found!#";
if ($file) if ($file)
{ {
foreach my $directory (@{$an->Storage->search_directories()}) foreach my $directory (@{$anvil->Storage->search_directories()})
{ {
# If "directory" is ".", expand it. # If "directory" is ".", expand it.
print $THIS_FILE." ".__LINE__."; [ Debug] - >> directory: [$directory]\n" if $debug; print $THIS_FILE." ".__LINE__."; [ Debug] - >> directory: [$directory]\n" if $debug;
@ -416,7 +416,7 @@ sub find
This creates a directory (and any parent directories). This creates a directory (and any parent directories).
$an->Storage->make_directory({directory => "/foo/bar/baz", owner => "me", grou[ => "me", group => 755}); $anvil->Storage->make_directory({directory => "/foo/bar/baz", owner => "me", grou[ => "me", group => 755});
If it fails to create the directory, an alert will be logged. If it fails to create the directory, an alert will be logged.
@ -443,13 +443,13 @@ sub make_directory
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $directory = defined $parameter->{directory} ? $parameter->{directory} : ""; my $directory = defined $parameter->{directory} ? $parameter->{directory} : "";
my $group = defined $parameter->{group} ? $parameter->{group} : ""; my $group = defined $parameter->{group} ? $parameter->{group} : "";
my $mode = defined $parameter->{mode} ? $parameter->{mode} : ""; my $mode = defined $parameter->{mode} ? $parameter->{mode} : "";
my $user = defined $parameter->{user} ? $parameter->{user} : ""; my $user = defined $parameter->{user} ? $parameter->{user} : "";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
directory => $directory, directory => $directory,
group => $group, group => $group,
mode => $mode, mode => $mode,
@ -459,7 +459,7 @@ sub make_directory
# Make sure the user and group and just one digit or word. # Make sure the user and group and just one digit or word.
$user =~ s/^(\S+)\s.*$/$1/; $user =~ s/^(\S+)\s.*$/$1/;
$group =~ s/^(\S+)\s.*$/$1/; $group =~ s/^(\S+)\s.*$/$1/;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
group => $group, group => $group,
user => $user, user => $user,
}}); }});
@ -471,28 +471,28 @@ sub make_directory
next if not $this_directory; next if not $this_directory;
$working_directory .= "/$this_directory"; $working_directory .= "/$this_directory";
$working_directory =~ s/\/\//\//g; $working_directory =~ s/\/\//\//g;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { working_directory => $working_directory }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { working_directory => $working_directory }});
if (not -e $working_directory) if (not -e $working_directory)
{ {
# Directory doesn't exist, so create it. # Directory doesn't exist, so create it.
my $shell_call = $an->data->{path}{exe}{'mkdir'}." ".$working_directory; my $shell_call = $anvil->data->{path}{exe}{'mkdir'}." ".$working_directory;
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0011", variables => { shell_call => $shell_call }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0011", variables => { shell_call => $shell_call }});
open (my $file_handle, $shell_call." 2>&1 |") or $an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0014", variables => { shell_call => $shell_call, error => $! }}); open (my $file_handle, $shell_call." 2>&1 |") or $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0014", variables => { shell_call => $shell_call, error => $! }});
while(<$file_handle>) while(<$file_handle>)
{ {
chomp; chomp;
my $line = $_; my $line = $_;
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0017", variables => { line => $line }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0017", variables => { line => $line }});
} }
close $file_handle; close $file_handle;
if ($mode) if ($mode)
{ {
$an->Storage->change_mode({target => $working_directory, mode => $mode}); $anvil->Storage->change_mode({target => $working_directory, mode => $mode});
} }
if (($user) or ($group)) if (($user) or ($group))
{ {
$an->Storage->change_owner({target => $working_directory, user => $user, group => $group}); $anvil->Storage->change_owner({target => $working_directory, user => $user, group => $group});
} }
} }
} }
@ -502,16 +502,16 @@ sub make_directory
=head2 read_config =head2 read_config
This method is used to read 'AN::Tools' style configuration files. These configuration files are in the format: This method is used to read 'Anvil::Tools' style configuration files. These configuration files are in the format:
# This is a comment for the 'a::b::c' variable # This is a comment for the 'a::b::c' variable
a::b::c = x a::b::c = x
A configuration file can be read in like this; A configuration file can be read in like this;
$an->Storage->read_config({file => "test.conf"}); $anvil->Storage->read_config({file => "test.conf"});
In this example, the file 'C<< test.conf >>' will be searched for in the directories returned by 'C<< $an->Storage->search_directories >>'. In this example, the file 'C<< test.conf >>' will be searched for in the directories returned by 'C<< $anvil->Storage->search_directories >>'.
Any line starting with '#' is a comment and is ignored. Preceding white spaces are allowed and also ignored. Any line starting with '#' is a comment and is ignored. Preceding white spaces are allowed and also ignored.
@ -529,36 +529,36 @@ Parameters;
This is the configuration file to read. This is the configuration file to read.
If the 'C<< file >>' parameter starts with 'C<< / >>', the exact path to the file is used. Otherwise, this method will search for the file in the list of directories returned by 'C<< $an->Storage->search_directories >>'. The first match is read in. If the 'C<< file >>' parameter starts with 'C<< / >>', the exact path to the file is used. Otherwise, this method will search for the file in the list of directories returned by 'C<< $anvil->Storage->search_directories >>'. The first match is read in.
All variables are stored in the root of 'C<< $an->data >>', allowing for configuration files to override internally set variables. All variables are stored in the root of 'C<< $anvil->data >>', allowing for configuration files to override internally set variables.
For example, if you set: For example, if you set:
$an->data->{a}{b}{c} = "1"; $anvil->data->{a}{b}{c} = "1";
Then you read in a config file with: Then you read in a config file with:
a::b::c = x a::b::c = x
Then 'C<< $an->data->{a}{b}{c} >>' will now contain 'C<< x >>'. Then 'C<< $anvil->data->{a}{b}{c} >>' will now contain 'C<< x >>'.
=cut =cut
sub read_config sub read_config
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
# Setup default values # Setup default values
my $file = defined $parameter->{file} ? $parameter->{file} : 0; my $file = defined $parameter->{file} ? $parameter->{file} : 0;
my $return_code = 0; my $return_code = 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { file => $file }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { file => $file }});
if (not $file) if (not $file)
{ {
# No file to read # No file to read
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0032"}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0032"});
$return_code = 1; $return_code = 1;
} }
@ -567,13 +567,13 @@ sub read_config
{ {
# Find the file, if possible. If not found, we'll not alter what the user passed in and hope # Find the file, if possible. If not found, we'll not alter what the user passed in and hope
# it is relative to where we are. # it is relative to where we are.
my $path = $an->Storage->find({ file => $file }); my $path = $anvil->Storage->find({ file => $file });
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { path => $path }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { path => $path }});
if ($path ne "#!not_found!#") if ($path ne "#!not_found!#")
{ {
# Update the file # Update the file
$file = $path; $file = $path;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { file => $file }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { file => $file }});
} }
} }
@ -582,13 +582,13 @@ sub read_config
if (not -e $file) if (not -e $file)
{ {
# The file doesn't exist # The file doesn't exist
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0033", variables => { file => $file }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0033", variables => { file => $file }});
$return_code = 2; $return_code = 2;
} }
elsif (not -r $file) elsif (not -r $file)
{ {
# The file can't be read # The file can't be read
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0034", variables => { $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0034", variables => {
file => $file, file => $file,
user => getpwuid($<), user => getpwuid($<),
uid => $<, uid => $<,
@ -614,14 +614,14 @@ sub read_config
$value =~ s/^\s+//; $value =~ s/^\s+//;
if (not $variable) if (not $variable)
{ {
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0035", variables => { $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0035", variables => {
file => $file, file => $file,
count => $count, count => $count,
line => $line, line => $line,
}}); }});
} }
$an->_make_hash_reference($an->data, $variable, $value); $anvil->_make_hash_reference($anvil->data, $variable, $value);
} }
close $file_handle; close $file_handle;
} }
@ -634,7 +634,7 @@ sub read_config
This reads in a file and returns the contents of the file as a single string variable. This reads in a file and returns the contents of the file as a single string variable.
my $body = $an->Storage->read_file({file => "/tmp/foo"}); my $body = $anvil->Storage->read_file({file => "/tmp/foo"});
If it fails to find the file, or the file is not readable, 'C<< !!error!! >>' is returned. If it fails to find the file, or the file is not readable, 'C<< !!error!! >>' is returned.
@ -657,13 +657,13 @@ sub read_file
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $body = ""; my $body = "";
my $cache = defined $parameter->{cache} ? $parameter->{cache} : 1; my $cache = defined $parameter->{cache} ? $parameter->{cache} : 1;
my $file = defined $parameter->{file} ? $parameter->{file} : ""; my $file = defined $parameter->{file} ? $parameter->{file} : "";
my $force_read = defined $parameter->{force_read} ? $parameter->{force_read} : 0; my $force_read = defined $parameter->{force_read} ? $parameter->{force_read} : 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
cache => $cache, cache => $cache,
file => $file, file => $file,
force_read => $force_read, force_read => $force_read,
@ -671,38 +671,38 @@ sub read_file
if (not $file) if (not $file)
{ {
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->read_file()", parameter => "file" }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->read_file()", parameter => "file" }});
return("!!error!!"); return("!!error!!");
} }
elsif (not -e $file) elsif (not -e $file)
{ {
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0021", variables => { file => $file }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0021", variables => { file => $file }});
return("!!error!!"); return("!!error!!");
} }
elsif (not -r $file) elsif (not -r $file)
{ {
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0022", variables => { file => $file }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0022", variables => { file => $file }});
return("!!error!!"); return("!!error!!");
} }
# If I've read this before, don't read it again. # If I've read this before, don't read it again.
if ((exists $an->data->{cache}{file}{$file}) && (not $force_read)) if ((exists $anvil->data->{cache}{file}{$file}) && (not $force_read))
{ {
# Use the cache # Use the cache
$body = $an->data->{cache}{file}{$file}; $body = $anvil->data->{cache}{file}{$file};
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { body => $body }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { body => $body }});
} }
else else
{ {
# Read from disk. # Read from disk.
my $shell_call = $file; my $shell_call = $file;
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0012", variables => { shell_call => $shell_call }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0012", variables => { shell_call => $shell_call }});
open (my $file_handle, "<", $shell_call) or $an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0015", variables => { shell_call => $shell_call, error => $! }}); open (my $file_handle, "<", $shell_call) or $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0015", variables => { shell_call => $shell_call, error => $! }});
while(<$file_handle>) while(<$file_handle>)
{ {
chomp; chomp;
my $line = $_; my $line = $_;
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0023", variables => { line => $line }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0023", variables => { line => $line }});
$body .= $line."\n"; $body .= $line."\n";
} }
close $file_handle; close $file_handle;
@ -710,12 +710,12 @@ sub read_file
if ($cache) if ($cache)
{ {
$an->data->{cache}{file}{$file} = $body; $anvil->data->{cache}{file}{$file} = $body;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { "cache::file::$file" => $an->data->{cache}{file}{$file} }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { "cache::file::$file" => $anvil->data->{cache}{file}{$file} }});
} }
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { body => $body }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { body => $body }});
return($body); return($body);
} }
@ -723,7 +723,7 @@ sub read_file
This reads a file or directory's mode (sticky-bit and ownership) and returns the mode as a four-digit string (ie: 'c<< 0644 >>', 'C<< 4755 >>', etc. This reads a file or directory's mode (sticky-bit and ownership) and returns the mode as a four-digit string (ie: 'c<< 0644 >>', 'C<< 4755 >>', etc.
my $mode = $an->Storage->read_mode({file => "/tmp/foo"}); my $mode = $anvil->Storage->read_mode({file => "/tmp/foo"});
If it fails to find the file, or the file is not readable, 'C<< 0 >>' is returned. If it fails to find the file, or the file is not readable, 'C<< 0 >>' is returned.
@ -738,21 +738,21 @@ sub read_mode
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $debug = 1; my $debug = 1;
my $target = defined $parameter->{target} ? $parameter->{target} : ""; my $target = defined $parameter->{target} ? $parameter->{target} : "";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { target => $target }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { target => $target }});
if (not $target) if (not $target)
{ {
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->read_mode()", parameter => "target" }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0020", variables => { method => "Storage->read_mode()", parameter => "target" }});
return(1); return(1);
} }
# Read the mode and convert it to digits. # Read the mode and convert it to digits.
my $mode = (stat($target))[2]; my $mode = (stat($target))[2];
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { mode => $mode }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { mode => $mode }});
# Return the full mode, unless it is a directory or file. In those cases, return the last four digits. # Return the full mode, unless it is a directory or file. In those cases, return the last four digits.
my $say_mode = $mode; my $say_mode = $mode;
@ -761,17 +761,17 @@ sub read_mode
# Directory - five digits # Directory - five digits
$say_mode = sprintf("%04o", $mode); $say_mode = sprintf("%04o", $mode);
$say_mode =~ s/^\d(\d\d\d\d)$/$1/; $say_mode =~ s/^\d(\d\d\d\d)$/$1/;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { say_mode => $say_mode }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { say_mode => $say_mode }});
} }
elsif (-f $target) elsif (-f $target)
{ {
# File - six digits # File - six digits
$say_mode = sprintf("%04o", $mode); $say_mode = sprintf("%04o", $mode);
$say_mode =~ s/^\d\d(\d\d\d\d)$/$1/; $say_mode =~ s/^\d\d(\d\d\d\d)$/$1/;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { say_mode => $say_mode }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { say_mode => $say_mode }});
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { mode => $mode, say_mode => $say_mode }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { mode => $mode, say_mode => $say_mode }});
return($say_mode); return($say_mode);
} }
@ -791,14 +791,14 @@ By default, it is set to all directories in C<< @INC >>, 'C<< path::directories:
If this is set, the list of directories to search will be set to 'C<< @INC >>' + 'C<< $ENV{'PATH'} >>' + 'C<< path::directories::tools >>'. If this is set, the list of directories to search will be set to 'C<< @INC >>' + 'C<< $ENV{'PATH'} >>' + 'C<< path::directories::tools >>'.
NOTE: You don't need to call this manually unless you want to reset the list. Invoking AN::Tools->new() causes this to be called automatically. NOTE: You don't need to call this manually unless you want to reset the list. Invoking Anvil::Tools->new() causes this to be called automatically.
=cut =cut
sub search_directories sub search_directories
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
# Set a default if nothing was passed. # Set a default if nothing was passed.
my $array = defined $parameter->{directories} ? $parameter->{directories} : ""; my $array = defined $parameter->{directories} ? $parameter->{directories} : "";
@ -816,7 +816,7 @@ sub search_directories
if (not $initialize) if (not $initialize)
{ {
# Not initializing and an array was passed that isn't. # Not initializing and an array was passed that isn't.
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0031", variables => { array => $array }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0031", variables => { array => $array }});
} }
# Create a new array containing the '$ENV{'PATH'}' directories and the @INC directories. # Create a new array containing the '$ENV{'PATH'}' directories and the @INC directories.
@ -827,7 +827,7 @@ sub search_directories
} }
# Add the tools directory # Add the tools directory
push @new_array, $an->data->{path}{directories}{tools}; push @new_array, $anvil->data->{path}{directories}{tools};
$array = \@new_array; $array = \@new_array;
} }
@ -865,7 +865,7 @@ sub search_directories
# Debug # Debug
foreach my $directory (@{$self->{SEARCH_DIRECTORIES}}) foreach my $directory (@{$self->{SEARCH_DIRECTORIES}})
{ {
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { directory => $directory }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { directory => $directory }});
} }
return ($self->{SEARCH_DIRECTORIES}); return ($self->{SEARCH_DIRECTORIES});
@ -875,7 +875,7 @@ sub search_directories
This writes out a file on the local system. It can optionally set the mode as well. This writes out a file on the local system. It can optionally set the mode as well.
$an->Storage->write_file({file => "/tmp/foo", body => "some data", mode => 0644}); $anvil->Storage->write_file({file => "/tmp/foo", body => "some data", mode => 0644});
If it fails to write the file, an alert will be logged. If it fails to write the file, an alert will be logged.
@ -916,7 +916,7 @@ sub write_file
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $body = defined $parameter->{body} ? $parameter->{body} : ""; my $body = defined $parameter->{body} ? $parameter->{body} : "";
my $file = defined $parameter->{file} ? $parameter->{file} : ""; my $file = defined $parameter->{file} ? $parameter->{file} : "";
@ -925,7 +925,7 @@ sub write_file
my $overwrite = defined $parameter->{overwrite} ? $parameter->{overwrite} : 0; my $overwrite = defined $parameter->{overwrite} ? $parameter->{overwrite} : 0;
my $secure = defined $parameter->{secure} ? $parameter->{secure} : ""; my $secure = defined $parameter->{secure} ? $parameter->{secure} : "";
my $user = defined $parameter->{user} ? $parameter->{user} : ""; my $user = defined $parameter->{user} ? $parameter->{user} : "";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, secure => $secure, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, secure => $secure, list => {
body => $body, body => $body,
file => $file, file => $file,
group => $group, group => $group,
@ -938,7 +938,7 @@ sub write_file
# Make sure the user and group and just one digit or word. # Make sure the user and group and just one digit or word.
$user =~ s/^(\S+)\s.*$/$1/; $user =~ s/^(\S+)\s.*$/$1/;
$group =~ s/^(\S+)\s.*$/$1/; $group =~ s/^(\S+)\s.*$/$1/;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
group => $group, group => $group,
user => $user, user => $user,
}}); }});
@ -947,14 +947,14 @@ sub write_file
if ((-e $file) && (not $overwrite)) if ((-e $file) && (not $overwrite))
{ {
# Nope. # Nope.
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0040", variables => { file => $file }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0040", variables => { file => $file }});
$error = 1; $error = 1;
} }
if ($file !~ /^\/\w/) if ($file !~ /^\/\w/)
{ {
# Not a fully defined path, abort. # Not a fully defined path, abort.
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0041", variables => { file => $file }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0041", variables => { file => $file }});
$error = 1; $error = 1;
} }
@ -962,7 +962,7 @@ sub write_file
{ {
# Break the directory off the file. # Break the directory off the file.
my ($directory, $file_name) = ($file =~ /^(\/.*)\/(.*)$/); my ($directory, $file_name) = ($file =~ /^(\/.*)\/(.*)$/);
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
directory => $directory, directory => $directory,
file_name => $file_name, file_name => $file_name,
}}); }});
@ -970,7 +970,7 @@ sub write_file
if (not -e $directory) if (not -e $directory)
{ {
# Don't pass the mode as the file's mode is likely not executable. # Don't pass the mode as the file's mode is likely not executable.
$an->Storage->make_directory({ $anvil->Storage->make_directory({
directory => $directory, directory => $directory,
group => $group, group => $group,
user => $user, user => $user,
@ -981,27 +981,27 @@ sub write_file
# the mode before writing it. # the mode before writing it.
if ($secure) if ($secure)
{ {
my $shell_call = $an->data->{path}{exe}{touch}." ".$file; my $shell_call = $anvil->data->{path}{exe}{touch}." ".$file;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { shell_call => $shell_call }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { shell_call => $shell_call }});
$an->System->call({shell_call => $shell_call}); $anvil->System->call({shell_call => $shell_call});
$an->Storage->change_mode({target => $file, mode => $mode}); $anvil->Storage->change_mode({target => $file, mode => $mode});
} }
# Now write the file. # Now write the file.
my $shell_call = $file; my $shell_call = $file;
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, secure => $secure, key => "log_0013", variables => { shell_call => $shell_call }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, secure => $secure, key => "log_0013", variables => { shell_call => $shell_call }});
open (my $file_handle, ">", $shell_call) or $an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, secure => $secure, priority => "err", key => "log_0016", variables => { shell_call => $shell_call, error => $! }}); open (my $file_handle, ">", $shell_call) or $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, secure => $secure, priority => "err", key => "log_0016", variables => { shell_call => $shell_call, error => $! }});
print $file_handle $body; print $file_handle $body;
close $file_handle; close $file_handle;
if ($mode) if ($mode)
{ {
$an->Storage->change_mode({target => $file, mode => $mode}); $anvil->Storage->change_mode({target => $file, mode => $mode});
} }
if (($user) or ($group)) if (($user) or ($group))
{ {
$an->Storage->change_owner({target => $file, user => $user, group => $group}); $anvil->Storage->change_owner({target => $file, user => $user, group => $group});
} }
} }

568
AN/Tools/System.pm → Anvil/Tools/System.pm
View File

File diff suppressed because it is too large Load Diff

107
AN/Tools/Template.pm → Anvil/Tools/Template.pm
Unescape View File

@ -1,4 +1,4 @@
package AN::Tools::Template; package Anvil::Tools::Template;
# #
# This module contains methods used to handle templates. # This module contains methods used to handle templates.
# #
@ -22,18 +22,18 @@ my $THIS_FILE = "Template.pm";
=head1 NAME =head1 NAME
AN::Tools::Template Anvil::Tools::Template
Provides all methods related to template handling. Provides all methods related to template handling.
=head1 SYNOPSIS =head1 SYNOPSIS
use AN::Tools; use Anvil::Tools;
# Template a common object handle on all AN::Tools modules. # Template a common object handle on all Anvil::Tools modules.
my $an = AN::Tools->new(); my $anvil = Anvil::Tools->new();
# Access to methods using '$an->Template->X'. # Access to methods using '$anvil->Template->X'.
# #
# Example using '()'; # Example using '()';
@ -57,7 +57,7 @@ sub new
return ($self); return ($self);
} }
# Get a handle on the AN::Tools object. I know that technically that is a sibling module, but it makes more # Get a handle on the Anvil::Tools object. I know that technically that is a sibling module, but it makes more
# sense in this case to think of it as a parent. # sense in this case to think of it as a parent.
sub parent sub parent
{ {
@ -84,7 +84,7 @@ sub parent
This method takes a template file name and a template section name and returns that body template. This method takes a template file name and a template section name and returns that body template.
my $body = $an->Template->get({file => "foo.html", name => "bar"})) my $body = $anvil->Template->get({file => "foo.html", name => "bar"}))
=head2 Parameters; =head2 Parameters;
@ -100,6 +100,10 @@ This is the language (iso code) to use when inserting strings into the template.
This is the name of the template section, bounded by 'C<< <!-- start foo --> >>' and 'C<< <!-- end food --> >>' to read in from the file. This is the name of the template section, bounded by 'C<< <!-- start foo --> >>' and 'C<< <!-- end food --> >>' to read in from the file.
=head3 show_name (optional)
If set the C<< 1 >>, the HTML will have comments shows which parts came from what file. By default, this is disabled.
=head3 skin (optional) =head3 skin (optional)
By default, the active skin is set by 'C<< defaults::template::html >>' ('C<< alteeve >>' by default). This can be checked or set using 'C<< Template->skin >>'. By default, the active skin is set by 'C<< defaults::template::html >>' ('C<< alteeve >>' by default). This can be checked or set using 'C<< Template->skin >>'.
@ -115,30 +119,33 @@ sub get
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $debug = 3; my $debug = 3;
my $file = defined $parameter->{file} ? $parameter->{file} : ""; my $file = defined $parameter->{file} ? $parameter->{file} : "";
my $language = defined $parameter->{language} ? $parameter->{language} : $an->Words->language; my $language = defined $parameter->{language} ? $parameter->{language} : $anvil->Words->language;
my $name = defined $parameter->{name} ? $parameter->{name} : ""; my $name = defined $parameter->{name} ? $parameter->{name} : "";
my $skin = defined $parameter->{skin} ? $parameter->{skin} : $an->Template->skin; my $show_name = defined $parameter->{show_name} ? $parameter->{show_name} : 0;
my $skin = defined $parameter->{skin} ? $parameter->{skin} : $anvil->Template->skin;
my $variables = defined $parameter->{variables} ? $parameter->{variables} : ""; my $variables = defined $parameter->{variables} ? $parameter->{variables} : "";
$skin = $an->data->{path}{directories}{skins}."/".$skin; $skin = $anvil->data->{path}{directories}{skins}."/".$skin;
my $template = ""; my $template = "";
my $source = ""; my $source = "";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
file => $file, file => $file,
language => $language, language => $language,
name => $name, name => $name,
skin => $skin, skin => $skin,
}}); }});
my $show_name = $name eq "http_headers" ? 0 : 1;
# The 'http_headers' template can never show the name
$show_name = 0 if $name eq "http_headers";
my $error = 0; my $error = 0;
if (not $file) if (not $file)
{ {
# No file passed. # No file passed.
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0024"}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0024"});
$error = 1; $error = 1;
} }
else else
@ -148,19 +155,19 @@ sub get
{ {
# Fully defined path, don't alter it. # Fully defined path, don't alter it.
$source = $file; $source = $file;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { source => $source }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { source => $source }});
} }
else else
{ {
# Just a file name, prepend the skin path. # Just a file name, prepend the skin path.
$source = $skin."/".$file; $source = $skin."/".$file;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { source => $source }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { source => $source }});
} }
if (not -e $source) if (not -e $source)
{ {
# Source doesn't exist # Source doesn't exist
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0025", variables => { source => $source }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0025", variables => { source => $source }});
$error = 1; $error = 1;
} }
elsif (not -r $source) elsif (not -r $source)
@ -168,29 +175,29 @@ sub get
# Source isn't readable. # Source isn't readable.
my $user_name = getpwuid($<); my $user_name = getpwuid($<);
$user_name = $< if not $user_name; $user_name = $< if not $user_name;
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0026", variables => { source => $source, user_name => $user_name }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0026", variables => { source => $source, user_name => $user_name }});
$error = 1; $error = 1;
} }
} }
if (not $name) if (not $name)
{ {
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0027"}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0027"});
$error = 1; $error = 1;
} }
if (not $error) if (not $error)
{ {
my $in_template = 0; my $in_template = 0;
my $template_file = $an->Storage->read_file({file => $source}); my $template_file = $anvil->Storage->read_file({file => $source});
foreach my $line (split/\n/, $template_file) foreach my $line (split/\n/, $template_file)
{ {
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0023", variables => { line => $line }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => $debug, key => "log_0023", variables => { line => $line }});
if ($line =~ /^<!-- start $name -->/) if ($line =~ /^<!-- start $name -->/)
{ {
$in_template = 1; $in_template = 1;
if ($show_name) if ($show_name)
{ {
$template .= $line."\n"; $template .= "<!-- start: [$source] -> [$name] -->\n";
} }
next; next;
} }
@ -201,7 +208,7 @@ sub get
$in_template = 0; $in_template = 0;
if ($show_name) if ($show_name)
{ {
$template .= $line."\n"; $template .= "<!-- end: [$source] -> [$name] -->\n";
} }
last; last;
} }
@ -211,14 +218,14 @@ sub get
} }
} }
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { template => $template }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { template => $template }});
# Now that I have the skin, inject my variables. We'll use Words->string() to do this for us. # Now that I have the skin, inject my variables. We'll use Words->string() to do this for us.
$template = $an->Words->string({ $template = $anvil->Words->string({
string => $template, string => $template,
variables => $variables, variables => $variables,
}); });
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { source => $source }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { source => $source }});
} }
return($template); return($template);
@ -279,7 +286,7 @@ sub select_form
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $debug = 3; my $debug = 3;
my $name = defined $parameter->{name} ? $parameter->{name} : ""; my $name = defined $parameter->{name} ? $parameter->{name} : "";
@ -290,7 +297,7 @@ sub select_form
my $blank = defined $parameter->{blank} ? $parameter->{blank} : 0; # Add a blank/null entry? my $blank = defined $parameter->{blank} ? $parameter->{blank} : 0; # Add a blank/null entry?
my $say_blank = defined $parameter->{say_blank} ? $parameter->{say_blank} : ""; # An optional, grayed-out string in the place of the "blank" option my $say_blank = defined $parameter->{say_blank} ? $parameter->{say_blank} : ""; # An optional, grayed-out string in the place of the "blank" option
my $selected = defined $parameter->{selected} ? $parameter->{selected} : ""; # Pre-select an option? my $selected = defined $parameter->{selected} ? $parameter->{selected} : ""; # Pre-select an option?
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
name => $name, name => $name,
options => $options, options => $options,
'sort' => $sort, 'sort' => $sort,
@ -306,7 +313,7 @@ sub select_form
{ {
$select = "<select name=\"$name\" id=\"$id\" class=\"$class\">\n"; $select = "<select name=\"$name\" id=\"$id\" class=\"$class\">\n";
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }});
# Insert a blank line. # Insert a blank line.
if ($blank) if ($blank)
@ -323,12 +330,12 @@ sub select_form
{ {
$selected = ""; $selected = "";
$select .= "<option value=\"\" $blank_class selected>$blank_string</option>\n"; $select .= "<option value=\"\" $blank_class selected>$blank_string</option>\n";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }});
} }
else else
{ {
$select .= "<option value=\"\" $blank_class>$blank_string</option>\n"; $select .= "<option value=\"\" $blank_class>$blank_string</option>\n";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }});
} }
} }
@ -343,12 +350,12 @@ sub select_form
my $value = $1; my $value = $1;
my $description = $2; my $description = $2;
$select .= "<option value=\"$value\">$description</option>\n"; $select .= "<option value=\"$value\">$description</option>\n";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }});
} }
else else
{ {
$select .= "<option value=\"$entry\">$entry</option>\n"; $select .= "<option value=\"$entry\">$entry</option>\n";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }});
} }
} }
} }
@ -362,12 +369,12 @@ sub select_form
my $value = $1; my $value = $1;
my $description = $2; my $description = $2;
$select .= "<option value=\"$value\">$description</option>\n"; $select .= "<option value=\"$value\">$description</option>\n";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }});
} }
else else
{ {
$select .= "<option value=\"$entry\">$entry</option>\n"; $select .= "<option value=\"$entry\">$entry</option>\n";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }});
} }
} }
} }
@ -376,13 +383,13 @@ sub select_form
if ($selected) if ($selected)
{ {
$select =~ s/value=\"$selected\">/value=\"$selected\" selected>/m; $select =~ s/value=\"$selected\">/value=\"$selected\" selected>/m;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }});
} }
# Done! # Done!
$select .= "</select>\n"; $select .= "</select>\n";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'select' => $select }});
return($select); return($select);
} }
@ -394,11 +401,11 @@ The default skin is set via 'C<< defaults::template::html >>' and it must be the
Get the active skin directory; Get the active skin directory;
my $skin = $an->Template->skin; my $skin = $anvil->Template->skin;
Set the active skin to 'C<< foo >>'. Only pass the skin name, not the full path. Set the active skin to 'C<< foo >>'. Only pass the skin name, not the full path.
$an->Template->skin({set => "foo"}); $anvil->Template->skin({set => "foo"});
Parameters; Parameters;
@ -415,36 +422,36 @@ sub skin
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $debug = 3; my $debug = 3;
my $fatal = defined $parameter->{fatal} ? $parameter->{fatal} : 1; my $fatal = defined $parameter->{fatal} ? $parameter->{fatal} : 1;
my $set = defined $parameter->{set} ? $parameter->{set} : ""; my $set = defined $parameter->{set} ? $parameter->{set} : "";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { fatal => $fatal, set => $set }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { fatal => $fatal, set => $set }});
if ($set) if ($set)
{ {
my $skin_directory = $an->data->{path}{directories}{skins}."/".$set; my $skin_directory = $anvil->data->{path}{directories}{skins}."/".$set;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { skin_directory => $skin_directory }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { skin_directory => $skin_directory }});
if ((-d $skin_directory) or (not $fatal)) if ((-d $skin_directory) or (not $fatal))
{ {
$self->{SKIN}{HTML} = $set; $self->{SKIN}{HTML} = $set;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'SKIN::HTML' => $self->{SKIN}{HTML} }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'SKIN::HTML' => $self->{SKIN}{HTML} }});
} }
else else
{ {
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0031", variables => { set => $set, skin_directory => $skin_directory }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "log_0031", variables => { set => $set, skin_directory => $skin_directory }});
} }
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'SKIN::HTML' => $self->{SKIN}{HTML} }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'SKIN::HTML' => $self->{SKIN}{HTML} }});
if (not $self->{SKIN}{HTML}) if (not $self->{SKIN}{HTML})
{ {
$self->{SKIN}{HTML} = $an->data->{defaults}{template}{html}; $self->{SKIN}{HTML} = $anvil->data->{defaults}{template}{html};
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'SKIN::HTML' => $self->{SKIN}{HTML}, 'defaults::template::html' => $an->data->{defaults}{template}{html} }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'SKIN::HTML' => $self->{SKIN}{HTML}, 'defaults::template::html' => $anvil->data->{defaults}{template}{html} }});
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'SKIN::HTML' => $self->{SKIN}{HTML} }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { 'SKIN::HTML' => $self->{SKIN}{HTML} }});
return($self->{SKIN}{HTML}); return($self->{SKIN}{HTML});
} }

158
AN/Tools/Validate.pm → Anvil/Tools/Validate.pm
Unescape View File

@ -1,4 +1,4 @@
package AN::Tools::Validate; package Anvil::Tools::Validate;
# #
# This module contains methods used to validate types of data. # This module contains methods used to validate types of data.
# #
@ -27,21 +27,21 @@ my $THIS_FILE = "Validate.pm";
=head1 NAME =head1 NAME
AN::Tools::Validate Anvil::Tools::Validate
Provides all methods related to data validation. Provides all methods related to data validation.
=head1 SYNOPSIS =head1 SYNOPSIS
use AN::Tools; use Anvil::Tools;
# Validate a common object handle on all AN::Tools modules. # Validate a common object handle on all Anvil::Tools modules.
my $an = AN::Tools->new(); my $anvil = Anvil::Tools->new();
# Access to methods using '$an->Validate->X'. # Access to methods using '$anvil->Validate->X'.
# #
# Example using 'is_uuid()'; # Example using 'is_uuid()';
if ($an->Validate->is_uuid({uuid => $string})) if ($anvil->Validate->is_uuid({uuid => $string}))
{ {
print "The UUID: [$string] is valid!\n"; print "The UUID: [$string] is valid!\n";
} }
@ -61,7 +61,7 @@ sub new
return ($self); return ($self);
} }
# Get a handle on the AN::Tools object. I know that technically that is a sibling module, but it makes more # Get a handle on the Anvil::Tools object. I know that technically that is a sibling module, but it makes more
# sense in this case to think of it as a parent. # sense in this case to think of it as a parent.
sub parent sub parent
{ {
@ -123,7 +123,7 @@ sub form_field
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $valid = 1; my $valid = 1;
my $debug = 3; my $debug = 3;
@ -131,7 +131,7 @@ sub form_field
my $type = defined $parameter->{type} ? $parameter->{type} : ""; my $type = defined $parameter->{type} ? $parameter->{type} : "";
my $empty_ok = defined $parameter->{empty_ok} ? $parameter->{empty_ok} : 0; my $empty_ok = defined $parameter->{empty_ok} ? $parameter->{empty_ok} : 0;
my $zero = defined $parameter->{zero} ? $parameter->{zero} : 0; my $zero = defined $parameter->{zero} ? $parameter->{zero} : 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
name => $name, name => $name,
type => $type, type => $type,
empty_ok => $empty_ok, empty_ok => $empty_ok,
@ -140,73 +140,73 @@ sub form_field
if ((not $name) or (not $type)) if ((not $name) or (not $type))
{ {
$valid = 0; $valid = 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
} }
else else
{ {
if ((not exists $an->data->{cgi}{$name}{value}) or (not defined $an->data->{cgi}{$name}{value})) if ((not exists $anvil->data->{cgi}{$name}{value}) or (not defined $anvil->data->{cgi}{$name}{value}))
{ {
# Not defined # Not defined
$valid = 0; $valid = 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
} }
else else
{ {
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { "cgi::${name}::value" => $an->data->{cgi}{$name}{value} }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { "cgi::${name}::value" => $anvil->data->{cgi}{$name}{value} }});
if (not $an->data->{cgi}{$name}{value}) if (not $anvil->data->{cgi}{$name}{value})
{ {
if (not $empty_ok) if (not $empty_ok)
{ {
$valid = 0; $valid = 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
} }
} }
elsif (($type eq "alphanumeric") && (not $an->Validate->is_alphanumeric({string => $an->data->{cgi}{$name}{value}}))) elsif (($type eq "alphanumeric") && (not $anvil->Validate->is_alphanumeric({string => $anvil->data->{cgi}{$name}{value}})))
{ {
$valid = 0; $valid = 0;
$an->data->{cgi}{$name}{alert} = 1; $anvil->data->{cgi}{$name}{alert} = 1;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $an->data->{cgi}{$name}{alert} }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $anvil->data->{cgi}{$name}{alert} }});
} }
elsif (($type eq "domain_name") && (not $an->Validate->is_domain_name({name => $an->data->{cgi}{$name}{value}}))) elsif (($type eq "domain_name") && (not $anvil->Validate->is_domain_name({name => $anvil->data->{cgi}{$name}{value}})))
{ {
$valid = 0; $valid = 0;
$an->data->{cgi}{$name}{alert} = 1; $anvil->data->{cgi}{$name}{alert} = 1;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $an->data->{cgi}{$name}{alert} }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $anvil->data->{cgi}{$name}{alert} }});
} }
elsif (($type eq "ipv4") && (not $an->Validate->is_ipv4({ip => $an->data->{cgi}{$name}{value}}))) elsif (($type eq "ipv4") && (not $anvil->Validate->is_ipv4({ip => $anvil->data->{cgi}{$name}{value}})))
{ {
$valid = 0; $valid = 0;
$an->data->{cgi}{$name}{alert} = 1; $anvil->data->{cgi}{$name}{alert} = 1;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $an->data->{cgi}{$name}{alert} }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $anvil->data->{cgi}{$name}{alert} }});
} }
elsif (($type eq "mac") && (not $an->Validate->is_mac({mac => $an->data->{cgi}{$name}{value}}))) elsif (($type eq "mac") && (not $anvil->Validate->is_mac({mac => $anvil->data->{cgi}{$name}{value}})))
{ {
$valid = 0; $valid = 0;
$an->data->{cgi}{$name}{alert} = 1; $anvil->data->{cgi}{$name}{alert} = 1;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $an->data->{cgi}{$name}{alert} }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $anvil->data->{cgi}{$name}{alert} }});
} }
elsif (($type eq "positive_integer") && (not $an->Validate->is_positive_integer({number => $an->data->{cgi}{$name}{value}, zero => $zero}))) elsif (($type eq "positive_integer") && (not $anvil->Validate->is_positive_integer({number => $anvil->data->{cgi}{$name}{value}, zero => $zero})))
{ {
$valid = 0; $valid = 0;
$an->data->{cgi}{$name}{alert} = 1; $anvil->data->{cgi}{$name}{alert} = 1;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $an->data->{cgi}{$name}{alert} }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $anvil->data->{cgi}{$name}{alert} }});
} }
elsif (($type eq "subnet") && (not $an->Validate->is_subnet({subnet => $an->data->{cgi}{$name}{value}}))) elsif (($type eq "subnet") && (not $anvil->Validate->is_subnet({subnet => $anvil->data->{cgi}{$name}{value}})))
{ {
$valid = 0; $valid = 0;
$an->data->{cgi}{$name}{alert} = 1; $anvil->data->{cgi}{$name}{alert} = 1;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $an->data->{cgi}{$name}{alert} }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $anvil->data->{cgi}{$name}{alert} }});
} }
elsif (($type eq "uuid") && (not $an->Validate->is_uuid({uuid => $an->data->{cgi}{$name}{value}}))) elsif (($type eq "uuid") && (not $anvil->Validate->is_uuid({uuid => $anvil->data->{cgi}{$name}{value}})))
{ {
$valid = 0; $valid = 0;
$an->data->{cgi}{$name}{alert} = 1; $anvil->data->{cgi}{$name}{alert} = 1;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $an->data->{cgi}{$name}{alert} }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 1, list => { valid => $valid, "cgi::${name}::alert" => $anvil->data->{cgi}{$name}{alert} }});
} }
} }
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
return($valid); return($valid);
} }
@ -217,7 +217,7 @@ This verifies that the passed-in string contains only alpha-numeric characters.
NOTE: An empty string is considered invalid. NOTE: An empty string is considered invalid.
$string = "4words"; $string = "4words";
if ($an->Validate->is_alphanumeric({string => $string})) if ($anvil->Validate->is_alphanumeric({string => $string}))
{ {
print "The string: [$string] is valid!\n"; print "The string: [$string] is valid!\n";
} }
@ -233,26 +233,26 @@ sub is_alphanumeric
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $valid = 1; my $valid = 1;
my $debug = 3; my $debug = 3;
my $string = defined $parameter->{string} ? $parameter->{string} : ""; my $string = defined $parameter->{string} ? $parameter->{string} : "";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { string => $string }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { string => $string }});
if (not $string) if (not $string)
{ {
$valid = 0; $valid = 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
} }
if ($string !~ /^[a-zA-Z0-9]+$/) if ($string !~ /^[a-zA-Z0-9]+$/)
{ {
$valid = 0; $valid = 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
return($valid); return($valid);
} }
@ -261,7 +261,7 @@ sub is_alphanumeric
Checks if the passed-in string is a valid domain name. Returns 'C<< 1 >>' if OK, 'C<< 0 >>' if not. Checks if the passed-in string is a valid domain name. Returns 'C<< 1 >>' if OK, 'C<< 0 >>' if not.
$name = "alteeve.com"; $name = "alteeve.com";
if ($an->Validate->is_domain_name({name => $name})) if ($anvil->Validate->is_domain_name({name => $name}))
{ {
print "The domain name: [$name] is valid!\n"; print "The domain name: [$name] is valid!\n";
} }
@ -277,26 +277,26 @@ sub is_domain_name
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $valid = 1; my $valid = 1;
my $debug = 3; my $debug = 3;
my $name = $parameter->{name} ? $parameter->{name} : ""; my $name = $parameter->{name} ? $parameter->{name} : "";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { name => $name }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { name => $name }});
if (not $name) if (not $name)
{ {
$valid = 0; $valid = 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
} }
elsif (($name !~ /^((([a-z]|[0-9]|\-)+)\.)+([a-z])+$/i) && (($name !~ /^\w+$/) && ($name !~ /-/))) elsif (($name !~ /^((([a-z]|[0-9]|\-)+)\.)+([a-z])+$/i) && (($name !~ /^\w+$/) && ($name !~ /-/)))
{ {
# Doesn't appear to be valid. # Doesn't appear to be valid.
$valid = 0; $valid = 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
return($valid); return($valid);
} }
@ -305,7 +305,7 @@ sub is_domain_name
Checks if the passed-in string is an IPv4 address. Returns 'C<< 1 >>' if OK, 'C<< 0 >>' if not. Checks if the passed-in string is an IPv4 address. Returns 'C<< 1 >>' if OK, 'C<< 0 >>' if not.
$ip = "111.222.33.44"; $ip = "111.222.33.44";
if ($an->Validate->is_ipv4({ip => $ip})) if ($anvil->Validate->is_ipv4({ip => $ip}))
{ {
print "The IP address: [$ip] is valid!\n"; print "The IP address: [$ip] is valid!\n";
} }
@ -321,11 +321,11 @@ sub is_ipv4
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $debug = 3; my $debug = 3;
my $ip = defined $parameter->{ip} ? $parameter->{ip} : ""; my $ip = defined $parameter->{ip} ? $parameter->{ip} : "";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { ip => $ip }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { ip => $ip }});
my $valid = 1; my $valid = 1;
if ($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) if ($ip =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/)
@ -335,7 +335,7 @@ sub is_ipv4
my $second_octet = $2; my $second_octet = $2;
my $third_octet = $3; my $third_octet = $3;
my $fourth_octet = $4; my $fourth_octet = $4;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
first_octet => $first_octet, first_octet => $first_octet,
second_octet => $second_octet, second_octet => $second_octet,
third_octet => $third_octet, third_octet => $third_octet,
@ -349,17 +349,17 @@ sub is_ipv4
{ {
# One of the octets is out of range. # One of the octets is out of range.
$valid = 0; $valid = 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
} }
} }
else else
{ {
# Not in the right format. # Not in the right format.
$valid = 0; $valid = 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
return($valid); return($valid);
} }
@ -378,21 +378,21 @@ sub is_mac
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $debug = 3; my $debug = 3;
my $mac = defined $parameter->{mac} ? $parameter->{mac} : ""; my $mac = defined $parameter->{mac} ? $parameter->{mac} : "";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { mac => $mac }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { mac => $mac }});
my $valid = 0; my $valid = 0;
if ($mac =~ /^([0-9a-f]{2}([:-]|$)){6}$/i) if ($mac =~ /^([0-9a-f]{2}([:-]|$)){6}$/i)
{ {
# It is in the right format. # It is in the right format.
$valid = 1; $valid = 1;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
return($valid); return($valid);
} }
@ -403,7 +403,7 @@ This method verifies that the passed in value is a positive integer.
NOTE: This method is strict and will only validate numbers without decimal places and that have no sign or a positive sign only (ie: C<< +3 >>, or C<< 3 >> are valid, but C<< -3 >> or C<< 3.0 >> are not). NOTE: This method is strict and will only validate numbers without decimal places and that have no sign or a positive sign only (ie: C<< +3 >>, or C<< 3 >> are valid, but C<< -3 >> or C<< 3.0 >> are not).
my $number = 3; my $number = 3;
if ($an->Validate->is_positive_integer({number => $number})) if ($anvil->Validate->is_positive_integer({number => $number}))
{ {
print "The number: [$number] is valid!\n"; print "The number: [$number] is valid!\n";
} }
@ -423,13 +423,13 @@ sub is_positive_integer
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $debug = 3; my $debug = 3;
my $valid = 1; my $valid = 1;
my $number = defined $parameter->{number} ? $parameter->{number} : ""; my $number = defined $parameter->{number} ? $parameter->{number} : "";
my $zero = defined $parameter->{zero} ? $parameter->{zero} : 0; my $zero = defined $parameter->{zero} ? $parameter->{zero} : 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => {
number => $number, number => $number,
zero => $zero, zero => $zero,
}}); }});
@ -441,16 +441,16 @@ sub is_positive_integer
if ($number !~ /^\d+$/) if ($number !~ /^\d+$/)
{ {
$valid = 0; $valid = 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
} }
if ((not $zero) && (not $number)) if ((not $zero) && (not $number))
{ {
$valid = 0; $valid = 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
return($valid); return($valid);
} }
@ -469,43 +469,43 @@ sub is_subnet
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $valid = 0; my $valid = 0;
my $debug = 3; my $debug = 3;
my $subnet = defined $parameter->{subnet} ? $parameter->{subnet} : 0; my $subnet = defined $parameter->{subnet} ? $parameter->{subnet} : 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { subnet => $subnet }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { subnet => $subnet }});
if ($subnet) if ($subnet)
{ {
# We have something. Is it an IPv4 address? # We have something. Is it an IPv4 address?
if ($an->Validate->is_ipv4({ip => $subnet})) if ($anvil->Validate->is_ipv4({ip => $subnet}))
{ {
# It is. Try converting it to a CIDR notation. If we get an empty string back, it isn't valid. # It is. Try converting it to a CIDR notation. If we get an empty string back, it isn't valid.
my $cidr = $an->Convert->cidr({subnet => $subnet}); my $cidr = $anvil->Convert->cidr({subnet => $subnet});
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { cidr => $cidr }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { cidr => $cidr }});
if ($cidr) if ($cidr)
{ {
# It's valid. # It's valid.
$valid = 1; $valid = 1;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
} }
else else
{ {
# OK, maybe it's a CIDR notation? # OK, maybe it's a CIDR notation?
my $ip = $an->Convert->cidr({cidr => $subnet}); my $ip = $anvil->Convert->cidr({cidr => $subnet});
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { ip => $ip }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { ip => $ip }});
if ($ip) if ($ip)
{ {
# There we go. # There we go.
$valid = 1; $valid = 1;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
} }
} }
} }
} }
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => $debug, list => { valid => $valid }});
return($valid); return($valid);
} }
@ -515,7 +515,7 @@ This method takes a UUID string and returns 'C<< 1 >>' if it is a valid UUID str
NOTE: This method is strict and will only validate UUIDs that are lower case! NOTE: This method is strict and will only validate UUIDs that are lower case!
if ($an->Validate->is_uuid({uuid => $string})) if ($anvil->Validate->is_uuid({uuid => $string}))
{ {
print "The UUID: [$string] is valid!\n"; print "The UUID: [$string] is valid!\n";
} }
@ -531,7 +531,7 @@ sub is_uuid
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $uuid = defined $parameter->{uuid} ? $parameter->{uuid} : 0; my $uuid = defined $parameter->{uuid} ? $parameter->{uuid} : 0;
my $valid = 0; my $valid = 0;

106
AN/Tools/Words.pm → Anvil/Tools/Words.pm
Unescape View File

@ -1,4 +1,4 @@
package AN::Tools::Words; package Anvil::Tools::Words;
# #
# This module contains methods used to handle storage related tasks # This module contains methods used to handle storage related tasks
# #
@ -29,21 +29,21 @@ my $THIS_FILE = "Words.pm";
=head1 NAME =head1 NAME
AN::Tools::Words Anvil::Tools::Words
Provides all methods related to generating translated strings for users. Provides all methods related to generating translated strings for users.
=head1 SYNOPSIS =head1 SYNOPSIS
use AN::Tools; use Anvil::Tools;
# Get a common object handle on all AN::Tools modules. # Get a common object handle on all Anvil::Tools modules.
my $an = AN::Tools->new(); my $anvil = Anvil::Tools->new();
# Access to methods using '$an->Words->X'. # Access to methods using '$anvil->Words->X'.
# #
# Example using 'read()'; # Example using 'read()';
my $foo_path = $an->Words->read({file => $an->data->{path}{words}{'an-tools.xml'}}); my $foo_path = $anvil->Words->read({file => $anvil->data->{path}{words}{'anvil.xml'}});
=head1 METHODS =head1 METHODS
@ -64,7 +64,7 @@ sub new
return ($self); return ($self);
} }
# Get a handle on the AN::Tools object. I know that technically that is a sibling module, but it makes more # Get a handle on the Anvil::Tools object. I know that technically that is a sibling module, but it makes more
# sense in this case to think of it as a parent. # sense in this case to think of it as a parent.
sub parent sub parent
{ {
@ -91,7 +91,7 @@ sub parent
This methid takes a string via a 'C<< line >>' parameter and strips leading and trailing spaces, plus compresses multiple spaces into single spaces. It is designed primarily for use by code parsing text coming in from a shell command. This methid takes a string via a 'C<< line >>' parameter and strips leading and trailing spaces, plus compresses multiple spaces into single spaces. It is designed primarily for use by code parsing text coming in from a shell command.
my $line = $an->Words->clean_spaces({ string => $_ }); my $line = $anvil->Words->clean_spaces({ string => $_ });
Parameters; Parameters;
@ -104,7 +104,7 @@ sub clean_spaces
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
# Setup default values # Setup default values
my $string = defined $parameter->{string} ? $parameter->{string} : ""; my $string = defined $parameter->{string} ? $parameter->{string} : "";
@ -117,7 +117,7 @@ sub clean_spaces
=head2 key =head2 key
NOTE: This is likely not the method you want. This method does no parsing at all. It returns the raw string from the 'words' file. You probably want C<< $an->Words->string() >> if you want to inject variables and get a string back ready to display to the user. NOTE: This is likely not the method you want. This method does no parsing at all. It returns the raw string from the 'words' file. You probably want C<< $anvil->Words->string() >> if you want to inject variables and get a string back ready to display to the user.
This returns a string by its key name. Optionally, a language and/or a source file can be specified. When no file is specified, loaded files will be search in alphabetical order (including path) and the first match is returned. This returns a string by its key name. Optionally, a language and/or a source file can be specified. When no file is specified, loaded files will be search in alphabetical order (including path) and the first match is returned.
@ -125,21 +125,21 @@ If the requested string is not found, 'C<< #!not_found!# >>' is returned.
Example to retrieve 'C<< t_0001 >>'; Example to retrieve 'C<< t_0001 >>';
my $string = $an->Words->key({key => 't_0001'}); my $string = $anvil->Words->key({key => 't_0001'});
Same, but specifying the key from Canadian english; Same, but specifying the key from Canadian english;
my $string = $an->Words->key({ my $string = $anvil->Words->key({
key => 't_0001', key => 't_0001',
language => 'en_CA', language => 'en_CA',
}); });
Same, but specifying a source file. Same, but specifying a source file.
my $string = $an->Words->key({ my $string = $anvil->Words->key({
key => 't_0001', key => 't_0001',
language => 'en_CA', language => 'en_CA',
file => 'an-tools.xml', file => 'anvil.xml',
}); });
Parameters; Parameters;
@ -148,7 +148,7 @@ Parameters;
This is the specific file to read the string from. It should generally not be needed as string keys should not be reused. However, if it happens, this is a way to specify which file's version you want. This is the specific file to read the string from. It should generally not be needed as string keys should not be reused. However, if it happens, this is a way to specify which file's version you want.
The file can be the file name, or a path. The specified file is search for by matching the the passed in string against the end of the file path. For example, 'C<< file => 'AN/an-tools.xml' >> will match the file 'c<< /usr/share/perl5/AN/an-tools.xml >>'. The file can be the file name, or a path. The specified file is search for by matching the the passed in string against the end of the file path. For example, 'C<< file => 'AN/anvil.xml' >> will match the file 'c<< /usr/share/perl5/AN/anvil.xml >>'.
=head3 key (required) =head3 key (required)
@ -165,11 +165,11 @@ sub key
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
# Setup default values # Setup default values
my $key = defined $parameter->{key} ? $parameter->{key} : ""; my $key = defined $parameter->{key} ? $parameter->{key} : "";
my $language = defined $parameter->{language} ? $parameter->{language} : $an->Words->language; my $language = defined $parameter->{language} ? $parameter->{language} : $anvil->Words->language;
my $file = defined $parameter->{file} ? $parameter->{file} : ""; my $file = defined $parameter->{file} ? $parameter->{file} : "";
my $string = "#!not_found!#"; my $string = "#!not_found!#";
my $error = 0; my $error = 0;
@ -177,25 +177,25 @@ sub key
if (not $key) if (not $key)
{ {
#print $THIS_FILE." ".__LINE__."; AN::Tools::Words->key()' called without a key name to read.\n"; #print $THIS_FILE." ".__LINE__."; Anvil::Tools::Words->key()' called without a key name to read.\n";
$error = 1; $error = 1;
} }
if (not $language) if (not $language)
{ {
#print $THIS_FILE." ".__LINE__."; AN::Tools::Words->key()' called without a language, and 'defaults::languages::output' is not set.\n"; #print $THIS_FILE." ".__LINE__."; Anvil::Tools::Words->key()' called without a language, and 'defaults::languages::output' is not set.\n";
$error = 2; $error = 2;
} }
if (not $error) if (not $error)
{ {
foreach my $this_file (sort {$a cmp $b} keys %{$an->data->{words}}) foreach my $this_file (sort {$a cmp $b} keys %{$anvil->data->{words}})
{ {
#print $THIS_FILE." ".__LINE__."; [ Debug ] - this_file: [$this_file], file: [$file]\n"; #print $THIS_FILE." ".__LINE__."; [ Debug ] - this_file: [$this_file], file: [$file]\n";
# If they've specified a file and this doesn't match, skip it. # If they've specified a file and this doesn't match, skip it.
next if (($file) && ($this_file !~ /$file$/)); next if (($file) && ($this_file !~ /$file$/));
if (exists $an->data->{words}{$this_file}{language}{$language}{key}{$key}{content}) if (exists $anvil->data->{words}{$this_file}{language}{$language}{key}{$key}{content})
{ {
$string = $an->data->{words}{$this_file}{language}{$language}{key}{$key}{content}; $string = $anvil->data->{words}{$this_file}{language}{$language}{key}{$key}{content};
#print $THIS_FILE." ".__LINE__."; [ Debug ] - string: [$string]\n"; #print $THIS_FILE." ".__LINE__."; [ Debug ] - string: [$string]\n";
last; last;
} }
@ -212,18 +212,18 @@ This sets or returns the output language ISO code.
Get the current log language; Get the current log language;
my $language = $an->Words->language; my $language = $anvil->Words->language;
Set the output langauge to Japanese; Set the output langauge to Japanese;
$an->Words->language({set => "jp"}); $anvil->Words->language({set => "jp"});
=cut =cut
sub language sub language
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
my $set = defined $parameter->{set} ? $parameter->{set} : ""; my $set = defined $parameter->{set} ? $parameter->{set} : "";
@ -234,7 +234,7 @@ sub language
if (not $self->{WORDS}{LANGUAGE}) if (not $self->{WORDS}{LANGUAGE})
{ {
$self->{WORDS}{LANGUAGE} = $an->data->{defaults}{language}{output}; $self->{WORDS}{LANGUAGE} = $anvil->data->{defaults}{language}{output};
} }
return($self->{WORDS}{LANGUAGE}); return($self->{WORDS}{LANGUAGE});
@ -244,10 +244,10 @@ sub language
This reads in a words file containing translated strings used to generated output for the user. This reads in a words file containing translated strings used to generated output for the user.
Example to read 'C<< an-tools.xml >>'; Example to read 'C<< anvil.xml >>';
my $words_file = $an->data->{path}{words}{'an-words.xml'}; my $words_file = $anvil->data->{path}{words}{'an-words.xml'};
my $an->Words->read({file => $words_file}) or die "Failed to read: [$words_file]. Does the file exist?\n"; my $anvil->Words->read({file => $words_file}) or die "Failed to read: [$words_file]. Does the file exist?\n";
Successful read will return '0'. Non-0 is an error; Successful read will return '0'. Non-0 is an error;
0 = OK 0 = OK
@ -256,7 +256,7 @@ Successful read will return '0'. Non-0 is an error;
3 = File not readable 3 = File not readable
4 = File found, failed to read for another reason. The error details will be printed. 4 = File found, failed to read for another reason. The error details will be printed.
NOTE: Read works are stored in 'C<< $an->data->{words}{<file_name>}{language}{<language>}{string}{content} >>'. Metadata, like what languages are provided, are stored under 'C<< $an->data->{words}{<file_name>}{meta}{...} >>'. NOTE: Read works are stored in 'C<< $anvil->data->{words}{<file_name>}{language}{<language>}{string}{content} >>'. Metadata, like what languages are provided, are stored under 'C<< $anvil->data->{words}{<file_name>}{meta}{...} >>'.
Parameters; Parameters;
@ -269,36 +269,36 @@ sub read
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
# Setup default values # Setup default values
my $return_code = 0; my $return_code = 0;
my $file = defined $parameter->{file} ? $parameter->{file} : 0; my $file = defined $parameter->{file} ? $parameter->{file} : 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { file => $file }}); $anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { file => $file }});
if (not $file) if (not $file)
{ {
# NOTE: Log the problem, do not translate. # NOTE: Log the problem, do not translate.
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", raw => "[ Error ] - Words->read()' called without a file name to read."}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", raw => "[ Error ] - Words->read()' called without a file name to read."});
$return_code = 1; $return_code = 1;
} }
elsif (not -e $file) elsif (not -e $file)
{ {
# NOTE: Log the problem, do not translate. # NOTE: Log the problem, do not translate.
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", raw => "[ Error ] - Words->read()' asked to read: [$file] which was not found."}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", raw => "[ Error ] - Words->read()' asked to read: [$file] which was not found."});
$return_code = 2; $return_code = 2;
} }
elsif (not -r $file) elsif (not -r $file)
{ {
# NOTE: Log the problem, do not translate. # NOTE: Log the problem, do not translate.
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", raw => "[ Error ] - Words->read()' asked to read: [$file] which was not readable by: [".getpwuid($<)."] (uid/euid: [".$<."])."}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", raw => "[ Error ] - Words->read()' asked to read: [$file] which was not readable by: [".getpwuid($<)."] (uid/euid: [".$<."])."});
$return_code = 3; $return_code = 3;
} }
else else
{ {
# Read the file with XML::Simple # Read the file with XML::Simple
my $xml = XML::Simple->new(); my $xml = XML::Simple->new();
eval { $an->data->{words}{$file} = $xml->XMLin($file, KeyAttr => { language => 'name', key => 'name' }, ForceArray => [ 'language', 'key' ]) }; eval { $anvil->data->{words}{$file} = $xml->XMLin($file, KeyAttr => { language => 'name', key => 'name' }, ForceArray => [ 'language', 'key' ]) };
if ($@) if ($@)
{ {
chomp $@; chomp $@;
@ -306,12 +306,12 @@ sub read
$error .= "===========================================================\n"; $error .= "===========================================================\n";
$error .= $@."\n"; $error .= $@."\n";
$error .= "===========================================================\n"; $error .= "===========================================================\n";
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", raw => $error}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", raw => $error});
$return_code = 4; $return_code = 4;
} }
else else
{ {
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0028", variables => { file => $file }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0028", variables => { file => $file }});
} }
} }
@ -326,7 +326,7 @@ If the requested string is not found, 'C<< #!not_found!# >>' is returned.
Example to retrieve 'C<< t_0001 >>'; Example to retrieve 'C<< t_0001 >>';
my $string = $an->Words->string({key => 't_0001'}); my $string = $anvil->Words->string({key => 't_0001'});
This time, requesting 'C<< t_0002 >>' and passing in two variables. Note that 'C<< t_0002 >>' in Canadian English is; This time, requesting 'C<< t_0002 >>' and passing in two variables. Note that 'C<< t_0002 >>' in Canadian English is;
@ -334,7 +334,7 @@ This time, requesting 'C<< t_0002 >>' and passing in two variables. Note that 'C
So to request this string in Canadian English is the two variables inserted, we would call: So to request this string in Canadian English is the two variables inserted, we would call:
my $string = $an->Words->string({ my $string = $anvil->Words->string({
language => 'en_CA', language => 'en_CA',
key => 't_0002', key => 't_0002',
variables => { variables => {
@ -349,9 +349,9 @@ This would return;
Normally, there should never be a key collision. However, just in case you find yourself needing to request the string from a specific file, you can do the same call with a file specified. Normally, there should never be a key collision. However, just in case you find yourself needing to request the string from a specific file, you can do the same call with a file specified.
my $string = $an->Words->string({ my $string = $anvil->Words->string({
language => 'en_CA', language => 'en_CA',
file => 'an-tools.xml', file => 'anvil.xml',
key => 't_0002', key => 't_0002',
variables => { variables => {
first => "foo", first => "foo",
@ -392,11 +392,11 @@ sub string
{ {
my $self = shift; my $self = shift;
my $parameter = shift; my $parameter = shift;
my $an = $self->parent; my $anvil = $self->parent;
# Setup default values # Setup default values
my $key = defined $parameter->{key} ? $parameter->{key} : ""; my $key = defined $parameter->{key} ? $parameter->{key} : "";
my $language = defined $parameter->{language} ? $parameter->{language} : $an->Words->language; my $language = defined $parameter->{language} ? $parameter->{language} : $anvil->Words->language;
my $file = defined $parameter->{file} ? $parameter->{file} : ""; my $file = defined $parameter->{file} ? $parameter->{file} : "";
my $string = defined $parameter->{string} ? $parameter->{string} : ""; my $string = defined $parameter->{string} ? $parameter->{string} : "";
my $variables = defined $parameter->{variables} ? $parameter->{variables} : ""; my $variables = defined $parameter->{variables} ? $parameter->{variables} : "";
@ -406,7 +406,7 @@ sub string
# we'll exit. # we'll exit.
if (not $string) if (not $string)
{ {
$string = $an->Words->key({ $string = $anvil->Words->key({
key => $key, key => $key,
language => $language, language => $language,
file => $file, file => $file,
@ -417,7 +417,7 @@ sub string
{ {
# We've got a string and variables from the caller, so inject them as needed. # We've got a string and variables from the caller, so inject them as needed.
my $loops = 0; my $loops = 0;
my $limit = $an->data->{defaults}{limits}{string_loops} =~ /^\d+$/ ? $an->data->{defaults}{limits}{string_loops} : 1000; my $limit = $anvil->data->{defaults}{limits}{string_loops} =~ /^\d+$/ ? $anvil->data->{defaults}{limits}{string_loops} : 1000;
# If the user didn't pass in any variables, then we're in trouble. # If the user didn't pass in any variables, then we're in trouble.
if (($string =~ /#!variable!(.+?)!#/s) && ((not $variables) or (ref($variables) ne "HASH"))) if (($string =~ /#!variable!(.+?)!#/s) && ((not $variables) or (ref($variables) ne "HASH")))
@ -431,7 +431,7 @@ sub string
$loops++; $loops++;
die "$THIS_FILE ".__LINE__."; Infinite loop detected while processing the string: [".$string."] from the key: [$key] in language: [$language], exiting.\n" if $loops > $limit; die "$THIS_FILE ".__LINE__."; Infinite loop detected while processing the string: [".$string."] from the key: [$key] in language: [$language], exiting.\n" if $loops > $limit;
} }
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0042", variables => { string => $string }}); $anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "log_0042", variables => { string => $string }});
return("#!error!#"); return("#!error!#");
} }
@ -463,7 +463,7 @@ sub string
while ($string =~ /#!string!(.+?)!#/) while ($string =~ /#!string!(.+?)!#/)
{ {
my $key = $1; my $key = $1;
my $this_string = $an->Words->key({ my $this_string = $anvil->Words->key({
key => $key, key => $key,
language => $language, language => $language,
file => $file, file => $file,
@ -519,14 +519,14 @@ sub string
die "$THIS_FILE ".__LINE__."; Infinite loop detected while processing the string: [".$string."] from the key: [$key] in language: [$language], exiting.\n" if $loops > $limit; die "$THIS_FILE ".__LINE__."; Infinite loop detected while processing the string: [".$string."] from the key: [$key] in language: [$language], exiting.\n" if $loops > $limit;
} }
# Next, convert '#!data!x!#' to the value in '$an->data->{x}'. # Next, convert '#!data!x!#' to the value in '$anvil->data->{x}'.
while ($string =~ /#!data!(.+?)!#/) while ($string =~ /#!data!(.+?)!#/)
{ {
my $id = $1; my $id = $1;
if ($id =~ /::/) if ($id =~ /::/)
{ {
# Multi-dimensional hash. # Multi-dimensional hash.
my $value = $an->_get_hash_reference({ key => $id }); my $value = $anvil->_get_hash_reference({ key => $id });
if (not defined $value) if (not defined $value)
{ {
$string =~ s/#!data!$id!#/!!a[$id]!!/; $string =~ s/#!data!$id!#/!!a[$id]!!/;
@ -539,13 +539,13 @@ sub string
else else
{ {
# One dimension # One dimension
if (not defined $an->data->{$id}) if (not defined $anvil->data->{$id})
{ {
$string =~ s/#!data!$id!#/!!b[$id]!!/; $string =~ s/#!data!$id!#/!!b[$id]!!/;
} }
else else
{ {
my $value = $an->data->{$id}; my $value = $anvil->data->{$id};
$string =~ s/#!data!$id!#/$value/; $string =~ s/#!data!$id!#/$value/;
} }
} }

22
Anvil/anvil-tools.xml
Unescape View File

@ -0,0 +1,22 @@
<?xml version="1.0" encoding="UTF-8"?>
<!--
Company: Alteeve's Niche, Inc.
License: GPL v2+
Author: Madison Kelly <mkelly@alteeve.ca>
This is the AN::Tools master 'words' file.
-->
<words>
<meta version="3.0.0" languages="en_CA,jp"/>
<!-- Canadian English -->
<language name="en_CA" long_name="Canadian English" description="Created by Madison Kelly (mkelly@alteeve.ca) for the AN::Tools suite of perl modules">
</language>
<!-- 日本語 -->
<language name="jp" long_name="日本語" description=">Created by Madison Kelly (mkelly@alteeve.ca) for the AN::Tools suite of perl modules.">
</language>
</words>

2
AN/test.conf → Anvil/test.conf
Unescape View File

@ -1,5 +1,5 @@
### DO NOT EDIT THIS FILE! ### DO NOT EDIT THIS FILE!
# This is a test configuration file used by AN::Tools to validate AN::Tools::Storage->read_config()'. If you # This is a test configuration file used by Anvil::Tools to validate Anvil::Tools::Storage->read_config()'. If you
# change any of the variable = value pairs below, you MUST also update 'AN/Tools.t'! # change any of the variable = value pairs below, you MUST also update 'AN/Tools.t'!
foo::bar::a = I am "a" foo::bar::a = I am "a"
foo::bar::b = I am "b", split with tabs and having trailing spaces. foo::bar::b = I am "b", split with tabs and having trailing spaces.

4
AN/tools.conf → Anvil/tools.conf
Unescape View File

@ -32,7 +32,7 @@
#defaults::log::server = #defaults::log::server =
# This sets the default log tag used when logging an entry. Most programs will likely override this. # This sets the default log tag used when logging an entry. Most programs will likely override this.
#defaults::log::tag = an-tools #defaults::log::tag = anvil
### Templates ### Templates
@ -79,6 +79,6 @@
# automatically the first time it is needed. # automatically the first time it is needed.
sys::database::archive::compress = 1 sys::database::archive::compress = 1
sys::database::archive::count = 50000 sys::database::archive::count = 50000
sys::database::archive::directory = /usr/local/an-tools/archives/ sys::database::archive::directory = /usr/local/anvil/archives/
sys::database::archive::division = 60000 sys::database::archive::division = 60000
sys::database::archive::trigger = 100000 sys::database::archive::trigger = 100000

116
anvil.conf
Unescape View File

@ -0,0 +1,116 @@
# This is the main Striker (and ScanCore) configuration file.
#
database::1::host = 192.168.122.201
database::1::port = 5432
database::1::name = scancore
database::1::user = admin
database::1::password = Initial1
database::1::ping_before_connect = 1
database::2::host = 192.168.122.202
database::2::port = 5432
database::2::name = scancore
database::2::user = admin
database::2::password = Initial1
database::2::ping_before_connect = 1
# This is the schema for the ScanCore database.
sys::database::schema = /etc/scancore/scancore.sql
# This puts a limit on how many queries (writes, generally) to make in a single batch transaction. This is
# useful when doing very large transacions, like resync'ing a large table, by limiting how long a given
# transaction can take and how much memory is used.
#sys::database::maximum_batch_size = 25000
# By default, we try to determine the host type using the host name. The rules used for this can be seen in
# 'perldoc Anvil::Tools::System -> determine_host_type'. If you are using non-standard host names, or for some
# other reason want to statically assign the host type, you can do so with this variable. Note that this sets
# the host type of this host only. You will need to set this appropriately on other hosts.
#
# Normally, you should not need to set this.
#sys::host_type = node
# This configuration file provides a way to override Anvil::Tools' built-in defaults.
# This controls the default language. The value is the ISO code of the country's language you want to use by
# default. Note that the logging language is set with 'defaults::log::language' below.
# NOTE: Be sure the language exists before changing it!
#defaults::languages::output = en_CA
# This controls how many loops Anvil::Tools::Words is allow to make while processing a string. This acts as a
# mechanism to exit infinite loops, and generally should not need to be changed.
#defaults::limits::string_loops = 1000
### Logging options
# This controls whether all database transactions are recorded or not. Genreally this should be left off
# unless you are debugging the program.
# WARNING: This ignores 'secure', and will always be logged. Be careful about exposing sensitive data!
#defaults::log::db_transactions = 0
# This controls what log facility to use by default.
# NOTE: This will always be 'authpriv' when a log entry is marked as secure.
#defaults::log::facility = local0
# This controls what language logs are recorded in. Be sure that the language exists before changing it!
#defaults::log::language = en_CA
# This controls the default log level. See 'perldoc Anvil::Tools::Logs' for details.
#defaults::log::level = 1
# This controls whether sensitive log entries are logged or not. Generally, this should be left disabled!
#defaults::log::secure = 0,
# THis sets the default log server to send the log entries to. Leave it blank in most cases.
#defaults::log::server =
# This sets the default log tag used when logging an entry. Most programs will likely override this.
#defaults::log::tag = anvil
### Templates
# This sets the default template used when rendering HTML pages. It must be the same as the directory name
# under /var/www/html/skins/
#defaults::template::html = alteeve
### Database
# To keep ScanCore's database growth in check, an auto-archive mechanism is
# used by some agents where, at the end of each scan, the number of records in
# the history schema for a given table are counted (restricted to the agent's
# host, when appropriate).
#
# When the number exceeds the trigger, the number of records that are archived
# is approximately (number of records above trigger + 'count'). This is not an
# exact number because a representative timestamp will be selected from the
# hostory schema at this count, and then any record equal to or older than the
# time stamp is removed.
#
# To protect against the potential of using too much disk space, archives are
# off by default. Under normal behaviour, old records are simple removed. To
# enable the archive function, set this to '1'.
#scancore::archive::save_to_disk = 1
#
# When archiving to disk is enabled, to protect against large memory use or
# long archive times in the case where the number of records to archive are
# particularly large, the 'division' value is used to break up the archive job
# into "chunks". Generally speaking, the division should be greater than the
# count, and never be needed. However, if the archive process takes too long,
# or if the archive was triggered well above the trigger value, the division
# can help prevent using too much memory at once. If division is set to '0',
# archive jobs will never be divided.
#
# The archives are all stored in the specified
# directory using the name format '<agent>.<table>.<timestamp>.bz2' and the
# archives are synced between dashboards for safe keeping. Archive files are
# never removed automatically.
#
# To disable auto-archiving entirely, set 'trigger' to '0'.
#
# NOTE: If the archive directory doesn't exist, ScanCore will create it
# automatically the first time it is needed.
sys::database::archive::compress = 1
sys::database::archive::count = 50000
sys::database::archive::directory = /usr/local/anvil/archives/
sys::database::archive::division = 60000
sys::database::archive::trigger = 100000

796
cgi-bin/home
View File

File diff suppressed because it is too large Load Diff

100
cgi-bin/words.xml
Unescape View File

@ -1,100 +0,0 @@
<?xml version="1.0" encoding="UTF-8"?>
<!--
Company: Alteeve's Niche, Inc.
License: GPL v2+
Author: Madison Kelly <mkelly@alteeve.ca>
This is the AN::Tools master 'words' file.
-->
<words>
<meta version="3.0.0" languages="en_CA,jp"/>
<!-- Canadian English -->
<language name="en_CA" long_name="Canadian English" description="Striker/ScanCore language file.">
<key name="brand_0001">Alteeve</key>
<key name="brand_0002">Anvil!</key>
<key name="brand_0003">Striker</key>
<key name="brand_0004">ScanCore</key>
<key name="brand_0005"><![CDATA[&copy; 2017 <a href="https://alteeve.com/" target="_new">Alteeve's Niche! Inc.</a>, Toronto, Ontario, Canada]]></key>
<key name="brand_0006"><![CDATA[<i>Anvil!</i>]]></key>
<key name="header_0001">Current Network Interfaces and States</key>
<key name="header_0002">MAC Address</key>
<key name="header_0003">Name</key>
<key name="header_0004">State</key>
<key name="header_0005">Speed</key>
<key name="header_0006">Up Order</key>
<!-- General strings shown in Striker -->
<key name="striker_0001">Welcome! Lets setup your #!string!brand_0003!# dashboard...</key>
<key name="striker_0002">We're going to ask you a few questions so that we can set things up for your environment. If you need help at any time, just click on the "[?]" icon in the top-right. Let's get started!</key>
<key name="striker_0003">Organization name</key>
<key name="striker_0004">This is the name of the company, organization or division that owns or maintains this #!string!brand_0006!#. This is a descriptive field and you can enter whatever makes most sense to you.</key>
<key name="striker_0005">Prefix</key>
<key name="striker_0006">This is a two to five character prefix used to identify this organization. It is used as the prefix for host names for dashboards, nodes and foundation pack equipment. You can use letters and numbers and set whatever makes sense to you.</key>
<key name="striker_0007">Domain Name</key>
<key name="striker_0008">This is the domain name you would like to use for this dashboard. This will also be used as the default domain used when creating new install manifests.</key>
<key name="striker_0009">Sequence Number</key>
<key name="striker_0010">If this is your first Striker, set this to '1'. If it is the second one, set '2'. If it is the third, '3' and so on.</key>
<key name="striker_0011">Internet-Facing Network Count</key>
<key name="striker_0012"><![CDATA[How many internal networks will this dashboard have access to? In most cases, this is just '1'.<br /><b>NOTE</b>: You must have a network interface for the back-channel network, plus one for each internal network. If you have two interfaces for each network, we will setup bonds for redundancy automatically.]]></key>
<key name="striker_0013">Next</key>
<key name="striker_0014">Step 1</key>
<key name="striker_0015">IFN Count</key>
<key name="striker_0016">Host name</key>
<key name="striker_0017">This is the hostname for this Striker dashboard. Generally it is a good idea to stick with the default.</key>
<key name="striker_0018">Back-Channel Network link #!variable!number!#</key>
<key name="striker_0019">This is where you configure the network to enable access this Back-Channel Network.</key>
<key name="striker_0020">Storage Network link #!variable!number!#</key>
<key name="striker_0021">This is where you configure the network to enable access this Storage Network.</key>
<key name="striker_0022">Internet-Facing Network link #!variable!number!#</key>
<key name="striker_0023">This is where you configure the network to enable access this Internet-Facing Network.</key>
<key name="striker_0024">IP Address</key>
<key name="striker_0025">Subnet</key>
<key name="striker_0026">Gateway</key>
<key name="striker_0027">DNS Server</key>
<key name="striker_0028">Network Interface</key>
<key name="striker_0029">Primary Interface</key>
<key name="striker_0030">Backup Interface</key>
<key name="striker_0031">Striker user name</key>
<key name="striker_0032">This is the user name that you will log into Striker as and the name of the user that owns the database.</key>
<key name="striker_0033">Striker password</key>
<key name="striker_0034"><![CDATA[This will be the password used to log into this Striker and connect to its database. It must be 6+ characters long.<br /><b>NOTE</b>: This password needs to be stored in plain text. Do not use a password you use elsewhere.]]></key>
<key name="striker_0035">Gateway</key>
<key name="striker_0036">This is the network gateway used to access the outside world.</key>
<key name="striker_0037">DNS</key>
<key name="striker_0038">This is the domain name server(s) to use when resolving domain names. You can specify 2 or more, separated by commas.</key>
<key name="striker_0039">Gateway Interface</key>
<key name="striker_0040">This is the interface with the internet access. Usually this is "ifn_link1".</key> <!-- Translation note; leave 'ifn_link1' as it is, it is the device name. -->
<key name="striker_0041">We're almost ready! Does this look right? If so, we'll setup this Striker dashboard.</key>
<key name="striker_0042">What we are planning to do...</key>
<key name="striker_0043">Apply New Configuration</key>
<!-- Warnings -->
<key name="striker_warning_0001">The IP address will change. You will need to reconnect after applying these changes.</key>
<!-- Errors -->
<key name="striker_error_0001">There are not enough network interfaces on this machine. You have: [#!variable!interface_count!#] interface(s), and you need at least: [#!variable!required_interfaces_for_single!#] interfaces to connect to the requested networks (one for Back-Channel and one for each Internet-Facing network).</key>
<key name="striker_error_0002">The local system UUID can't be read yet. This might be because the system is brand new and/or ScanCore hasn't run yet. Please try again in a minute.</key>
<key name="striker_error_0003">None of the databases are accessible, unable to proceed.</key>
<key name="striker_error_0004">The gateway address doesn't match any of your networks.</key>
<!-- These are works and strings used by javascript/jqery -->
<key name="js_0001">Up</key>
<key name="js_0002">Down</key>
<key name="js_0003">Mbps</key>
</language>
<!-- 日本語 -->
<language name="jp" long_name="日本語" description="Striker/ScanCore language file.">
<key name="brand_0001">アルティーブ</key>
<key name="brand_0002">Anvil!</key>
<key name="brand_0003">ストライカ</key>
<key name="brand_0004">スカンコア</key>
<key name="brand_0005"><![CDATA[&copy; 2017 <a href="https://alteeve.com/" target="_new">Alteeve's Niche! Inc.</a>, トロント、オンタリオ、カナダ]]></key>
</language>
</words>

6
notes
Unescape View File

@ -6,10 +6,10 @@ All systems have a UUID, even VMs. Use that for system UUID in the future.
### Setup - Striker ### Setup - Striker
# Packages # Packages
depends on: perl-XML-Simple postgresql-server postgresql-plperl postgresql-contrib perl-CGI perl-NetAddr-IP perl-DBD-Pg depends on: perl-XML-Simple postgresql-server postgresql-plperl postgresql-contrib perl-CGI perl-NetAddr-IP perl-DBD-Pg rsync perl-Log-Journald perl-Net-SSH2
# Paths # Paths
mkdir /usr/sbin/striker mkdir /usr/sbin/anvil
# virsh # virsh
virsh net-destroy default virsh net-destroy default
@ -33,4 +33,4 @@ restorecon -rv /var/www
============================================================= =============================================================
[root@striker-m3 ~]# cat watch_logs [root@striker-m3 ~]# cat watch_logs
clear; journalctl -f -a -S "$(date +"%F %R:%S")" -t an-tools clear; journalctl -f -a -S "$(date +"%F %R:%S")" -t anvil

227
scancore.sql
Unescape View File

@ -1,227 +0,0 @@
-- This is the core database schema for ScanCore.
-- It builds on AN::Tools.sql.
-- NOTE: network_interfaces, network_bonds and network_bridges are all used by scan-network (which doesn't
-- exist yet).
-- This stores information about network interfaces on hosts. It is mainly used to match a MAC address to a
-- host. Given that it is possible that network devices can move, the linkage to the host_uuid can change.
CREATE TABLE network_interfaces (
network_interface_uuid uuid not null primary key,
network_interface_host_uuid uuid not null,
network_interface_mac_address text not null,
network_interface_name text not null, -- This is the current name of the interface.
network_interface_speed bigint not null, -- This is the speed, in bits-per-second, of the interface.
network_interface_mtu bigint, -- This is the MTU (Maximum Transmitable Size), in bytes, for this interface.
network_interface_link_state text not null, -- 0 or 1
network_interface_operational text not null, -- This is 'up', 'down' or 'unknown'
network_interface_duplex text not null, -- This is 'full', 'half' or 'unknown'
network_interface_medium text, -- This is 'tp' (twisted pair), 'fiber' or whatever they invent in the future.
network_interface_bond_uuid uuid, -- If this iface is in a bond, this will contain the 'bonds -> bond_uuid' that it is slaved to.
network_interface_bridge_uuid uuid, -- If this iface is attached to a bridge, this will contain the 'bridgess -> bridge_uuid' that it is connected to.
modified_date timestamp with time zone not null
);
ALTER TABLE network_interfaces OWNER TO #!variable!user!#;
CREATE TABLE history.network_interfaces (
history_id bigserial,
network_interface_uuid uuid not null,
network_interface_host_uuid uuid,
network_interface_mac_address text,
network_interface_name text,
network_interface_speed bigint,
network_interface_mtu bigint,
network_interface_link_state text,
network_interface_operational text,
network_interface_duplex text,
network_interface_medium text,
network_interface_bond_uuid uuid,
network_interface_bridge_uuid uuid,
modified_date timestamp with time zone not null
);
ALTER TABLE history.network_interfaces OWNER TO #!variable!user!#;
CREATE FUNCTION history_network_interfaces() RETURNS trigger
AS $$
DECLARE
history_network_interfaces RECORD;
BEGIN
SELECT INTO history_network_interfaces * FROM network_interfaces WHERE network_interface_host_uuid = new.network_interface_host_uuid;
INSERT INTO history.network_interfaces
(network_interface_uuid,
network_interface_host_uuid,
network_interface_mac_address,
network_interface_name,
network_interface_speed,
network_interface_mtu,
network_interface_link_state,
network_interface_operational,
network_interface_duplex,
network_interface_medium,
network_interface_bond_uuid,
network_interface_bridge_uuid,
modified_date)
VALUES
(history_network_interfaces.network_interface_uuid,
history_network_interfaces.network_interface_host_uuid,
history_network_interfaces.network_interface_mac_address,
history_network_interfaces.network_interface_name,
history_network_interfaces.network_interface_speed,
history_network_interfaces.network_interface_mtu,
history_network_interfaces.network_interface_link_state,
history_network_interfaces.network_interface_operational,
history_network_interfaces.network_interface_duplex,
history_network_interfaces.network_interface_medium,
history_network_interfaces.network_interface_bond_uuid,
history_network_interfaces.network_interface_bridge_uuid,
history_network_interfaces.modified_date);
RETURN NULL;
END;
$$
LANGUAGE plpgsql;
ALTER FUNCTION history_network_interfaces() OWNER TO #!variable!user!#;
CREATE TRIGGER trigger_network_interfaces
AFTER INSERT OR UPDATE ON network_interfaces
FOR EACH ROW EXECUTE PROCEDURE history_network_interfaces();
-- This stores information about network bonds (mode=1) on a hosts.
CREATE TABLE bonds (
bond_uuid uuid primary key,
bond_host_uuid uuid not null,
bond_name text not null,
bond_mode integer not null, -- This is the numerical bond type (will translate to the user's language in ScanCore)
bond_mtu bigint,
bond_primary_slave text,
bond_primary_reselect text,
bond_active_slave text,
bond_mii_status text,
bond_mii_polling_interval bigint,
bond_up_delay bigint,
bond_down_delay bigint,
modified_date timestamp with time zone not null,
FOREIGN KEY(bond_host_uuid) REFERENCES hosts(host_uuid)
);
ALTER TABLE bonds OWNER TO #!variable!user!#;
CREATE TABLE history.bonds (
history_id bigserial,
bond_uuid uuid,
bond_host_uuid uuid,
bond_name text,
bond_mode integer,
bond_mtu bigint,
bond_primary_slave text,
bond_primary_reselect text,
bond_active_slave text,
bond_mii_status text,
bond_mii_polling_interval bigint,
bond_up_delay bigint,
bond_down_delay bigint,
modified_date timestamp with time zone not null
);
ALTER TABLE history.bonds OWNER TO #!variable!user!#;
CREATE FUNCTION history_bonds() RETURNS trigger
AS $$
DECLARE
history_bonds RECORD;
BEGIN
SELECT INTO history_bonds * FROM bonds WHERE bond_uuid=new.bond_uuid;
INSERT INTO history.bonds
(bond_uuid,
bond_host_uuid,
bond_name,
bond_mode,
bond_mtu,
bond_primary_slave,
bond_primary_reselect,
bond_active_slave,
bond_mii_status,
bond_mii_polling_interval,
bond_up_delay,
bond_down_delay,
modified_date)
VALUES
(history_bonds.bond_uuid,
history_bonds.bond_host_uuid,
history_bonds.bond_name,
history_bonds.bond_mode,
history_bonds.bond_mtu,
history_bonds.bond_primary_slave,
history_bonds.bond_primary_reselect,
history_bonds.bond_active_slave,
history_bonds.bond_mii_status,
history_bonds.bond_mii_polling_interval,
history_bonds.bond_up_delay,
history_bonds.bond_down_delay,
history_bonds.modified_date);
RETURN NULL;
END;
$$
LANGUAGE plpgsql;
ALTER FUNCTION history_bonds() OWNER TO #!variable!user!#;
CREATE TRIGGER trigger_bonds
AFTER INSERT OR UPDATE ON bonds
FOR EACH ROW EXECUTE PROCEDURE history_bonds();
-- This stores information about network bridges.
CREATE TABLE bridges (
bridge_uuid uuid primary key,
bridge_host_uuid uuid not null,
bridge_name text not null,
bridge_id text,
bridge_stp_enabled text,
modified_date timestamp with time zone not null,
FOREIGN KEY(bridge_host_uuid) REFERENCES hosts(host_uuid)
);
ALTER TABLE bridges OWNER TO #!variable!user!#;
CREATE TABLE history.bridges (
history_id bigserial,
bridge_uuid uuid,
bridge_host_uuid uuid,
bridge_name text,
bridge_id text,
bridge_stp_enabled text,
modified_date timestamp with time zone not null
);
ALTER TABLE history.bridges OWNER TO #!variable!user!#;
CREATE FUNCTION history_bridges() RETURNS trigger
AS $$
DECLARE
history_bridges RECORD;
BEGIN
SELECT INTO history_bridges * FROM bridges WHERE bridge_uuid=new.bridge_uuid;
INSERT INTO history.bridges
(bridge_uuid,
bridge_host_uuid,
bridge_name,
bridge_name,
bridge_id,
bridge_stp_enabled,
modified_date)
VALUES
(history_bridges.bridge_uuid,
history_bridges.bridge_host_uuid,
history_bridges.bridge_name,
history_bridges.bridge_name,
history_bridges.bridge_id,
history_bridges.bridge_stp_enabled,
history_bridges.modified_date);
RETURN NULL;
END;
$$
LANGUAGE plpgsql;
ALTER FUNCTION history_bridges() OWNER TO #!variable!user!#;
CREATE TRIGGER trigger_bridges
AFTER INSERT OR UPDATE ON bridges
FOR EACH ROW EXECUTE PROCEDURE history_bridges();

32
striker.conf
Unescape View File

@ -1,32 +0,0 @@
# This is the main Striker (and ScanCore) configuration file.
#
database::1::host = 192.168.122.201
database::1::port = 5432
database::1::name = scancore
database::1::user = admin
database::1::password = Initial1
database::1::ping_before_connect = 1
database::2::host = 192.168.122.202
database::2::port = 5432
database::2::name = scancore
database::2::user = admin
database::2::password = Initial1
database::2::ping_before_connect = 1
# This is the schema for the ScanCore database.
sys::database::schema = /etc/scancore/scancore.sql
# This puts a limit on how many queries (writes, generally) to make in a single batch transaction. This is
# useful when doing very large transacions, like resync'ing a large table, by limiting how long a given
# transaction can take and how much memory is used.
#sys::database::maximum_batch_size = 25000
# By default, we try to determine the host type using the host name. The rules used for this can be seen in
# 'perldoc AN::Tools::System -> determine_host_type'. If you are using non-standard host names, or for some
# other reason want to statically assign the host type, you can do so with this variable. Note that this sets
# the host type of this host only. You will need to set this appropriately on other hosts.
#
# Normally, you should not need to set this.
#sys::host_type = node

15
test.pl
Unescape View File

@ -0,0 +1,15 @@
#!/usr/bin/perl
#
use strict;
use warnings;
use Anvil::Tools;
my $anvil = Anvil::Tools->new();
$anvil->Log->level({set => 2});
# This is used to initialize the database
my $connections = $anvil->Database->connect();
print "Connections: [$connections]\n";
exit(0);

373
tools/an-prep-database
Unescape View File

@ -1,373 +0,0 @@
#!/usr/bin/perl
#
# This checks the state of the postgresql database server and, if necessary, configures it for external
# access, initializes it and gets it running.
#
# Exit codes;
# 0 = Normal exit.
# 1 = Failed to initialize postgres
# 2 = Failed to start postgres
# 3 = ScanCore user not set in the local ID in striker.conf
# 4 = Failed to create the database user.
# 5 =
use strict;
use warnings;
use Data::Dumper;
use AN::Tools;
my $THIS_FILE = ($0 =~ /^.*\/(.*)$/)[0];
my $running_directory = ($0 =~ /^(.*?)\/$THIS_FILE$/)[0];
if (($running_directory =~ /^\./) && ($ENV{PWD}))
{
$running_directory =~ s/^\./$ENV{PWD}/;
}
# Turn off buffering so that the pinwheel will display while waiting for the SSH call(s) to complete.
$| = 1;
my $an = AN::Tools->new();
$an->Log->level({set => 2});
$an->Log->secure({set => 1});
# Paths
$an->data->{path}{tools}{'an-prep-database'} = "/usr/sbin/striker/scancore-database";
$an->data->{path}{tools}{'scancore-update-states'} = "/usr/sbin/striker/scancore-update-states";
$an->data->{path}{config}{'striker.conf'} = "/etc/striker/striker.conf";
$an->Storage->read_config({file => $an->data->{path}{config}{'striker.conf'}});
my $local_id = $an->Database->get_local_id;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { local_id => $local_id }});
if ($local_id)
{
# Start checks
my $running = $an->System->check_daemon({daemon => "postgresql"});
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { running => $running }});
if (not $running)
{
# Do we need to initialize the databae?
if (not -e $an->data->{path}{configs}{'pg_hba.conf'})
{
# Initialize.
my $output = $an->System->call({shell_call => $an->data->{path}{exe}{'postgresql-setup'}." initdb", source => $THIS_FILE, line => __LINE__});
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { output => $output }});
# Did it succeed?
if (not -e $an->data->{path}{configs}{'pg_hba.conf'})
{
# Failed...
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "error_0001"});
exit(1);
}
else
{
# Initialized!
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "message_0001"});
}
# Setup postgresql.conf
my $postgresql_backup = $an->data->{path}{directories}{backups}."/pgsql/postgresql.conf";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { postgresql_backup => $postgresql_backup }});
$an->Storage->copy_file({source => $an->data->{path}{configs}{'postgresql.conf'}, target => $postgresql_backup});
my $postgresql_conf = $an->Storage->read_file({file => $an->data->{path}{configs}{'postgresql.conf'}});
my $update_file = 1;
my $new_postgresql_conf = "";
foreach my $line (split/\n/, $postgresql_conf)
{
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { line => $line }});
if ($line =~ /^listen_addresses = '\*'/)
{
# No need to update.
$update_file = 0;
last;
}
elsif ($line =~ /^#listen_addresses = 'localhost'/)
{
# Inject the new listen_addresses
$new_postgresql_conf .= "listen_addresses = '*'\n";
}
$new_postgresql_conf .= $line."\n";
}
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { update_file => $update_file }});
if ($update_file)
{
$an->Storage->write_file({
file => $an->data->{path}{configs}{'postgresql.conf'},
body => $new_postgresql_conf,
user => "postgres",
group => "postgres",
mode => "0600",
overwrite => 1,
});
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "message_0002", variables => { file => $an->data->{path}{configs}{'postgresql.conf'} }});
}
# Setup pg_hba.conf now
my $pg_hba_backup = $an->data->{path}{directories}{backups}."/pgsql/pg_hba.conf";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { pg_hba_backup => $pg_hba_backup }});
$an->Storage->copy_file({source => $an->data->{path}{configs}{'pg_hba.conf'}, target => $pg_hba_backup});
my $pg_hba_conf = $an->Storage->read_file({file => $an->data->{path}{configs}{'pg_hba.conf'}});
$update_file = 1;
my $new_pg_hba_conf = "";
foreach my $line (split/\n/, $pg_hba_conf)
{
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { line => $line }});
if ($line =~ /^host\s+all\s+all\s+\all\s+md5$/)
{
# No need to update.
$update_file = 0;
last;
}
elsif ($line =~ /^# TYPE\s+DATABASE/)
{
# Inject the new listen_addresses
$new_pg_hba_conf .= $line."\n";
$new_pg_hba_conf .= "host\tall\t\tall\t\t*\t\t\tmd5\n";
}
else
{
$new_pg_hba_conf .= $line."\n";
}
}
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { update_file => $update_file }});
if ($update_file)
{
$an->Storage->write_file({
file => $an->data->{path}{configs}{'pg_hba.conf'},
body => $new_pg_hba_conf,
user => "postgres",
group => "postgres",
mode => "0600",
overwrite => 1,
});
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "message_0003", variables => { file => $an->data->{path}{configs}{'postgresql.conf'} }});
}
}
# Start the daemon. It might fail if it has never been initialized.
my $started = $an->System->start_daemon({daemon => "postgresql"});
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { started => $started }});
if ($started)
{
# Started the daemon.
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "message_0004"});
}
else
{
# Failed to start
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "error_0002"});
exit(2);
}
}
# Create the .pgpass file, if needed.
my $created_pgpass = 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, secure => 1, list => {
'path::secure::postgres_pgpass' => $an->data->{path}{secure}{postgres_pgpass},
"database::${local_id}::password" => $an->data->{database}{$local_id}{password},
}});
if ((not -e $an->data->{path}{secure}{postgres_pgpass}) && ($an->data->{database}{$local_id}{password}))
{
my $body = "*:*:*:postgres:".$an->data->{database}{$local_id}{password}."\n";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, secure => 1, list => { body => $body }});
$an->Storage->write_file({
file => $an->data->{path}{secure}{postgres_pgpass},
body => $body,
user => "postgres",
group => "postgres",
mode => "0600",
overwrite => 1,
secure => 1,
});
if (-e $an->data->{path}{secure}{postgres_pgpass})
{
$created_pgpass = 1;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { created_pgpass => $created_pgpass }});
}
}
# Does the database user exist?
my $create_user = 1;
my $scancore_user = $an->data->{database}{$local_id}{user};
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { scancore_user => $scancore_user }});
if (not $scancore_user)
{
# No database user defined
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "error_0003", variables => { id => $local_id }});
exit(3);
}
my $user_list = $an->System->call({shell_call => $an->data->{path}{exe}{su}." - postgres -c \"".$an->data->{path}{exe}{psql}." template1 -c 'SELECT usename, usesysid FROM pg_catalog.pg_user;'\"", source => $THIS_FILE, line => __LINE__});
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { user_list => $user_list }});
foreach my $line (split/\n/, $user_list)
{
if ($line =~ /^ $scancore_user\s+\|\s+(\d+)/)
{
# User exists already
my $id = $1;
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 2, key => "message_0005", variables => { user => $scancore_user, id => $id }});
$create_user = 0;
last;
}
}
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { create_user => $create_user }});
if ($create_user)
{
# Create the user
my $create_output = $an->System->call({shell_call => $an->data->{path}{exe}{su}." - postgres -c \"".$an->data->{path}{exe}{createuser}." --no-superuser --createdb --no-createrole $scancore_user\"", source => $THIS_FILE, line => __LINE__});
my $user_list = $an->System->call({shell_call => $an->data->{path}{exe}{su}." - postgres -c \"".$an->data->{path}{exe}{psql}." template1 -c 'SELECT usename, usesysid FROM pg_catalog.pg_user;'\"", source => $THIS_FILE, line => __LINE__});
my $user_exists = 0;
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { create_output => $create_output, user_list => $user_list }});
foreach my $line (split/\n/, $user_list)
{
if ($line =~ /^ $scancore_user\s+\|\s+(\d+)/)
{
# Success!
my $id = $1;
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 2, key => "message_0006", variables => { user => $scancore_user, id => $id }});
$user_exists = 1;
last;
}
}
if (not $user_exists)
{
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "error_0004", variables => { user => $scancore_user }});
exit(4);
}
# Update/set the passwords.
if ($an->data->{database}{$local_id}{password})
{
foreach my $user ("postgres", $scancore_user)
{
my $update_output = $an->System->call({secure => 1, shell_call => $an->data->{path}{exe}{su}." - postgres -c \"".$an->data->{path}{exe}{psql}." template1 -c \\\"ALTER ROLE $user WITH PASSWORD '".$an->data->{database}{$local_id}{password}."';\\\"\"", source => $THIS_FILE, line => __LINE__});
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, secure => 1, list => { update_output => $update_output }});
foreach my $line (split/\n/, $user_list)
{
if ($line =~ /ALTER ROLE/)
{
# Password set
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 2, key => "message_0007", variables => { user => $user }});
}
}
}
}
}
# Create the database, if needed.
my $create_database = 1;
my $scancore_database = $an->data->{database}{$local_id}{name};
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { "database::${local_id}::name" => $an->data->{database}{$local_id}{name} }});
my $database_list = $an->System->call({shell_call => $an->data->{path}{exe}{su}." - postgres -c \"".$an->data->{path}{exe}{psql}." template1 -c 'SELECT datname FROM pg_catalog.pg_database;'\"", source => $THIS_FILE, line => __LINE__});
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { database_list => $database_list }});
foreach my $line (split/\n/, $database_list)
{
if ($line =~ /^ $scancore_database$/)
{
# Database already exists.
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 2, key => "message_0008", variables => { database => $scancore_database }});
$create_database = 0;
last;
}
}
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { create_database => $create_database }});
if ($create_database)
{
my $create_output = $an->System->call({shell_call => $an->data->{path}{exe}{su}." - postgres -c \"".$an->data->{path}{exe}{createdb}." --owner $scancore_user $scancore_database\"", source => $THIS_FILE, line => __LINE__});
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { create_output => $create_output }});
my $database_exists = 0;
my $database_list = $an->System->call({shell_call => $an->data->{path}{exe}{su}." - postgres -c \"".$an->data->{path}{exe}{psql}." template1 -c 'SELECT datname FROM pg_catalog.pg_database;'\"", source => $THIS_FILE, line => __LINE__});
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { database_list => $database_list }});
foreach my $line (split/\n/, $database_list)
{
if ($line =~ /^ $scancore_database$/)
{
# Database created
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 2, key => "message_0008", variables => { database => $scancore_database }});
$database_exists = 1;
last;
}
}
if (not $database_exists)
{
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "error_0005", variables => { database => $scancore_database }});
exit(5);
}
}
# Remove the temporary password file.
if (($created_pgpass) && (-e $an->data->{path}{secure}{postgres_pgpass}))
{
unlink $an->data->{path}{secure}{postgres_pgpass};
if (-e $an->data->{path}{secure}{postgres_pgpass})
{
# Failed to unlink the file.
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "warning_0001"});
}
}
#####################################################################################################
# NOTE: Below here is stuff that is for general setup. If it grows, we'll have to rename this tool. #
#####################################################################################################
### TODO: This will need to set the proper SELinux context.
# Apache run scripts can't call the system UUID, so we'll write it to a text file.
if (not -e $an->data->{path}{data}{host_uuid})
{
$an->Storage->write_file({
file => $an->data->{path}{data}{host_uuid},
body => $an->Get->host_uuid,
user => "apache",
group => "apache",
mode => "0666",
overwrite => 0,
});
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "message_0011", variables => { file => $an->data->{path}{configs}{'postgresql.conf'} }});
}
# Log level 3 creates so much logging that it hits journald's rate limiting (1000 logs per 30
# seconds). So we need to disable it.
if (not -e $an->data->{path}{configs}{'journald_an'})
{
# Write the file to disable journald rate limiting.
my $body = "# This disables the rate limiting so that when log level is set to 3, log
# entries aren't lost. If you want to override this, don't delete the file,
# just comment out the lines below.
[Journal]
RateLimitInterval=0
RateLimitBurst=0
";
$an->Storage->write_file({
file => $an->data->{path}{configs}{'journald_an'},
body => $body,
user => "root",
group => "root",
mode => "0644",
overwrite => 0,
});
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "message_0012", variables => { file => $an->data->{path}{configs}{'journald_an'} }});
my $shell_call = $an->data->{path}{exe}{systemctl}." restart systemd-journald.service";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { shell_call => $shell_call }});
my $output = $an->System->call({shell_call => $shell_call, source => $THIS_FILE, line => __LINE__});
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { output => $output }});
}
}
else
{
# Didn't find an entry for this machine.
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 2, key => "message_0010"});
}
exit(0);
#############################################################################################################
# Functions #
#############################################################################################################

101
tools/anvil-daemon
Unescape View File

@ -0,0 +1,101 @@
#!/usr/bin/perl
#
# This is the master daemon that manages all periodically run processes on Striker dashboards and Anvil!
# nodes.
#
# TODO: At somepoint, we'll need to have a mechanism to fire off processes that might take a long time.
#
use strict;
use warnings;
use Anvil::Tools;
my $THIS_FILE = ($0 =~ /^.*\/(.*)$/)[0];
my $running_directory = ($0 =~ /^(.*?)\/$THIS_FILE$/)[0];
if (($running_directory =~ /^\./) && ($ENV{PWD}))
{
$running_directory =~ s/^\./$ENV{PWD}/;
}
# Turn off buffering so that the pinwheel will display while waiting for the SSH call(s) to complete.
$| = 1;
my $anvil = Anvil::Tools->new();
$$anvil->Log->level({set => 2});
# Paths
$$anvil->data->{path}{tools}{'an-prep-database'} = "/usr/sbin/striker/an-prep-database";
$$anvil->data->{path}{tools}{'scancore-update-states'} = "/usr/sbin/striker/scancore-update-states";
$$anvil->data->{path}{config}{'striker.conf'} = "/etc/striker/striker.conf";
# Read our config.
$$anvil->Storage->read_config({file => $$anvil->data->{path}{config}{'striker.conf'}});
# There are some things we only want to run on (re)start and don't need to always run.
run_once($anvil);
# These are the things we always want running.
while(1)
{
# Loop and sleep for 2s.
keep_running($anvil);
# Exit if called with '--run-once'
if ($$anvil->data->{switches}{'run-once'})
{
$$anvil->nice_exit({code => 0});
}
sleep 2;
}
$$anvil->nice_exit({code => 0});
#############################################################################################################
# Functions #
#############################################################################################################
# These are tools that don't need to constantly run.
sub run_once
{
my ($anvil) = @_;
# Check that the database is ready.
my $shell_call = $$anvil->data->{path}{tools}{'an-prep-database'};
$$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { shell_call => $shell_call }});
my $database_output = $$anvil->System->call({shell_call => $shell_call, source => $THIS_FILE, line => __LINE__});
if ($database_output)
{
$$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { database_output => $database_output }});
}
return(0);
}
# These are tools that need to keep running.
sub keep_running
{
my ($anvil) = @_;
# Update hardware state files.
update_state_file($anvil);
return(0);
}
# This calls 'scancore-update-states' which will scan the local machine's state (hardware and software) and
# record write it out to an HTML file
sub update_state_file
{
my ($anvil) = @_;
my $shell_call = $$anvil->data->{path}{tools}{'scancore-update-states'};
$$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { shell_call => $shell_call }});
my $states_output = $$anvil->System->call({shell_call => $shell_call, source => $THIS_FILE, line => __LINE__});
if ($states_output)
{
$$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { states_output => $states_output }});
}
return(0);
}

370
tools/anvil-prep-database
Unescape View File

@ -0,0 +1,370 @@
#!/usr/bin/perl
#
# This checks the state of the postgresql database server and, if necessary, configures it for external
# access, initializes it and gets it running.
#
# Exit codes;
# 0 = Normal exit.
# 1 = Failed to initialize postgres
# 2 = Failed to start postgres
# 3 = ScanCore user not set in the local ID in striker.conf
# 4 = Failed to create the database user.
# 5 =
use strict;
use warnings;
use Data::Dumper;
use Anvil::Tools;
my $THIS_FILE = ($0 =~ /^.*\/(.*)$/)[0];
my $running_directory = ($0 =~ /^(.*?)\/$THIS_FILE$/)[0];
if (($running_directory =~ /^\./) && ($ENV{PWD}))
{
$running_directory =~ s/^\./$ENV{PWD}/;
}
# Turn off buffering so that the pinwheel will display while waiting for the SSH call(s) to complete.
$| = 1;
my $anvil = Anvil::Tools->new();
$anvil->Log->level({set => 2});
$anvil->Log->secure({set => 1});
# Paths
$anvil->data->{path}{config}{'striker.conf'} = "/etc/anvil/anvil.conf";
$anvil->Storage->read_config({file => $anvil->data->{path}{config}{'striker.conf'}});
my $local_id = $anvil->Database->get_local_id;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { local_id => $local_id }});
if ($local_id)
{
# Start checks
my $running = $anvil->System->check_daemon({daemon => "postgresql"});
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { running => $running }});
if (not $running)
{
# Do we need to initialize the databae?
if (not -e $anvil->data->{path}{configs}{'pg_hba.conf'})
{
# Initialize.
my $output = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{'postgresql-setup'}." initdb", source => $THIS_FILE, line => __LINE__});
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { output => $output }});
# Did it succeed?
if (not -e $anvil->data->{path}{configs}{'pg_hba.conf'})
{
# Failed...
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "error_0001"});
exit(1);
}
else
{
# Initialized!
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "message_0001"});
}
# Setup postgresql.conf
my $postgresql_backup = $anvil->data->{path}{directories}{backups}."/pgsql/postgresql.conf";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { postgresql_backup => $postgresql_backup }});
$anvil->Storage->copy_file({source => $anvil->data->{path}{configs}{'postgresql.conf'}, target => $postgresql_backup});
my $postgresql_conf = $anvil->Storage->read_file({file => $anvil->data->{path}{configs}{'postgresql.conf'}});
my $update_file = 1;
my $new_postgresql_conf = "";
foreach my $line (split/\n/, $postgresql_conf)
{
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { line => $line }});
if ($line =~ /^listen_addresses = '\*'/)
{
# No need to update.
$update_file = 0;
last;
}
elsif ($line =~ /^#listen_addresses = 'localhost'/)
{
# Inject the new listen_addresses
$new_postgresql_conf .= "listen_addresses = '*'\n";
}
$new_postgresql_conf .= $line."\n";
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { update_file => $update_file }});
if ($update_file)
{
$anvil->Storage->write_file({
file => $anvil->data->{path}{configs}{'postgresql.conf'},
body => $new_postgresql_conf,
user => "postgres",
group => "postgres",
mode => "0600",
overwrite => 1,
});
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "message_0002", variables => { file => $anvil->data->{path}{configs}{'postgresql.conf'} }});
}
# Setup pg_hba.conf now
my $pg_hba_backup = $anvil->data->{path}{directories}{backups}."/pgsql/pg_hba.conf";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { pg_hba_backup => $pg_hba_backup }});
$anvil->Storage->copy_file({source => $anvil->data->{path}{configs}{'pg_hba.conf'}, target => $pg_hba_backup});
my $pg_hba_conf = $anvil->Storage->read_file({file => $anvil->data->{path}{configs}{'pg_hba.conf'}});
$update_file = 1;
my $new_pg_hba_conf = "";
foreach my $line (split/\n/, $pg_hba_conf)
{
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { line => $line }});
if ($line =~ /^host\s+all\s+all\s+\all\s+md5$/)
{
# No need to update.
$update_file = 0;
last;
}
elsif ($line =~ /^# TYPE\s+DATABASE/)
{
# Inject the new listen_addresses
$new_pg_hba_conf .= $line."\n";
$new_pg_hba_conf .= "host\tall\t\tall\t\t*\t\t\tmd5\n";
}
else
{
$new_pg_hba_conf .= $line."\n";
}
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { update_file => $update_file }});
if ($update_file)
{
$anvil->Storage->write_file({
file => $anvil->data->{path}{configs}{'pg_hba.conf'},
body => $new_pg_hba_conf,
user => "postgres",
group => "postgres",
mode => "0600",
overwrite => 1,
});
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "message_0003", variables => { file => $anvil->data->{path}{configs}{'postgresql.conf'} }});
}
}
# Start the daemon. It might fail if it has never been initialized.
my $started = $anvil->System->start_daemon({daemon => "postgresql"});
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { started => $started }});
if ($started)
{
# Started the daemon.
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "message_0004"});
}
else
{
# Failed to start
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "error_0002"});
exit(2);
}
}
# Create the .pgpass file, if needed.
my $created_pgpass = 0;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, secure => 1, list => {
'path::secure::postgres_pgpass' => $anvil->data->{path}{secure}{postgres_pgpass},
"database::${local_id}::password" => $anvil->data->{database}{$local_id}{password},
}});
if ((not -e $anvil->data->{path}{secure}{postgres_pgpass}) && ($anvil->data->{database}{$local_id}{password}))
{
my $body = "*:*:*:postgres:".$anvil->data->{database}{$local_id}{password}."\n";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, secure => 1, list => { body => $body }});
$anvil->Storage->write_file({
file => $anvil->data->{path}{secure}{postgres_pgpass},
body => $body,
user => "postgres",
group => "postgres",
mode => "0600",
overwrite => 1,
secure => 1,
});
if (-e $anvil->data->{path}{secure}{postgres_pgpass})
{
$created_pgpass = 1;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { created_pgpass => $created_pgpass }});
}
}
# Does the database user exist?
my $create_user = 1;
my $scancore_user = $anvil->data->{database}{$local_id}{user};
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { scancore_user => $scancore_user }});
if (not $scancore_user)
{
# No database user defined
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "error_0003", variables => { id => $local_id }});
exit(3);
}
my $user_list = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{su}." - postgres -c \"".$anvil->data->{path}{exe}{psql}." template1 -c 'SELECT usename, usesysid FROM pg_catalog.pg_user;'\"", source => $THIS_FILE, line => __LINE__});
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { user_list => $user_list }});
foreach my $line (split/\n/, $user_list)
{
if ($line =~ /^ $scancore_user\s+\|\s+(\d+)/)
{
# User exists already
my $id = $1;
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 2, key => "message_0005", variables => { user => $scancore_user, id => $id }});
$create_user = 0;
last;
}
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { create_user => $create_user }});
if ($create_user)
{
# Create the user
my $create_output = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{su}." - postgres -c \"".$anvil->data->{path}{exe}{createuser}." --no-superuser --createdb --no-createrole $scancore_user\"", source => $THIS_FILE, line => __LINE__});
my $user_list = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{su}." - postgres -c \"".$anvil->data->{path}{exe}{psql}." template1 -c 'SELECT usename, usesysid FROM pg_catalog.pg_user;'\"", source => $THIS_FILE, line => __LINE__});
my $user_exists = 0;
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { create_output => $create_output, user_list => $user_list }});
foreach my $line (split/\n/, $user_list)
{
if ($line =~ /^ $scancore_user\s+\|\s+(\d+)/)
{
# Success!
my $id = $1;
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 2, key => "message_0006", variables => { user => $scancore_user, id => $id }});
$user_exists = 1;
last;
}
}
if (not $user_exists)
{
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "error_0004", variables => { user => $scancore_user }});
exit(4);
}
# Update/set the passwords.
if ($anvil->data->{database}{$local_id}{password})
{
foreach my $user ("postgres", $scancore_user)
{
my $update_output = $anvil->System->call({secure => 1, shell_call => $anvil->data->{path}{exe}{su}." - postgres -c \"".$anvil->data->{path}{exe}{psql}." template1 -c \\\"ALTER ROLE $user WITH PASSWORD '".$anvil->data->{database}{$local_id}{password}."';\\\"\"", source => $THIS_FILE, line => __LINE__});
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, secure => 1, list => { update_output => $update_output }});
foreach my $line (split/\n/, $user_list)
{
if ($line =~ /ALTER ROLE/)
{
# Password set
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 2, key => "message_0007", variables => { user => $user }});
}
}
}
}
}
# Create the database, if needed.
my $create_database = 1;
my $scancore_database = $anvil->data->{database}{$local_id}{name};
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { "database::${local_id}::name" => $anvil->data->{database}{$local_id}{name} }});
my $database_list = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{su}." - postgres -c \"".$anvil->data->{path}{exe}{psql}." template1 -c 'SELECT datname FROM pg_catalog.pg_database;'\"", source => $THIS_FILE, line => __LINE__});
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { database_list => $database_list }});
foreach my $line (split/\n/, $database_list)
{
if ($line =~ /^ $scancore_database$/)
{
# Database already exists.
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 2, key => "message_0008", variables => { database => $scancore_database }});
$create_database = 0;
last;
}
}
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { create_database => $create_database }});
if ($create_database)
{
my $create_output = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{su}." - postgres -c \"".$anvil->data->{path}{exe}{createdb}." --owner $scancore_user $scancore_database\"", source => $THIS_FILE, line => __LINE__});
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { create_output => $create_output }});
my $database_exists = 0;
my $database_list = $anvil->System->call({shell_call => $anvil->data->{path}{exe}{su}." - postgres -c \"".$anvil->data->{path}{exe}{psql}." template1 -c 'SELECT datname FROM pg_catalog.pg_database;'\"", source => $THIS_FILE, line => __LINE__});
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { database_list => $database_list }});
foreach my $line (split/\n/, $database_list)
{
if ($line =~ /^ $scancore_database$/)
{
# Database created
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 2, key => "message_0008", variables => { database => $scancore_database }});
$database_exists = 1;
last;
}
}
if (not $database_exists)
{
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "err", key => "error_0005", variables => { database => $scancore_database }});
exit(5);
}
}
# Remove the temporary password file.
if (($created_pgpass) && (-e $anvil->data->{path}{secure}{postgres_pgpass}))
{
unlink $anvil->data->{path}{secure}{postgres_pgpass};
if (-e $anvil->data->{path}{secure}{postgres_pgpass})
{
# Failed to unlink the file.
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 0, priority => "alert", key => "warning_0001"});
}
}
#####################################################################################################
# NOTE: Below here is stuff that is for general setup. If it grows, we'll have to rename this tool. #
#####################################################################################################
### TODO: This will need to set the proper SELinux context.
# Apache run scripts can't call the system UUID, so we'll write it to a text file.
if (not -e $anvil->data->{path}{data}{host_uuid})
{
$anvil->Storage->write_file({
file => $anvil->data->{path}{data}{host_uuid},
body => $anvil->Get->host_uuid,
user => "apache",
group => "apache",
mode => "0666",
overwrite => 0,
});
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "message_0011", variables => { file => $anvil->data->{path}{configs}{'postgresql.conf'} }});
}
# Log level 3 creates so much logging that it hits journald's rate limiting (1000 logs per 30
# seconds). So we need to disable it.
if (not -e $anvil->data->{path}{configs}{'journald_an'})
{
# Write the file to disable journald rate limiting.
my $body = "# This disables the rate limiting so that when log level is set to 3, log
# entries aren't lost. If you want to override this, don't delete the file,
# just comment out the lines below.
[Journal]
RateLimitInterval=0
RateLimitBurst=0
";
$anvil->Storage->write_file({
file => $anvil->data->{path}{configs}{'journald_an'},
body => $body,
user => "root",
group => "root",
mode => "0644",
overwrite => 0,
});
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 1, key => "message_0012", variables => { file => $anvil->data->{path}{configs}{'journald_an'} }});
my $shell_call = $anvil->data->{path}{exe}{systemctl}." restart systemd-journald.service";
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { shell_call => $shell_call }});
my $output = $anvil->System->call({shell_call => $shell_call, source => $THIS_FILE, line => __LINE__});
$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { output => $output }});
}
}
else
{
# Didn't find an entry for this machine.
$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 2, key => "message_0010"});
}
exit(0);
#############################################################################################################
# Functions #
#############################################################################################################

70
tools/scancore-update-states → tools/anvil-update-states
Unescape View File

@ -5,7 +5,7 @@
# #
use strict; use strict;
use warnings; use warnings;
use AN::Tools; use Anvil::Tools;
my $THIS_FILE = ($0 =~ /^.*\/(.*)$/)[0]; my $THIS_FILE = ($0 =~ /^.*\/(.*)$/)[0];
my $running_directory = ($0 =~ /^(.*?)\/$THIS_FILE$/)[0]; my $running_directory = ($0 =~ /^(.*?)\/$THIS_FILE$/)[0];
@ -14,19 +14,19 @@ if (($running_directory =~ /^\./) && ($ENV{PWD}))
$running_directory =~ s/^\./$ENV{PWD}/; $running_directory =~ s/^\./$ENV{PWD}/;
} }
my $an = AN::Tools->new(); my $$anvil = Anvil::Tools->new();
$an->Log->level({set => 2}); $$anvil->Log->level({set => 2});
$an->Storage->read_config({file => "/etc/striker/striker.conf"}); $$anvil->Storage->read_config({file => "/etc/anvil/anvil.conf"});
my $connections = $an->Database->connect({ my $connections = $$anvil->Database->connect({
sql_file => $an->data->{sys}{database}{schema}, sql_file => $$anvil->data->{sys}{database}{schema},
test_table => "network_interfaces", test_table => "network_interfaces",
}); });
# Turn off buffering so that the pinwheel will display while waiting for the SSH call(s) to complete. # Turn off buffering so that the pinwheel will display while waiting for the SSH call(s) to complete.
$| = 1; $| = 1;
report_network($an); report_network($anvil);
exit(0); exit(0);
@ -37,12 +37,12 @@ exit(0);
# This reports the current network interface states, tracked by the MAC address. # This reports the current network interface states, tracked by the MAC address.
sub report_network sub report_network
{ {
my ($an) = @_; my ($anvil) = @_;
# Write out the data in json format. # Write out the data in json format.
my $directory = $an->data->{path}{sysfs}{network_interfaces}; my $directory = $$anvil->data->{path}{sysfs}{network_interfaces};
local(*DIRECTORY); local(*DIRECTORY);
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0018", variables => { directory => $directory }}); $$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0018", variables => { directory => $directory }});
opendir(DIRECTORY, $directory); opendir(DIRECTORY, $directory);
while(my $file = readdir(DIRECTORY)) while(my $file = readdir(DIRECTORY))
{ {
@ -50,17 +50,17 @@ sub report_network
next if $file eq ".."; next if $file eq "..";
next if $file eq "lo"; next if $file eq "lo";
my $full_path = "$directory/$file"; my $full_path = "$directory/$file";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { full_path => $full_path }}); $$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { full_path => $full_path }});
if (-d $full_path) if (-d $full_path)
{ {
# Pull out the data I want. # Pull out the data I want.
my $interface = $file; my $interface = $file;
my $mac_address = $an->Storage->read_file({file => $full_path."/address"}); my $mac_address = $$anvil->Storage->read_file({file => $full_path."/address"});
my $link_state = $an->Storage->read_file({file => $full_path."/carrier"}); my $link_state = $$anvil->Storage->read_file({file => $full_path."/carrier"});
my $mtu = $an->Storage->read_file({file => $full_path."/mtu"}); my $mtu = $$anvil->Storage->read_file({file => $full_path."/mtu"});
my $duplex = $an->Storage->read_file({file => $full_path."/duplex"}); # full or half? my $duplex = $$anvil->Storage->read_file({file => $full_path."/duplex"}); # full or half?
my $operational = $an->Storage->read_file({file => $full_path."/operstate"}); # up or down my $operational = $$anvil->Storage->read_file({file => $full_path."/operstate"}); # up or down
my $speed = $link_state ? $an->Storage->read_file({file => $full_path."/speed"}) : 0; # Mbps (ie: 1000 = Gbps), gives a very high number for unplugged link my $speed = $link_state ? $$anvil->Storage->read_file({file => $full_path."/speed"}) : 0; # Mbps (ie: 1000 = Gbps), gives a very high number for unplugged link
if ($speed > 100000) if ($speed > 100000)
{ {
# NOTE: This is probably 0 now... Though someday >100 Gbps will be reasonable # NOTE: This is probably 0 now... Though someday >100 Gbps will be reasonable
@ -70,7 +70,7 @@ sub report_network
# Find the media, if possible. # Find the media, if possible.
my $media = "unknown"; my $media = "unknown";
my $ethtool = $an->System->call({shell_call => $an->data->{path}{exe}{ethtool}}); my $ethtool = $$anvil->System->call({shell_call => $$anvil->data->{path}{exe}{ethtool}});
foreach my $line (split/\n/, $ethtool) foreach my $line (split/\n/, $ethtool)
{ {
if ($line =~ /Supported ports: \[ (.*?) \]/i) if ($line =~ /Supported ports: \[ (.*?) \]/i)
@ -81,7 +81,7 @@ sub report_network
} }
# Log # Log
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { $$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
interface => $interface, interface => $interface,
mac_address => $mac_address, mac_address => $mac_address,
link_state => $link_state, link_state => $link_state,
@ -92,7 +92,7 @@ sub report_network
media => $media, media => $media,
}}); }});
$an->Database->insert_or_update_network_interfaces({ $$anvil->Database->insert_or_update_network_interfaces({
network_interface_name => $interface, network_interface_name => $interface,
network_interface_duplex => $duplex, network_interface_duplex => $duplex,
network_interface_link_state => $link_state, network_interface_link_state => $link_state,
@ -107,10 +107,10 @@ sub report_network
} }
closedir(DIRECTORY); closedir(DIRECTORY);
### TODO: Create an "ip" table and record IPs on this system, linking back to an interface, bond or ### TODO: Create $anvil "ip" table and record IPs on this system, linking back to $anvil interface, bond or
### bridge. ### bridge.
# Run 'ip addr' to see what IPs are in use. # Run 'ip addr' to see what IPs are in use.
$an->System->get_ips; $$anvil->System->get_ips;
# Write out the XML file and JSON file. # Write out the XML file and JSON file.
my $order = 1; my $order = 1;
@ -132,14 +132,14 @@ SELECT
FROM FROM
network_interfaces network_interfaces
WHERE WHERE
network_interface_host_uuid = ".$an->data->{sys}{use_db_fh}->quote($an->Get->host_uuid)." network_interface_host_uuid = ".$$anvil->data->{sys}{use_db_fh}->quote($$anvil->Get->host_uuid)."
ORDER BY ORDER BY
modified_date DESC modified_date DESC
;"; ;";
$an->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0124", variables => { query => $query }}); $$anvil->Log->entry({source => $THIS_FILE, line => __LINE__, level => 3, key => "log_0124", variables => { query => $query }});
my $results = $an->Database->query({query => $query, source => $THIS_FILE, line => __LINE__}); my $results = $$anvil->Database->query({query => $query, source => $THIS_FILE, line => __LINE__});
my $count = @{$results}; my $count = @{$results};
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { $$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
results => $results, results => $results,
count => $count, count => $count,
}}); }});
@ -155,7 +155,7 @@ ORDER BY
my $network_interface_medium = defined $row->[7] ? $row->[7] : ""; my $network_interface_medium = defined $row->[7] ? $row->[7] : "";
my $network_interface_bond_uuid = defined $row->[8] ? $row->[8] : ""; my $network_interface_bond_uuid = defined $row->[8] ? $row->[8] : "";
my $network_interface_bridge_uuid = defined $row->[9] ? $row->[9] : ""; my $network_interface_bridge_uuid = defined $row->[9] ? $row->[9] : "";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { $$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => {
network_interface_mac_address => $network_interface_mac_address, network_interface_mac_address => $network_interface_mac_address,
network_interface_name => $network_interface_name, network_interface_name => $network_interface_name,
network_interface_speed => $network_interface_speed, network_interface_speed => $network_interface_speed,
@ -175,16 +175,16 @@ ORDER BY
$network_json =~ s/,$//s; $network_json =~ s/,$//s;
$network_json .= "]}\n"; $network_json .= "]}\n";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { network_json => $network_json }}); $$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { network_json => $network_json }});
$network_xml .= "</network>\n"; $network_xml .= "</network>\n";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { network_xml => $network_xml }}); $$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { network_xml => $network_xml }});
### TODO: Set the 'status/network.json' name into 'striker.conf' ### TODO: Set the 'status/network.json' name into 'striker.conf'
# Write the JSON file. # Write the JSON file.
my $output_json = $an->data->{path}{directories}{html}."/status/network.json"; my $output_json = $$anvil->data->{path}{directories}{html}."/status/network.json";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { output_xml => $output_json }}); $$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { output_xml => $output_json }});
$an->Storage->write_file({ $$anvil->Storage->write_file({
file => $output_json, file => $output_json,
body => $network_json, body => $network_json,
overwrite => 1, overwrite => 1,
@ -194,9 +194,9 @@ ORDER BY
}); });
# Write the XML file. # Write the XML file.
my $output_xml = $an->data->{path}{directories}{html}."/status/network.xml"; my $output_xml = $$anvil->data->{path}{directories}{html}."/status/network.xml";
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { output_xml => $output_xml }}); $$anvil->Log->variables({source => $THIS_FILE, line => __LINE__, level => 3, list => { output_xml => $output_xml }});
$an->Storage->write_file({ $$anvil->Storage->write_file({
file => $output_xml, file => $output_xml,
body => $network_xml, body => $network_xml,
overwrite => 1, overwrite => 1,

230
AN/Tools.sql → tools/anvil.sql
Unescape View File

@ -1,6 +1,7 @@
-- This is the core database schema for AN::Tools. -- This is the core database schema for the Anvil! Intelligent Availability platform.
--
-- It expects PostgreSQL v. 9.1+ -- It expects PostgreSQL v. 9.1+
--
-- Table construction rules; -- Table construction rules;
-- --
-- All tables need to have a column called '<table>_uuid uuid not null primary key' that will have a -- All tables need to have a column called '<table>_uuid uuid not null primary key' that will have a
@ -317,3 +318,228 @@ CREATE TABLE states (
FOREIGN KEY(state_host_uuid) REFERENCES hosts(host_uuid) FOREIGN KEY(state_host_uuid) REFERENCES hosts(host_uuid)
); );
ALTER TABLE states OWNER TO #!variable!user!#; ALTER TABLE states OWNER TO #!variable!user!#;
-- NOTE: network_interfaces, network_bonds and network_bridges are all used by scan-network (which doesn't
-- exist yet).
-- This stores information about network interfaces on hosts. It is mainly used to match a MAC address to a
-- host. Given that it is possible that network devices can move, the linkage to the host_uuid can change.
CREATE TABLE network_interfaces (
network_interface_uuid uuid not null primary key,
network_interface_host_uuid uuid not null,
network_interface_mac_address text not null,
network_interface_name text not null, -- This is the current name of the interface.
network_interface_speed bigint not null, -- This is the speed, in bits-per-second, of the interface.
network_interface_mtu bigint, -- This is the MTU (Maximum Transmitable Size), in bytes, for this interface.
network_interface_link_state text not null, -- 0 or 1
network_interface_operational text not null, -- This is 'up', 'down' or 'unknown'
network_interface_duplex text not null, -- This is 'full', 'half' or 'unknown'
network_interface_medium text, -- This is 'tp' (twisted pair), 'fiber' or whatever they invent in the future.
network_interface_bond_uuid uuid, -- If this iface is in a bond, this will contain the 'bonds -> bond_uuid' that it is slaved to.
network_interface_bridge_uuid uuid, -- If this iface is attached to a bridge, this will contain the 'bridgess -> bridge_uuid' that it is connected to.
modified_date timestamp with time zone not null
);
ALTER TABLE network_interfaces OWNER TO #!variable!user!#;
CREATE TABLE history.network_interfaces (
history_id bigserial,
network_interface_uuid uuid not null,
network_interface_host_uuid uuid,
network_interface_mac_address text,
network_interface_name text,
network_interface_speed bigint,
network_interface_mtu bigint,
network_interface_link_state text,
network_interface_operational text,
network_interface_duplex text,
network_interface_medium text,
network_interface_bond_uuid uuid,
network_interface_bridge_uuid uuid,
modified_date timestamp with time zone not null
);
ALTER TABLE history.network_interfaces OWNER TO #!variable!user!#;
CREATE FUNCTION history_network_interfaces() RETURNS trigger
AS $$
DECLARE
history_network_interfaces RECORD;
BEGIN
SELECT INTO history_network_interfaces * FROM network_interfaces WHERE network_interface_host_uuid = new.network_interface_host_uuid;
INSERT INTO history.network_interfaces
(network_interface_uuid,
network_interface_host_uuid,
network_interface_mac_address,
network_interface_name,
network_interface_speed,
network_interface_mtu,
network_interface_link_state,
network_interface_operational,
network_interface_duplex,
network_interface_medium,
network_interface_bond_uuid,
network_interface_bridge_uuid,
modified_date)
VALUES
(history_network_interfaces.network_interface_uuid,
history_network_interfaces.network_interface_host_uuid,
history_network_interfaces.network_interface_mac_address,
history_network_interfaces.network_interface_name,
history_network_interfaces.network_interface_speed,
history_network_interfaces.network_interface_mtu,
history_network_interfaces.network_interface_link_state,
history_network_interfaces.network_interface_operational,
history_network_interfaces.network_interface_duplex,
history_network_interfaces.network_interface_medium,
history_network_interfaces.network_interface_bond_uuid,
history_network_interfaces.network_interface_bridge_uuid,
history_network_interfaces.modified_date);
RETURN NULL;
END;
$$
LANGUAGE plpgsql;
ALTER FUNCTION history_network_interfaces() OWNER TO #!variable!user!#;
CREATE TRIGGER trigger_network_interfaces
AFTER INSERT OR UPDATE ON network_interfaces
FOR EACH ROW EXECUTE PROCEDURE history_network_interfaces();
-- This stores information about network bonds (mode=1) on a hosts.
CREATE TABLE bonds (
bond_uuid uuid primary key,
bond_host_uuid uuid not null,
bond_name text not null,
bond_mode integer not null, -- This is the numerical bond type (will translate to the user's language in ScanCore)
bond_mtu bigint,
bond_primary_slave text,
bond_primary_reselect text,
bond_active_slave text,
bond_mii_status text,
bond_mii_polling_interval bigint,
bond_up_delay bigint,
bond_down_delay bigint,
modified_date timestamp with time zone not null,
FOREIGN KEY(bond_host_uuid) REFERENCES hosts(host_uuid)
);
ALTER TABLE bonds OWNER TO #!variable!user!#;
CREATE TABLE history.bonds (
history_id bigserial,
bond_uuid uuid,
bond_host_uuid uuid,
bond_name text,
bond_mode integer,
bond_mtu bigint,
bond_primary_slave text,
bond_primary_reselect text,
bond_active_slave text,
bond_mii_status text,
bond_mii_polling_interval bigint,
bond_up_delay bigint,
bond_down_delay bigint,
modified_date timestamp with time zone not null
);
ALTER TABLE history.bonds OWNER TO #!variable!user!#;
CREATE FUNCTION history_bonds() RETURNS trigger
AS $$
DECLARE
history_bonds RECORD;
BEGIN
SELECT INTO history_bonds * FROM bonds WHERE bond_uuid=new.bond_uuid;
INSERT INTO history.bonds
(bond_uuid,
bond_host_uuid,
bond_name,
bond_mode,
bond_mtu,
bond_primary_slave,
bond_primary_reselect,
bond_active_slave,
bond_mii_status,
bond_mii_polling_interval,
bond_up_delay,
bond_down_delay,
modified_date)
VALUES
(history_bonds.bond_uuid,
history_bonds.bond_host_uuid,
history_bonds.bond_name,
history_bonds.bond_mode,
history_bonds.bond_mtu,
history_bonds.bond_primary_slave,
history_bonds.bond_primary_reselect,
history_bonds.bond_active_slave,
history_bonds.bond_mii_status,
history_bonds.bond_mii_polling_interval,
history_bonds.bond_up_delay,
history_bonds.bond_down_delay,
history_bonds.modified_date);
RETURN NULL;
END;
$$
LANGUAGE plpgsql;
ALTER FUNCTION history_bonds() OWNER TO #!variable!user!#;
CREATE TRIGGER trigger_bonds
AFTER INSERT OR UPDATE ON bonds
FOR EACH ROW EXECUTE PROCEDURE history_bonds();
-- This stores information about network bridges.
CREATE TABLE bridges (
bridge_uuid uuid primary key,
bridge_host_uuid uuid not null,
bridge_name text not null,
bridge_id text,
bridge_stp_enabled text,
modified_date timestamp with time zone not null,
FOREIGN KEY(bridge_host_uuid) REFERENCES hosts(host_uuid)
);
ALTER TABLE bridges OWNER TO #!variable!user!#;
CREATE TABLE history.bridges (
history_id bigserial,
bridge_uuid uuid,
bridge_host_uuid uuid,
bridge_name text,
bridge_id text,
bridge_stp_enabled text,
modified_date timestamp with time zone not null
);
ALTER TABLE history.bridges OWNER TO #!variable!user!#;
CREATE FUNCTION history_bridges() RETURNS trigger
AS $$
DECLARE
history_bridges RECORD;
BEGIN
SELECT INTO history_bridges * FROM bridges WHERE bridge_uuid=new.bridge_uuid;
INSERT INTO history.bridges
(bridge_uuid,
bridge_host_uuid,
bridge_name,
bridge_name,
bridge_id,
bridge_stp_enabled,
modified_date)
VALUES
(history_bridges.bridge_uuid,
history_bridges.bridge_host_uuid,
history_bridges.bridge_name,
history_bridges.bridge_name,
history_bridges.bridge_id,
history_bridges.bridge_stp_enabled,
history_bridges.modified_date);
RETURN NULL;
END;
$$
LANGUAGE plpgsql;
ALTER FUNCTION history_bridges() OWNER TO #!variable!user!#;
CREATE TRIGGER trigger_bridges
AFTER INSERT OR UPDATE ON bridges
FOR EACH ROW EXECUTE PROCEDURE history_bridges();

87
tools/scancore-daemon
Unescape View File

@ -1,87 +0,0 @@
#!/usr/bin/perl
#
# This is the master daemon that manages all periodically run processes on Striker dashboards and Anvil!
# nodes.
#
use strict;
use warnings;
use AN::Tools;
my $THIS_FILE = ($0 =~ /^.*\/(.*)$/)[0];
my $running_directory = ($0 =~ /^(.*?)\/$THIS_FILE$/)[0];
if (($running_directory =~ /^\./) && ($ENV{PWD}))
{
$running_directory =~ s/^\./$ENV{PWD}/;
}
# Turn off buffering so that the pinwheel will display while waiting for the SSH call(s) to complete.
$| = 1;
my $an = AN::Tools->new();
$an->Log->level({set => 2});
# Paths
$an->data->{path}{tools}{'scancore-database'} = "/usr/sbin/striker/scancore-database";
$an->data->{path}{tools}{'scancore-update-states'} = "/usr/sbin/striker/scancore-update-states";
$an->data->{path}{config}{'striker.conf'} = "/etc/striker/striker.conf";
# Read our config.
$an->Storage->read_config({file => $an->data->{path}{config}{'striker.conf'}});
# There are some things we only want to run on (re)start and don't need to always run.
run_once($an);
# These are the things we always want running.
while(1)
{
# Loop and sleep for 2s.
keep_running($an);
sleep 2;
}
$an->nice_exit({code => 0});
#############################################################################################################
# Functions #
#############################################################################################################
# These are tools that don't need to constantly run.
sub run_once
{
my ($an) = @_;
# Check that the database is ready.
my $database_output = $an->System->call({shell_call => $an->data->{path}{tools}{'scancore-database'}, source => $THIS_FILE, line => __LINE__});
if ($database_output)
{
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { database_output => $database_output }});
}
return(0);
}
# These are tools that need to keep running.
sub keep_running
{
my ($an) = @_;
# Update hardware state files.
update_state_file($an);
return(0);
}
# This calls 'scancore-update-states' which will scan the local machine's state (hardware and software) and
# record write it out to an HTML file
sub update_state_file
{
my ($an) = @_;
my $states_output = $an->System->call({shell_call => $an->data->{path}{tools}{'scancore-update-states'}, source => $THIS_FILE, line => __LINE__});
if ($states_output)
{
$an->Log->variables({source => $THIS_FILE, line => __LINE__, level => 2, list => { states_output => $states_output }});
}
return(0);
}

98
AN/an-tools.xml → tools/words.xml
Unescape View File

@ -4,14 +4,12 @@
Company: Alteeve's Niche, Inc. Company: Alteeve's Niche, Inc.
License: GPL v2+ License: GPL v2+
Author: Madison Kelly <mkelly@alteeve.ca> Author: Madison Kelly <mkelly@alteeve.ca>
This is the AN::Tools master 'words' file.
--> -->
<words> <words>
<meta version="3.0.0" languages="en_CA,jp"/> <meta version="3.0.0" languages="en_CA,jp"/>
<!-- Canadian English --> <!-- Canadian English -->
<language name="en_CA" long_name="Canadian English" description="Created by Madison Kelly (mkelly@alteeve.ca) for the AN::Tools suite of perl modules"> <language name="en_CA" long_name="Canadian English" description="Striker/ScanCore language file.">
<!-- Alert titles --> <!-- Alert titles -->
<key name="alert_title_0001">Debug</key> <key name="alert_title_0001">Debug</key>
@ -77,7 +75,7 @@ It also has replacement variables: [#!variable!first!#] and [#!variable!second!#
<key name="log_0031"><![CDATA[[ Warning ] - Storage->search_directories() was passed the array: [#!variable!array!#], but it wasn't actually an array. Using @INC + path::directories::tools + \$ENV{'PATH'} for the list of directories to search instead.]]></key> <key name="log_0031"><![CDATA[[ Warning ] - Storage->search_directories() was passed the array: [#!variable!array!#], but it wasn't actually an array. Using @INC + path::directories::tools + \$ENV{'PATH'} for the list of directories to search instead.]]></key>
<key name="log_0032"><![CDATA[[ Warning ] - Words->read()' called without a file name to read.]]></key> <key name="log_0032"><![CDATA[[ Warning ] - Words->read()' called without a file name to read.]]></key>
<key name="log_0033"><![CDATA[[ Warning ] - Words->read()' asked to read: [#!variable!file!#] which was not found.]]></key> <key name="log_0033"><![CDATA[[ Warning ] - Words->read()' asked to read: [#!variable!file!#] which was not found.]]></key>
<key name="log_0034"><![CDATA[[ Warning ] - AN::Tools::Words->read()' asked to read: [#!variable!file!#] which was not readable by: [#!variable!user!#] (uid/euid: [#!variable!uid!#]).]]></key> <key name="log_0034"><![CDATA[[ Warning ] - Anvil::Tools::Words->read()' asked to read: [#!variable!file!#] which was not readable by: [#!variable!user!#] (uid/euid: [#!variable!uid!#]).]]></key>
<key name="log_0035"><![CDATA[[ Warning ] - The config file: [#!variable!file!#] appears to have a malformed line: [#!variable!count!#:#!variable!line!#].]]></key> <key name="log_0035"><![CDATA[[ Warning ] - The config file: [#!variable!file!#] appears to have a malformed line: [#!variable!count!#:#!variable!line!#].]]></key>
<key name="log_0036"><![CDATA[[ Error ] - The method Database->read_variable() was called but both the 'variable_name' and 'variable_uuid' parameters were not passed or both were empty.]]></key> <key name="log_0036"><![CDATA[[ Error ] - The method Database->read_variable() was called but both the 'variable_name' and 'variable_uuid' parameters were not passed or both were empty.]]></key>
<key name="log_0037"><![CDATA[[ Error ] - The method Database->insert_or_update_variables() method was called but both the 'variable_name' and 'variable_uuid' parameters were not passed or both were empty.]]></key> <key name="log_0037"><![CDATA[[ Error ] - The method Database->insert_or_update_variables() method was called but both the 'variable_name' and 'variable_uuid' parameters were not passed or both were empty.]]></key>
@ -91,8 +89,8 @@ It also has replacement variables: [#!variable!first!#] and [#!variable!second!#
<key name="log_0045">The host: [#!variable!host!#] is requesting a database lock.</key> <key name="log_0045">The host: [#!variable!host!#] is requesting a database lock.</key>
<key name="log_0046"><![CDATA[[ Note ] - The method Storage->copy_file() was asked to copy: [#!variable!source!#] to: [#!variable!target!#], but the target already exists and 'overwrite' wasn't specified, skipping.]]></key> <key name="log_0046"><![CDATA[[ Note ] - The method Storage->copy_file() was asked to copy: [#!variable!source!#] to: [#!variable!target!#], but the target already exists and 'overwrite' wasn't specified, skipping.]]></key>
<key name="log_0047"><![CDATA[[ Error ] - The method Log->level() was passed an invalid log level: [#!variable!set!#]. Only '0', '1', '2', '3' or '4' are valid.]]></key> <key name="log_0047"><![CDATA[[ Error ] - The method Log->level() was passed an invalid log level: [#!variable!set!#]. Only '0', '1', '2', '3' or '4' are valid.]]></key>
<key name="log_0048"><![CDATA[[ Warning ] - Testing of AN::Tools is beginning. This will generate warnings and alerts and are not a concern.]]></key> <key name="log_0048"><![CDATA[[ Warning ] - Testing of Anvil::Tools is beginning. This will generate warnings and alerts and are not a concern.]]></key>
<key name="log_0049"><![CDATA[[ Warning ] - Testing of AN::Tools is complete.]]></key> <key name="log_0049"><![CDATA[[ Warning ] - Testing of Anvil::Tools is complete.]]></key>
<key name="log_0050">[ Error ] - There is a local database defined, but it does not appear to exist and we could not initialize the database server. Is 'postgresql-server' installed?</key> <key name="log_0050">[ Error ] - There is a local database defined, but it does not appear to exist and we could not initialize the database server. Is 'postgresql-server' installed?</key>
<key name="log_0051"><![CDATA[[ Error ] - The method Storage->change_owner() was asked to change the ownership of: [#!variable!target!#] which doesn't exist.]]></key> <key name="log_0051"><![CDATA[[ Error ] - The method Storage->change_owner() was asked to change the ownership of: [#!variable!target!#] which doesn't exist.]]></key>
<key name="log_0052"><![CDATA[[ Error ] - The method Storage->copy_file() was called but the source file: [#!variable!source!#] doesn't exist.]]></key> <key name="log_0052"><![CDATA[[ Error ] - The method Storage->copy_file() was called but the source file: [#!variable!source!#] doesn't exist.]]></key>
@ -137,8 +135,8 @@ The database connection error was:
<key name="log_0072"><![CDATA[[ Error ] - The method Database->query() was called without a database ID to query and 'sys::read_db_id' doesn't contain a database ID, either. Are any databases available?]]></key> <key name="log_0072"><![CDATA[[ Error ] - The method Database->query() was called without a database ID to query and 'sys::read_db_id' doesn't contain a database ID, either. Are any databases available?]]></key>
<key name="log_0073"><![CDATA[[ Error ] - The method Database->query() was asked to query the database with ID: [#!variable!id!#] but there is no file handle open to the database. Was the connection lost?]]></key> <key name="log_0073"><![CDATA[[ Error ] - The method Database->query() was asked to query the database with ID: [#!variable!id!#] but there is no file handle open to the database. Was the connection lost?]]></key>
<key name="log_0074">About to query: [#!variable!id!#]:[#!variable!query!#]</key> <key name="log_0074">About to query: [#!variable!id!#]:[#!variable!query!#]</key>
<key name="log_0075"><![CDATA[[ Error ] - Failed to prepare the database query: [#!variable!query!#] on: [#!variable!server!#]. The error was: [#!variable!db_error!#]. Note that if the query reports '--', the query was listed as containing sensitive data and '$an->Log->secure' is not set.]]></key> <key name="log_0075"><![CDATA[[ Error ] - Failed to prepare the database query: [#!variable!query!#] on: [#!variable!server!#]. The error was: [#!variable!db_error!#]. Note that if the query reports '--', the query was listed as containing sensitive data and '$anvil->Log->secure' is not set.]]></key>
<key name="log_0076"><![CDATA[[ Error ] - Failed to execute the database query: [#!variable!query!#] on: [#!variable!server!#]. The error was: [#!variable!db_error!#]. Note that if the query reports '--', the query was listed as containing sensitive data and '$an->Log->secure' is not set.]]></key> <key name="log_0076"><![CDATA[[ Error ] - Failed to execute the database query: [#!variable!query!#] on: [#!variable!server!#]. The error was: [#!variable!db_error!#]. Note that if the query reports '--', the query was listed as containing sensitive data and '$anvil->Log->secure' is not set.]]></key>
<key name="log_0077"><![CDATA[[ Error ] - The method Database->initialize() was called without a database ID to query and 'sys::read_db_id' doesn't contain a database ID, either. Are any databases available?]]></key> <key name="log_0077"><![CDATA[[ Error ] - The method Database->initialize() was called without a database ID to query and 'sys::read_db_id' doesn't contain a database ID, either. Are any databases available?]]></key>
<key name="log_0078"><![CDATA[[ Error ] - The method Database->initialize() was asked to query the database with ID: [#!variable!id!#] but there is no file handle open to the database. Was the connection lost?]]></key> <key name="log_0078"><![CDATA[[ Error ] - The method Database->initialize() was asked to query the database with ID: [#!variable!id!#] but there is no file handle open to the database. Was the connection lost?]]></key>
<key name="log_0079"><![CDATA[[ Error ] - The method Database->initialize() was asked to initialize the database: [#!variable!server!#] (id: [#!variable!id!#]) but a core SQL file to load wasn't passed, and the 'database::#!variable!id!#::core_sql' variable isn't set. Unable to initialize without the core SQL file.]]></key> <key name="log_0079"><![CDATA[[ Error ] - The method Database->initialize() was asked to initialize the database: [#!variable!server!#] (id: [#!variable!id!#]) but a core SQL file to load wasn't passed, and the 'database::#!variable!id!#::core_sql' variable isn't set. Unable to initialize without the core SQL file.]]></key>
@ -152,7 +150,7 @@ The database connection error was:
<key name="log_0087">Testing access to the the database: [#!variable!server!#] prior to query or write. Program will exit if it fails.</key> <key name="log_0087">Testing access to the the database: [#!variable!server!#] prior to query or write. Program will exit if it fails.</key>
<key name="log_0088">Access confirmed.</key> <key name="log_0088">Access confirmed.</key>
<key name="log_0089"><![CDATA[[ Error ] - The method Database->write() was asked to write to the database with ID: [#!variable!id!#] but there is no file handle open to the database. Was the connection lost?]]></key> <key name="log_0089"><![CDATA[[ Error ] - The method Database->write() was asked to write to the database with ID: [#!variable!id!#] but there is no file handle open to the database. Was the connection lost?]]></key>
<key name="log_0090"><![CDATA[[ Error ] - Failed to 'do' the database query: [#!variable!query!#] on: [#!variable!server!#]. The error was: [#!variable!db_error!#]. Note that if the query reports '--', the query was listed as containing sensitive data and '$an->Log->secure' is not set.]]></key> <key name="log_0090"><![CDATA[[ Error ] - Failed to 'do' the database query: [#!variable!query!#] on: [#!variable!server!#]. The error was: [#!variable!db_error!#]. Note that if the query reports '--', the query was listed as containing sensitive data and '$anvil->Log->secure' is not set.]]></key>
<key name="log_0091">Failed to connect to any database.</key> <key name="log_0091">Failed to connect to any database.</key>
<key name="log_0092"><![CDATA[[ Error ] - Unable to connect to the database: [#!variable!server!#] (id: [#!variable!id!#]).]]></key> <key name="log_0092"><![CDATA[[ Error ] - Unable to connect to the database: [#!variable!server!#] (id: [#!variable!id!#]).]]></key>
<key name="log_0093"><![CDATA[[ Error ] - The method Alert->check_alert_sent() was called but the 'modified_date' parameter was not passed and/or 'sys::db_timestamp' is not set. Did the program fail to connect to any databases?]]></key> <key name="log_0093"><![CDATA[[ Error ] - The method Alert->check_alert_sent() was called but the 'modified_date' parameter was not passed and/or 'sys::db_timestamp' is not set. Did the program fail to connect to any databases?]]></key>
@ -225,9 +223,82 @@ Here we will inject 't_0006', which injects 't_0001' which has a variable: [#!st
</key> </key>
<key name="t_0006">This string embeds 't_0001': [#!string!t_0001!#]</key> <key name="t_0006">This string embeds 't_0001': [#!string!t_0001!#]</key>
<key name="brand_0001">Alteeve</key>
<key name="brand_0002">Anvil!</key>
<key name="brand_0003">Striker</key>
<key name="brand_0004">ScanCore</key>
<key name="brand_0005"><![CDATA[&copy; 2017 <a href="https://alteeve.com/" target="_new">Alteeve's Niche! Inc.</a>, Toronto, Ontario, Canada]]></key>
<key name="brand_0006"><![CDATA[<i>Anvil!</i>]]></key>
<key name="header_0001">Current Network Interfaces and States</key>
<key name="header_0002">MAC Address</key>
<key name="header_0003">Name</key>
<key name="header_0004">State</key>
<key name="header_0005">Speed</key>
<key name="header_0006">Up Order</key>
<!-- General strings shown in Striker -->
<key name="striker_0001">Welcome! Lets setup your #!string!brand_0003!# dashboard...</key>
<key name="striker_0002">We're going to ask you a few questions so that we can set things up for your environment. If you need help at any time, just click on the "[?]" icon in the top-right. Let's get started!</key>
<key name="striker_0003">Organization name</key>
<key name="striker_0004">This is the name of the company, organization or division that owns or maintains this #!string!brand_0006!#. This is a descriptive field and you can enter whatever makes most sense to you.</key>
<key name="striker_0005">Prefix</key>
<key name="striker_0006">This is a two to five character prefix used to identify this organization. It is used as the prefix for host names for dashboards, nodes and foundation pack equipment. You can use letters and numbers and set whatever makes sense to you.</key>
<key name="striker_0007">Domain Name</key>
<key name="striker_0008">This is the domain name you would like to use for this dashboard. This will also be used as the default domain used when creating new install manifests.</key>
<key name="striker_0009">Sequence Number</key>
<key name="striker_0010">If this is your first Striker, set this to '1'. If it is the second one, set '2'. If it is the third, '3' and so on.</key>
<key name="striker_0011">Internet-Facing Network Count</key>
<key name="striker_0012"><![CDATA[How many internal networks will this dashboard have access to? In most cases, this is just '1'.<br /><b>NOTE</b>: You must have a network interface for the back-channel network, plus one for each internal network. If you have two interfaces for each network, we will setup bonds for redundancy automatically.]]></key>
<key name="striker_0013">Next</key>
<key name="striker_0014">Step 1</key>
<key name="striker_0015">IFN Count</key>
<key name="striker_0016">Host name</key>
<key name="striker_0017">This is the hostname for this Striker dashboard. Generally it is a good idea to stick with the default.</key>
<key name="striker_0018">Back-Channel Network link #!variable!number!#</key>
<key name="striker_0019">This is where you configure the network to enable access this Back-Channel Network.</key>
<key name="striker_0020">Storage Network link #!variable!number!#</key>
<key name="striker_0021">This is where you configure the network to enable access this Storage Network.</key>
<key name="striker_0022">Internet-Facing Network link #!variable!number!#</key>
<key name="striker_0023">This is where you configure the network to enable access this Internet-Facing Network.</key>
<key name="striker_0024">IP Address</key>
<key name="striker_0025">Subnet</key>
<key name="striker_0026">Gateway</key>
<key name="striker_0027">DNS Server</key>
<key name="striker_0028">Network Interface</key>
<key name="striker_0029">Primary Interface</key>
<key name="striker_0030">Backup Interface</key>
<key name="striker_0031">Striker user name</key>
<key name="striker_0032">This is the user name that you will log into Striker as and the name of the user that owns the database.</key>
<key name="striker_0033">Striker password</key>
<key name="striker_0034"><![CDATA[This will be the password used to log into this Striker and connect to its database. It must be 6+ characters long.<br /><b>NOTE</b>: This password needs to be stored in plain text. Do not use a password you use elsewhere.]]></key>
<key name="striker_0035">Gateway</key>
<key name="striker_0036">This is the network gateway used to access the outside world.</key>
<key name="striker_0037">DNS</key>
<key name="striker_0038">This is the domain name server(s) to use when resolving domain names. You can specify 2 or more, separated by commas.</key>
<key name="striker_0039">Gateway Interface</key>
<key name="striker_0040">This is the interface with the internet access. Usually this is "ifn_link1".</key> <!-- Translation note; leave 'ifn_link1' as it is, it is the device name. -->
<key name="striker_0041">We're almost ready! Does this look right? If so, we'll setup this Striker dashboard.</key>
<key name="striker_0042">What we are planning to do...</key>
<key name="striker_0043">Apply New Configuration</key>
<!-- Warnings -->
<key name="striker_warning_0001">The IP address will change. You will need to reconnect after applying these changes.</key>
<!-- Errors -->
<key name="striker_error_0001">There are not enough network interfaces on this machine. You have: [#!variable!interface_count!#] interface(s), and you need at least: [#!variable!required_interfaces_for_single!#] interfaces to connect to the requested networks (one for Back-Channel and one for each Internet-Facing network).</key>
<key name="striker_error_0002">The local system UUID can't be read yet. This might be because the system is brand new and/or ScanCore hasn't run yet. Please try again in a minute.</key>
<key name="striker_error_0003">None of the databases are accessible, unable to proceed.</key>
<key name="striker_error_0004">The gateway address doesn't match any of your networks.</key>
<!-- These are works and strings used by javascript/jqery -->
<key name="js_0001">Up</key>
<key name="js_0002">Down</key>
<key name="js_0003">Mbps</key>
</language> </language>
<!-- 日本語 --> <!-- 日本語 -->
<language name="jp" long_name="日本語" description=">Created by Madison Kelly (mkelly@alteeve.ca) for the AN::Tools suite of perl modules."> <language name="jp" long_name="日本語" description="Striker/ScanCore language file.">
<!-- Test words. Do NOT change unless you update 't/Words.t' or tests will needlessly fail. --> <!-- Test words. Do NOT change unless you update 't/Words.t' or tests will needlessly fail. -->
<key name="t_0000">テスト</key> <key name="t_0000">テスト</key>
@ -246,5 +317,12 @@ Here we will inject 't_0006', which injects 't_0001' which has a variable: [#!st
ここでは変数 「#!string!t_0006!#」を持つ 「t_0001」を注入する 「t_0006」を注入します。 ここでは変数 「#!string!t_0006!#」を持つ 「t_0001」を注入する 「t_0006」を注入します。
</key> </key>
<key name="t_0006">この文字列には「t_0001」が埋め込まれています：「#!string!t_0001!#」</key> <key name="t_0006">この文字列には「t_0001」が埋め込まれています：「#!string!t_0001!#」</key>
<key name="brand_0001">アルティーブ</key>
<key name="brand_0002">Anvil!</key>
<key name="brand_0003">ストライカ</key>
<key name="brand_0004">スカンコア</key>
<key name="brand_0005"><![CDATA[&copy; 2017 <a href="https://alteeve.com/" target="_new">Alteeve's Niche! Inc.</a>, トロント、オンタリオ、カナダ]]></key>
</language> </language>
</words> </words>

4
units/scancore-daemon.service → units/anvil-daemon.service
Unescape View File

@ -1,10 +1,10 @@
[Unit] [Unit]
Description=ScanCore - Anvil! IA Suite Description=Anvil! Intelligent Availability Platform - main service daemon
Wants=network.target Wants=network.target
[Service] [Service]
Type=simple Type=simple
ExecStart=/usr/sbin/striker/scancore-daemon ExecStart=/usr/sbin/anvil/anvil-daemon
ExecStop=/bin/kill -WINCH ${MAINPID} ExecStop=/bin/kill -WINCH ${MAINPID}
Restart=always Restart=always

1
watch_logs
Unescape View File

@ -0,0 +1 @@
clear; journalctl -f -a -S "$(date +"%F %R:%S")" -t anvil
Write Preview
Loading…
Cancel
Save