#!/usr/bin/perl
use warnings;
use strict;
use Glib qw(TRUE FALSE);
use Gtk2 -init;
use IO::Socket::SSL;
$IO::Socket::SSL::DEBUG = 3;
use IO::Socket::Timeout;

# gtk2ssl-server, start server, then connect with gtk2ssl-client(s)

$|++;

my @clients; #used for server messaging to clients

my $address = 'localhost:7070';

my $server = IO::Socket::SSL->can_ipv6 ->new(
    Listen => 5,
    LocalAddr => $address,
    Reuse => 1,
    timeout => .1
) or die "failed to create SSL server at $address : $!";

print "listening on $address\n";

# Enable read and write timeouts on the socket
IO::Socket::Timeout->enable_timeouts_on($server);
# Setup the timeouts
$server->read_timeout(0.5);
$server->write_timeout(0.5);

my $ctx = IO::Socket::SSL::SSL_Context->new(
    SSL_server => 1,
    SSL_cert_file => './host.crt',
    SSL_key_file  => './host.key',
    SSL_verify_mode => 0x00,  #SSL_VERIFY_PEER | SSL_VERIFY_FAIL_IF_NO_PEER_CERT
    ) or die "cannot create context: $SSL_ERROR";

print "\n",$server,' fileno ',fileno($server),"\n";

if( ! defined $server){ 
          print "\nERROR: Can't connect to $address: $!\n" ;
          exit;
  } else{ print "\nServer up and running on $address\n" }


my $con_watcher = Glib::IO->add_watch ( fileno( $server ), 
                 'in', \&new_connection, $server );

my $stdin_watcher = Glib::IO->add_watch ( fileno( 'STDIN' ), 
                 'in', \&watch_stdin, 'STDIN' );

# make entry widget larger, colored text
Gtk2::Rc->parse_string(<<__);

style "my_entry" {
  font_name ="arial 18"
  text[NORMAL] = "#FF0000"
}

style "my_text" {
font_name ="sans 18"
text[NORMAL] = "#FFAA00"
base[NORMAL] = "#000000"   
GtkTextView::cursor-color = "red"
}
style "my_cursor"{
fg[NORMAL] = "#FF0000"
}

widget "*Text*" style "my_text"
widget "*Entry*" style "my_entry"
__

my $window = Gtk2::Window->new;
$window->signal_connect( delete_event => sub { $server->close;
                                               print "Server shutdown\n";
                                               exit } );
$window->set_default_size( 700, 300 );

my $vbox = Gtk2::VBox->new;
$window->add($vbox);

my $scroller = Gtk2::ScrolledWindow->new;
$vbox->add($scroller);
my $textview = Gtk2::TextView->new;
$textview ->set_editable (0); #read-only text
$textview ->can_focus(0);     #

my $buffer = $textview->get_buffer;
$buffer->create_mark( 'end', $buffer->get_end_iter, FALSE );

$buffer->signal_connect(
    insert_text => sub {
        $textview->scroll_to_mark( $buffer->get_mark('end'), 0.0, TRUE, 0, 0.5 );
    }
);

$scroller->add($textview);

my $entry = Gtk2::Entry->new();
$vbox->pack_start( $entry, FALSE, FALSE, 0 );
$vbox->set_focus_child ($entry); # keeps cursor in entry
$window->set_focus_child ($entry); # keeps cursor in entry

# allows for sending each line with an enter keypress
my $send_sig = $entry->signal_connect ('key-press-event' => sub {
         my ($widget,$event)= @_;
         if( $event->keyval() == 65293){  # a return key press
                my $text = $entry->get_text;
                 root_message( $text ); 
	         
	         $entry->set_text('');
	         $entry->set_position(0);
	 }
   });

#If you store the ID returned by signal_connect, you can temporarily
#block your signal handler with
#  $object->signal_handler_block ($handler_id)
#    and unblock it again when you're done with
##        $object->signal_handler_unblock ($handler_id).

# we want to block/unblock the enter keypress depending
# on the state of the socket
#$entry->signal_handler_block($send_sig); #not connected yet
#$entry->set_editable(0);

