#!/usr/bin/perl -w

# ==============================================================================
# IMIP TEST MID
# ==============================================================================


use strict;

use IO::Socket;
use Fcntl;

use Errno qw(EWOULDBLOCK);

$| = 1;


# ------------------------------------------------------------------------------
# constants

my $MSG_EOL = "\015\012";
my $MSG_TERM = $MSG_EOL;
my $MSG_EOL_ACCEPT = '\015?\012';
my $MSG_TERM_ACCEPT = "$MSG_EOL_ACCEPT$MSG_EOL_ACCEPT";
my $MAX_CHUNK = 62*1024;

my $debug = 0;
my $monitor = 0;


# ------------------------------------------------------------------------------
# command line arguments

if (@ARGV and $ARGV[0] =~ /^-[d|D]$/) {
    my $opt = shift;
    $debug = $opt eq '-d' ? 1 : 2;
}
die "syntax: $0 mux_sock n_deployments n_customers_per_deployment [server|client]"
    unless @ARGV == 3 || @ARGV == 4;
my ($mux_socket, $n_deployments, $n_customers_per_deployment, $cs) = @ARGV; @ARGV = ();
$cs ||= 'both';


# ------------------------------------------------------------------------------
# connect to the mux

my $sock_mux = IO::Socket::UNIX->new( Peer => $mux_socket )
    or die "cannot connect to mux";

send_message('hello_mid', '.', 1, time => time);

receive_messages();


# ------------------------------------------------------------------------------
# main test

my $seq_my_ref = 1;

my $client_prob = 0.90;
my $fortune_prob = 0.0;#0.5;
my $print_prob = 0.01;
my $null_cust_prob = 0.5;

my $next_server = ($cs eq 'server' or rand > $client_prob and not $cs eq 'client');
send_message('state', '.', '.', state => 'free') if $next_server;
while(1) {
    if ($next_server) {
	$next_server = ($cs eq 'server' or rand > $client_prob and not $cs eq 'client');
	server();
    } else {
	client();
    }
    print "$seq_my_ref" if $seq_my_ref % 100 == 0 and $monitor == 1;
}


# ------------------------------------------------------------------------------
# be a server for one request

sub server {
#    send_message('state', '.', '.', state => 'free');

    my @request = receive_messages();

    my $request = shift @request;

    die 'too many requests' if @request;

    $seq_my_ref ++;
    
#    send_message('state', '.', '.', state => 'busy_remote'); - the state is automatically changed by the mux

    if ($request->{type} eq 'fortune') {
	my $fortune = `/usr/games/fortune`;
	# don't want to cache these!!
	send_message( 'response', $request->{your_ref}, '.',
		      state => ($next_server ? 'free' : 'busy_local'),
		      $fortune );
    } else {
	send_message( 'response', $request->{your_ref}, '.',
		      cache_until => time+5,
		      # cache key must be returned, in case there are some NULLs
		      cache_key => "$request->{type} $request->{identifier} $request->{requester}",
		      state => ($next_server ? 'free' : 'busy_local'),
		      "Here is my lovely reply of '$request->{identifier}' for '$request->{requester}'.\nI hope you enjoy it\n" );
    }

    print "." if $monitor == 2;
}


# ------------------------------------------------------------------------------
# be a client for one request

sub client {
#    send_message('state', '.', '.', state => 'busy_local');
#    print "press enter!";
#    my $enter = <>;

    my $dest_depl = int rand $n_deployments;

    my $dest_cust;

    if (rand() < $null_cust_prob) {
	$dest_cust = 'NULL';
    } else {
	$dest_cust = "c_${dest_depl}_". (int rand $n_customers_per_deployment);
    }

    if (rand() < $fortune_prob) {
	send_message('request', '.', $seq_my_ref ++,
		     type => 'fortune',
		     identifier => "$dest_depl $dest_cust fortune ?",
		     requester => "snc mi admin sam" );
    } else {
	send_message('request', '.', $seq_my_ref ++,
		     type => 'object',
		     identifier => "$dest_depl $dest_cust MiniForum 1004",
		     requester => "snc mi teaching sophie" );
    }

    my @reply = receive_messages();

    my $reply = shift @reply;

    die 'too many replies' if @reply;

    if ($reply->{msg_type} eq 'error') {
	print ">> $reply->{message}\n";
    } elsif (rand() < $print_prob) {
	print "$reply->{body}\n";
    }

    print exists $reply->{body} ? "*" : "!" if $monitor == 2;
}


# ------------------------------------------------------------------------------
# send a message to the mux socket
# the paramater spec is: your_ref my_ref [key1 val1]* [body]

sub send_message {
    my $body = @_ % 2 ? '' : pop;
    my ($msg_type, $your_ref, $my_ref) = splice @_, 0, 3;

    my $message = "$msg_type $your_ref $my_ref$MSG_EOL";
    $message .= (shift) .": ". (shift) . $MSG_EOL while @_;
    $message .= 'body_length: '. length($body) . $MSG_EOL if length $body;

    $message .= $MSG_TERM . $body;

    my $n = 0;
    do {
	$n += syswrite $sock_mux, $message;
    } while $n < length $message;

    # debug message:
    chomp (my $debug_msg = "SENT:\n". $message);
    vmessage($debug_msg);
}


# ------------------------------------------------------------------------------
# receive all messages waiting on the mux socket

sub receive_messages {
    my @messages = ();

    my $buffer = '';
    do {
	my $n = sysread $sock_mux, $buffer, $MAX_CHUNK, length $buffer;
	if (not defined $n) {
	    return () if $! == EWOULDBLOCK;
	    message("error reading: $!");
	} elsif ($n == 0) {
	    message("connection closed");
	    exit 0;
	} else {
	    if ($buffer =~ s/^(.*?)$MSG_TERM_ACCEPT//so) {
		my @lines = split /$MSG_EOL_ACCEPT/so, $1;
		my ($msg_type, $my_ref, $your_ref) = split /\s+/, shift @lines;
		my %fields = map { split /:\s*/, $_, 2 } @lines;
		
		vmessage("RECEIVED:\n". "$msg_type $my_ref $your_ref\n". (join '', map {"$_\n"} @lines). ".");
		
		@fields{qw(msg_type my_ref your_ref)} = ($msg_type, $my_ref, $your_ref);
		
		my $body_length;
		if (defined ($body_length = delete $fields{body_length})) {
		    until($body_length <= length $buffer) {
			sysread $sock_mux, $buffer, $MAX_CHUNK, length $buffer;
		    }
		    $fields{body} = substr $buffer, 0, $body_length, '';
		    
		    vmessage("BODY: $fields{body}");
		}
		push @messages, \%fields;
	    }
	}
    } until $buffer eq '';

    return @messages;
}


# ------------------------------------------------------------------------------
# print debugging messages

sub message {
    print shift, "\n" if $debug;
}

# only if verbose!
sub vmessage {
    print shift, "\n" if $debug == 2;
}


# ------------------------------------------------------------------------------
# make the socket blocking / non-blocking

sub nonblock {
    my $flags;
    
    $flags = fcntl($sock_mux, F_GETFL, 0)
	|| die "Can't get flags";
    fcntl($sock_mux, F_SETFL, $flags | O_NONBLOCK)
	|| die "Can't set flags";
}

sub block {
    my $flags;
    
    $flags = fcntl($sock_mux, F_GETFL, 0)
	|| die "Can't get flags";
    fcntl($sock_mux, F_SETFL, $flags &~ O_NONBLOCK)
	|| die "Can't set flags";
}