package POEDaemon;


use strict;
use warnings FATAL => 'all';
no warnings 'redefine';

use Data::Dumper;
use Time::HiRes;
use POSIX qw(strftime);
use Sys::Syslog qw(:standard :macros);
use Time::Duration ();
use Socket qw(AF_INET AF_INET6 sockaddr_family inet_ntop unpack_sockaddr_in unpack_sockaddr_in6);
use BSD::Sysctl qw(sysctl);
use POE qw(Filter::SSL);
use POEDaemon::Config;

our (@ISA, @EXPORT);

BEGIN
{
	require Exporter;
	
	@ISA = qw(Exporter);
	
	@EXPORT = qw
	(
		GPIO_HIGH
		GPIO_LOW
		GPIO_TOGGLE
		MAIN_POE_SESSION_NAME
		POESERVER_CMD_PREFIX
		POECLIENT_CMD_PREFIX
		FASTCGI_CMD_PREFIX
		
		dumper_oneline
		
		dumper_compare
		
		cfg
		
		argv_quiet
		
		log_enabled
		prod_log_enabled
		
		time_hires
		
		connretry_rand
		client_periodic_cmd_delay_rand
		
		duration
		duration_exact
		concise_duration
		concise_duration_exact
		
		console_output
		logline
		prod_logline
		syslogline
		
		logbuf
		
		exitmsg_set
		exitmsg_get
		
		parse_ssl_cert_ids
		
		get_sockinfo
		
		hexval
		
		substr_count
		
		websocket_frame_type
		
		read_file
		
		socket_can_disable_v6only
		
		format_bytes
	);
}


my (@logbuf, $last_time, $exitmsg);


sub GPIO_HIGH             () { return 1;           }
sub GPIO_LOW              () { return 0;           }
sub GPIO_TOGGLE           () { return 't';         }
sub MAIN_POE_SESSION_NAME () { return 'main';      }
sub POESERVER_CMD_PREFIX  () { return 'POESERVER'; }
sub POECLIENT_CMD_PREFIX  () { return 'POECLIENT'; }
sub FASTCGI_CMD_PREFIX    () { return 'FASTCGI';   }


sub dumper_oneline
{
	local $Data::Dumper::Indent    = 0;
	local $Data::Dumper::Terse     = 1;
	local $Data::Dumper::Quotekeys = 0;
	local $Data::Dumper::Pair      = '=>';
	
	return Dumper @_;
}


sub get_main_session_heap ()
{
	my $session_main_heap;
	
	
	my $session_main = $poe_kernel->alias_resolve(MAIN_POE_SESSION_NAME);
	
	
	if ($session_main)
	{
		$session_main_heap = $session_main->get_heap;
	}
	
	
	$session_main_heap = {} unless ref $session_main_heap eq 'HASH';
	
	
	return $session_main_heap;
}


sub dumper_compare ($$)
{
	my ($struct_a, $struct_b) = @_;
	
	
	local $Data::Dumper::Terse    = 1;
	local $Data::Dumper::Indent   = 0;
	local $Data::Dumper::Sortkeys = 1;
	
	
	return (Dumper($struct_a) eq Dumper($struct_b) ? 1 : undef);
}


sub cfg ()
{
	my $result;
	
	
	eval
	{
		$result = POEDaemon::Config->get;
	};
	
	
	if ($@ || ref $result ne 'HASH' || !%$result)
	{
		my $old_config = get_main_session_heap->{reload}->{old_config};
		
		
		$result = ref $old_config eq 'HASH' ? { __config__ => 'using alternate', %$old_config } : { __config__ => 'alternate not found' };
	}
	
	
	return $result;
}


sub argv_quiet ()
{
	return (defined $ARGV[0] && $ARGV[0] eq 'quiet' ? 1 : undef);
}


sub log_enabled ()
{
	return (!argv_quiet || (argv_quiet && cfg->{log_enable_in_quiet_mode}) ? 1 : undef);
}


sub prod_log_enabled ()
{
	return 1;
}


