debug_adm

#!/usr/bin/env perl

use strict;
use warnings;

use Carp 'verbose';

use FindBin;

use File::Slurp;
use File::Glob qw(:glob);
use File::Copy;
use File::Copy::Recursive qw(dircopy);
use File::Path qw(make_path remove_tree);
use File::Temp;
use File::Spec;
use File::Basename qw(dirname);

use Cwd qw(abs_path);

use IPC::Cmd qw(run);

use List::MoreUtils qw(uniq);

use Cache::Memcached::Fast;
use ExtUtils::Installed;

our $VERSION = '1.0001';

my $self = $0 = ( -f $0 && -l $0 ) ? abs_path( readlink( $0 ) ) : abs_path( $0 );

use Pod::Usage;
use Getopt::Long;

use Data::Dumper qw(Dumper);

my %options = ();
my $arg_line = join ' ', $0, @ARGV; # survive GetOptions

GetOptions (\%options,
    'webmin=s',
    'action=s',
    'object=s',
    'level=s',
    'name=s',
    'log=s',
    'debug',
    'help|?'
);

pod2usage(1) if $options{help};

my $self_path = dirname( $self );
my $webmin_conf_path = $options{webmin} || "/etc/webmin/miniserv.conf";

my $log_file = $options{'log'} || "/var/log/thirdlane/debug_adm.log";

our @possible_objects = qw(debug pbxconf pbxlogs);

our $cache;

$SIG{__WARN__} = sub {
    my $strace = Carp::longmess();
    &write_log(@_, $strace);
    print "Warn:" . $_[0] . "\n" if $options{debug};
};

$SIG{__DIE__} = sub {
    my $strace = Carp::longmess();
    &write_log(@_, $strace);
    print "Die:" . $_[0] . "\n" if $options{debug};
};

sub data_dump {
    return Data::Dumper->new([@_])
        ->Purity(0)
        ->Useqq(0)
        ->Terse(1)
        ->Deepcopy(1)
        ->Quotekeys(0)
        ->Maxdepth(32)
        ->Dump;
}

sub get_cache_handle {
    my $cache = new Cache::Memcached::Fast {
	servers => [ "127.0.0.1:11211" ],
	serialize_methods => [ \&Storable::freeze, \&Storable::thaw ],
	utf8 => 1,
	compress_threshold => 10_000
    };

    die "cache inaccessible" unless defined $cache;

    return $cache;
}

sub write_log {
    my ( @args ) = @_;

    my $date_string = localtime();

    $_ = ( ref $_ ? data_dump($_) : $_ ) for @args;

    foreach my $log_line ( split /\n/, join "\n", @args ) {
	$log_line = "$date_string [v$VERSION]: " . $log_line;
	$log_line .= "\n" unless $log_line =~ m/\n$/sg;

	print "LOG:", $log_line if $options{debug};
	write_file($log_file, { append => 1 }, $log_line);
    }
}

sub get_webmin_port {
    my $webmin_conf = read_file($webmin_conf_path);
    my ($port) = $webmin_conf =~ m/port\=(\d+)/sg;

    return $port;
}

sub set_webmin_port {
    my $port = shift;

    my $webmin_conf = read_file($webmin_conf_path);
    $webmin_conf =~ s/port\=(\d+)/port\=$port/sg;
    write_file($webmin_conf_path, $webmin_conf);

    system("/usr/bin/systemctl", "restart", "webmin");

    return $port;
}

sub usage {
    pod2usage(1);
}

sub action_status_all {
    no strict 'refs';

    foreach my $object_name ( @possible_objects ) {
	my $action_name_sub = sprintf( "action_status_%s", $object_name );
	if ( defined *$action_name_sub{CODE} ) {
	    $action_name_sub->();
	}
    }
}

sub action_status_debug {
    if ( $cache->get("thirdlane::debug::core") ) {
	print "Core debug is enabled.\n";
    } else {
	print "Core debug is disabled.\n";
    }
}

sub action_enable_debug {
    $options{level} ||= "debug";
    $cache->set("thirdlane::debug::core", 1);
    $cache->set("thirdlane::debug::core::level", $options{level});
}

sub action_disable_debug {
    $cache->delete("thirdlane::debug::core");
    $cache->delete("thirdlane::debug::core::level");
}

sub action_modules_perl {
    my $installed = ExtUtils::Installed->new( skip_cwd => 1 );
    for my $module ($installed->modules()) {
	printf("%s %s\n", $module, $installed->version($module));
    }
}

write_log("Started with arguments:", $arg_line);
write_log("Used options:", \%options);

$options{action} = "enable" if ( lc $options{action} eq "on" );
$options{action} = "disable" if ( lc $options{action} eq "off" );

my $action_sub = $options{action} && $options{object} ? "action_" . $options{action} . "_" . $options{object} : "usage";

$cache = &get_cache_handle();

{
    no strict 'refs';

    if ( defined *$action_sub{CODE} ) {
	write_log("Calling function:", $action_sub);
	&action_status_all() if $action_sub eq "usage";
	$action_sub->();
	my $action_status_sub = "action_status_" . $options{object};
	if ( defined *$action_status_sub{CODE} ) {
	    $action_status_sub->();
	}
    } else {
	write_log("Unknown function:", $action_sub);
	&action_status_all();
	&usage();
	die("unknown operation!\n");
    }
}

__END__

=head1 NAME

debug_adm - Debug configuration manager for Thirdlane PBX distribution

=head1 SYNOPSIS

debug_adm --action=[action] --object=[object] [options ...]

 Options:
   --help               help message
   --action             manager action
   --object             manager object
   --level              debug level

=head1 OPTIONS

=over 4

=item B<--help>

Print a brief help message and exits.

=item B<--action>

Configuration action. Possible actions [ "enable", "disable", "status" ]

=item B<--object>

Configuration object. Possible objects [ "debug", "pbxconf", "pbxlogs" ]

=head1 DESCRIPTION

B<This program> will read the given input configuration and do something
useful with the debug behavior.

=cut