Open-ILS/src/support-scripts/settings-tester.pl

   1 #!/usr/bin/perl
   2 # vim:noet:ts=4:
   3 use strict;
   4 use warnings;
   5
   6 BEGIN {
   7         eval "use OpenSRF::Utils::Config;";
   8         die "Please ensure that /openils/lib/perl5 is in your PERL5LIB environment variable.
   9         You must run this script as the 'opensrf' user.\n" if ($@);
  10         eval "use Error qw/:try/;";
  11         die "Please install Error.pm.\n" if ($@);
  12         eval "use UNIVERSAL::require;";
  13         die "Please install the UNIVERSAL::require perl module.\n" if ($@);
  14         eval "use Getopt::Long;";
  15         die "Please install the Getopt::Long perl module.\n" if ($@);
  16         eval "use Net::Domain;";
  17         die "Please install the Net::Domain perl module.\n" if ($@);
  18 }
  19
  20 my $output = '';
  21 my $perloutput = '';
  22 my $result;
  23
  24 my ($gather, $hostname, $core_config, $tmpdir) =
  25         (0, Net::Domain::hostfqdn(), '/openils/conf/opensrf_core.xml', '/tmp/');
  26
  27 GetOptions(
  28         'gather' => \$gather,
  29         'hostname=s' => \$hostname,
  30         'config_file=s' => \$core_config,
  31         'tempdir=s' => \$tmpdir,
  32 );
  33
  34 while (my $mod = <DATA>) {
  35         chomp $mod;
  36         my @list = split / /, $mod;
  37
  38         my $ok = 0;
  39         for my $m (@list) {
  40                 if ($m->use) {
  41                         $ok++;
  42                         my $version = $m->VERSION;
  43                         print "$m version $version\n" if ($version);
  44                 }
  45         }
  46
  47         unless ($ok) {
  48                 if (@list == 1) {
  49                         warn "Please install $mod\n";
  50                         $perloutput .= "Please install the $mod Perl module.\n";
  51                 } else {
  52                         warn "Please install one of the following modules: $mod\n";
  53                         $perloutput .= "Please install one of the following modules: $mod\n";
  54                 }
  55         }
  56
  57 }
  58
  59 use OpenSRF::Transport::SlimJabber::Client;
  60 use OpenSRF::Utils::SettingsParser;
  61 use OpenSRF::Utils::SettingsClient;
  62 use Data::Dumper;
  63 use DBI;
  64
  65 (my $conf_dir = $core_config) =~ s#(.*)/.*#$1#;
  66 OpenSRF::Utils::Config->load(config_file => $core_config);
  67 my $conf = OpenSRF::Utils::Config->current;
  68 my $settings_config = $conf->bootstrap->settings_config;
  69 my $logfile    = $conf->bootstrap->logfile;
  70 (my $log_dir = $logfile) =~ s#(.*)/.*#$1#;
  71
  72 my $xmlparser = XML::LibXML->new();
  73 my $confxml = $xmlparser->parse_file($core_config);
  74 my $confxpc = XML::LibXML::XPathContext->new($confxml);
  75
  76 foreach my $section (qw/opensrf gateway/) {
  77         my $j_username = $confxpc->find("/config/$section/username");
  78         my $j_password = $confxpc->find("/config/$section/passwd");
  79         my $j_port = $confxpc->find("/config/$section/port");
  80         # We should check for a domains element to catch likely upgrade errors
  81         my $j_domain = $confxpc->find("/config/$section/domain");
  82         check_jabber($j_username, $j_password, $j_domain, $j_port);
  83 }
  84
  85 my @routers = $confxpc->findnodes("/config/routers/router");
  86 foreach my $router (@routers) {
  87         my $j_username = $router->findvalue("./transport/username");
  88         my $j_password = $router->findvalue("./transport/password");
  89         my $j_port = $router->findvalue("./transport/port");
  90         # We should check for a domains element to catch likely upgrade errors
  91         my $j_domain = $router->findvalue("./transport/server");
  92         check_jabber($j_username, $j_password, $j_domain, $j_port);
  93 }
  94
  95 my $osrfxml = $xmlparser->parse_file($settings_config);
  96 print "\nChecking database connections\n";
  97 # Check database connections
  98 my @databases = $osrfxml->findnodes('//database');
  99 foreach my $database (@databases) {
 100         my $db_name = $database->findvalue("./db");
 101         if (!$db_name) {
 102                 $db_name = $database->findvalue("./name");
 103         }
 104         my $db_host = $database->findvalue("./host");
 105         my $db_port = $database->findvalue("./port");
 106         my $db_user = $database->findvalue("./user");
 107         my $db_pw = $database->findvalue("./pw");
 108         if (!$db_pw && $database->parentNode->parentNode->nodeName eq 'reporter') {
 109                 $db_pw = $database->findvalue("./password");
 110                 warn "* WARNING: Deprecated <password> element used for the <reporter> entry.  " .
 111                         "Please use <pw> instead.\n" if ($db_pw);
 112         }
 113
 114         my $osrf_xpath;
 115         foreach my $node ($database->findnodes("ancestor::node()")) {
 116                 next unless $node->nodeType == XML::LibXML::XML_ELEMENT_NODE;
 117                 $osrf_xpath .= "/" . $node->nodeName;
 118         }
 119         $output .= test_db_connect($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath);
 120 }
 121
 122 print "\nChecking database drivers to ensure <driver> matches <language>\n";
 123 # Check database drivers
 124 # if language eq 'C', driver eq 'pgsql'
 125 # if language eq 'perl', driver eq 'Pg'
 126 my @drivers = $osrfxml->findnodes('//driver');
 127 foreach my $driver_node (@drivers) {
 128         my $language;
 129         my $driver_xpath;
 130         my @driver_xpath_nodes;
 131         foreach my $node ($driver_node->findnodes("ancestor::node()")) {
 132                 next unless $node->nodeType == XML::LibXML::XML_ELEMENT_NODE;
 133                 $driver_xpath .= "/" . $node->nodeName;
 134                 push @driver_xpath_nodes, $node->nodeName;
 135         }
 136         my $lang_xpath;
 137         my $driver = $driver_node->findvalue("child::text()");
 138         while (pop(@driver_xpath_nodes) && scalar(@driver_xpath_nodes) > 0 && !$language) {
 139                 $lang_xpath = "/" . join('/', @driver_xpath_nodes) . "/language";
 140                 my @lang_nodes = $osrfxml->findnodes($lang_xpath);
 141                 next unless scalar(@lang_nodes > 0);
 142                 $language = $lang_nodes[0]->findvalue("child::text()");
 143         }
 144         if ($driver eq "pgsql") {
 145                 if ($driver_xpath =~ m#/reporter/#) {
 146                         $result = "* ERROR: reporter application must use driver 'Pg', but '$driver' is defined\n";
 147                         warn $result;
 148                 } elsif ($language eq "C") {
 149                         $result = "* OK: $driver language is $language in $lang_xpath\n";
 150                 } else {
 151                         $result = "* ERROR: $driver language is $language in $lang_xpath\n";
 152                         warn $result;
 153                 }
 154         } elsif ($driver eq "Pg") {
 155                 if ($driver_xpath =~ m#/reporter/#) {
 156                         $result = "* OK: $driver language is undefined for reporter base configuration\n";
 157                 } elsif ($language eq "perl") {
 158                         $result = "* OK: $driver language is $language in $lang_xpath\n";
 159                 } else {
 160                         $result = "* ERROR: $driver language is $language in $lang_xpath\n";
 161                         warn $result;
 162                 }
 163         } else {
 164                 $result = "* ERROR: Unknown driver $driver in $driver_xpath\n";
 165                 warn $result;
 166         }
 167         print $result;
 168         $output .= $result;
 169 }
 170
 171 print "\nChecking libdbi and libdbi-drivers\n";
 172 $output .= check_libdbd();
 173
 174 print "\nChecking hostname\n";
 175 my @hosts = $osrfxml->findnodes('/opensrf/hosts/*');
 176 foreach my $host (@hosts) {
 177         next unless $host->nodeType == XML::LibXML::XML_ELEMENT_NODE;
 178         my $osrfhost = $host->nodeName;
 179         my $he;
 180         if ($osrfhost ne $hostname && $osrfhost ne "localhost") {
 181                 $result = " * ERROR: expected hostname '$hostname', found '$osrfhost' in <hosts> section of opensrf.xml\n";
 182                 warn $result;
 183                 $he = 1;
 184         } elsif ($osrfhost eq "localhost") {
 185                 $result = " * OK: found hostname 'localhost' in <hosts> section of opensrf.xml\n";
 186         } else {
 187                 $result = " * OK: found hostname '$hostname' in <hosts> section of opensrf.xml\n";
 188         }
 189         print $result unless $he;
 190         $output .= $result;
 191 }
 192
 193
 194 if ($gather) {
 195         get_debug_info( $tmpdir, $log_dir, $conf_dir, $perloutput, $output );
 196 }
 197
 198 sub test_db_connect {
 199         my ($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath) = @_;
 200
 201         my $dsn = "dbi:Pg:dbname=$db_name;host=$db_host;port=$db_port";
 202         my $de = undef;
 203         my ($dbh, $encoding, $langs);
 204         try {
 205                 $dbh = DBI->connect($dsn, $db_user, $db_pw);
 206                 unless($dbh) {
 207                         $de = "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
 208                         warn "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
 209                 }
 210
 211                 # Get server encoding
 212                 my $sth = $dbh->prepare("SHOW server_encoding");
 213                 $sth->execute;
 214                 $sth->bind_col(1, \$encoding);
 215                 $sth->fetch;
 216                 $sth->finish;
 217
 218                 # Get list of server languages
 219                 $sth = $dbh->prepare("SELECT lanname FROM pg_catalog.pg_language");
 220                 $sth->execute;
 221                 $langs = $sth->fetchall_arrayref([0]);
 222                 $sth->finish;
 223
 224                 $dbh->disconnect;
 225         } catch Error with {
 226                 $de = "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n" . shift() . "\n";
 227                 warn "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n" . shift() . "\n";
 228         };
 229         print "* $osrf_xpath :: Successfully connected to database $dsn\n" unless ($de);
 230
 231         # Check encoding
 232         if ($encoding !~ m/(utf-?8|unicode)/i) {
 233                 $de .= "* ERROR: $osrf_xpath :: Database $dsn has encoding $encoding instead of UTF8 or UNICODE.\n";
 234                 warn "* ERROR: $osrf_xpath :: Database $dsn has encoding $encoding instead of UTF8 or UNICODE.\n";
 235         } else {
 236                 print "  * Database has the expected server encoding $encoding.\n";
 237         }
 238
 239         my $result = check_db_langs($langs);
 240         if ($result) {
 241                 $de .= $result;
 242                 warn $result;
 243         }
 244
 245         return ($de) ? $de : "* $osrf_xpath :: Successfully connected to database $dsn with encoding $encoding\n";
 246
 247 }
 248
 249 sub check_db_langs {
 250         my $langs = shift;
 251
 252         my $errors;
 253
 254         # Ensure the following PostgreSQL languages have been enabled
 255         my %languages = (
 256                 'plperl' => 0,
 257                 'plperlu' => 0,
 258                 'plpgsql' => 0,
 259         );
 260
 261         foreach my $lang (@$langs) {
 262                 my $lower = lc($$lang[0]);
 263                 $languages{$lower} = 1;
 264         }
 265
 266         foreach my $lang (keys %languages) {
 267                 if (!$languages{$lang}) {
 268                         $errors .= "  * ERROR: Language '$lang' is not enabled in the target database\n";
 269                 }
 270         }
 271
 272         return $errors;
 273 }
 274
 275 sub check_jabber {
 276         my ($j_username, $j_password, $j_domain, $j_port) = @_;
 277         print "\nChecking Jabber connection for user $j_username, domain $j_domain\n";
 278
 279         # connect to jabber
 280         my $client = OpenSRF::Transport::SlimJabber::Client->new(
 281                 port => $j_port,
 282                 username => $j_username,
 283                 password => $j_password,
 284                 host => $j_domain,
 285                 resource => 'test123'
 286         );
 287
 288
 289         my $je = undef;
 290         try {
 291                 unless($client->initialize()) {
 292                         $je = "* Unable to connect to jabber server $j_domain\n";
 293                         warn "* Unable to connect to jabber server $j_domain\n";
 294                 }
 295         } catch Error with {
 296                 $je = "* Error connecting to jabber:\n" . shift() . "\n";
 297                 warn "* Error connecting to jabber:\n" . shift() . "\n";
 298         };
 299
 300         print "* Jabber successfully connected\n" unless ($je);
 301         $output .= ($je) ? $je : "* Jabber successfully connected\n";
 302 }
 303
 304 sub check_libdbd {
 305         my $results = '';
 306         my @location = `/sbin/ldconfig --print | grep libdbdpgsql`; # simple(ton) attempt to filter out build versions
 307     unless(@location) {
 308                 # This is pretty distro-specific, but let's worry about other distros and operating systems when we get there
 309         my $res = "libdbi PostgreSQL driver not found in shared library path;
 310   you may need to edit /etc/ld.so.conf or add an entry to /etc/ld.so.conf.d/
 311   and run 'ldconfig' as root\n";
 312         print $res;
 313         return $res;
 314     }
 315         if ($location[0] !~ m#/usr/local/lib/dbd/#) {
 316                 my $res = "libdbdpgsql.so was not found in /usr/local/libdbi/dbd/
 317   We have found that system packages don't link against libdbi.so;
 318   therefore, we strongly recommend compiling libdbi and libdbi-drivers from source.\n";
 319                 $results .= $res;
 320                 print $res;
 321         }
 322         if ($results eq '') {
 323                 $results = "  * OK - found locally installed libdbi.so and libdbdpgsql.so in shared library path\n";
 324                 print $results;
 325         }
 326         return $results;
 327 }
 328
 329 sub get_debug_info {
 330   my $temp_dir = shift; # place we can write files
 331   my $log = shift; # location of the log directory
 332   my $config = shift; # location of the config files
 333   my $perl_test = shift; # output from the Perl prereq testing
 334   my $config_test = shift; # output from the config file testing
 335
 336   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
 337   my $oils_time = sprintf("%04d-%02d-%02d_%02dh-%02d-%02d", $year+1900, $mon, $mday, $hour, $min, $sec);
 338
 339   # evil approach that requires no other Perl dependencies
 340   chdir($temp_dir);
 341   my $oils_debug_dir = "$temp_dir/oils_$oils_time";
 342
 343   # Replace with something Perlish
 344   mkdir($oils_debug_dir) or die $!;
 345
 346   # Replace with File::Copy
 347   system("cp $log/*log $oils_debug_dir");
 348
 349   # Passwords will go through in the clear for now
 350   system("cp $config/*xml $oils_debug_dir");
 351
 352   # Get Perl output
 353   open(FH, ">", "$oils_debug_dir/perl_test.out") or die $!;
 354   print FH $perl_test;
 355   close(FH);
 356
 357   # Get XML output
 358   open(FH, ">", "$oils_debug_dir/xml_test.out") or die $!;
 359   print FH $config_test;
 360   close(FH);
 361
 362   # Tar this up - does any system not have tar?
 363   system("tar czf oils_$oils_time.tar.gz oils_$oils_time");
 364
 365   # Clean up after ourselves, somewhat dangerously
 366   system("rm -fr $oils_debug_dir");
 367
 368   print "Wrote your debug information to $temp_dir/oils_$oils_time.tar.gz.\n";
 369 }
 370
 371 __DATA__
 372 LWP::UserAgent
 373 XML::LibXML
 374 XML::LibXML::XPathContext
 375 XML::LibXSLT
 376 Net::Server::PreFork
 377 Cache::Memcached
 378 Class::DBI
 379 Class::DBI::AbstractSearch
 380 Template
 381 DBD::Pg
 382 Net::Z3950 Net::Z3950::ZOOM
 383 MARC::Record
 384 MARC::Charset
 385 MARC::File::XML
 386 Text::Aspell
 387 CGI
 388 DateTime::TimeZone
 389 DateTime
 390 DateTime::Format::ISO8601
 391 DateTime::Format::Mail
 392 Unix::Syslog
 393 GD::Graph3d
 394 JavaScript::SpiderMonkey
 395 Log::Log4perl
 396 Email::Send
 397 Text::CSV
 398 Text::CSV_XS
 399 Spreadsheet::WriteExcel::Big
 400 Tie::IxHash
 401 Parse::RecDescent
 402 SRU
 403 JSON::XS