sub time_hires ()
{
	return sprintf "%.6f", Time::HiRes::time;
}


sub connretry_rand ()
{
	return sprintf "%.6f", rand 11;
}


sub client_periodic_cmd_delay_rand ()
{
	return sprintf "%.6f", rand 1;
}


sub duration_wrapper ($$$)
{
	my ($mode1, $mode2, $seconds) = @_;
	
	
	return unless defined $mode1 && defined $mode2;
	
	
	my $seconds_converted;
	
	
	if ($mode1 eq 'duration')
	{
		$seconds_converted = Time::Duration::duration $seconds;
	}
	elsif ($mode1 eq 'duration_exact')
	{
		$seconds_converted = Time::Duration::duration_exact $seconds;
	}
	
	
	if ($mode2 eq 'concise')
	{
		$seconds_converted = Time::Duration::concise $seconds_converted;
		
		
		$seconds_converted =~ s/^just\s+now$/0s/;
	}
	else
	{
		$seconds_converted =~ s/^just\s+now$/0\x20seconds/;
	}
	
	
	return $seconds_converted;
}


sub duration ($)
{
	my ($seconds) = @_;
	
	
	return duration_wrapper 'duration', '', $seconds;
}


sub duration_exact ($)
{
	my ($seconds) = @_;
	
	
	return duration_wrapper 'duration_exact', '', $seconds;
}


sub concise_duration ($)
{
	my ($seconds) = @_;
	
	
	return duration_wrapper 'duration', 'concise', $seconds;
}


sub concise_duration_exact ($)
{
	my ($seconds) = @_;
	
	
	return duration_wrapper 'duration_exact', 'concise', $seconds;
}


sub console_output ($)
{
	my ($line) = @_;
	
	
	return unless defined $line;
	
	
	return if argv_quiet;
	
	
	my $session_main_heap = get_main_session_heap;
	
	
	if ($session_main_heap->{console})
	{
		$session_main_heap->{console}->put($line);
	}
	else
	{
		printf "%s\n", $line;
	}
}


sub logline
{
	#return unless log_enabled;
	
	
	my ($message, @args) = @_;
	
	
	unless (defined $message)
	{
		$message = 'sub logline $message undef';
	}
	
	foreach my $arg (@args)
	{
		unless (defined $arg)
		{
			$arg = 'sub logline @args member undef';
		}
		else
		{
			if ($arg =~ /^\$VAR\d+\x20=\x20/)
			{
				$arg =~ s/[\x00-\x09\x0b-\x1f\x7f]/./g;
			}
			else
			{
				$arg =~ s/[[:cntrl:]]/./g;
			}
		}
	}
	
	
	my $curr_time = time_hires;
	
	
	my $state = $poe_kernel->get_active_event;
	
	if ($state)
	{
		$state =~ s/POE::(W)heel(::)(S)ocket(F)actory/$1$2$3$4/;
		$state =~ s/POE::(W)heel(::)(R)ead(W)rite/$1$2$3$4/;
		$state =~ s/-> select //;
	}
	
	
	my $line = sprintf "[%s%s%s] %s: %s",
		strftime("%F %T %z", localtime),
		(cfg->{log_timestamp_uptime} ? sprintf " | %s", concise_duration time - $^T : ''),
		(cfg->{log_timestamp_millisecond_diff} ? sprintf(" | %sms", (defined $last_time ? sprintf "%.3f", (($curr_time - $last_time) * 1000) : 0)) : ''),
		($state || sprintf "PID %s", $$),
		(@args ? sprintf $message, @args : $message);
	
	
	push @logbuf, $line;
	
	
	shift @logbuf if $#logbuf > 1000;
	
	
	console_output $line unless argv_quiet;
	
	
	$last_time = time_hires;
}


