#!/usr/bin/perl -w =head1 NAME xterm-server-backend - TOD =head1 SYNOPSIS xterm-server-backend [options] --help --daemonize (Default) --no-daemonize =head1 DESCRIPTION TODO =cut use strict; # Seemingly socat doesn't seem to transmit STDERR automatically so # re-route it myself. # *STDERR = *STDOUT; # Option handling # use Getopt::Long (); Getopt::Long::GetOptions( help => \&pod2usage, 'daemonize!' => \ my $daemonize, ) or pod2usage(); $daemonize = 1 if ! defined $daemonize; # Daemonization by default # if ( $daemonize ) { fork && exit; fork && exit; umask 0; chdir '/'; } # TODO: Add a socat readline proxy # TODO: reduce the # of processes required here. # 8105 pts/0 S 0:00 socat TCP-LISTEN:53505,fork,reuseaddr EXEC:/home/josh/src/xterm-server/xterm-server-backend,setsid,nofork # 8110 pts/2 S+ 0:00 telnet localhost 53505 # 8113 ? S 0:00 /home/josh/perl5/perlbrew/perls/perl-5.12.1/bin/perl /home/josh/src/xterm-server/xterm-server-backend # 8114 ? S 0:00 sh -c 3>&1 xterm -title 'Perl 5 Debugger' -e sh -c "tty 1>&3;?sleep 10000000" # 8115 ? S 0:00 xterm -title Perl 5 Debugger -e sh -c tty 1>&3;?sleep 10000000 # 8116 pts/4 Ss+ 0:00 sh -c tty 1>&3;?sleep 10000000 # 8118 ? S 0:00 socat - FILE:/dev/pts/4 # 8119 pts/4 S+ 0:00 sleep 10000000 # Launch xterm in a child process and have it write its tty to the # STDOUT I'm reading from. It's going to sleep for approximately 115 # days. # my $cmd = q(3>&1 xterm -title 'Perl 5 Debugger' -e sh -c "tty 1>&3; sleep 10000000"|); my $xterm_pid = open my( $xterm_process ), $cmd; if ( ! defined $xterm_pid ) { die "Can't [$cmd]: \$?=$?"; } # Read the xterm's tty. # my $tty = <$xterm_process>; chomp $tty; if ( ! $tty ) { die "Couldn't get tty from xterm pid $xterm_pid"; } # Launch socat to tie my STDIN, STDOUT, STDERR to the TTY that's in # use by the xterm. We won't continue until the conversation is # complete. # my @cmd = ( 'socat', '-', "FILE:$tty" ); system @cmd; if ( $? ) { die "Can't [@cmd]: \$?=$?"; } # Tell the xterm that the socket has closed. It's entirely possible # that I can't talk to the tty anymore either so ignore any failures. # $^W = 0; open my $tty_fh, '>', $tty; if ( $tty_fh ) { syswrite $tty_fh, "Socket closed\n"; close $tty_fh; } # Kill all our children, if they still exist # kill -2, 0; # SIGINT kill -15, 0; # SIGTERM kill -9, 0; # SIGKILL sub pod2usage { require Pod::Usage; goto &Pod::Usage::pod2usage; }