#!/usr/bin/perl -w
#
# polyp.pl, a stupid linemode screen replacement, with less resource usage.
# version 3.0.0 by Pegasus Epsilon <pegasus@pimninjas.org>
#
# (C) 2014, Distribute Unmodified - http://pegasus.pimninjas.org/license
use strict;
use IO::Pty; # I mean...
use IO::Stty; # $slave->stty()
use POSIX; # F_SETFL, O_NONBLOCK
use Socket; # PF_UNIX, SOCK_STREAM
unless ($ARGV[1]) {
print "Usage: $0 name command\n";
exit;
}
# don't run twice, clean stale sockets
if (-e "$ARGV[0].polyp.master.pid") {
open my $fd, "<", "$ARGV[0].polyp.master.pid";
my $pid = <$fd>;
close $fd;
if (kill 0, $pid) {
print "[polyp] $ARGV[0] master 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 my $listen, PF_UNIX, SOCK_STREAM, 0;
bind $listen, sockaddr_un $socket;
listen $listen, 1;
my $pty = new IO::Pty;
my $slave = $pty->slave;
my $slave_pid = fork;
die "Couldn't fork: $!\n" unless defined $slave_pid;
if (not $slave_pid) {
open my $fd, ">", "$ARGV[0].polyp.slave.pid";
print $fd "$$\n";
close $fd;
# fix ps listing
$0 = join ' ', "[polyp] $ARGV[0]/slave";
$pty->close;
$pty->make_slave_controlling_terminal;
$slave->stty('-echo');
open STDIN , ">&", $slave or die "Can't dup STDIN: $!\n";
open STDOUT, ">&", $slave or die "Can't dup STDOUT: $!\n";
open STDERR, ">&", $slave or die "Can't dup STDERR: $!\n";
#print "[polyp/slave] Launching $ARGV[1]...\n";
system $ARGV[1];
#print "[polyp/slave] $ARGV[1] exited, cleaning up...\n";
unlink $socket,
"$ARGV[0].polyp.master.pid",
"$ARGV[0].polyp.slave.pid";
exit;
}
# fix ps listing
$0 = join ' ', "[polyp] $ARGV[0]/master";
$pty->close_slave;
vec(my $inputs = '', my $fd_listen = fileno $listen, 1) = 1;
vec($inputs, my $fd_pty = $pty->fileno, 1) = 1;
my ($client, $fd_client);
print "[$$] $ARGV[0] polyp started, detaching...\n";
exit if fork;
open STDIN, '<', '/dev/null';
open STDOUT, '>>', '/dev/null';
#open STDOUT, '>', "$ARGV[0].polyp.log";
open STDERR, '>&', fileno STDOUT;
open my $fd, ">", "$ARGV[0].polyp.master.pid";
print $fd "$$\n";
close $fd;
fcntl $pty, F_SETFL, O_NONBLOCK;
while (my $n = select(my $readable = $inputs, undef, undef, undef)) {
if (defined $fd_client) { # if connected
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 "from \$client to \$pty: $_";
print $pty $_;
} continue { defined($_ = <$client>) or last };
}
if (vec $readable, $fd_pty, 1) {
defined(local $_ = <$pty>) or do {
# wrapped program exited, shut down
print "[polyp/master/connected] $ARGV[0] exited.\n";
exit;
};
while () {
print "from \$pty to \$client: $_";
print $client $_;
} continue { defined($_ = <$pty>) or last };
}
} else {
if (vec $readable, $fd_pty, 1) {
defined(local $_ = <$pty>) or do {
print "[polyp/master/disconnected] $ARGV[0] exited.\n";
exit;
};
while () {
print "from \$pty to the void: $_";
} continue { defined($_ = <$pty>) or last };
}
if (vec $readable, $fd_listen, 1) {
print "[polyp/master/disconnected] connection! answering...\n";
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;
}
}
}