#!/usr/bin/perl

# ttyon - run command controlled by fake terminal
#
# Copyright 2021, Nicholas Guriev <guriev-ns@ya.ru>
#
# Permission is hereby granted, free of charge, to any person obtaining a
# copy of this software and associated documentation files (the "Software"),
# to deal in the Software without restriction, including without limitation
# the rights to use, copy, modify, merge, publish, distribute, sublicense,
# and/or sell copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included
# in all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
# OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
# THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
# OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
# ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
# OTHER DEALINGS IN THE SOFTWARE.

=head1 NAME

ttyon - run command controlled by fake terminal

=head1 SYNOPSIS

B<ttyon> [B<-a> I<NAME>] [B<-fs>] [I<COMMAND>...]

=head1 DESCRIPTION

Simple script that tries to open a fake controlling terminal and executes
passed command. The script is primarily intended for running automated tests.

If no command is specified, current Shell is executed.

Options:

=over

=item B<-a>

Override the zeroth argument of the command.

=item B<-f>

Never avoid wasted forks.

=item B<-s>

Connect standard streams (numbered 0, 1, and 2) to the opened terminal.

=back

=head1 AUTHOR

Written by Nicholas Guriev on New Year's holidays 2021.

=head1 SEE ALSO

pts(4), ioctl_tty(2)

=cut


use strict;
use warnings;

use Getopt::Std;
use Fcntl;
use POSIX ();
BEGIN { require "sys/ioctl.ph" }

sub do_switch {
  my $child = fork;
  die $! unless defined $child;
  if ($child) {
    waitpid $child, 0 or die $!;
    kill $? & 127, $$ if $? & 127;
    POSIX::_exit $? >> 8;  # Perl's cleaning causes unwanted SIGHUP.
  }
}

# Some constants from ioctl.ph have incorrect value due to missing %sizeof hash.
# Apply a workaround suggested by Celelibi at https://bugs.debian.org/190887#26
our %sizeof = (int => length pack "i!", 0);

$Getopt::Std::STANDARD_HELP_VERSION = 1;
our ($opt_a, $opt_f, $opt_s);
getopts("a:fs") or exit 1;

my $term;
if ($opt_f or not open $term, "+<", "/dev/tty") {
  # Become a session leader.
  if ($opt_f or POSIX::setsid() < 0) {
    do_switch;
    POSIX::setsid() > 0 or die $!;
  }

  # Open a new terminal pair trough a multiplexor and treat its descriptor as
  # system file to not auto-close it by master process.
  local $^F = 3;
  open $term, "+<", "/dev/ptmx" or die $!;

  # Equivalent of unlockpt(3) which is not provided by the POSIX package.
  my $buf = pack "i!", 0;
  ioctl $term, TIOCSPTLCK, $buf or die $!;

  # Set the new terminal as controlling of us.
  ioctl $term, TIOCSCTTY, 0 or die $!;
}
do_switch if $opt_f;

if ($opt_s and $term) {
  for my $stream (*STDIN, *STDOUT, *STDERR) {
    # Reopen via an equivalent of ptsname(3).
    close $stream or die $!;
    my $fd = ioctl $term, TIOCGPTPEER, O_RDWR or die $!;
    open $stream, "+<&=", $fd or die $!;
  }
}
close $term or die $! if $opt_f;

unless (@ARGV) {
  push @ARGV, $ENV{SHELL} || "/bin/sh";
}
exec { $opt_a or $ARGV[0] } @ARGV or die $!;
