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

   1 #!/usr/bin/perl
   2 # vim:noet:ts=4:
   3
   4 BEGIN {
   5         eval "use OpenSRF::Utils::Config;";
   6         die "Please ensure that /openils/lib/perl5 is in your PERL5LIB environment variable.
   7         You must run this script as the 'opensrf' user.\n" if ($@);
   8         eval "use Error qw/:try/;";
   9         die "Please install Error.pm.\n" if ($@);
  10         eval "use UNIVERSAL::require;";
  11         die "Please install the UNIVERSAL::require perl module.\n" if ($@);
  12         eval "use Getopt::Long;";
  13         die "Please install the Getopt::Long perl module.\n" if ($@);
  14         eval "use Net::Domain;";
  15         die "Please install the Net::Domain perl module.\n" if ($@);
  16 }
  17
  18 my $output = '';
  19 my $perloutput = '';
  20
  21 my ($gather, $hostname, $core_config, $tmpdir) =
  22         (0, Net::Domain::hostfqdn(), '/openils/conf/opensrf_core.xml', '/tmp/');
  23
  24 GetOptions(
  25         'gather' => \$gather,
  26         'hostname=s' => \$hostname,
  27         'config_file=s' => \$core_config,
  28         'tempdir=s' => \$tmpdir,
  29 );
  30
  31 while (my $mod = <DATA>) {
  32         chomp $mod;
  33         my @list = split / /, $mod;
  34
  35         my $ok = 0;
  36         for my $m (@list) {
  37                 $ok++ if ($m->use);
  38                 print "$m version ".${$m."::VERSION"}."\n" unless ($@);
  39         }
  40
  41         unless ($ok) {
  42                 if (@list == 1) {
  43                         warn "Please install $mod\n";
  44                         $perloutput .= "Please install the $mod Perl module.\n";
  45                 } else {
  46                         warn "Please install one of the following modules: $mod\n";
  47                         $perloutput .= "Please install one of the following modules: $mod\n";
  48                 }
  49         }
  50
  51 }
  52
  53 use OpenSRF::Transport::SlimJabber::Client;
  54 use OpenSRF::Utils::SettingsParser;
  55 use OpenSRF::Utils::SettingsClient;
  56 use Data::Dumper;
  57 use DBI;
  58
  59 (my $conf_dir = $core_config) =~ s#(.*)/.*#$1#;
  60
  61
  62 OpenSRF::Utils::Config->load(config_file => $core_config);
  63 my $conf = OpenSRF::Utils::Config->current;
  64 my $j_username    = $conf->bootstrap->username;
  65 my $j_password    = $conf->bootstrap->passwd;
  66 my $j_port    = $conf->bootstrap->port;
  67 my $j_domain    = $conf->bootstrap->domains->[0];
  68 my $settings_config = $conf->bootstrap->settings_config;
  69 my $logfile    = $conf->bootstrap->logfile;
  70 (my $log_dir = $logfile) =~ s#(.*)/.*#$1#;
  71
  72
  73 print "\nChecking Jabber connection\n";
  74 # connect to jabber
  75 my $client = OpenSRF::Transport::SlimJabber::Client->new(
  76     port => $j_port,
  77     username => $j_username,
  78     password => $j_password,
  79     host => $j_domain,
  80     resource => 'test123'
  81 );
  82
  83
  84 my $je = undef;
  85 try {
  86     unless($client->initialize()) {
  87         $je = "* Unable to connect to jabber server $j_domain\n";
  88         warn "* Unable to connect to jabber server $j_domain\n";
  89     }
  90 } catch Error with {
  91     $je = "* Error connecting to jabber:\n" . shift() . "\n";
  92     warn "* Error connecting to jabber:\n" . shift() . "\n";
  93 };
  94
  95 print "* Jabber successfully connected\n" unless ($je);
  96 $output .= ($je) ? $je : "* Jabber successfully connected\n";
  97
  98 my $xmlparser = XML::LibXML->new();
  99 my $osrfxml = $xmlparser->parse_file($settings_config);
 100
 101 print "\nChecking database connections\n";
 102 # Check database connections
 103 my @databases = $osrfxml->findnodes('//database');
 104 foreach my $database (@databases) {
 105         my $db_name = $database->findvalue("./db");
 106         if (!$db_name) {
 107                 $db_name = $database->findvalue("./name");
 108         }
 109         my $db_host = $database->findvalue("./host");
 110         my $db_port = $database->findvalue("./port");
 111         my $db_user = $database->findvalue("./user");
 112         my $db_pw = $database->findvalue("./pw");
 113         my $osrf_xpath;
 114         foreach my $node ($database->findnodes("ancestor::node()")) {
 115                 next unless $node->nodeType == XML::LibXML::XML_ELEMENT_NODE;
 116                 $osrf_xpath .= "/" . $node->nodeName;
 117         }
 118         $output .= test_db_connect($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath);
 119 }
 120
 121 print "\nChecking database drivers to ensure <driver> matches <language>\n";
 122 # Check database drivers
 123 # if language eq 'C', driver eq 'pgsql'
 124 # if language eq 'perl', driver eq 'Pg'
 125 my @drivers = $osrfxml->findnodes('//driver');
 126 foreach my $driver_node (@drivers) {
 127         my $language;
 128         my $driver_xpath;
 129         my @driver_xpath_nodes;
 130         foreach my $node ($driver_node->findnodes("ancestor::node()")) {
 131                 next unless $node->nodeType == XML::LibXML::XML_ELEMENT_NODE;
 132                 $driver_xpath .= "/" . $node->nodeName;
 133                 push @driver_xpath_nodes, $node->nodeName;
 134         }
 135         my $lang_xpath;
 136         my $driver = $driver_node->findvalue("child::text()");
 137         while (pop(@driver_xpath_nodes) && scalar(@driver_xpath_nodes) > 0 && !$language) {
 138                 $lang_xpath = "/" . join('/', @driver_xpath_nodes) . "/language";
 139                 my @lang_nodes = $osrfxml->findnodes($lang_xpath);
 140                 next unless scalar(@lang_nodes > 0);
 141                 $language = $lang_nodes[0]->findvalue("child::text()");
 142         }
 143         my $result;
 144         if ($driver eq "pgsql") {
 145                 if ($language eq "C") {
 146                         $result = "* OK: $driver language is $language in $lang_xpath\n";
 147                 } else {
 148                         $result = "* ERROR: $driver language is $language in $lang_xpath\n";
 149                         warn $result;
 150                 }
 151         } elsif ($driver eq "Pg") {
 152                 if ($language eq "perl") {
 153                         $result = "* OK: $driver language is $language in $lang_xpath\n";
 154                 } elsif ($driver_xpath =~ /reporter/) {
 155                         $result = "* OK: $driver language is undefined for reporter base configuration\n";
 156                 } else {
 157                         $result = "* ERROR: $driver language is $language in $lang_xpath\n";
 158                         warn $result;
 159                 }
 160         } else {
 161                 $result = "* ERROR: Unknown driver $driver in $driver_xpath\n";
 162                 warn $result;
 163         }
 164         print $result;
 165         $output .= $result;
 166 }
 167
 168 print "\nChecking libdbi and libdbi-drivers\n";
 169 $output .= check_libdbd();
 170
 171 print "\nChecking hostname\n";
 172 my @hosts = $osrfxml->findnodes('/opensrf/hosts/*');
 173 foreach my $host (@hosts) {
 174         next unless $host->nodeType == XML::LibXML::XML_ELEMENT_NODE;
 175         my $osrfhost = $host->nodeName;
 176         my $he;
 177         if ($osrfhost ne $hostname && $osrfhost ne "localhost") {
 178                 $result = " * ERROR: expected hostname '$hostname', found '$osrfhost' in <hosts> section of opensrf.xml\n";
 179                 warn $result;
 180                 $he = 1;
 181         } elsif ($osrfhost eq "localhost") {
 182                 $result = " * OK: found hostname 'localhost' in <hosts> section of opensrf.xml\n";
 183         } else {
 184                 $result = " * OK: found hostname '$hostname' in <hosts> section of opensrf.xml\n";
 185         }
 186         print $result unless $he;
 187         $output .= $result;
 188 }
 189
 190
 191 if ($gather) {
 192         get_debug_info( $tmpdir, $log_dir, $conf_dir, $perloutput, $output );
 193 }
 194
 195 sub test_db_connect {
 196         my ($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath) = @_;
 197
 198         my $dsn = "dbi:Pg:dbname=$db_name;host=$db_host;port=$db_port";
 199         my $de = undef;
 200         my $dbh, $encoding;
 201         try {
 202                 $dbh = DBI->connect($dsn, $db_user, $db_pw);
 203                 unless($dbh) {
 204                         $de = "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
 205                         warn "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
 206                 }
 207                 my $sth = $dbh->prepare("show server_encoding");
 208                 $sth->execute;
 209                 $sth->bind_col(1, \$encoding);
 210                 $sth->fetch;
 211                 $sth->finish;
 212                 $dbh->disconnect;
 213         } catch Error with {
 214                 $de = "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n" . shift() . "\n";
 215                 warn "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n" . shift() . "\n";
 216         };
 217         print "* $osrf_xpath :: Successfully connected to database $dsn\n" unless ($de);
 218         if ($encoding !~ m/(utf-?8|unicode)/i) {
 219                 $de .= "* ERROR: $osrf_xpath :: Database $dsn has encoding $encoding instead of UTF8 or UNICODE.\n";
 220                 warn "* ERROR: $osrf_xpath :: Database $dsn has encoding $encoding instead of UTF8 or UNICODE.\n";
 221         } else {
 222                 print "  * Database has the expected server encoding $encoding.\n";
 223         }
 224         return ($de) ? $de : "* $osrf_xpath :: Successfully connected to database $dsn with encoding $encoding\n";
 225
 226 }
 227
 228 sub check_libdbd {
 229         my $results;
 230         my $de = undef;
 231         my @location = `locate libdbdpgsql.so |grep -v home`; # simple(ton) attempt to filter out build versions
 232         if (scalar(@location) > 1) {
 233
 234                 my $res = "Found more than one location for libdbdpgsql.so.
 235   We have found that system packages don't link against libdbi.so;
 236   therefore, we strongly recommend compiling libdbi and libdbi-drivers from source.\n";
 237                 $results .= $res;
 238                 print $res;
 239         }
 240         foreach my $loc (@location) {
 241                 my @linkage = `ldd $loc`;
 242                 if (!grep(/libdbi/, @linkage)) {
 243                         my $res = "$loc was not linked against libdbi - you probably need to compile libdbi-drivers from source with the --enable-libdbi configure switch.\n";
 244                         $results .= $res;
 245                         print $res;
 246                 }
 247         }
 248         return $results;
 249 }
 250
 251 sub get_debug_info {
 252   my $temp_dir = shift; # place we can write files
 253   my $log = shift; # location of the log directory
 254   my $config = shift; # location of the config files
 255   my $perl_test = shift; # output from the Perl prereq testing
 256   my $config_test = shift; # output from the config file testing
 257
 258   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
 259   my $oils_time = sprintf("%04d-%02d-%02d_%02dh-%02d-%02d", $year+1900, $mon, $mday, $hour, $min, $sec);
 260
 261   # evil approach that requires no other Perl dependencies
 262   chdir($temp_dir);
 263   my $oils_debug_dir = "$temp_dir/oils_$oils_time";
 264
 265   # Replace with something Perlish
 266   mkdir($oils_debug_dir) or die $!;
 267
 268   # Replace with File::Copy
 269   system("cp $log/*log $oils_debug_dir");
 270
 271   # Passwords will go through in the clear for now
 272   system("cp $config/*xml $oils_debug_dir");
 273
 274   # Get Perl output
 275   open(FH, ">", "$oils_debug_dir/perl_test.out") or die $!;
 276   print FH $perl_test;
 277   close(FH);
 278
 279   # Get XML output
 280   open(FH, ">", "$oils_debug_dir/xml_test.out") or die $!;
 281   print FH $config_test;
 282   close(FH);
 283
 284   # Tar this up - does any system not have tar?
 285   system("tar czf oils_$oils_time.tar.gz oils_$oils_time");
 286
 287   # Clean up after ourselves, somewhat dangerously
 288   system("rm -fr $oils_debug_dir");
 289
 290   print "Wrote your debug information to $temp_dir/oils_$oils_time.tar.gz.\n";
 291 }
 292
 293 __DATA__
 294 LWP::UserAgent
 295 XML::LibXML
 296 XML::LibXSLT
 297 Net::Server::PreFork
 298 Cache::Memcached
 299 Class::DBI
 300 Class::DBI::AbstractSearch
 301 Template
 302 DBD::Pg
 303 Net::Z3950 Net::Z3950::ZOOM
 304 MARC::Record
 305 MARC::Charset
 306 MARC::File::XML
 307 Text::Aspell
 308 CGI
 309 DateTime::TimeZone
 310 DateTime
 311 DateTime::Format::ISO8601
 312 Unix::Syslog
 313 GD::Graph3d
 314 JavaScript::SpiderMonkey
 315 Log::Log4perl
 316 Email::Send
 317 Text::CSV
 318 Text::CSV_XS
 319 Spreadsheet::WriteExcel::Big
 320 Tie::IxHash