#!/usr/bin/perl -w
#
# polyp.pl, a stupid linemode screen replacement, with less resource usage.
# version 2.0.0 by Pegasus Epsilon <pegasus@pimninjas.org>
#
# (C) 2014, Distribute Unmodified - http://pegasus.pimninjas.org/license
use strict;
use IPC::Open2;
use POSIX;
use Socket;
use Fcntl;
unless ($ARGV[1]) {
print "Usage: $0 name command\n";
exit;
}
# fix ps listing
$0 = join ' ', "[polyp]", @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";
}
}
unlink my $socket = "$ARGV[0].polyp";
socket LISTEN, PF_UNIX, SOCK_STREAM, 0;
bind LISTEN, sockaddr_un $socket;
listen LISTEN, 1;
# 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; }
$SIG{INT} = sub {
kill SIGINT, $wrapped_pid;
unlink $socket, "$ARGV[0].pid";
exit;
};
open(*PID, ">", "$ARGV[0].pid");
print PID "$wrapped_pid\n";
close PID;
fcntl W_STDOUT, F_SETFL, O_NONBLOCK;
vec(my $inputs = '', my $fd_listen = fileno LISTEN, 1) = 1;
vec($inputs, my $fd_w_stdout = fileno W_STDOUT, 1) = 1;
my $fd_client;
print "[$$] $ARGV[0] polyp started, detaching...\n";
exit if fork; exit if fork;
open STDIN, '<', '/dev/null';
open STDOUT, '>>', "$ARGV[0].log";
open STDERR, '>&', fileno STDOUT;
while (my $n = select(my $readable = $inputs, undef, my $error = $inputs, undef)) {
if (-1 == $n && $!{EINTR}) { undef $!; next; }
print "W_STDOUT exception\n" if (vec $error, $fd_w_stdout, 1);
if (defined $fd_client) { # if connected
# send data from wrapped program to client
if (vec $readable, $fd_w_stdout, 1) {
defined(local $_ = <W_STDOUT>) or do {
# wrapped program exited, shut down
print "[polyp] $ARGV[0] exited.\n";
unlink $socket, "$ARGV[0].pid";
exit;
};
while () { print CLIENT $_; }
continue { defined($_ = <W_STDOUT>) or last };
}
# send data from client to wrapped program
if (vec $readable, $fd_client, 1) {
defined(local $_ = <CLIENT>) or do {
# client disconnected, stop listening to them
close CLIENT;
vec($inputs, $fd_client, 1) = 0;
undef $fd_client;
# listen for new incoming connections
socket LISTEN, PF_UNIX, SOCK_STREAM, 0;
bind LISTEN, sockaddr_un $socket;
listen LISTEN, 1;
vec($inputs, $fd_listen = fileno LISTEN, 1) = 1;
next;
};
while () { print W_STDIN $_; }
continue { defined($_ = <CLIENT>) or last };
}
} else { # if not connected
# throw away input
if (vec $readable, $fd_w_stdout, 1) {
readline W_STDOUT || do {
# wrapped program exited, shut down
unlink $socket, "$ARGV[0].pid";
exit;
};
}
# answer incoming connection
if (vec $readable, $fd_listen, 1) {
accept CLIENT, LISTEN or next;
select(((select CLIENT), $| = 1)[0]);
fcntl CLIENT, F_SETFL, O_NONBLOCK;
vec($inputs, $fd_client = fileno CLIENT, 1) = 1;
# stop listening for new connections
close LISTEN;
vec($inputs, $fd_listen, 1) = 0;
undef $fd_listen;
unlink $socket;
}
}
}