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