#my $button = Gtk2::Button->new('Connect');
#$button->signal_connect( clicked => \&init_connect );
#$vbox->pack_start( $button, FALSE, FALSE, 0 );

my $bexit = Gtk2::Button->new('Exit');
$bexit->signal_connect( clicked => sub{ 
                print "clients -> @clients\n";
                foreach my $cli (@clients){$cli->close;}
                exit;
               });
$vbox->pack_start( $bexit, FALSE, FALSE, 0 );

$window->show_all;

$buffer->insert( $buffer->get_end_iter, "Server up and running on $address\n" );

Gtk2->main;
exit;


sub new_connection{
    my ( $fd, $condition, $fh ) = @_;
    print  "NEW CONNECTION callback start $fd, $condition, $fh\n"; 

    # this grabs the incoming connections and hands them off to
    # a client_handler
   
     my $client = $server->accept() or warn "Can't accept connection @_\n";
     $client->autoflush(1);
    
    
    # test for SSL connection, if not close client
     IO::Socket::SSL->start_SSL($client, SSL_server => 1, SSL_reuse_ctx => $ctx) or do {
	 warn "ssl handshake failed: $SSL_ERROR\n";
         my $peerAddress = $client->peerhost();
         my $peerPort = $client->peerport();
         warn "bad incoming from $peerAddress $peerPort\n"; 
         
         $buffer->insert( $buffer->get_end_iter, 
           "client $client ssl handshake failed:
            $SSL_ERROR from $peerAddress $peerPort; \n" );
         $client->close;
         
        return 1; # this client is no good, return and keep this callback installed
    };

    # if a good ssl connection             
      if ($client ){
         $buffer->insert( $buffer->get_end_iter, "Accepted a client $client\n" );
         push @clients, $client; # for root messaging

        # make a listener for this client
        my $client_listener = Glib::IO->add_watch ( fileno( $client ), 
                     ['in', 'hup', 'err'], \&handle_connection, $client );
      }
}


sub handle_connection{
    my ( $fd, $condition, $client ) = @_;
#   print  "handle connection $fd, $condition, $client\n"; 
   
  # since 'in','hup', and 'err' are not mutually exclusive,
  # they can all come in together, so test for hup/err first

     if ( $condition >= 'hup' or $condition >= 'err' ) {
        # End Of File, Hang UP, or ERRor.  that means
        # we're finished.
        $buffer->insert( $buffer->get_end_iter, "Nohup or err received from $client\n" );
        #print "\nhup or err received\n";
        #close socket
        @clients = grep { $_ ne $client } @clients; #remove from connected list                   
        $client->close;
        $client = undef;
        
        return 0;  #stop this callback 
      }
    
    # if the client still exists, get data and return 1 to keep callback alive
    if ($client) {
      if ( $condition >= 'in' ){
        #  data available for reading
        my $bytes = sysread($client,my $data,16324);
        if ( defined $data ) {
            # do something useful with the text.

           $buffer->insert( $buffer->get_end_iter, "$data\n" );
           print $client "$data\n";  #echo back
        }
      }

        # the file handle is still open, so return TRUE to
        # stay installed and be called again.
        # print "still connected\n";
        # possibly have a "connection alive" indicator
        #print "still alive\n";
        return 1;
    }
    else {

        # we're finished with this job.  start another one,
        # if there are any, and uninstall ourselves. 

        $buffer->insert( $buffer->get_end_iter, "client $client exiting\n" );
      
        return 0;  #end this callback
    
    }

}
#end of client callback    


sub root_message {
        
        #sent to all clients 
        my $text = $_[0];
       # print "$text\n";
        
        $buffer->insert( $buffer->get_end_iter, "ROOT MESSAGE-> $text\n" );
        	
	foreach my $cli(@clients){
             
             if($cli->connected){
                 print $cli 'ROOT MESSAGE-> ', "$text\n"; 
                }else{
                  # remove dead client
                  @clients = grep { $_ ne $cli } @clients;                   
                }	   
	   }
	
	#always return TRUE to continue the callback
	return 1;
}
__END__