125 lines
2.4 KiB
Perl
125 lines
2.4 KiB
Perl
|
#!/usr/bin/perl
|
||
|
|
|
||
|
|
#use strict;
|
||
|
|
use IO::Socket;
|
||
|
|
use File::Path;
|
||
|
|
use POSIX qw(:signal_h WNOHANG);
|
||
|
|
use Sys::Syslog qw(:DEFAULT setlogsock);
|
||
|
|
|
||
|
|
my $sock_dir = "/tmp/.xtcd";
|
||
|
|
mkpath($sock_dir);
|
||
|
|
my $display = shift;
|
||
|
|
my $node = shift;
|
||
|
|
my $title = shift;
|
||
|
|
my $quit = 0;
|
||
|
|
|
||
|
|
my $sock_path = "$sock_dir/$display.$node";
|
||
|
|
|
||
|
|
$SIG{CHLD} = sub { while ( waitpid(-1,WNOHANG) > 0 ) { } };
|
||
|
|
$SIG{HUP} = $SIG{TERM} = $SIG{INT} = sub { $quit++ };
|
||
|
|
|
||
|
|
unlink($sock_path);
|
||
|
|
umask(0111);
|
||
|
|
|
||
|
|
my $listen;
|
||
|
|
|
||
|
|
$listen = IO::Socket::UNIX->new(
|
||
|
|
Local => $sock_path,
|
||
|
|
Listen => SOMAXCONN
|
||
|
|
);
|
||
|
|
unless($listen) {
|
||
|
|
print("xtcd: $display.$node cannot create a listening socket: $@");
|
||
|
|
die "cannot create a listening socket $sock_path: $@";
|
||
|
|
}
|
||
|
|
|
||
|
|
while(!$quit) {
|
||
|
|
my $connected = $listen->accept();
|
||
|
|
my $child = launch_child();
|
||
|
|
|
||
|
|
if(!defined $child) {
|
||
|
|
print("xtcd: $display.$node cannot fork, exiting");
|
||
|
|
die "cannot fork";
|
||
|
|
}
|
||
|
|
|
||
|
|
if($child) {
|
||
|
|
close $connected;
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
close $listen;
|
||
|
|
interact($connected);
|
||
|
|
exit 0;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
unlink($sock_path);
|
||
|
|
exit(0);
|
||
|
|
|
||
|
|
sub launch_child {
|
||
|
|
my $signals = POSIX::SigSet->new(SIGINT,SIGCHLD,SIGTERM,SIGHUP);
|
||
|
|
sigprocmask(SIG_BLOCK,$signals);
|
||
|
|
my $child = fork();
|
||
|
|
unless($child) {
|
||
|
|
$SIG{$_} = 'DEFAULT' foreach qw(HUP INT TERM CHLD);
|
||
|
|
}
|
||
|
|
sigprocmask(SIG_UNBLOCK,$signals);
|
||
|
|
return $child;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub interact {
|
||
|
|
my $c = shift;
|
||
|
|
my $command;
|
||
|
|
|
||
|
|
my $commandstring = <$c>;
|
||
|
|
chomp($commandstring);
|
||
|
|
|
||
|
|
foreach(split(/ /,$commandstring)) {
|
||
|
|
$command = $_;
|
||
|
|
|
||
|
|
if($command eq "ping") {
|
||
|
|
# print $c "ok ping\n";
|
||
|
|
}
|
||
|
|
elsif($command =~ /move=/) {
|
||
|
|
$command =~ s/move=//;
|
||
|
|
my ($x,$y) = split(/x/,$command);
|
||
|
|
print "\033[3;${x};${y}t";
|
||
|
|
# print $c "ok move\n";
|
||
|
|
}
|
||
|
|
elsif($command =~ /font=/) {
|
||
|
|
$command =~ s/font=//;
|
||
|
|
print "\033]50;${command}\007";
|
||
|
|
# print $c "ok font\n";
|
||
|
|
}
|
||
|
|
elsif($command eq "raise") {
|
||
|
|
print "\033[5t";
|
||
|
|
# print $c "ok raise\n";
|
||
|
|
}
|
||
|
|
elsif($command eq "lower") {
|
||
|
|
print "\033[6t";
|
||
|
|
# print $c "ok lower\n";
|
||
|
|
}
|
||
|
|
elsif($command eq "refresh") {
|
||
|
|
print "\033[7t";
|
||
|
|
# print $c "ok refresh\n";
|
||
|
|
}
|
||
|
|
elsif($command eq "iconify") {
|
||
|
|
print "\033[2t";
|
||
|
|
# print $c "ok iconify\n";
|
||
|
|
}
|
||
|
|
elsif($command eq "restore") {
|
||
|
|
print "\033[1t";
|
||
|
|
# print $c "ok restore\n";
|
||
|
|
}
|
||
|
|
elsif($command eq "title") {
|
||
|
|
print "\033]2;${title}\007";
|
||
|
|
# print $c "ok title\n";
|
||
|
|
}
|
||
|
|
elsif($command =~ /title=/) {
|
||
|
|
$command =~ s/title=//;
|
||
|
|
print "\033]2;${command}\007";
|
||
|
|
# print $c "ok title\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
close $c;
|
||
|
|
}
|