#!/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__
####
#!/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 $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);
IO::Socket::SSL->start_SSL($client, SSL_server => 1, SSL_reuse_ctx => $ctx) or do {
warn "ssl handshake failed: $SSL_ERROR\n";
next;
};
$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
$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,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 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__
##
##
#!/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 lost !!\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__
##
##
#!/bin/bash
openssl genrsa -out rootCA.key 2048
openssl req -x509 -new -nodes -key rootCA.key -days 365 -out rootCA.crt -subj '/C=US/ST=Texas/L=Dallas/CN=localhost'
openssl genrsa -out host.key 2048 -subj '/C=US/ST=Georgia/L=Mauk/CN=localhost'
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 -CAcreateserial -out host.crt -days 365