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         warn "Please install $mod\n" unless ($mod->use);
  34         $perloutput .= "Please install the $mod Perl module.\n";
  35         print "$mod version ".${$mod."::VERSION"}."\n" unless ($@);
  36 }
  37
  38 use OpenSRF::Transport::SlimJabber::Client;
  39 use OpenSRF::Utils::SettingsParser;
  40 use OpenSRF::Utils::SettingsClient;
  41 use Data::Dumper;
  42 use DBI;
  43
  44 (my $conf_dir = $core_config) =~ s#(.*)/.*#$1#;
  45
  46
  47 OpenSRF::Utils::Config->load(config_file => $core_config);
  48 my $conf = OpenSRF::Utils::Config->current;
  49 my $j_username    = $conf->bootstrap->username;
  50 my $j_password    = $conf->bootstrap->passwd;
  51 my $j_port    = $conf->bootstrap->port;
  52 my $j_domain    = $conf->bootstrap->domains->[0];
  53 my $settings_config = $conf->bootstrap->settings_config;
  54 my $logfile    = $conf->bootstrap->logfile;
  55 (my $log_dir = $logfile) =~ s#(.*)/.*#$1#;
  56
  57
  58 print "\nChecking Jabber connection\n";
  59 # connect to jabber
  60 my $client = OpenSRF::Transport::SlimJabber::Client->new(
  61     port => $j_port,
  62     username => $j_username,
  63     password => $j_password,
  64     host => $j_domain,
  65     resource => 'test123'
  66 );
  67
  68
  69 my $je = undef;
  70 try {
  71     unless($client->initialize()) {
  72         $je = "* Unable to connect to jabber server $j_domain\n";
  73         warn "* Unable to connect to jabber server $j_domain\n";
  74     }
  75 } catch Error with {
  76     $je = "* Error connecting to jabber:\n" . shift() . "\n";
  77     warn "* Error connecting to jabber:\n" . shift() . "\n";
  78 };
  79
  80 print "* Jabber successfully connected\n" unless ($je);
  81 $output .= ($je) ? $je : "* Jabber successfully connected\n";
  82
  83 my $xmlparser = XML::LibXML->new();
  84 my $osrfxml = $xmlparser->parse_file($settings_config);
  85 my $xpc = XML::LibXML::XPathContext->new($osrfxml);
  86
  87 print "\nChecking database connections\n";
  88 # Check database connections
  89 my @databases = $xpc->findnodes('//database');
  90 foreach my $database (@databases) {
  91         my $db_name = $xpc->findvalue("./db", $database);
  92         my $db_host = $xpc->findvalue("./host", $database);
  93         my $db_port = $xpc->findvalue("./port", $database);
  94         my $db_user = $xpc->findvalue("./user", $database);
  95         my $db_pw = $xpc->findvalue("./pw", $database);
  96         my $osrf_xpath;
  97         foreach my $node ($xpc->findnodes("ancestor::node()", $database)) {
  98                 $osrf_xpath .= "/" . $node->nodeName unless $node->nodeName eq '#document';
  99         }
 100         $output .= test_db_connect($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath);
 101 }
 102
 103 print "\nChecking database drivers to ensure <driver> matches <language>\n";
 104 # Check database drivers
 105 # if language eq 'C', driver eq 'pgsql'
 106 # if language eq 'perl', driver eq 'Pg'
 107 my @drivers = $xpc->findnodes('//driver');
 108 foreach my $driver_node (@drivers) {
 109         my $language;
 110         my $driver_xpath;
 111         my @driver_xpath_nodes;
 112         foreach my $node ($xpc->findnodes("ancestor::node()", $driver_node)) {
 113                 next if $node->nodeName eq "#document";
 114                 $driver_xpath .= "/" . $node->nodeName;
 115                 push @driver_xpath_nodes, $node->nodeName;
 116         }
 117         my $lang_xpath;
 118         my $driver = $xpc->findvalue("child::text()", $driver_node);
 119         while (pop(@driver_xpath_nodes) && scalar(@driver_xpath_nodes) > 0 && !$language) {
 120                 $lang_xpath = "/" . join('/', @driver_xpath_nodes) . "/language";
 121                 my @lang_nodes = $xpc->findnodes($lang_xpath);
 122                 next unless scalar(@lang_nodes > 0);
 123                 $language = $xpc->findvalue("child::text()", $lang_nodes[0]);
 124         }
 125         my $result;
 126         if ($driver eq "pgsql") {
 127                 if ($language eq "C") {
 128                         $result = "* OK: $driver language is $language in $lang_xpath\n";
 129                 } else {
 130                         $result = "* ERROR: $driver language is $language in $lang_xpath\n";
 131                         warn $result;
 132                 }
 133         } elsif ($driver eq "Pg") {
 134                 if ($language eq "perl") {
 135                         $result = "* OK: $driver language is $language in $lang_xpath\n";
 136                 } elsif ($driver_xpath =~ /reporter/) {
 137                         $result = "* OK: $driver language is allowed to be undefined for reporter application\n";
 138                 } else {
 139                         $result = "* ERROR: $driver language is $language in $lang_xpath\n";
 140                         warn $result;
 141                 }
 142         } else {
 143                 $result = "* ERROR: Unknown driver $driver in $driver_xpath\n";
 144                 warn $result;
 145         }
 146         print $result;
 147         $output .= $result;
 148 }
 149
 150
 151 $output .= check_libdbd();
 152
 153 if ($gather) {
 154         get_debug_info( $tmpdir, $log_dir, $conf_dir, $perloutput, $output );
 155 }
 156
 157 sub test_db_connect {
 158         my ($db_name, $db_host, $db_port, $db_user, $db_pw, $osrf_xpath) = @_;
 159
 160         my $dsn = "dbi:Pg:dbname=$db_name;host=$db_host;port=$db_port";
 161         my $de = undef;
 162         try {
 163                 unless( DBI->connect($dsn, $db_user, $db_pw) ) {
 164                         $de = "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
 165                         warn "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
 166                 }
 167         } catch Error with {
 168                 $de = "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n" . shift() . "\n";
 169                 warn "* $osrf_xpath :: Unable to connect to database $dsn, user=$db_user, password=$db_pw\n" . shift() . "\n";
 170         };
 171         print "* $osrf_xpath :: Successfully connected to database $dsn\n" unless ($de);
 172         return ($de) ? $de : "* $osrf_xpath :: Successfully connected to database $dsn\n";
 173 }
 174
 175 sub check_libdbd {
 176         my $results;
 177         my $de = undef;
 178         my @location = `locate libdbdpgsql.so`;
 179         if (scalar(@location) > 1) {
 180
 181                 my $res = "Found more than one location for libdbdpgsql.so.
 182   We have found that system packages don't link against libdbi.so;
 183   therefore, we strongly recommend compiling libdbi and libdbi-drivers from source.\n";
 184                 $results .= $res;
 185                 print $res;
 186         }
 187         foreach my $loc (@location) {
 188                 my @linkage = `ldd $loc`;
 189                 if (!grep(/libdbi/, @linkage)) {
 190                         my $res = "libdbi.so was not linked against $loc - you probably need to compile from source.\n";
 191                         $results .= $res;
 192                         print $res;
 193                 }
 194         }
 195         return $results;
 196 }
 197
 198 sub get_debug_info {
 199   my $temp_dir = shift; # place we can write files
 200   my $log = shift; # location of the log directory
 201   my $config = shift; # location of the config files
 202   my $perl_test = shift; # output from the Perl prereq testing
 203   my $config_test = shift; # output from the config file testing
 204
 205   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
 206   my $oils_time = sprintf("%04d-%02d-%02d_%02dh-%02d-%02d", $year+1900, $mon, $mday, $hour, $min, $sec);
 207
 208   # evil approach that requires no other Perl dependencies
 209   chdir($temp_dir);
 210   my $oils_debug_dir = "$temp_dir/oils_$oils_time";
 211
 212   # Replace with something Perlish
 213   mkdir($oils_debug_dir) or die $!;
 214
 215   # Replace with File::Copy
 216   system("cp $log/*log $oils_debug_dir");
 217
 218   # Passwords will go through in the clear for now
 219   system("cp $config/*xml $oils_debug_dir");
 220
 221   # Get Perl output
 222   open(FH, ">", "$oils_debug_dir/perl_test.out") or die $!;
 223   print FH $perl_test;
 224   close(FH);
 225
 226   # Get XML output
 227   open(FH, ">", "$oils_debug_dir/xml_test.out") or die $!;
 228   print FH $config_test;
 229   close(FH);
 230
 231   # Tar this up - does any system not have tar?
 232   system("tar czf oils_$oils_time.tar.gz oils_$oils_time");
 233
 234   # Clean up after ourselves, somewhat dangerously
 235   system("rm -fr $oils_debug_dir");
 236
 237   print "Wrote your debug information to oils_$oils_time.tar.gz.\n";
 238 }
 239
 240 __DATA__
 241 LWP::UserAgent
 242 XML::LibXML
 243 XML::LibXSLT
 244 Net::Server::PreFork
 245 Cache::Memcached
 246 Class::DBI
 247 Class::DBI::AbstractSearch
 248 Template
 249 DBD::Pg
 250 Net::Z3950
 251 MARC::Record
 252 MARC::Charset
 253 MARC::File::XML
 254 Text::Aspell
 255 CGI
 256 DateTime::TimeZone
 257 DateTime
 258 DateTime::Format::ISO8601
 259 Unix::Syslog
 260 GD::Graph3d
 261 JavaScript::SpiderMonkey
 262 Log::Log4perl
 263 Email::Send
 264 Text::CSV