290 lines
8.7 KiB
Perl
Executable file
290 lines
8.7 KiB
Perl
Executable file
#!/usr/bin/perl
|
|
#
|
|
# This code was forked from the LiveJournal project owned and operated
|
|
# by Live Journal, Inc. The code has been modified and expanded by
|
|
# Dreamwidth Studios, LLC. These files were originally licensed under
|
|
# the terms of the license supplied by Live Journal, Inc, which can
|
|
# currently be found at:
|
|
#
|
|
# http://code.livejournal.org/trac/livejournal/browser/trunk/LICENSE-LiveJournal.txt
|
|
#
|
|
# In accordance with the original license, this code and all its
|
|
# modifications are provided under the GNU General Public License.
|
|
# A copy of that license can be found in the LICENSE file included as
|
|
# part of this distribution.
|
|
|
|
use strict;
|
|
use lib "$ENV{LJHOME}/extlib/lib/perl5";
|
|
use Getopt::Long;
|
|
use version;
|
|
use File::Temp;
|
|
|
|
my $debs_only = 0;
|
|
my ( $only_check, $no_check, $opt_nolocal, $opt_install );
|
|
|
|
my %dochecks; # these are the ones we'll actually do
|
|
my @checks = ( # put these in the order they should be checked in
|
|
"timezone",
|
|
"modules",
|
|
"env",
|
|
"database",
|
|
"secrets",
|
|
);
|
|
foreach my $check (@checks) { $dochecks{$check} = 1; }
|
|
|
|
sub usage {
|
|
die "Usage: checkconfig.pl
|
|
checkconfig.pl --needed-debs
|
|
checkconfig.pl --only=<check> | --no=<check>
|
|
checkconfig.pl --install
|
|
|
|
Checks are:
|
|
" . join( ', ', @checks );
|
|
}
|
|
|
|
usage()
|
|
unless GetOptions(
|
|
'needed-debs' => \$debs_only,
|
|
'only=s' => \$only_check,
|
|
'no=s' => \$no_check,
|
|
'nolocal' => \$opt_nolocal,
|
|
'install' => \$opt_install,
|
|
);
|
|
|
|
if ($debs_only) {
|
|
$dochecks{database} = 0;
|
|
$dochecks{timezone} = 0;
|
|
$dochecks{secrets} = 0;
|
|
}
|
|
|
|
usage() if $only_check && $no_check;
|
|
|
|
%dochecks = ( $only_check => 1 )
|
|
if $only_check;
|
|
|
|
$dochecks{$no_check} = 0
|
|
if $no_check;
|
|
|
|
my @errors;
|
|
my $err = sub {
|
|
return unless @_;
|
|
die "\nProblem:\n" . join( '', map { " * $_\n" } @_ );
|
|
};
|
|
|
|
my %modules;
|
|
|
|
open MODULES, "<$ENV{LJHOME}/doc/dependencies-cpanm" or die;
|
|
foreach my $module_line (<MODULES>) {
|
|
my ( $module, $ver, $opt ) = ( $1, $2, $3 )
|
|
if $module_line =~ /^(.+?)(?:@(.+))?(\?)?$/;
|
|
if ($module) {
|
|
$modules{$module} = { ver => $ver, opt => $opt eq '?' ? 1 : 0 };
|
|
}
|
|
}
|
|
close MODULES;
|
|
|
|
sub check_modules {
|
|
print "[Checking for Perl Modules....]\n"
|
|
unless $debs_only;
|
|
|
|
my ( @debs, @mods );
|
|
|
|
foreach my $mod ( sort keys %modules ) {
|
|
my $rv = eval "use $mod ();";
|
|
if ($@) {
|
|
my $dt = $modules{$mod};
|
|
unless ($debs_only) {
|
|
if ( $dt->{opt} ) {
|
|
print STDERR "Missing optional module $mod: $dt->{'opt'}\n";
|
|
}
|
|
else {
|
|
push @errors, "Missing perl module: $mod";
|
|
}
|
|
}
|
|
push @mods, $dt->{ver} ? "$mod\@$dt->{ver}" : $mod;
|
|
next;
|
|
}
|
|
|
|
my $ver_want = $modules{$mod}{ver};
|
|
my $ver_got = $mod->VERSION;
|
|
|
|
# handle version strings with multiple decimal points
|
|
# assumes there will never be a version part prepended
|
|
# only appended
|
|
if ( $ver_want && $ver_got ) {
|
|
if ( version->parse($ver_want) > version->parse($ver_got) ) {
|
|
if ( $modules{$mod}->{opt} ) {
|
|
print STDERR
|
|
"Out of date optional module: $mod (need $ver_want, $ver_got installed)\n";
|
|
}
|
|
else {
|
|
push @errors, "Out of date module: $mod (need $ver_want, $ver_got installed)";
|
|
}
|
|
}
|
|
}
|
|
}
|
|
if ( @debs && -e '/etc/debian_version' ) {
|
|
if ($debs_only) {
|
|
print join( ' ', @debs );
|
|
}
|
|
else {
|
|
print STDERR "\n# apt-get install ", join( ' ', @debs ), "\n\n";
|
|
}
|
|
}
|
|
if (@mods) {
|
|
print "\n# curl -L http://cpanmin.us | sudo perl - --self-upgrade\n";
|
|
print "# cpanm -L \$LJHOME/extlib/ " . join( ' ', @mods ) . "\n\n";
|
|
if ($opt_install) {
|
|
system( "cpanm", "-n", "-L", "$ENV{LJHOME}/extlib/", @mods );
|
|
}
|
|
}
|
|
|
|
$err->(@errors);
|
|
}
|
|
|
|
sub check_env {
|
|
print "[Checking LJ Environment...]\n"
|
|
unless $debs_only;
|
|
|
|
$err->("\$LJHOME environment variable not set.")
|
|
unless $ENV{'LJHOME'};
|
|
$err->("\$LJHOME directory doesn't exist ($ENV{'LJHOME'})")
|
|
unless -d $ENV{'LJHOME'};
|
|
|
|
# before config.pl is called, we want to call the site-local checkconfig,
|
|
# otherwise config.pl might load config-local.pl, which could load
|
|
# new modules to implement site-specific hooks.
|
|
my $local_config = "$ENV{'LJHOME'}/bin/checkconfig-local.pl";
|
|
$local_config .= ' --needed-debs' if $debs_only;
|
|
if ( !$opt_nolocal && -e $local_config ) {
|
|
my $good = eval { require $local_config; };
|
|
exit 1 unless $good;
|
|
}
|
|
|
|
eval { require "$ENV{'LJHOME'}/cgi-bin/ljlib.pl"; };
|
|
$err->("Failed to load ljlib.pl: $@") if $@;
|
|
|
|
# this is copied from similar logic in 00-compile.t
|
|
my $tempdir = File::Temp::tempdir( CLEANUP => 1 );
|
|
my $slurp = sub {
|
|
my $file = $_[0];
|
|
open my $fh, '<', $file or die $!;
|
|
local $/ = undef;
|
|
return <$fh>;
|
|
};
|
|
my $test_syntax = sub {
|
|
my $file = $_[0];
|
|
my $out = "$tempdir/out";
|
|
my $err = "$tempdir/err";
|
|
system qq($^X -I"$ENV{LJHOME}/extlib/lib/perl5" -c $file > $out 2>$err);
|
|
my $err_data = $slurp->($err);
|
|
return 1 if $err_data && $err_data eq "$file syntax OK\n";
|
|
};
|
|
|
|
my @configs_to_test = qw(
|
|
etc/config-private.pl
|
|
etc/config-local.pl
|
|
etc/config.pl
|
|
);
|
|
|
|
push @configs_to_test, qw( t/config-test-private.pl t/config-test.pl )
|
|
if $LJ::IS_DEV_SERVER;
|
|
|
|
foreach my $testfile (@configs_to_test) {
|
|
if ( my $config = LJ::resolve_file($testfile) ) {
|
|
my $fn = $config;
|
|
$fn =~ s=^\Q$ENV{LJHOME}\E/==;
|
|
my $parse_config = $test_syntax->($config);
|
|
$err->("Failed to parse $fn -- check syntax") unless $parse_config;
|
|
}
|
|
else {
|
|
$err->("No file found for $testfile");
|
|
}
|
|
}
|
|
|
|
}
|
|
|
|
sub check_database {
|
|
require "$ENV{'LJHOME'}/cgi-bin/ljlib.pl";
|
|
my $dbh = LJ::get_dbh("master");
|
|
unless ($dbh) {
|
|
$err->("Couldn't get master database handle.");
|
|
}
|
|
foreach my $c (@LJ::CLUSTERS) {
|
|
my $dbc = LJ::get_cluster_master($c);
|
|
next if $dbc;
|
|
$err->("Couldn't get db handle for cluster \#$c");
|
|
}
|
|
}
|
|
|
|
foreach my $check (@checks) {
|
|
next unless $dochecks{$check};
|
|
my $cn = "check_" . $check;
|
|
no strict 'refs';
|
|
&$cn;
|
|
}
|
|
|
|
unless ($debs_only) {
|
|
print "All good.\n";
|
|
print "NOTE: checkconfig.pl doesn't check everything yet\n";
|
|
}
|
|
|
|
sub check_timezone {
|
|
print "[Checking Timezone...]\n";
|
|
my $rv = eval "use DateTime::TimeZone;";
|
|
if ($@) {
|
|
$err->("Missing required perl module: DateTime::TimeZone");
|
|
}
|
|
|
|
my $timezone = DateTime::TimeZone->new( name => 'local' );
|
|
|
|
$err->("Timezone must be UTC.") unless $timezone->is_utc;
|
|
}
|
|
|
|
sub check_secrets {
|
|
print "[Checking Secrets...]\n";
|
|
|
|
foreach my $secret ( keys %LJ::Secrets::secret ) {
|
|
my $def = $LJ::Secrets::secret{$secret};
|
|
my $req_len = exists $def->{len} || exists $def->{min_len} || exists $def->{max_len};
|
|
my $rec_len =
|
|
exists $def->{rec_len} || exists $def->{rec_min_len} || exists $def->{rec_max_len};
|
|
|
|
my $req_min = $def->{len} || $def->{min_len} || 0;
|
|
my $req_max = $def->{len} || $def->{max_len} || 0;
|
|
|
|
my $rec_min = $def->{rec_len} || $def->{rec_min_len} || 0;
|
|
my $rec_max = $def->{rec_len} || $def->{rec_max_len} || 0;
|
|
my $val = $LJ::SECRETS{$secret} || '';
|
|
my $len = length($val);
|
|
|
|
if ( !defined( $LJ::SECRETS{$secret} ) || !$LJ::SECRETS{$secret} ) {
|
|
if ( $def->{required} ) {
|
|
$err->("Missing requred secret '$secret': $def->{desc}");
|
|
}
|
|
else {
|
|
print STDERR "Missing optional secret '$secret': $def->{desc}\n";
|
|
}
|
|
}
|
|
elsif ( $req_len && ( $len < $req_min || $len > $req_max ) ) {
|
|
if ( $req_min == $req_max ) {
|
|
$err->("Secret '$secret' not of required length: is $len, must be $req_min");
|
|
}
|
|
else {
|
|
$err->(
|
|
"Secret '$secret' not of required length: is $len, must be between $req_min and $req_max"
|
|
);
|
|
}
|
|
}
|
|
elsif ( $rec_len && ( $len < $rec_min || $len > $rec_max ) ) {
|
|
if ( $rec_min == $rec_max ) {
|
|
print STDERR
|
|
"Secret '$secret' not of recommended length: is $len, should be $rec_min\n";
|
|
}
|
|
else {
|
|
print STDERR
|
|
"Secret '$secret' not of recommended length: is $len, should be between $rec_min and $rec_max\n";
|
|
}
|
|
}
|
|
}
|
|
}
|