#!/usr/bin/perl -w
#
# freeside-selfservice-clientd
#
# This is run REMOTELY over ssh by freeside-selfservice-server

use strict;
use subs qw(spawn logmsg);
use Fcntl qw(:flock);
use Socket;
use Storable qw(nstore_fd fd_retrieve);
use IO::Handle;
use IO::Select;
use IPC::Open2;

use LockFile::Simple qw(lock unlock);

use vars qw( $Debug );
$Debug = 2;

my $socket = "/usr/local/freeside/selfservice_socket";
my $pid_file = "$socket.pid";
my $lock_file = "$socket.lock";
unlink $lock_file;

my $me = '[client]';

$|=1;

#read data to be cached or something
#warn "$me Reading init data\n" if $Debug;
#my $signup_init = 

warn "[client] Creating $socket\n" if $Debug;
my $uaddr = sockaddr_un($socket);
my $proto = getprotobyname('tcp');
socket(Server,PF_UNIX,SOCK_STREAM,0) or die "socket: $!";
unlink($socket);
bind(Server, $uaddr) or die "bind: $!";
listen(Server,SOMAXCONN) or die "listen: $!";

if ( -e $pid_file ) {
  open(PIDFILE,"<$pid_file");
  #chomp( my $old_pid = <PIDFILE> );
  my $old_pid = <PIDFILE>;
  close PIDFILE;
  $old_pid =~ /^(\d+)$/;
  kill 'TERM', $1;
}
open(PIDFILE,">$pid_file");
print PIDFILE "$$\n";
close PIDFILE;

#my $waitedpid;
#sub REAPER { $waitedpid = wait; $SIG{CHLD} = \&REAPER; }
#$SIG{CHLD} =  \&REAPER;

warn "[client] entering main loop\n" if $Debug;

#sub spawn;
#sub logmsg;

my %kids;

  #    my $gar = <STDIN>;

#my $s = new IO::Select;
#$s->add(\*STDIN);
#$s->add(\*Server);

#for ( $waitedpid = 0;
#      accept(Client,Server) || $waitedpid;
#      $waitedpid = 0, close Client)
#{
#  next if $waitedpid;

#$SIG{PIPE} = sub { warn "SIGPIPE received" };
#$SIG{CHLD} = sub { warn "SIGCHLD received" };

sub REAPER { warn "SIGCHLD received"; my $pid = wait; $SIG{CHLD} = \&REAPER; }
#sub REAPER { my $pid = wait; delete $kids{$pid}; $SIG{CHLD} = \&REAPER; }
$SIG{CHLD} =  \&REAPER;

warn "[client] creating IO::Select\n" if $Debug;
my $s = new IO::Select;
$s->add(\*STDIN);
$s->add(\*Server);

while (1) {

warn "[client] waiting for connection or token\n" if $Debug;
while ( my @handles = $s->can_read ) {

  foreach my $handle ( @handles ) {

    if ( $handle == \*STDIN ) {

#      my $gar = <STDIN>;
#      die $gar;

      my $packet = fd_retrieve(\*STDIN);
      my $token = $packet->{'_token'};
      warn "[client] received packet with token $token\n".
           join('', map { " $_=>$packet->{$_}\n" } keys %$packet )
        if $Debug;
     if ( exists($kids{$token}) ) {
        warn "[client] sending return packet to $token via $kids{$token}\n"
          if $Debug;
        nstore_fd($packet, $kids{$token});
        warn "[client] flushing $kids{$token}\n" if $Debug;
        $kids{$token}->flush;
        #eval { $kids{$token}->flush; };
        #die "error flushing?!?!? $@\n" if $@ ne '';
        #warn "[client] closing $kids{$token}\n";
        #close $kids{$token};
        #warn "[client] deleting $kids{$token}\n";
        #delete $kids{$token};
        warn "[client] done with $token\n" if $Debug;
      } else {
        warn "[client] WARNING: unknown token $token, discarding message";
        #die "[client] FATAL: unknown token $token, discarding message";
      }

    } elsif ( $handle == \*Server ) {

      warn "[client] received local connection; forking\n" if $Debug;

      accept(Client, Server);

      spawn sub { #child
        warn "[client-$$] reading packet from local client" if $Debug > 1;
        my $packet = fd_retrieve(\*Client);
        warn "[client-$$] packet received:\n".
             join('', map { " $_=>$packet->{$_}\n" } keys %$packet )
          if $Debug > 1;
        my $command = $packet->{'command'};
        #handle some commands weirdly?
        $packet->{_token}=$$; #??

        warn "[client-$$] sending packet to remote server" if $Debug > 1;
        flock(STDOUT, LOCK_EX); #acquire write lock
        #lock($lock_file);
        nstore_fd($packet, \*STDOUT);
        STDOUT->flush;
        #unlock($lock_file);
        flock(STDOUT, LOCK_UN); #release write lock

        warn "[client-$$] waiting for response from parent" if $Debug > 1;

        #block until parent has a message
        my $w = new IO::Select;
        $w->add(\*STDIN);
        my @wait = $w->can_read;
        my $rv = fd_retrieve(\*STDIN);

        #close STDIN;

        warn "[client-$$] sending response to local client" if $Debug > 1;

        #send message to local client
        nstore_fd($rv, \*Client);
        Client->flush;

        close Client;

        warn "[client-$$] child exiting" if $Debug > 1;

        #while (1) { sleep 5 };
        #sleep 5;
        exit;

      }; #eo child

      #close Client; #in parent, right?

    } else {
      die "wtf?  $handle";
    }

  }

  warn "[client] done handling messages; returning to wait-state" if $Debug;;

}

#die "[client] died unexpectedly: $!\n";
warn "[client] fell-through unexpectedly: $!\n" if $Debug;

} #WTF?

sub spawn {
    my $coderef = shift;

    unless (@_ == 0 && $coderef && ref($coderef) eq 'CODE') {
        use Carp;
        confess "usage: spawn CODEREF";
    }

    my $pid;
    #if (!defined($pid = fork)) {
    my $kid = new IO::Handle;
    if (!defined($pid = open($kid, '|-'))) {
        logmsg "WARNING: cannot fork: $!";
        return;
    } elsif ($pid) {
        logmsg "begat $pid" if $Debug;
        $kids{$pid} = $kid;
        #$kids{$pid}->autoflush;
        return; # I'm the parent
    }
    # else I'm the child -- go spawn

#    open(STDIN,  "<&Client")   || die "can't dup client to stdin";
#    open(STDOUT, ">&Client")   || die "can't dup client to stdout";
    ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
    exit &$coderef();
}

#sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }
#DON'T PRINT!!!!!
sub logmsg { warn "[client] $0 $$: @_ at ", scalar localtime, "\n" }