File Coverage

blib/lib/Zabbix/ServerScript.pm

Criterion	Covered	Total	%
statement	243	247	98.3
branch	96	106	90.5
condition	23	30	76.6
subroutine	39	40	97.5
pod	7	7	100.0
total	408	430	94.8

package Zabbix::ServerScript;

use strict;
use warnings;
use Exporter;
use Data::Dumper;
use YAML;
use JSON;
use Log::Log4perl;
use Log::Log4perl::Level;
use Proc::PID::File;
use Proc::Daemon;
use File::Basename;
use Exporter;
use Carp;
use Storable;
use Term::ReadLine;
use Term::UI;
use Getopt::Long qw(:config bundling);
use List::MoreUtils qw(uniq);

BEGIN {
	eval {
		require Zabbix::ServerScript::Config;
		1;
	} or eval {
		require Zabbix::ServerScript::DefaultConfig;
		1;
	} or die q(Either Zabbix::ServerScript::DefaultConfig or Zabbix::ServerScript::Config is required);
}

our @ISA = q(Exporter);
our @EXPORT = qw($config $logger $zx_api create_config);
our $VERSION = q(0.13);

our $config = {};
our $logger;
our $zx_api;

sub _get_options {
	my ($opt, @opt_specs) = @_;
	my $default_opt = {
		daemon => 0,
		verbose => 0,
		debug => 0,
		unique => 0,
		debug => 0,
		console => 0,
	};

	if (defined $opt){
		croak q($opt must be hashref) unless ref $opt eq q(HASH);
	} else {
		$opt = {};
	}

	map { $opt->{$_} = $default_opt->{$_} unless defined $opt->{$_} } keys %$default_opt;

	my @default_opt_specs = qw(
		verbose|v+
		debug
		daemon
		console
	);
	@opt_specs = uniq (@opt_specs, @default_opt_specs);
	GetOptions($opt, @opt_specs) or croak qq(Cannot get options);
	return $opt;
}

sub _set_basename {
	my @caller = @_;
	$ENV{BASENAME} = basename($caller[1]);
	$ENV{BASENAME} =~ s/\.pl$//;
	$ENV{BASENAME} =~ s/[\0\/]//;
	return;
}

sub _set_binmode {
	binmode(STDOUT, q(utf8:));
	binmode(STDERR, q(utf8:));
	return;
}

sub _set_id {
	my ($id) = @_;
	if (defined $id){
		$ENV{ID} = $id;
	} else {
		$ENV{ID} = $ENV{BASENAME};
	}
	return;
}

