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
  67
  68 OpenSRF::Utils::Config->load(config_file => $core_config);
  69 my $conf = OpenSRF::Utils::Config->current;
  70 my $j_username    = $conf->bootstrap->username;
  71 my $j_password    = $conf->bootstrap->passwd;
  72 my $j_port    = $conf->bootstrap->port;
  73 # We should check for a domains element to catch likely upgrade errors
  74 my $j_domain    = $conf->bootstrap->domain;
  75 my $settings_config = $conf->bootstrap->settings_config;
  76 my $logfile    = $conf->bootstrap->logfile;
  77 (my $log_dir = $logfile) =~ s#(.*)/.*#$1#;
  78
  79
  80 print "\nChecking Jabber connection\n";
  81 # connect to jabber
  82 my $client = OpenSRF::Transport::SlimJabber::Client->new(
  83     port => $j_port,
  84     username => $j_username,
  85     password => $j_password,
  86     host => $j_domain,
  87     resource => 'test123'
  88 );
  89
  90
  91 my $je = undef;
  92 try {
  93     unless($client->initialize()) {
  94         $je = "* Unable to connect to jabber server $j_domain\n";
  95         warn "* Unable to connect to jabber server $j_domain\n";
  96     }
  97 } catch Error with {
  98     $je = "* Error connecting to jabber:\n" . shift() . "\n";
  99     warn "* Error connecting to jabber:\n" . shift() . "\n";
 100 };
 101
 102 print "* Jabber successfully connected\n" unless ($je);
 103 $output .= ($je) ? $je : "* Jabber successfully connected\n";
 104
 105 my $xmlparser = XML::LibXML->new();
 106 my $osrfxml = $xmlparser->parse_file($settings_config);
 107
 108 print "\nChecking database connections\n";
 109 # Check database connections
 110 my @databases = $osrfxml->findnodes('//database');
 111 foreach my $database (@databases) {
 112         my $db_name = $database->findvalue("./db");
 113         if (!$db_name) {
 114                 $db_name = $database->findvalue("./name");
 115         }
 116         my $db_host = $database->findvalue("./host");
 117         my $db_port = $database->findvalue("./port");
 118         my $db_user = $database->findvalue("./user");
 119         my $db_pw = $database->findvalue("./pw");
 120     if (!$db_pw && $database->parentNode->parentNode->nodeName eq 'reporter') {
 121         $db_pw = $database->findvalue("./password");
 122         warn "* WARNING: Deprecated <password> element used for the <reporter> entry.  ".
 123             "Please use <pw> instead.\n" if ($db_pw);
 124     }
 125
 126         my $osrf_xpath;
 127         foreach my $node ($database->findnodes("ancestor::node()")) {
 128                 next unless $node->nodeType == XML::LibXML::XML_ELEMENT_NODE;
 129                 $osrf_xpath .= "/" . $node->nodeName;
 130         }
 131         $output .= test_db_connect($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath);
 132 }
 133
 134 print "\nChecking database drivers to ensure <driver> matches <language>\n";
 135 # Check database drivers
 136 # if language eq 'C', driver eq 'pgsql'
 137 # if language eq 'perl', driver eq 'Pg'
 138 my @drivers = $osrfxml->findnodes('//driver');
 139 foreach my $driver_node (@drivers) {
 140         my $language;
 141         my $driver_xpath;
 142         my @driver_xpath_nodes;
 143         foreach my $node ($driver_node->findnodes("ancestor::node()")) {
 144                 next unless $node->nodeType == XML::LibXML::XML_ELEMENT_NODE;
 145                 $driver_xpath .= "/" . $node->nodeName;
 146                 push @driver_xpath_nodes, $node->nodeName;
 147         }
 148         my $lang_xpath;
 149         my $driver = $driver_node->findvalue("child::text()");
 150         while (pop(@driver_xpath_nodes) && scalar(@driver_xpath_nodes) > 0 && !$language) {
 151                 $lang_xpath = "/" . join('/', @driver_xpath_nodes) . "/language";
 152                 my @lang_nodes = $osrfxml->findnodes($lang_xpath);
 153                 next unless scalar(@lang_nodes > 0);
 154                 $language = $lang_nodes[0]->findvalue("child::text()");
 155         }
 156         if ($driver eq "pgsql") {
 157                 if ($driver_xpath =~ m#/reporter/#) {
 158                         $result = "* ERROR: reporter application must use driver 'Pg', but '$driver' is defined\n";
 159                         warn $result;
 160                 } elsif ($language eq "C") {
 161                         $result = "* OK: $driver language is $language in $lang_xpath\n";
 162                 } else {
 163                         $result = "* ERROR: $driver language is $language in $lang_xpath\n";
 164                         warn $result;
 165                 }
 166         } elsif ($driver eq "Pg") {
 167                 if ($driver_xpath =~ m#/reporter/#) {
 168                         $result = "* OK: $driver language is undefined for reporter base configuration\n";
 169                 } elsif ($language eq "perl") {
 170                         $result = "* OK: $driver language is $language in $lang_xpath\n";
 171                 } else {
 172                         $result = "* ERROR: $driver language is $language in $lang_xpath\n";
 173                         warn $result;
 174                 }
 175         } else {
 176                 $result = "* ERROR: Unknown driver $driver in $driver_xpath\n";
 177                 warn $result;
 178         }
 179         print $result;
 180         $output .= $result;
 181 }
 182
 183 print "\nChecking libdbi and libdbi-drivers\n";
 184 $output .= check_libdbd();
 185
 186 print "\nChecking hostname\n";
 187 my @hosts = $osrfxml->findnodes('/opensrf/hosts/*');
 188 foreach my $host (@hosts) {
 189         next unless $host->nodeType == XML::LibXML::XML_ELEMENT_NODE;
 190         my $osrfhost = $host->nodeName;
 191         my $he;
 192         if ($osrfhost ne $hostname && $osrfhost ne "localhost") {
 193                 $result = " * ERROR: expected hostname '$hostname', found '$osrfhost' in <hosts> section of opensrf.xml\n";
 194                 warn $result;
 195                 $he = 1;
 196         } elsif ($osrfhost eq "localhost") {
 197                 $result = " * OK: found hostname 'localhost' in <hosts> section of opensrf.xml\n";
 198         } else {
 199                 $result = " * OK: found hostname '$hostname' in <hosts> section of opensrf.xml\n";
 200         }
 201         print $result unless $he;
 202         $output .= $result;
 203 }
 204
 205
 206 if ($gather) {
 207         get_debug_info( $tmpdir, $log_dir, $conf_dir, $perloutput, $output );
 208 }
 209
 210 sub test_db_connect {
 211         my ($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath) = @_;
 212
 213         my $dsn = "dbi:Pg:dbname=$db_name;host=$db_host;port=$db_port";
 214         my $de = undef;
 215         my ($dbh, $encoding, $langs);
 216         try {
 217                 $dbh = DBI->connect($dsn, $db_user, $db_pw);
 218                 unless($dbh) {
 219                         $de = "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
 220                         warn "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
 221                 }
 222
 223                 # Get server encoding
 224                 my $sth = $dbh->prepare("SHOW server_encoding");
 225                 $sth->execute;
 226                 $sth->bind_col(1, \$encoding);
 227                 $sth->fetch;
 228                 $sth->finish;
 229
 230                 # Get list of server languages
 231                 $sth = $dbh->prepare("SELECT lanname FROM pg_catalog.pg_language");
 232                 $sth->execute;
 233                 $langs = $sth->fetchall_arrayref([0]);
 234                 $sth->finish;
 235
 236                 $dbh->disconnect;
 237         } catch Error with {
 238                 $de = "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n" . shift() . "\n";
 239                 warn "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n" . shift() . "\n";
 240         };
 241         print "* $osrf_xpath :: Successfully connected to database $dsn\n" unless ($de);
 242
 243         # Check encoding
 244         if ($encoding !~ m/(utf-?8|unicode)/i) {
 245                 $de .= "* ERROR: $osrf_xpath :: Database $dsn has encoding $encoding instead of UTF8 or UNICODE.\n";
 246                 warn "* ERROR: $osrf_xpath :: Database $dsn has encoding $encoding instead of UTF8 or UNICODE.\n";
 247         } else {
 248                 print "  * Database has the expected server encoding $encoding.\n";
 249         }
 250
 251         my $result = check_db_langs($langs);
 252         if ($result) {
 253                 $de .= $result;
 254                 warn $result;
 255         }
 256
 257         return ($de) ? $de : "* $osrf_xpath :: Successfully connected to database $dsn with encoding $encoding\n";
 258
 259 }
 260
 261 sub check_db_langs {
 262         my $langs = shift;
 263
 264         my $errors;
 265
 266         # Ensure the following PostgreSQL languages have been enabled
 267         my %languages = (
 268                 'plperl' => 0,
 269                 'plperlu' => 0,
 270                 'plpgsql' => 0,
 271         );
 272
 273         foreach my $lang (@$langs) {
 274                 my $lower = lc($$lang[0]);
 275                 $languages{$lower} = 1;
 276         }
 277
 278         foreach my $lang (keys %languages) {
 279                 if (!$languages{$lang}) {
 280                         $errors .= "  * ERROR: Language '$lang' is not enabled in the target database\n";
 281                 }
 282         }
 283
 284         return $errors;
 285 }
 286
 287 sub check_libdbd {
 288         my $results = '';
 289         my @location = `locate libdbdpgsql.so | grep -v home | grep -v .libs`; # simple(ton) attempt to filter out build versions
 290     unless(@location) {
 291         my $res = "Libdbi postgres driver not found\n";
 292         print $res;
 293         return $res;
 294     }
 295         if (scalar(@location) > 1) {
 296
 297                 my $res = "Found more than one location for libdbdpgsql.so.
 298   We have found that system packages don't link against libdbi.so;
 299   therefore, we strongly recommend compiling libdbi and libdbi-drivers from source.\n";
 300                 $results .= $res;
 301                 print $res;
 302         }
 303         foreach my $loc (@location) {
 304                 my @linkage = `ldd $loc`;
 305                 if (!grep(/libdbi/, @linkage)) {
 306                         my $res = "$loc was not linked against libdbi - you probably need to compile libdbi-drivers from source with the --enable-libdbi configure switch.\n";
 307                         $results .= $res;
 308                         print $res;
 309                 }
 310         }
 311         return $results;
 312 }
 313
 314 sub get_debug_info {
 315   my $temp_dir = shift; # place we can write files
 316   my $log = shift; # location of the log directory
 317   my $config = shift; # location of the config files
 318   my $perl_test = shift; # output from the Perl prereq testing
 319   my $config_test = shift; # output from the config file testing
 320
 321   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
 322   my $oils_time = sprintf("%04d-%02d-%02d_%02dh-%02d-%02d", $year+1900, $mon, $mday, $hour, $min, $sec);
 323
 324   # evil approach that requires no other Perl dependencies
 325   chdir($temp_dir);
 326   my $oils_debug_dir = "$temp_dir/oils_$oils_time";
 327
 328   # Replace with something Perlish
 329   mkdir($oils_debug_dir) or die $!;
 330
 331   # Replace with File::Copy
 332   system("cp $log/*log $oils_debug_dir");
 333
 334   # Passwords will go through in the clear for now
 335   system("cp $config/*xml $oils_debug_dir");
 336
 337   # Get Perl output
 338   open(FH, ">", "$oils_debug_dir/perl_test.out") or die $!;
 339   print FH $perl_test;
 340   close(FH);
 341
 342   # Get XML output
 343   open(FH, ">", "$oils_debug_dir/xml_test.out") or die $!;
 344   print FH $config_test;
 345   close(FH);
 346
 347   # Tar this up - does any system not have tar?
 348   system("tar czf oils_$oils_time.tar.gz oils_$oils_time");
 349
 350   # Clean up after ourselves, somewhat dangerously
 351   system("rm -fr $oils_debug_dir");
 352
 353   print "Wrote your debug information to $temp_dir/oils_$oils_time.tar.gz.\n";
 354 }
 355
 356 __DATA__
 357 LWP::UserAgent
 358 XML::LibXML
 359 XML::LibXML::XPathContext
 360 XML::LibXSLT
 361 Net::Server::PreFork
 362 Cache::Memcached
 363 Class::DBI
 364 Class::DBI::AbstractSearch
 365 Template
 366 DBD::Pg
 367 Net::Z3950 Net::Z3950::ZOOM
 368 MARC::Record
 369 MARC::Charset
 370 MARC::File::XML
 371 Text::Aspell
 372 CGI
 373 DateTime::TimeZone
 374 DateTime
 375 DateTime::Format::ISO8601
 376 DateTime::Format::Mail
 377 Unix::Syslog
 378 GD::Graph3d
 379 JavaScript::SpiderMonkey
 380 Log::Log4perl
 381 Email::Send
 382 Text::CSV
 383 Text::CSV_XS
 384 Spreadsheet::WriteExcel::Big
 385 Tie::IxHash
 386 Parse::RecDescent
 387 SRU