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

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