sub _set_logger {
	my ($opt) = @_;
	$opt = {} unless defined $opt;

	croak qq(Couldn't find 'log_dir' section in Zabbix::ServerScript::Config) unless defined $Zabbix::ServerScript::Config->{log_dir};
	croak qq(Environment variables BASENAME and ID are not set) unless (defined $ENV{BASENAME} and $ENV{ID});
	if (defined $opt->{log_filename}){
		if ($opt->{log_filename} ne q()){
			$ENV{LOG_FILENAME} = $opt->{log_filename};
		} else {
			$logger->logdie(q(Cannot log to empty filename));
		}
	} else {
		$ENV{LOG_FILENAME} = qq($Zabbix::ServerScript::Config->{log_dir}/$ENV{BASENAME}.log);
	}

	croak qq(Couldn't find 'log' section in Zabbix::ServerScript::Config) unless defined $Zabbix::ServerScript::Config->{log};
	Log::Log4perl->init($Zabbix::ServerScript::Config->{log});

	my $log_category;
	if (defined $opt->{logger}){
		if ($opt->{logger} eq q()){
			$log_category = q(Zabbix.ServerScript.nolog);
		} else {
			$log_category = $opt->{logger};
		}
	} else {
		if (defined $opt->{console} && $opt->{console} == 1){
			$log_category = q(Zabbix.ServerScript.console);
		} else {
			$log_category = q(Zabbix.ServerScript);
		}
	}
	$logger = Log::Log4perl::get_logger($log_category);
	$ENV{LOG_CATEGORY} = $log_category;

	if (defined $opt->{verbose} && $opt->{verbose}){
		$logger->more_logging($opt->{verbose});
	}
	if (defined $opt->{debug} && $opt->{debug} == 1){
		$logger->level($DEBUG);
	}

	$SIG{__DIE__} = sub {
		my ($message) = @_;
		if($^S and not (defined $ENV{ZBX_TESTING} and $ENV{ZBX_TESTING} == 1)) {
			# We're in an eval {} and don't want log
			# this message but catch it later
			return;
		}
		$Log::Log4perl::caller_depth++;
		$logger->fatal($message);
	};

	$SIG{__WARN__} = sub {
		my ($message) = @_;
		local $Log::Log4perl::caller_depth;
		$Log::Log4perl::caller_depth++;
		$logger->warn($message);
	};
	return;
}

sub _set_config {
	my ($config_filename) = @_;

	$logger->logcroak(qq(Environment variables BASENAME and ID are not set)) unless (defined $ENV{BASENAME} and $ENV{ID});

	if (not defined $config_filename){
		$config_filename = qq($Zabbix::ServerScript::Config->{config_dir}/$ENV{BASENAME}.yaml);
	}
	if ($config_filename ne q()){
		if (-f $config_filename){
			$logger->debug(qq(Loading local config from file $config_filename));
			$config = YAML::LoadFile($config_filename) or $logger->logdie(qq(Cannot load config from $config_filename));
		} else {
			$logger->debug(qq(Local config $config_filename was not found.)) unless $config_filename eq q();
		}
	}
	$config->{global} = $Zabbix::ServerScript::Config;
	return;
}

sub _set_api {
	my ($api) = @_;
	my $api_config;
	if (defined $api){
		require Zabbix::ServerScript::API;
		$zx_api = Zabbix::ServerScript::API::init($api);
	}
}

sub _get_pid {
	my ($id) = @_;
	my $name = $ENV{BASENAME};
	$name .= qq(_$id) if defined $id;
	$name =~ s/[\0\/]/_/g;
	my $pid = {
		name => $name,
		dir => $Zabbix::ServerScript::Config->{pid_dir},
	};
	$logger->debug(qq(Using PID file $pid->{dir}/$pid->{name}.pid));
	return $pid;
}

sub _set_unique {
	my ($unique, $id) = @_;
	if (defined $unique && $unique){
		my $pid = _get_pid($id);
		if (Proc::PID::File->running($pid)){
			croak(qq($pid->{name} is already running));
		}
	}
}

sub _set_daemon {
	my ($daemon) = @_;
	return Proc::Daemon::Init() if $daemon;
	return;
}

sub retrieve_cache {
	my ($cache_filename) = @_;
	if (not defined $cache_filename){
		$logger->debug(q(Cache filename is not specified, using default filename));
		$cache_filename = qq($Zabbix::ServerScript::Config->{cache_dir}/$ENV{BASENAME}.cache)
	}
	my $cache;
	if (-f $cache_filename){
		$logger->debug(qq(Loading cache from "$cache_filename"));
		eval {
			$cache = retrieve $cache_filename;
			1;
		} or do {
			$logger->error(qq(Cannot retrieve cache from "$cache_filename": $@));
		};
	} else {
		$logger->info(qq(Cache file "$cache_filename" was not found));
	}
	return $cache;
}

sub store_cache {
	my ($cache, $cache_filename) = @_;
	if (not defined $cache_filename){
		$logger->debug(q(Cache filename is not specified, using default filename));
		$cache_filename = qq($Zabbix::ServerScript::Config->{cache_dir}/$ENV{BASENAME}.cache)
	}
	$logger->debug(qq(Storing cache to $cache_filename));
	eval {
		store $cache, $cache_filename;
		1;
	} or do {
		$logger->error(qq(Cannot store cache to "$cache_filename"));
		return;
	};
	return 1;
}

sub init {
	my ($opt, @opt_specs) = @_;

	_get_options($opt, @opt_specs);
	_set_basename(caller);
	_set_id($opt->{id});
	_set_daemon($opt->{daemon});
	_set_logger($opt);
	_set_unique($opt->{unique}, $opt->{id});
	_set_config($opt->{config});
	_set_api($opt->{api});
	$logger->debug(q(Initialized Zabbix::ServerScript));
}

sub return_value {
	my ($value) = @_;
	if (defined $value){
		$logger->debug(qq(Return value: $value));
		chomp $value;
		print qq($value\n);
		exit;
	} else {
		$logger->logcroak(q(Return value is not defined));
	}
}

sub connect_to_db {
	my ($dbname, $user, $password, $mode) = @_;
	$logger->logcroak(q(dbname is not defined)) unless defined $dbname;
	my $dbh;
	$logger->debug(qq(Trying to connect to $dbname via ODBC));
	$dbh = DBI->connect(
		qq(dbi:ODBC:DSN=$dbname),
		$user,
		$password,
	) or $logger->logcroak(qq(Failed to connect to $dbname: $DBI::errstr));
	$logger->debug(qq(Connected to $dbname));
	return $dbh;
}

sub _prepare_sender_data {
	my ($request_data) = @_;
	if (ref($request_data) eq q(HASH)){
		$request_data = [ $request_data ];
	} elsif (ref($request_data) ne q(ARRAY)){
		croak(qq(Request is neither arrayref nor hashref: ) . Dumper($request_data));
	}
	$request_data = {
		request => q(sender data),
		data => $request_data,
	};
	# encode_json throws an exception itself, if it cannot encode json.
	# This 'croak' stands here just in case encode_json implementation will be changed.
	my $request_json = encode_json($request_data) or croak(qq(Cannot encode to JSON: ) . Dumper($request_data));
}

sub _proceed_sender_response {
	my ($response_json) = @_;
	$response_json =~ s/^.+(?={)//;
	my $response_data = decode_json($response_json) or croak(qq(Cannon decode JSON));
	return $response_data;
}

sub send {
	my ($request_data, $sender_host, $sender_port) = @_;
	$sender_host = q(localhost) if not defined $sender_host;
	$sender_port = q(10051) if not defined $sender_port;
	$logger->debug(qq(Opening sender socket to $sender_host:$sender_port));
	require IO::Socket::INET;
	my $socket = IO::Socket::INET->new(
		PeerAddr => $sender_host,
		PeerPort => $sender_port,
		Proto => q(tcp),
		Timeout => 10,
	) or croak(qq(Cannot open socket for zabbix sender to "$sender_host:$sender_port": $?));

	my $request_json = _prepare_sender_data($request_data);
	my $request_length = length($request_json);
	my $response_json;

	$logger->debug(qq(Writing $request_length of data to sender socket: $request_json));
	$socket->write($request_json, $request_length) or croak(qq(Cannot write to socket: $!));
	$socket->read($response_json, 2048) or croak(qq(Cannot read from socket: $!));
	$socket->close or croak(qq(Cannot close socket: $!));
	$logger->debug(qq(Server answered to sender: $response_json));
	my $response_data = _proceed_sender_response($response_json);
	return $response_data;
}

sub create_config {
	require Zabbix::ServerScript::DefaultConfig;

	my ($opt) = @_;
	$opt = {
		console => 1,
		verbose => 1,
		(defined $opt ? %$opt : ()),
	};
	print Dumper($opt);
	init($opt);

	my $term = Term::ReadLine->new('Zabbix::ServerScript');
	(my $module_dir = dirname($INC{q(Zabbix/ServerScript/DefaultConfig.pm)})) =~ s|//|/|g;
	$module_dir = $term->get_reply(
		prompt => q(Directory to store Config.pm),
		default => $module_dir,
	);
	die(qq(Wrong directory: $module_dir)) unless (-d $module_dir and -w $module_dir);
	$logger->debug(qq(Will store Config.pm in $module_dir));

	my $module_filename = qq($module_dir/Config.pm);
	if (-f $module_filename){
		$term->ask_yn(
			prompt => qq(\n$module_filename exists.\nOverwrite?),
			default => q(n),
		) or exit 0;
		$logger->info(q(Overwrite has been requested));
	}

	for my $section (qw(config_dir pid_dir log_dir)){
		$Zabbix::ServerScript::Config->{$section} = $term->get_reply(
			prompt => $section,
			default => $Zabbix::ServerScript::Config->{$section},
		);
	}

	open my $fh, q(>), $module_filename or die(qq(Cannot open file $module_filename: $!));
	print $fh Data::Dumper->Dump([$Zabbix::ServerScript::Config], [q($Zabbix::ServerScript::Config)]);
	close $fh;

	require $module_filename or die(qq(Cannot load module: $!));
	$logger->info(qq($module_filename has been created successfully));
	exit 0;
}

1;

__END__