97f59bc0a55cd583aa4773eeff42382972266053
[Evergreen.git] / 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 = `ldconfig --print | grep libdbdpgsql`; # simple(ton) attempt to filter out build versions
290     unless(@location) {
291                 # This is pretty distro-specific, but let's worry about other distros and operating systems when we get there
292         my $res = "libdbi PostgreSQL driver not found in shared library path;
293   you may need to edit /etc/ld.so.conf or add an entry to /etc/ld.so.conf.d/
294   and run 'ldconfig' as root\n";
295         print $res;
296         return $res;
297     }
298         if ($location[0] !~ m#/usr/local/lib/dbd/#) {
299                 my $res = "libdbdpgsql.so was not found in /usr/local/libdbi/dbd/
300   We have found that system packages don't link against libdbi.so;
301   therefore, we strongly recommend compiling libdbi and libdbi-drivers from source.\n";
302                 $results .= $res;
303                 print $res;
304         }
305         if ($results eq '') {
306                 $results = "  * OK - found locally installed libdbi.so and libdbdpgsql.so in shared library path\n";
307                 print $results;
308         }
309         return $results;
310 }
311
312 sub get_debug_info {
313   my $temp_dir = shift; # place we can write files
314   my $log = shift; # location of the log directory
315   my $config = shift; # location of the config files
316   my $perl_test = shift; # output from the Perl prereq testing
317   my $config_test = shift; # output from the config file testing
318
319   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
320   my $oils_time = sprintf("%04d-%02d-%02d_%02dh-%02d-%02d", $year+1900, $mon, $mday, $hour, $min, $sec);
321   
322   # evil approach that requires no other Perl dependencies
323   chdir($temp_dir);
324   my $oils_debug_dir = "$temp_dir/oils_$oils_time";
325
326   # Replace with something Perlish
327   mkdir($oils_debug_dir) or die $!;
328
329   # Replace with File::Copy
330   system("cp $log/*log $oils_debug_dir");
331
332   # Passwords will go through in the clear for now
333   system("cp $config/*xml $oils_debug_dir");
334
335   # Get Perl output
336   open(FH, ">", "$oils_debug_dir/perl_test.out") or die $!;
337   print FH $perl_test;
338   close(FH);
339
340   # Get XML output
341   open(FH, ">", "$oils_debug_dir/xml_test.out") or die $!;
342   print FH $config_test;
343   close(FH);
344   
345   # Tar this up - does any system not have tar?
346   system("tar czf oils_$oils_time.tar.gz oils_$oils_time");
347
348   # Clean up after ourselves, somewhat dangerously
349   system("rm -fr $oils_debug_dir");
350
351   print "Wrote your debug information to $temp_dir/oils_$oils_time.tar.gz.\n";
352 }
353
354 __DATA__
355 LWP::UserAgent
356 XML::LibXML
357 XML::LibXML::XPathContext
358 XML::LibXSLT
359 Net::Server::PreFork
360 Cache::Memcached
361 Class::DBI
362 Class::DBI::AbstractSearch
363 Template
364 DBD::Pg
365 Net::Z3950 Net::Z3950::ZOOM
366 MARC::Record
367 MARC::Charset
368 MARC::File::XML
369 Text::Aspell
370 CGI
371 DateTime::TimeZone
372 DateTime
373 DateTime::Format::ISO8601
374 DateTime::Format::Mail
375 Unix::Syslog
376 GD::Graph3d
377 JavaScript::SpiderMonkey
378 Log::Log4perl
379 Email::Send
380 Text::CSV
381 Text::CSV_XS
382 Spreadsheet::WriteExcel::Big
383 Tie::IxHash
384 Parse::RecDescent
385 SRU
386 JSON::XS