require UNIVERSAL::require;
use POSIX qw/:sys_wait_h :errno_h/;
-#use Sip qw(readline);
+use Sip qw($protocol_version);
use Sip::Constants qw(:all);
use Sip::Configuration;
use Sip::Checksum qw(checksum verify_cksum);
use Sip::MsgType;
-use File::Queue;
-use FreezeThaw qw(freeze thaw);
-
-my $mp_fifo = File::Queue->new( File => "/tmp/SIPServer.mulitplex-fifo.$$" );
-END { $mp_fifo->delete };
+use Cache::Memcached;
use constant LOG_SIP => "local6"; # Local alias for the logging facility
print Dumper(@parms);
+# initialize all remaining global variables before
+# going into listen mode.
+my %kid_hash;
+my $kid_count = 0;
+my $cache;
+my @pending_connections;
+my %active_connections;
+
#
# This is the main event.
SIPServer->run(@parms);
# an incoming connection request when the peronsality is
# Multiplex.
-my %kid_hash;
-my $kid_count = 0;
sub REAPER {
for (keys(%kid_hash)) {
$SIG{CHLD} = sub { REAPER() };
}
-my %active_connections;
-sub PERMAFROST {
- while (my $login = $mp_fifo->deq) {
- ($login) = thaw($login);
-
- my $c = $$login{id};
- if ($$login{success}) {
- for my $p (keys %{ $$login{net_server_parts} }) {
- $active_connections{$c}{net_server}{$p} =
- $$login{net_server_parts}{$p};
- }
- } else {
- delete $active_connections{$c};
- }
+sub init_cache {
+ return $cache if $cache;
+
+ if (!$config->{cache}) {
+ syslog('LOG_ERR', "Cache servers needed");
+ return;
}
+ my $servers = $config->{cache}->{server};
+ syslog('LOG_DEBUG', "Cache servers: @$servers");
+
+ $cache = Cache::Memcached->new({servers => $servers}) or
+ syslog('LOG_ERR', "Unable to initialize memcache: @$servers");
+
+ return $cache;
+}
+
+# In the parent, pending connections are tracked as an array of PIDs.
+# As each child process completes the login dance, it plops some
+# info into memcache for us to pickup and copy into our active
+# connections. No memcache entry means the child login dance
+# is still in progress.
+sub check_pending_connections {
+ return unless @pending_connections;
+
+ init_cache();
+
+ syslog('LOG_DEBUG',
+ "multi: pending connections to inspect: @pending_connections");
+
+ # get_multi will return all completed login blobs
+ my @keys = map { "sip_pending_auth_$_" } @pending_connections;
+ my $values = $cache->get_multi(@keys);
+
+ for my $key (keys %$values) {
+ my $VAR1; # for Dump() -> eval;
+ eval $values->{$key}; # Data::Dumper->Dump string
+
+ my $id = $VAR1->{id};
+ $active_connections{$id}{net_server} = $VAR1->{net_server_parts};
+ delete $active_connections{$id} unless $VAR1->{success};
+
+ # clean up ---
+
+ (my $pid = $key) =~ s/sip_pending_auth_(\d+)/$1/g;
+
+ syslog('LOG_DEBUG',
+ "multi: pending connection for pid=$pid / id=$id resolved");
+
+ $cache->delete($key);
+ @pending_connections = grep {$_ != $pid} @pending_connections;
+ }
+
+ syslog('LOG_DEBUG',
+ "multi: connections still pending after check: @pending_connections")
+ if @pending_connections;
}
sub mux_input {
REAPER();
# and process any pending logins
- PERMAFROST();
+ check_pending_connections();
my $c = scalar(keys %active_connections);
syslog("LOG_DEBUG", "multi: new active connection; $c total");
if ($pid == 0) { # in kid
+ $cache = undef; # don't use the same cache handle as our parent.
+ my $cache_data = {id => $conn_id};
+
+ # Once the login dance is complete in SipMsg, login_complete() is
+ # called so that we may cache the results before the login response
+ # message is delivered to the client.
+ $self->{login_complete} = sub {
+ my $status = shift;
+
+ if ($status) { # login OK
+
+ $self->{state} = $self->{ils}->state() if (UNIVERSAL::can($self->{ils},'state'));
+
+ # Evergreen, at least, needs a chance to clean up before forking for other requests
+ $self->{ils}->disconnect() if (UNIVERSAL::can($self->{ils},'disconnect'));
+
+ # Stash the ILS module somewhere handy for later
+ $self->{ils} = ref($self->{ils});
+
+ $cache_data->{success} = 1;
+ $cache_data->{net_server_parts} = {
+ map { ($_ => $$self{$_}) } qw/ils state institution account/
+ };
+ } else {
+ $cache_data->{success} = 0;
+ }
+
+ init_cache()->set(
+ "sip_pending_auth_$$",
+ Data::Dumper->Dump([$cache_data]),
+ # Our cache entry is only inspected when the parent process
+ # wakes up from an inbound request. If this is the last child
+ # to connect before a long period of inactivity, our cache
+ # entry may sit unnattended for some time, hence the
+ # 12 hour cache timeout. XXX: make it configurable?
+ 43200 # 12 hours
+ );
+
+ $self->{login_complete_called} = 1;
+ };
+
eval { &$transport($self, $str_fh) };
- my $success = 1;
if ($@) {
syslog('LOG_ERR', "ILS login error: $@");
- $success = 0;
- } else {
- # Grab any state data for later
- $self->{state} = $self->{ils}->state() if (UNIVERSAL::can($self->{ils},'state'));
-
- # Evergreen, at least, needs a chance to clean up before forking for other requests
- $self->{ils}->disconnect() if (UNIVERSAL::can($self->{ils},'disconnect'));
-
- # Stash the ILS module somewhere handy for later
- $self->{ils} = ref($self->{ils});
+ $self->{login_complete}->(0) unless $self->{login_complete_called};
}
- $mp_fifo->enq(
- freeze({
- id => $conn_id,
- success => $success,
- net_server_parts => {
- map { ($_ => $$self{$_}) } qw/ils state institution account/
- }
- })
- );
-
exit(0);
+
+ } else {
+ push(@pending_connections, $pid);
}
+ # nothing else for the parent to do until login completes
return; # NEXT CUSTOMER PLEASE STEP UP
}
if ($pid == 0) { # in kid
# build the connection we deleted after logging in
+ $self->{ils}->use; # module name in the parent
$self->{ils} = $self->{ils}->new($self->{institution}, $self->{account}, $self->{state});
+ # MUX mode only works with protocol version 2, because it assumes
+ # a SIP login has occured. However, since the login occured
+ # within a different now-dead process, the previously modified
+ # protocol_version is lost. Re-apply it globally here.
+ $protocol_version = 2;
+
if (!$self->{ils}) {
syslog('LOG_ERR', "Unable to build ILS module in mux child");
exit(0);