Add PVE::PTY helper class

[pve-common.git] / src / PVE / PTY.pm

package PVE::PTY;

use strict;
use warnings;

use Fcntl;
use POSIX qw(O_RDWR O_NOCTTY);

# Constants

use constant {
    TCGETS     => 0x5401,   # fixed, from asm-generic/ioctls.h
    TCSETS     => 0x5402,   # fixed, from asm-generic/ioctls.h
    TIOCGWINSZ => 0x5413,   # fixed, from asm-generic/ioctls.h
    TIOCSWINSZ => 0x5414,   # fixed, from asm-generic/ioctls.h
    TIOCSCTTY  => 0x540E,   # fixed, from asm-generic/ioctls.h
    TIOCNOTTY  => 0x5422,   # fixed, from asm-generic/ioctls.h
    TIOCGPGRP  => 0x540F,   # fixed, from asm-generic/ioctls.h
    TIOCSPGRP  => 0x5410,   # fixed, from asm-generic/ioctls.h

    # IOC: dir:2 size:14 type:8 nr:8
    # Get pty number: dir=2 size=4 type='T' nr=0x30
    TIOCGPTN => 0x80045430,

    # Set pty lock: dir=1 size=4 type='T' nr=0x31
    TIOCSPTLCK => 0x40045431,

    # Send signal: dir=1 size=4 type='T' nr=0x36
    TIOCSIG => 0x40045436,

    # c_cc indices:
    VINTR => 0,
    VQUIT => 1,
    VERASE => 2,
    VKILL => 3,
    VEOF => 4,
    VTIME => 5,
    VMIN => 6,
    VSWTC => 7,
    VSTART => 8,
    VSTOP => 9,
    VSUSP => 10,
    VEOL => 11,
    VREPRINT => 12,
    VDISCARD => 13,
    VWERASE => 14,
    VLNEXT => 15,
    VEOL2 => 16,
};

# Utility functions

sub createpty() {
    # Open the master file descriptor:
    sysopen(my $master, '/dev/ptmx', O_RDWR | O_NOCTTY)
	or die "failed to create pty: $!\n";

    # Find the tty number
    my $ttynum = pack('L', 0);
    ioctl($master, TIOCGPTN, $ttynum)
	or die "failed to query pty number: $!\n";
    $ttynum = unpack('L', $ttynum);

    # Get the slave name/path
    my $ttyname = "/dev/pts/$ttynum";

    # Unlock
    my $false = pack('L', 0);
    ioctl($master, TIOCSPTLCK, $false)
	or die "failed to unlock pty: $!\n";

    return ($master, $ttyname);
}

my $openslave = sub {
    my ($ttyname) = @_;

    # Create a slave file descriptor:
    sysopen(my $slave, $ttyname, O_RDWR | O_NOCTTY)
	or die "failed to open slave pty handle: $!\n";
    return $slave;
};

sub lose_controlling_terminal() {
    # Can we open our current terminal?
    if (sysopen(my $ttyfd, '/dev/tty', O_RDWR)) {
	# Disconnect:
	ioctl($ttyfd, TIOCNOTTY, 0)
	    or die "failed to disconnect controlling tty: $!\n";
	close($ttyfd);
    }
}

sub termios(%) {
    my (%termios) = @_;
    my $cc = $termios{cc} // [];
    if (@$cc < 19) {
	push @$cc, (0) x (19-@$cc);
    } elsif (@$cc > 19) {
	@$cc = $$cc[0..18];
    }

    return pack('LLLLCC[19]',
	$termios{iflag} || 0,
	$termios{oflag} || 0,
	$termios{cflag} || 0,
	$termios{lflag} || 0,
	$termios{line} || 0,
	@$cc);
}

my $parse_termios = sub {
    my ($blob) = @_;
    my ($iflag, $oflag, $cflag, $lflag, $line, @cc) =
    unpack('LLLLCC[19]', $blob);
    return {
	iflag => $iflag,
	oflag => $oflag,
	cflag => $cflag,
	lflag => $lflag,
	line => $line,
	cc => \@cc
    };
};

