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

   1 #!/usr/bin/perl
   2 # vim:noet:ts=4:
   3
   4 BEGIN {
   5         eval "use Error qw/:try/;";
   6         die "Please install Error.pm!\n" if ($@);
   7         eval "use UNIVERSAL::require;";
   8         die "Please install the UNIVERSAL::Require perl module!\n" if ($@);
   9         eval "use Getopt::Long;";
  10         die "Please install the Getopt::Long perl module!\n" if ($@);
  11         eval "use Net::Domain;";
  12         die "Please install the Net::Domain perl module!\n" if ($@);
  13 }
  14
  15 my $output = '';
  16 my $perloutput = '';
  17
  18 my ($gather, $hostname, $core_config, $tmpdir) =
  19         (0, Net::Domain::hostfqdn(), '/openils/conf/opensrf_core.xml', '/tmp/');
  20
  21 GetOptions(
  22         'gather' => \$gather,
  23         'hostname=s' => \$hostname,
  24         'config_file=s' => \$core_config,
  25         'tempdir=s' => \$tmpdir,
  26 );
  27
  28 while (my $mod = <DATA>) {
  29         chomp $mod;
  30         warn "Please install $mod\n" unless ($mod->use);
  31         $perloutput .= "Please install $mod\n";
  32         print "$mod version ".${$mod."::VERSION"}."\n" unless ($@);
  33 }
  34
  35 use OpenSRF::Transport::SlimJabber::Client;
  36 use OpenSRF::Utils::SettingsParser;
  37 use OpenSRF::Utils::SettingsClient;
  38 use OpenSRF::Utils::Config;
  39 use Data::Dumper;
  40 use DBI;
  41
  42 (my $conf_dir = $core_config) =~ s#(.*)/.*#$1#;
  43
  44
  45 OpenSRF::Utils::Config->load(config_file => $core_config);
  46 my $conf = OpenSRF::Utils::Config->current;
  47 my $j_username    = $conf->bootstrap->username;
  48 my $j_password    = $conf->bootstrap->passwd;
  49 my $j_port    = $conf->bootstrap->port;
  50 my $j_domain    = $conf->bootstrap->domains->[0];
  51 my $settings_config = $conf->bootstrap->settings_config;
  52 my $logfile    = $conf->bootstrap->logfile;
  53 (my $log_dir = $logfile) =~ s#(.*)/.*#$1#;
  54
  55
  56 # connect to jabber
  57 my $client = OpenSRF::Transport::SlimJabber::Client->new(
  58     port => $j_port,
  59     username => $j_username,
  60     password => $j_password,
  61     host => $j_domain,
  62     resource => 'test123'
  63 );
  64
  65
  66 my $je = undef;
  67 try {
  68     unless($client->initialize()) {
  69         $je = "* Unable to connect to jabber server $j_domain\n";
  70         warn "* Unable to connect to jabber server $j_domain\n";
  71     }
  72 } catch Error with {
  73     $je = "* Error connecting to jabber:\n" . shift() . "\n";
  74     warn "* Error connecting to jabber:\n" . shift() . "\n";
  75 };
  76
  77 print "* Jabber successfully connected\n" unless ($je);
  78 $output .= ($je) ? $je : "* Jabber successfully connected\n";
  79
  80 # parse the opensrf.xml file
  81 my $sparser = 'OpenSRF::Utils::SettingsParser';
  82 my $res = $sparser->initialize($settings_config);
  83 my $sconfig = $sparser->get_server_config($hostname);
  84 my $db_config = $sconfig->{apps}->{'open-ils.storage'}->{app_settings}->{databases}->{database};
  85
  86 # grab the open-ils.storage database settings
  87 my $db_host = $db_config->{host};
  88 my $db_user = $db_config->{user};
  89 my $db_port = $db_config->{port};
  90 my $db_pw = $db_config->{pw};
  91 my $db_db = $db_config->{db};
  92
  93
  94 # connect to the database
  95 my $dsn = "dbi:Pg:dbname=$db_db;host=$db_host;port=$db_port";
  96 my $de = undef;
  97 try {
  98     unless( DBI->connect($dsn, $db_user, $db_pw) ) {
  99         $de = "* Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
 100         warn "* Unable to connect to database $dsn, user=$db_user, password=$db_pw\n";
 101     }
 102 } catch Error with {
 103     $de = "* Unable to connect to database $dsn, user=$db_user, password=$db_pw\n" . shift() . "\n";
 104     warn "* Unable to connect to database $dsn, user=$db_user, password=$db_pw\n" . shift() . "\n";
 105 };
 106 print "* Successfully connected to database $dsn\n" unless ($de);
 107 $output .= ($de) ? $de : "* Successfully connected to database $dsn\n";
 108
 109 $output .= check_libdbd();
 110
 111 if ($gather) {
 112         get_debug_info( $tmpdir, $log_dir, $conf_dir, $perloutput, $output );
 113 }
 114
 115 sub check_libdbd {
 116         my $results;
 117         my $de = undef;
 118         my @location = `locate libdbdpgsql.so`;
 119         if ($location > 1) {
 120
 121                 my $res = "Found more than one location for libdbdpgsql.so.
 122   We have found that system packages don't link against libdbi.so;
 123   therefore, we strongly recommend compiling libdbi and libdbi-drivers from source.\n";
 124                 $results .= $res;
 125                 print $res;
 126         }
 127         foreach my $loc (@location) {
 128                 my @linkage = `ldd $loc`;
 129                 if (!grep(/libdbi/, @linkage)) {
 130                         my $res = "libdbi.so was not linked against $loc - you probably need to compile from source.\n";
 131                         $results .= $res;
 132                         print $res;
 133                 }
 134         }
 135         return $results;
 136 }
 137
 138 sub get_debug_info {
 139   my $temp_dir = shift; # place we can write files
 140   my $log = shift; # location of the log directory
 141   my $config = shift; # location of the config files
 142   my $perl_test = shift; # output from the Perl prereq testing
 143   my $config_test = shift; # output from the config file testing
 144
 145   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
 146   my $oils_time = sprintf("%04d-%02d-%02d_%02dh-%02d-%02d", $year+1900, $mon, $mday, $hour, $min, $sec);
 147
 148   # evil approach that requires no other Perl dependencies
 149   chdir($temp_dir);
 150   my $oils_debug_dir = "$temp_dir/oils_$oils_time";
 151
 152   # Replace with something Perlish
 153   mkdir($oils_debug_dir) or die $!;
 154
 155   # Replace with File::Copy
 156   system("cp $log/*log $oils_debug_dir");
 157
 158   # Passwords will go through in the clear for now
 159   system("cp $config/*xml $oils_debug_dir");
 160
 161   # Get Perl output
 162   open(FH, ">", "$oils_debug_dir/perl_test.out") or die $!;
 163   print FH $perl_test;
 164   close(FH);
 165
 166   # Get XML output
 167   open(FH, ">", "$oils_debug_dir/xml_test.out") or die $!;
 168   print FH $config_test;
 169   close(FH);
 170
 171   # Tar this up - does any system not have tar?
 172   system("tar czf oils_$oils_time.tar.gz oils_$oils_time");
 173
 174   # Clean up after ourselves, somewhat dangerously
 175   system("rm -fr $oils_debug_dir");
 176
 177   print "Wrote your debug information to oils_$oils_time.tar.gz.\n";
 178 }
 179
 180 __DATA__
 181 LWP::UserAgent
 182 XML::LibXML
 183 XML::LibXSLT
 184 Net::Server::PreFork
 185 Cache::Memcached
 186 Class::DBI
 187 Class::DBI::AbstractSearch
 188 Template
 189 DBD::Pg
 190 Net::Z3950
 191 MARC::Record
 192 MARC::Charset
 193 MARC::File::XML
 194 Text::Aspell
 195 CGI
 196 DateTime::TimeZone
 197 DateTime
 198 DateTime::Format::ISO8601
 199 Unix::Syslog
 200 GD::Graph3d
 201 JavaScript::SpiderMonkey
 202 Log::Log4perl
 203 Email::Send
 204 Text::CSV