That only leaves the problem of how to use a certificate in the client, so I can use a real verify_mode.

So here is the improved Server. The client has not changed, and it is in the original post below.

#!/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 $add
+ress\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_ct
+x => $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 callb
+ack installed
    };

    # if a good ssl connection             
      if ($client ){
         $buffer->insert( $buffer->get_end_iter, "Accepted a client $c
+lient\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, $clien
+t );
      }
}


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 conne
+cted list                   
        $client->close;
        $client = undef;
        
        return 0;  #stop this callback 
      }
    
    # if the client still exists, get data and return 1 to keep callba
+ck 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 exitin
+g\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__
[download]

Original Post and code

Hi, this code is based on my previous post Gtk2 server and client GUI's with root messaging. I wanted to make the connection SSL, so this is my effort to convert it to use IO::Socket::SSL. It works for me fine on Linux.

When I first started searching google for IO::Socket::SSL example code, I could not find any complete set of running server and client. All there was were snippets of code, pointing in the right direction, but no actual code examples. There were plenty of connection examples, which would connect then exit, nothing with persistence. The following code examples are persistent.

Even the examples given in the IO::Socket::SSL's examples directory were hard to use, the use of GetOpt long obfuscated the script to make it look like mangled javascript. :-)

I sorted it all out, and here are my findings. They say that IO::Socket::SSL is a drop-in-replacement the IO::Socket::INET but there are alot of things to watch out for.

First, you need to use an IO::Socket::SSL::SSL_Context object to start_SSL on client sockets as they are accepted.

Second, you cannot use a READLINE or variant to read and write the sockets. The SSL sockets are sent in frames of 16k (iirc), and newlines are meaningless in encrypted transfers. So use sysread and syswrite.

Third, using select with the accepted clients can be tricky. Fortunately, Gtk2 handles it's socket callbacks with great detail, and it works. Read the code and see the detail in the Glib::IO->add_watch handlers.

Fourth, self-generated certificates and keys will work, but with SSL_verify_mode => 0. This makes it susceptible to man in the middle attacks because you have no way to verify the keys. But it is about the only way to get the encryption going without a real Certificate of Authority. I'm just happy enough that nothing is sent in clear text over the network, and there are further protections you can take, like adding a symmetric encryption layer to all text using a mutally agreed upon common key between the server and client. That technique is not shown here, but is left up to you. :-)

The easiest program I've found for sniffing the ports to watch the encryptions is tcpflow

So here is the server and client, and hopefully it will stimulate someone or help someone who is looking for working snippets. Any improvements would be welcome, especially in how to verify with self-certified certs. The docs mention something about using key fingerprints, but that eludes me for now.

Start the server, then start a few clients. Send text back and forth by entering text in the bottom Entry widgets. Play around killing the server or a client and watch the debug output.

THE SERVER:

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

# 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,
) or die "failed to create SSL server at $address : $!";

print "listening on $address\n";

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{ 
                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 $add
+ress\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);
    
     IO::Socket::SSL->start_SSL($client, SSL_server => 1, SSL_reuse_ct
+x => $ctx) or do {
    warn "ssl handshake failed: $SSL_ERROR\n";
    next;
    };
    
     $buffer->insert( $buffer->get_end_iter, "accepted a client $clien
+t\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, $clien
+t );
}


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
        $client->close;
        $client = undef;
   
        return 0;  #stop this callback 
      }
    
    # if the client still exists, get data and return 1 to keep callba
+ck alive
    if ($client) {
      if ( $condition >= 'in' ){
        #  data available for reading
        my $bytes = sysread($client,my $data,1024);
        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 exitin
+g\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__
[download]

THE CLIENT

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

# gtk2ssl-client

my $name = shift || 'anon'.time;
my $host = 'localhost';
my $port = 7070;
my $socket;

# 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 { exit } );
$window->set_default_size( 500, 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;
        if(defined $socket){ print $socket $name.'->'. $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{ exit  } );
$vbox->pack_start( $bexit, FALSE, FALSE, 0 );

$window->show_all;

Gtk2->main;
exit;


sub init_connect{

       $socket = IO::Socket::SSL->new(
             PeerAddr => $host,
             PeerPort => $port,
             Proto    => 'tcp',
             SSL_verify_mode => 0, #will work but less secure
           );
       
       if( ! defined $socket){ 
            $buffer->insert( $buffer->get_end_iter, 
            "ERROR: Can't connect to port $port on $host: $!\n" );
        return;
        }else{
          $buffer->insert( $buffer->get_end_iter, "Connected\n"); 
        }
      
      #if we have a socket
      $button->set_label('Connected');
      $button->set_state('insensitive');
 
        # install an io watch for this stream and
        # return immediately to the main caller, who will return
        # immediately to the event loop.  the callback will be
        # invoked whenever something interesting happens.
        Glib::IO->add_watch( fileno $socket, [qw/in hup err/], \&watch
+_callback, $socket );

       #turn on entry widget
       $entry->set_editable(1);
       $entry->grab_focus;
       $entry->signal_handler_unblock ($send_sig);
       Gtk2->main_iteration while Gtk2->events_pending; 
}


sub watch_callback {
    my ( $fd, $condition, $fh ) = @_;
    
    print "$fd, $condition, $fh\n"; 

    if ( $condition >= 'in' ) {

        # there's data available for reading.  
        my $bytes = sysread($fh,my $data,8192);


   # it seems if the server connection is lost
   # the condition is still 'in', not nohup or err
   # so test for zero data length
   
        if ( length $data ) {
            # do something useful with the text.
           
            $buffer->insert( $buffer->get_end_iter, "$data" );
        }
       
       else{
        # close socket as there is no data
        print "server closed\n";
        #$socket->close;
        $socket->close(
            SSL_no_shutdown => 1, 
            SSL_ctx_free    => 1,    
           ) or die "shutdown not ok: $SSL_ERROR";
         print "OK: socket shutdown ok ... Closed\n";

        $fh->close;
        $fh = undef;
     
        # stop ability to send 
        $entry->set_editable(0);
        $entry->signal_handler_block ($send_sig);
        
        $buffer->insert( $buffer->get_end_iter, "Server connection los
+t !!\n" );
 
        #allow for new connection
        $button->set_label('Connect');
        $button->set_sensitive(1);
        $button->grab_focus;
        Gtk2->main_iteration while Gtk2->events_pending; 
          
       }
      
    }
    


    if ($fh) {

        # 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
        return TRUE;
    }
    else {

        # we're finished with this job.  start another one,
        # if there are any, and uninstall ourselves. 
        print "done\n";
        return FALSE;
    }

}

__END__
[download]

THE CERTIFICATE GENERATOR: create-keys-host

#!/bin/bash

openssl genrsa -out rootCA.key 2048
openssl req -x509 -new -nodes -key rootCA.key -days 365 -out rootCA.cr
+t -subj '/C=US/ST=Texas/L=Dallas/CN=localhost'
openssl genrsa -out host.key 2048 -subj '/C=US/ST=Georgia/L=Mauk/CN=lo
+calhost'
openssl req -new -key host.key -out host.csr  -subj '/C=US/ST=Georgia/
+L=Mauk/CN=localhost'
openssl x509 -req -in host.csr -CA rootCA.crt -CAkey rootCA.key -CAcre
+ateserial -out host.crt -days 365
[download]