#!/usr/bin/perl -w
#
# polyp.pl, a stupid linemode screen replacement, with less resource usage.
# version 1.0.2 by Pegasus Epsilon <pegasus@pimninjas.org>
# written for jellyfish.pl, a minecraft to IRC bridge.
#
# Distribute Unmodified - http://pegasus.pimninjas.org/license
use strict;
use IPC::Open2;
use POSIX;
use Socket;
use Fcntl;
select STDOUT; $| = 1;
close STDERR;
unless ($ARGV[1]) {
print "Usage: $0 name command\n";
exit;
}
# fix ps listing
$0 = join ' ', $0, @ARGV;
# don't run twice, clean stale sockets
if (-e "$ARGV[0].pid") {
open *PID, "<", "$ARGV[0].pid";
my $pid = <PID>;
close PID;
if (kill 0, $pid) {
print "[polyp] $ARGV[0] already running\n";
exit;
} else {
print "[polyp] Cleaned up a stale socket\n";
unlink "$ARGV[0].pid", "polyp.$pid";
}
}
my $inputs = '';
# open2 does not return on failure, simply raises an exception.
# uncaught, it will spew garbage to STDERR.
# let's print an error instead.
my $wrapped_pid = eval { open2(*W_STDOUT, *W_STDIN, $ARGV[1]); };
if ($!) { print "[polyp] can't start $ARGV[1]: $!\n"; exit; }
vec($inputs, fileno W_STDOUT, 1) = 1;
open(*PID, ">", "$ARGV[0].pid");
print PID $wrapped_pid;
close PID;
my $socket = "polyp.$wrapped_pid";
sub INT {
kill SIGINT, $wrapped_pid;
unlink $socket, "$ARGV[0].pid";
exit;
}
$SIG{INT} = \&INT;
socket LISTEN, PF_UNIX, SOCK_STREAM, 0;
fcntl LISTEN, F_SETFL, O_NONBLOCK;
unlink $socket;
bind LISTEN, sockaddr_un $socket;
listen LISTEN, 1;
vec($inputs, fileno LISTEN, 1) = 1;
print "[$$] $ARGV[0] started, detaching...\n";
exit if fork; exit if fork;
open STDIN, '<', '/dev/null';
close STDOUT;
while (my $n = select(my $readable = $inputs, undef, my $error = $inputs, undef)) {
if (-1 == $n && $!{EINTR}) { $! = undef; next; }
print "error\n" if (vec $error, fileno W_STDOUT, 1);
if (fileno *CLIENT) { # if connected
# send data from wrapped program to client
if (vec $readable, fileno W_STDOUT, 1) {
print CLIENT <W_STDOUT> || do {
# wrapped program exited, shut down
print "[polyp] $ARGV[0] exited.\n";
unlink $socket, "$ARGV[0].pid";
exit;
};
}
# send data from client to wrapped program
if (vec $readable, fileno CLIENT, 1) {
my $buf = <CLIENT>;
print CLIENT "sending $buf";
print W_STDIN $buf || do {
# client disconnected, listen for more incoming connections
vec($inputs, fileno CLIENT, 1) = 0;
vec($inputs, fileno LISTEN, 1) = 1;
close CLIENT;
};
}
} else { # if not connected
# throw away input
if (vec $readable, fileno W_STDOUT, 1) {
readline W_STDOUT || do {
# wrapped program exited, shut down
unlink $socket, "$ARGV[0].pid";
exit;
};
}
# answer incoming connection
if (vec $readable, fileno LISTEN, 1) {
accept CLIENT, LISTEN or next;
select(((select CLIENT), $| = 1)[0]);
# stop listening for new connections
vec($inputs, fileno LISTEN, 1) = 0;
vec($inputs, fileno CLIENT, 1) = 1;
}
}
}