sub cfmakeraw($) {
    my ($termios) = @_;
    $termios->{iflag} &=
	~(POSIX::IGNBRK | POSIX::BRKINT | POSIX::PARMRK | POSIX::ISTRIP |
	  POSIX::INLCR | POSIX::IGNCR | POSIX::ICRNL | POSIX::IXON);
    $termios->{oflag} &= ~POSIX::OPOST;
    $termios->{lflag} &=
	~(POSIX::ECHO | POSIX::ECHONL | POSIX::ICANON | POSIX::ISIG |
	  POSIX::IEXTEN);
    $termios->{cflag} &= ~(POSIX::CSIZE | POSIX::PARENB);
    $termios->{cflag} |= POSIX::CS8;
}

sub tcgetattr($) {
    my ($fd) = @_;
    my $blob = termios();
    ioctl($fd, TCGETS, $blob) or die "failed to get terminal attributes\n";
    return $parse_termios->($blob);
}

sub tcsetattr($$) {
    my ($fd, $termios) = @_;
    my $blob = termios(%$termios);
    ioctl($fd, TCSETS, $blob) or die "failed to set terminal attributes\n";
}

# tcgetsize -> (columns, rows)
sub tcgetsize($) {
	my ($fd) = @_;
	my $struct_winsz = pack('SSSS', 0, 0, 0, 0);
	ioctl($fd, TIOCGWINSZ, $struct_winsz)
		or die "failed to get window size: $!\n";
	return reverse unpack('SS', $struct_winsz);
}

sub tcsetsize($$$) {
    my ($fd, $columns, $rows) = @_;
    my $struct_winsz = pack('SSSS', $rows, $columns, 0, 0);
    ioctl($fd, TIOCSWINSZ, $struct_winsz)
	or die "failed to set window size: $!\n";
}

# Class functions

sub new {
    my ($class) = @_;

    my ($master, $ttyname) = createpty();

    my $self = {
	master => $master,
	ttyname => $ttyname,
    };

    return bless $self, $class;
}

# Properties

sub master  { return $_[0]->{master}  }
sub ttyname { return $_[0]->{ttyname} }

# Methods

sub close {
    my ($self) = @_;
    close($self->{master});
}

sub open_slave {
    my ($self) = @_;
    return $openslave->($self->{ttyname});
}

sub set_size {
    my ($self, $columns, $rows) = @_;
    tcsetsize($self->{master}, $columns, $rows);
}

# get_size -> (columns, rows)
sub get_size {
    my ($self) = @_;
    return tcgetsize($self->{master});
}

sub kill {
    my ($self, $signal) = @_;
    if (!ioctl($self->{master}, TIOCSIG, $signal)) {
	# kill fallback if the ioctl does not work
	kill $signal, $self->get_foreground_pid()
	    or die "failed to send signal: $!\n";
    }
}

sub get_foreground_pid {
    my ($self) = @_;
    my $pid = pack('L', 0);
    ioctl($self->{master}, TIOCGPGRP, $pid)
	or die "failed to get foreground pid: $!\n";
    return unpack('L', $pid);
}

sub has_process {
    my ($self) = @_;
    return 0 != $self->get_foreground_pid();
}

sub make_controlling_terminal {
    my ($self) = @_;

    #lose_controlling_terminal();
    POSIX::setsid();
    my $slave = $self->open_slave();
    ioctl($slave, TIOCSCTTY, 0)
	or die "failed to change controlling tty: $!\n";
    POSIX::dup2(fileno($slave), 0) or die "failed to dup stdin\n";
    POSIX::dup2(fileno($slave), 1) or die "failed to dup stdout\n";
    POSIX::dup2(fileno($slave), 2) or die "failed to dup stderr\n";
    CORE::close($slave) if fileno($slave) > 2;
    CORE::close($self->{master});
}

sub getattr {
    my ($self) = @_;
    return tcgetattr($self->{master});
}

sub setattr {
    my ($self, $termios) = @_;
    return tcsetattr($self->{master}, $termios);
}

sub send_cc {
    my ($self, $ccidx) = @_;
    my $attrs = $self->getattr();
    my $data = pack('C', $attrs->{cc}->[$ccidx]);
    syswrite($self->{master}, $data)
    == 1 || die "write failed: $!\n";
}

sub send_eof {
    my ($self) = @_;
    $self->send_cc(VEOF);
}

sub send_interrupt {
    my ($self) = @_;
    $self->send_cc(VINTR);
}

1;