sub prod_logline
{
	my ($message, @args) = @_;
	
	
	unless (defined $message)
	{
		$message = 'sub prod_logline $message undef';
	}
	
	
	foreach my $arg (@args)
	{
		unless (defined $arg)
		{
			$arg = 'sub prod_logline @args member undef';
		}
		else
		{
			$arg =~ s/[^[:print:]]/./g;
		}
	}
	
	
	my $time = time_hires;
	
	my $time_usec = (split /\./, $time)[1];
	
	
	my $strftime_fmt = sprintf "%%F %%T%s %%z", (defined $time_usec ? sprintf ".%s", $time_usec : '');
	
	
	my $line = sprintf "%s: %s",
		strftime($strftime_fmt, localtime $time),
		(@args ? sprintf $message, @args : $message);
	
	
	#$poe_kernel->post(log => log => $line);
	$poe_kernel->yield(logger => $line);
}


sub syslogline
{
	my ($message, $options) = @_;
	
	
	my $high_priority = ref $options eq 'HASH' && $options->{high_priority} ? 1 : 0;
	
	
	log_enabled && logline "send syslog message ndelay,pid LOG_USER|%s: %s",
		($high_priority ? 'LOG_ERR' : 'LOG_NOTICE'),
		$message;
	
	
	my $ident = $0;
	
	
	$ident =~ s/^\s+//;
	$ident =~ s/\s+$//;
	$ident =~ s/\s+/-/g;
	$ident =~ s|^.*/||;
	
	
	my $level = $high_priority ? LOG_ERR : LOG_NOTICE;
	
	
	openlog $ident, 'ndelay,pid', LOG_USER;
	
	syslog $level, $message;
	
	closelog;
}


sub logbuf ()
{
	return \@logbuf;
}


sub exitmsg_set ($)
{
	$exitmsg = $_[0];
}


sub exitmsg_get ()
{
	return $exitmsg || 'n/a';
}


sub parse_ssl_cert_ids
{
	my (@certids_in) = @_;
	
	
	my $certids_out;
	
	
	foreach my $certid (@certids_in)
	{
		next unless $certid;
		
		
		my $entry =
		{
			serial         => POE::Filter::SSL->hexdump($certid->[2]),
			
			subject_string => $certid->[0],
			issuer_string  => $certid->[1],
		};
		
		
		foreach my $i (qw(0 1))
		{
			foreach my $string (split '/', $certid->[$i])
			{
				my ($key, $val) = split '=', $string;
				
				
				next unless defined $key && defined $val;
				
				
				if ($i == 0)
				{
					$entry->{subject}->{$key} = $val;
				}
				elsif ($i == 1)
				{
					$entry->{issuer}->{$key} = $val;
				}
			}
		}
		
		
		push @$certids_out, $entry;
	}
	
	
	return $certids_out;
}


sub get_sockinfo ($)
{
	my ($sockaddr) = @_;
	
	
	return unless $sockaddr;
	
	
	my $family = sockaddr_family $sockaddr;
	
	
	my ($family_humanreadable, $port, $addr);
	
	
	if ($family == AF_INET)
	{
		$family_humanreadable = 'inet';
		
		($port, $addr) = unpack_sockaddr_in $sockaddr;
	}
	elsif ($family == AF_INET6)
	{
		$family_humanreadable = 'inet6';
		
		($port, $addr) = unpack_sockaddr_in6 $sockaddr;
	}
	else
	{
		log_enabled && logline "invalid family = '%s'", $family || 'n/a';
		
		return;
	}
	
	
	my $addr_humanreadable = inet_ntop $family, $addr;
	
	
	return
	{
		family => $family_humanreadable,
		addr   => $addr_humanreadable,
		port   => $port,
	};
}


sub hexval ($)
{
	my ($bytes) = @_;
	
	
	return join '', map { sprintf "\\x%02X", $_ } unpack 'C*', $bytes;
}


