summaryrefslogtreecommitdiff
path: root/lib/Multi/Core.pm
blob: 076edf51f50d444e6cffc033315cb8a7cbf3fccd (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124

#
#  Multi::Core  -  handles logging and the main command queue
#

package Multi::Core;

use strict;
use warnings;
use POE;
use POE::Component::Pg;
use DBI;
use POSIX 'setsid', 'pause', 'SIGUSR1';


sub run {
  my $p = shift;

  die "PID file already exists\n" if -e "$VNDB::ROOT/data/multi.pid";

  # fork
  my $pid = fork();
  die "fork(): $!" if !defined $pid or $pid < 0;

  # parent process, log PID and wait for child to initialize
  if($pid > 0) {
    $SIG{CHLD} = sub { die "Initialization failed.\n"; };
    $SIG{ALRM} = sub { kill $pid, 9; die "Initialization timeout.\n"; };
    $SIG{USR1} = sub {
      open my $P, '>', "$VNDB::ROOT/data/multi.pid" or kill($pid, 9) && die $!;
      print $P $pid;
      close $P;
      exit;
    };
    alarm(10);
    pause();
    exit 1;
  }

  # spawn our SQL handling session
  my @db = @{$VNDB::O{db_login}};
  my(@dsn) = DBI->parse_dsn($db[0]);
  $dsn[2] = ($dsn[2]?$dsn[2].',':'').'pg_enable_utf8=>1';
  $db[0] = "$dsn[0]:$dsn[1]($dsn[2]):$dsn[4]";
  POE::Component::Pg->spawn(alias => 'pg', dsn => $db[0], user => $db[1], password => $db[2]);

  # spawn the core session (which handles logging & external signals)
  POE::Session->create(
    package_states => [
      $p => [qw| _start log pg_error sig_shutdown shutdown |],
    ],
  );

  $poe_kernel->run();
}


sub _start {
  $_[KERNEL]->alias_set('core');
  $_[KERNEL]->call(core => log => 'Starting Multi '.$VNDB::S{version});
  $_[KERNEL]->post(pg => register => error => 'pg_error');
  $_[KERNEL]->post(pg => 'connect');
  $_[KERNEL]->sig(INT => 'sig_shutdown');
  $_[KERNEL]->sig(TERM => 'sig_shutdown');
  $_[KERNEL]->sig('shutdown', 'shutdown');

  # dynamically load and spawn modules
  for (keys %{$VNDB::M{modules}}) {
    my($mod, $args) = ($_, $VNDB::M{modules}{$_});
    next if !$args || ref($args) ne 'HASH';
    require "Multi/$mod.pm";
    # I'm surprised the strict pagma isn't complaining about this
    "Multi::$mod"->spawn(%$args);
  }

  # finish daemonizing
  kill SIGUSR1, getppid();
  setsid();
  chdir '/';
  umask 0022;
  $SIG{__WARN__} = sub {(local$_=shift)=~s/\r?\n//;$poe_kernel->call(core=>log=>'__WARN__: '.$_)};
  close STDOUT;
  close STDERR;
  close STDIN;
}


sub log { # level, msg
  (my $p = eval { $_[SENDER][2]{$_[CALLER_STATE]}[0] } || '') =~ s/^Multi:://;
  my $msg = sprintf '%s::%s: %s', $p, $_[CALLER_STATE],
    $_[ARG1] ? sprintf($_[ARG0], @_[ARG1..$#_]) : $_[ARG0];

  open(my $F, '>>', $VNDB::M{log_dir}.'/multi.log');
  printf $F "[%s] %s\n", scalar localtime, $msg;
  close $F;
}


sub pg_error { # ARG: command, errmsg, [ query, params, orig_session, event-args ]
  my $s = $_[ARG2] ? sprintf ' (Session: %s, Query: "%s", Params: %s, Args: %s)',
    join(', ', $_[KERNEL]->alias_list($_[ARG4])), $_[ARG2],
    join(', ', $_[ARG3] ? map qq|"$_"|, @{$_[ARG3]} : '[none]'), $_[ARG5]||'' : '';
  $_[KERNEL]->call(core => log => 'SQL Error for command %s: %s %s', $_[ARG0], $_[ARG1], $s);
}


sub sig_shutdown {
  # Multi modules should listen to the shutdown signal (but should never call sig_handled() on it!)
  $_[KERNEL]->signal($_[SESSION], 'shutdown', 'SIG'.$_[ARG0]);
  # consider this event as handled, so our process won't be killed directly
  $_[KERNEL]->sig_handled();
}


sub shutdown {
  $_[KERNEL]->call(core => log => 'Shutting down (%s)', $_[ARG1]);
  $_[KERNEL]->post(pg => 'shutdown');
  $_[KERNEL]->alias_remove('core');
  unlink "$VNDB::ROOT/data/multi.pid";
}


1;