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

   1 #!/usr/bin/perl
   2
   3 BEGIN {
   4         eval "use Error qw/:try/;";
   5         die "Please install Error.pm!\n" if ($@);
   6         eval "use UNIVERSAL::require;";
   7         die "Please install the UNIVERSAL::Require perl module!\n" if ($@);
   8         eval "use Getopt::Long;";
   9         die "Please install the Getopt::Long perl module!\n" if ($@);
  10         eval "use Net::Domain;";
  11         die "Please install the Net::Domain perl module!\n" if ($@);
  12 }
  13
  14 my $output = '';
  15 my $perloutput = '';
  16
  17 my ($gather, $hostname, $core_config, $tmpdir) =
  18         (0, Net::Domain::hostfqdn(), '/openils/conf/opensrf_core.xml', '/tmp/');
  19
  20 GetOptions(
  21         'gather' => \$gather,
  22         'hostname=s' => \$hostname,
  23         'config_file=s' => \$core_config,
  24         'tempdir=s' => \$tmpdir,
  25 );
  26
  27 while (my $mod = <DATA>) {
  28         chomp $mod;
  29         warn "Please install $mod\n" unless ($mod->use);
  30         $perloutput .= "Please install $mod\n";
  31         print "$mod version ".${$mod."::VERSION"}."\n" unless ($@);
  32 }
  33
  34 use OpenSRF::Transport::SlimJabber::Client;
  35 use OpenSRF::Utils::SettingsParser;
  36 use OpenSRF::Utils::SettingsClient;
  37 use OpenSRF::Utils::Config;
  38 use Data::Dumper;
  39 use DBI;
  40
  41 (my $conf_dir = $core_config) =~ s#(.*)/.*#$1#;
  42
  43
  44 OpenSRF::Utils::Config->load(config_file => $core_config);
  45 my $conf = OpenSRF::Utils::Config->current;
  46 my $j_username    = $conf->bootstrap->username;
  47 my $j_password    = $conf->bootstrap->passwd;
  48 my $j_port    = $conf->bootstrap->port;
  49 my $j_domain    = $conf->bootstrap->domains->[0];
  50 my $settings_config = $conf->bootstrap->settings_config;
  51 my $logfile    = $conf->bootstrap->logfile;
  52 (my $log_dir = $logfile) =~ s#(.*)/.*#$1#;
  53
  54
  55 # connect to jabber
  56 my $client = OpenSRF::Transport::SlimJabber::Client->new(
  57     port => $j_port,
  58     username => $j_username,
  59     password => $j_password,
  60     host => $j_domain,
  61     resource => 'test123'
  62 );
  63
  64
  65 my $je = undef;
  66 try {
  67     unless($client->initialize()) {
  68         $je = "* Unable to connect to jabber server $j_domain\n";
  69         warn "* Unable to connect to jabber server $j_domain\n";
  70     }
  71 } catch Error with {
  72     $je = "* Error connecting to jabber:\n" . shift() . "\n";
  73     warn "* Error connecting to jabber:\n" . shift() . "\n";
  74 };
  75
  76 print "* Jabber successfully connected\n" unless ($je);
  77 $output .= ($je) ? $je : "* Jabber successfully connected\n";
  78
  79 # parse the opensrf.xml file
  80 my $sparser = 'OpenSRF::Utils::SettingsParser';
  81 my $res = $sparser->initialize($settings_config);
  82 my $sconfig = $sparser->get_server_config($hostname);
  83 my $db_config = $sconfig->{apps}->{'open-ils.storage'}->{app_settings}->{databases}->{database};
  84
  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
 110 if ($gather) {
 111         get_debug_info( $tmpdir, $logdir, $conf_dir, $perloutput, $output );
 112 }
 113
 114 sub get_debug_info {
 115   my $temp_dir = shift; # place we can write files
 116   my $log = shift; # location of the log directory
 117   my $config = shift; # location of the config files
 118   my $perl_test = shift; # output from the Perl prereq testing
 119   my $config_test = shift; # output from the config file testing
 120
 121   my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
 122   my $oils_time = sprintf("%04d-%02d-%02d_%02dh-%02d-%02d", $year+1900, $mon, $mday, $hour, $min, $sec);
 123
 124   # evil approach that requires no other Perl dependencies
 125   chdir($temp_dir);
 126   my $oils_debug_dir = "$temp_dir/oils_$oils_time";
 127
 128   # Replace with something Perlish
 129   mkdir($oils_debug_dir) or die $!;
 130
 131   # Replace with File::Copy
 132   system("cp $log/*log $oils_debug_dir");
 133
 134   # Passwords will go through in the clear for now
 135   system("cp $config/*xml $oils_debug_dir");
 136
 137   # Get Perl output
 138   open(FH, ">", "$oils_debug_dir/perl_test.out") or die $!;
 139   print FH $perl_test;
 140   close(FH);
 141
 142   # Get XML output
 143   open(FH, ">", "$oils_debug_dir/xml_test.out") or die $!;
 144   print FH $config_test;
 145   close(FH);
 146
 147   # Tar this up - does any system not have tar?
 148   system("tar czf oils_$oils_time.tar.gz oils_$oils_time");
 149
 150   # Clean up after ourselves, somewhat dangerously
 151   system("rm -fr $oils_debug_dir");
 152
 153   print "Wrote your debug information to oils_$oils_time.tar.gz.\n";
 154 }
 155
 156 __DATA__
 157 LWP::UserAgent
 158 XML::LibXML
 159 XML::LibXSLT
 160 Net::Server::PreFork
 161 Cache::Memcached
 162 Class::DBI
 163 Class::DBI::AbstractSearch
 164 Template
 165 DBD::Pg
 166 Net::Z3950
 167 MARC::Record
 168 MARC::Charset
 169 MARC::File::XML
 170 Text::Aspell
 171 CGI
 172 DateTime::TimeZone
 173 DateTime
 174 DateTime::Format::ISO8601
 175 Unix::Syslog
 176 GD::Graph3d
 177 JavaScript::SpiderMonkey
 178 Log::Log4perl
 179 Email::Send
 180 Text::CSV