sub kenvs ($)
{
	my ($regex) = @_;
	
	
	my $kenvs_result = {};
	
	
	return $kenvs_result unless ref $regex eq 'Regexp';
	
	
	my $output = `kenv`;
	
	$output = '' unless defined $output;
	
	
	foreach my $line (split "\n", $output)
	{
		my ($variable, $value) = split '=', $line;
		
		
		next unless defined $variable && $variable =~ /^[\w\.]+$/ && $variable =~ $regex && defined $value;
		
		
		$value =~ s/^[\s\"]+//;
		$value =~ s/[\s\"]+$//;
		
		
		$kenvs_result->{$variable} = $value;
	}
	
	
	return $kenvs_result;
}


sub rootfs ()
{
	my $output = `mount`;
	
	$output = '' unless defined $output;
	
	
	my ($rootfs) = split /\s+/, join '', grep m|^\S+\s+on\s+/\s+\S+|, split "\n", $output;
	
	
	$rootfs = '' unless defined $rootfs;
	
	
	$rootfs =~ s/^\s+//;
	$rootfs =~ s/\s+$//;
	$rootfs =~ s/\s+/\x20/g;
	
	
	return $rootfs
}


sub load_modules
{
	my ($mode, $module_modified_tags) = @_;
	
	
	my $reload = defined $mode && $mode eq 'reload' ? 1 : undef;
	
	
	$module_modified_tags = {} unless ref $module_modified_tags eq 'HASH';
	
	
	my $modules = cfg->{modules} || [];
	
	
	$modules = [ 'POEDaemon::Config', 'POEDaemon', @$modules ];
	
	
	my $result =
	{
		modules                    => $modules,
		errors                     => [],
		package_states             => [],
		poe_state_modules          => {},
		poe_state_modules_arrayref => [],
		statelist                  => {},
		module_modified_tags       => {},
		unmodified_states          => {},
		modules_modified           => [],
		modules_modified_hashref   => {},
		config_load_error          => undef,
	};
	
	
	log_enabled && logline "modules = %s", join(' ', @$modules);
	
	
	log_enabled && logline "%sloading modules...", ($reload ? 're' : '');
	
	
	foreach my $module (@$modules)
	{
		my $module_file = $module;
		
		$module_file =~ s|::|/|g;
		
		$module_file = sprintf "%s.pm", $module_file;
		
		
		my $module_modified_tag = -M sprintf "lib/%s", $module_file;
		
		
		if (!$reload && $module =~ /^POEDaemon(?:\:\:Config)?$/)
		{
			log_enabled && logline "only saving modified tag for module '%s'", $module;
			
			
			$result->{module_modified_tags}->{$module} = $module_modified_tag;
			
			
			next;
		}
		
		
		if (exists $module_modified_tags->{$module} && defined $module_modified_tags->{$module} && $module_modified_tags->{$module} eq $module_modified_tag)
		{
			log_enabled && logline "skip %sloading unmodified module '%s'",
				($reload ? 're' : ''),
				$module;
			
			
			$result->{module_modified_tags}->{$module} = $module_modified_tags->{$module};
		}
		else
		{
			log_enabled && logline "%sloading module '%s'",
				($reload ? 're' : ''),
				$module;
			
			
			$result->{module_modified_tags}->{$module} = $module_modified_tag;
			
			push @{$result->{modules_modified}}, $module;
			
			$result->{modules_modified_hashref}->{$module} = 1;
			
			
			unless (my $return = do $module_file)
			{
				my $error;
				
				
				if ($@)
				{
					$error = 1;
					
					
					push @{$result->{errors}}, sprintf("couldn't parse %s: %s", $module_file, $@ || 'n/a');
				}
				elsif (!defined $return)
				{
					$error = 1;
					
					
					push @{$result->{errors}}, sprintf("couldn't do %s: %s", $module_file, $! || 'n/a');
				}
				elsif (!$return)
				{
					$error = 1;
					
					
					push @{$result->{errors}}, sprintf("couldn't run %s", $module_file);
				}
				
				
				if ($error)
				{
					$result->{config_load_error} = 1 if $module eq 'POEDaemon::Config';
					
					
					next;
				}
			}
			
			
			if ($module eq 'POEDaemon::Config')
			{
				my $result;
				
				
				eval
				{
					$result = $module->get;
				};
				
				
				if ($@ || ref $result ne 'HASH' || !%$result)
				{
					$result->{config_load_error} = 1;
					
					
					push @{$result->{errors}}, sprintf("'%s'->get result is not proper HASHref: %s", $module, $@ || 'n/a');
				}
			}
		}
		
		
		next if $module =~ /^POEDaemon(?:\:\:Config)?$/;
		
		
		my $states;
		
		
		eval
		{
			$states = $module->states;
		};
		
		
		if ($@ || ref $states ne 'ARRAY' || !@$states)
		{
			push @{$result->{errors}}, sprintf("'%s'->states result is not proper ARRAYref: %s", $module, $@ || 'n/a');
			
			next;
		}
		
		
		$result->{package_states} = [ @{$result->{package_states}}, $module->states ];
		
		$result->{poe_state_modules}->{$module} = $states;
		
		push @{$result->{poe_state_modules_arrayref}}, { $module => $states };
		
		
		foreach my $state (@$states)
		{
			log_enabled && logline "found sub '%s'", $state;
			
			
			$result->{statelist}->{$state} = 1;
		}
	}
	
	
	log_enabled && logline "modules %sloaded", ($reload ? 're' : '');
	
	
	if (@{$result->{errors}})
	{
		log_enabled && logline "%sloading error:\n%s",
			($reload ? 're' : ''),
			Dumper $result->{errors};
	}
	
	
	return $result;
}


sub init ()
{
	if (defined $ARGV[0] && $ARGV[0] eq 'ciphers')
	{
		log_enabled && logline 'ciphers';
		
		
		foreach my $path (split ':', $ENV{PATH})
		{
			foreach my $opt (qw(ssl_cipher_list ssl_cipher_list_http))
			{
				my $binary = sprintf("%s/openssl", $path);
				
				next unless -x $binary;
				
				
				my $cipher_list = cfg->{$opt};
				
				next unless defined $cipher_list;
				
				
				my @openssl = ($binary, 'ciphers', '-v', $cipher_list);
				
				
				log_enabled && logline "for cfg->{%s}, run %s ...",
					dumper_oneline($opt),
					dumper_oneline(\@openssl);
				
				system { $openssl[0] } @openssl;
			}
		}
		
		
		log_enabled && logline 'exit';
		
		exit;
	}
	
	
	log_enabled && logline 'init';
	
	
	syslogline 'init';
	
	syslogline '#1, init', { high_priority => 1 } if cfg->{syslog_high_priority_debug};
	
	
	log_enabled && logline "running as: UID %s (effective %s) / GID %s (effective %s)",
		$<,
		$>,
		$(,
		$);
	
	
	my $sysctls =
	{
		'kern.boottime'         => sprintf("%.6f", sysctl 'kern.boottime'),
		'kern.compiler_version' => sysctl('kern.compiler_version'),
	};
	
	$sysctls->{'kern.compiler_version'} =~ s/\0$//;
	
	my $kenvs  = kenvs qr/^uboot\.(?:board_name|ver|bootcount)$/;
	
	my $rootfs = rootfs;
	
	
	log_enabled && logline "sysctls = %s",  dumper_oneline $sysctls;
	log_enabled && logline "kenvs = %s",    dumper_oneline $kenvs;
	log_enabled && logline "rootfs = '%s'",                $rootfs;
	
	
	my $argv0 = 'poe-daemon main';
	
	my $extramode;
	
	$extramode = '|quiet' if argv_quiet;
	
	$argv0 = sprintf "%s mode=%s%s",
		$argv0,
		cfg->{poesession_mode} || 'n/a',
		$extramode             || '';
	
	my $argv0_orig = $0;
	
	
	log_enabled && logline "change process title '%s' -> '%s'", $argv0_orig, $argv0;
	
	
	$0 = $argv0;
	
	
	my $poe_version = $POE::VERSION || -1;
	
	my $poe_version_minimum = 1.366;
	
	
	unless ($poe_version >= $poe_version_minimum)
	{
		log_enabled && logline "need POE version >= %s (found %s)",
			$poe_version_minimum,
			$poe_version;
		
		exit 1;
	}
	
	
	log_enabled && logline "using POE v%s", $poe_version;
	
	
	log_enabled && logline "poe session mode = '%s'", cfg->{poesession_mode} || 'n/a';
	
	
	my $load_modules_result = load_modules;
	
	
	my $errors               = $load_modules_result->{errors}               || [];
	my $package_states       = $load_modules_result->{package_states}       || [];
	my $poe_state_modules    = $load_modules_result->{poe_state_modules}    || {};
	my $statelist            = $load_modules_result->{statelist}            || {};
	my $module_modified_tags = $load_modules_result->{module_modified_tags} || {};
	
	
	if (@$errors)
	{
		my $msg = sprintf "\n\n%s: fatal error while loading modules on daemon init:\n\n%s\n\n\n",
			$0,
			join "\n", @$errors;
		
		
		die $msg;
	}
	
	
	log_enabled && logline 'POE::Session->create';
	
	
	my $options =
	{
		#trace   => 1,
		#debug   => 1,
		#
		#default => 1,
	};
	
	
	my $heap =
	{
		script               => 'poe-daemon.pl v0.1',
		
		argv                 => \@ARGV,
		
		argv0_orig           => $argv0_orig,
		argv0                => $argv0,
		
		(%$sysctls ? (init_sysctls => $sysctls) : ()),
		
		(%$kenvs   ? (init_kenvs   => $kenvs)   : ()),
		
		rootfs               => $rootfs,
		
		poe_state_modules    => $poe_state_modules,
		statelist            => $statelist,
		module_modified_tags => $module_modified_tags,
	};
	
	
	my $session = POE::Session->create
	(
		package_states => $package_states,
		
		options        => $options,
		
		heap           => $heap,
	);
	
	
	unless ($session)
	{
		exitmsg_set 'POE::Session->create error';
	}
	
	
	syslogline 'POE::Kernel->run';
	
	syslogline '#2, POE::Kernel->run', { high_priority => 1 } if cfg->{syslog_high_priority_debug};
	
	
	log_enabled && logline 'POE::Kernel->run';
	
	
	POE::Kernel->run;
	
	
	my $exitmsg = sprintf "exit: %s", exitmsg_get;
	
	
	syslogline $exitmsg;
	
	
	log_enabled && logline $exitmsg;
}


sub substr_count ($$)
{
	my ($string, $substring) = @_;
	
	
	my $count = 0;
	my $pos   = 0;
	
	
	while (($pos = index $string, $substring, $pos) != -1)
	{
		$pos++;
		$count++;
	}
	
	
	return $count;
}


sub websocket_frame_type ($)
{
	my ($websocket_frame) = @_;
	
	
	my $frame_type;
	
	if    ($websocket_frame->is_text)   { $frame_type = 'text';    }
	elsif ($websocket_frame->is_binary) { $frame_type = 'binary';  }
	elsif ($websocket_frame->is_ping)   { $frame_type = 'ping';    }
	elsif ($websocket_frame->is_pong)   { $frame_type = 'pong';    }
	elsif ($websocket_frame->is_close)  { $frame_type = 'close';   }
	else                                { $frame_type = 'unknown'; }
	
	
	return $frame_type;
}


sub read_file ($)
{
	my ($file) = @_;
	
	
	unless (open F, $file)
	{
		log_enabled && logline "file '%s' open error: %s",
			$file,
			$!;
		
		return '';
	}
	
	
	my $content = join '', <F>;
	
	
	unless (close F)
	{
		log_enabled && logline "file '%s' close error: %s",
			$file,
			$!;
		
		return '';
	}
	
	
	return $content;
}


{
	my $can_disable_v6only;
	
	
	sub socket_can_disable_v6only ()
	{
		return $can_disable_v6only if defined $can_disable_v6only;
		
		
		eval
		{
			$can_disable_v6only = POE::Wheel::SocketFactory->CAN_DISABLE_V6ONLY;
		};
		
		return $can_disable_v6only;
	}
}


eval
{
	require Number::Bytes::Human;
	
	Number::Bytes::Human->import(qw(format_bytes));
};

if ($@)
{
	sub format_bytes { return $_[0]; }
}


1;