Created
March 5, 2014 16:50
-
-
Save gordolio/9371193 to your computer and use it in GitHub Desktop.
A simple way to implement 'signals' in Windows since signals are not really supported in Win32. This only works via a server/client implementation. Server sends signals to client.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/perl | |
use strict; | |
use warnings; | |
use IO::Socket::INET; | |
use IO::Select; | |
open my $log,'>>','test.log'; | |
$| = 1; | |
my ( $socket, $client_socket, $select ); | |
$socket = IO::Socket::INET->new( | |
PeerHost => '127.0.0.1', | |
PeerPort => '5000', | |
Proto => 'tcp', | |
Blocking => 0 | |
) or die "ERROR in Socket Creation : $!\n"; | |
$select = IO::Select->new($socket); | |
print $log "TCP Connection Success.\n"; | |
my $data; | |
my $should_exit = 0; | |
while(!$should_exit) { | |
if(my @ready = $select->can_read){ | |
for my $sock(@ready){ | |
$sock->accept; | |
$sock->recv($data,1024); | |
if($data){ | |
print $log "got data...$data\n"; | |
if($data =~ /SIGINT/){ | |
$should_exit = 1; | |
} | |
} | |
} | |
}else{ | |
print $log "waiting..." . $select->count . "\n"; | |
select undef,undef,undef,1; | |
} | |
} | |
print $log "dying...\n"; | |
close $log; | |
0; |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/perl | |
use strict; | |
use warnings; | |
use IO::Socket::INET; | |
use IPC::Open2; | |
$| = 1; | |
my ( $socket, $client_socket ); | |
my ( $peer_address, $peer_port ); | |
$socket = new IO::Socket::INET( | |
LocalHost => '127.0.0.1', | |
LocalPort => '5000', | |
Proto => 'tcp', | |
Listen => 5, | |
Blocking => 0, | |
Reuse => 1 | |
) or die "ERROR in Socket Creation : $!\n"; | |
print "SERVER Waiting for client connection on port 5000\n"; | |
my ($pid,$chld_out,$chld_in); | |
sub create_process{ | |
$pid = open2($chld_out,$chld_in,'C:\\strawberry\\perl\\bin\\perl.exe','tcpclient.pl'); | |
} | |
create_process(); | |
while(1) { | |
if(!$client_socket){ | |
$client_socket = $socket->accept(); | |
} | |
if($client_socket){ | |
$peer_address = $client_socket->peerhost(); | |
$peer_port = $client_socket->peerport(); | |
print "Accepted New Client Connection From : $peer_address, $peer_port\n"; | |
select undef,undef,undef,2; | |
$client_socket->send("SIGINT"); | |
$client_socket->close; | |
$client_socket = undef; | |
print "waiting for process to die..."; | |
waitpid($pid,0); | |
print "done...\ncreating new process..."; | |
create_process(); | |
print "done\n"; | |
}else{ | |
print "waiting for connection...\n"; | |
select undef,undef,undef,1; | |
} | |
} | |
$socket->close(); | |
0; |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment