[pve-xtermjs.git] / src / PVE / CLI / termproxy.pm

package PVE::CLI::termproxy;

use strict;
use warnings;

use PVE::RPCEnvironment;
use PVE::CLIHandler;
use PVE::JSONSchema qw(get_standard_option);
use PVE::AccessControl;
use PVE::PTY;
use IO::Select;
use IO::Socket::IP;

use base qw(PVE::CLIHandler);

use constant MAX_QUEUE_LEN => 16*1024;

sub setup_environment {
    PVE::RPCEnvironment->setup_default_cli_env();
}

sub listen_and_authenticate {
    my ($port, $timeout) = @_;

    my $params = {
        Listen => 1,
        ReuseAddr => 1,
        Proto => &Socket::IPPROTO_TCP,
        GetAddrInfoFlags => 0,
        LocalAddr => 'localhost',
        LocalPort => $port,
    };

    my $socket = IO::Socket::IP->new(%$params) or die "failed to open socket: $!\n";

    alarm 0;
    local $SIG{ALRM} = sub { die "timed out waiting for client\n" };
    alarm $timeout;
    my $client = $socket->accept; # Wait for a client
    alarm 0;
    close($socket);

    my $queue;
    my $n = sysread($client, $queue, 4096);
    if ($n && $queue =~ s/^([^:]+):([^:]+):(.+)\n//) {
        my $user = $1;
        my $path = $2;
        my $ticket = $3;

        die "authentication failed\n"
            if !PVE::AccessControl::verify_vnc_ticket($ticket, $user, $path);

        die "aknowledge failed\n"
            if !syswrite($client, "OK");

    } else {
        die "malformed authentication string\n";
    }

    return ($queue, $client);
}

sub run_pty {
    my ($cmd, $webhandle, $queue) = @_;

    foreach my $k (keys %ENV) {
        next if $k eq 'PATH' || $k eq 'USER' || $k eq 'HOME' || $k eq 'LANG' || $k eq 'LANGUAGE';
        next if $k =~ m/^LC_/;
        delete $ENV{$k};
    }

    $ENV{TERM} = 'xterm-256color';

    my $pty = PVE::PTY->new();

    my $pid = fork();
    die "fork: $!\n" if !defined($pid);
    if (!$pid) {
        $pty->make_controlling_terminal();
        exec {$cmd->[0]} @$cmd
            or POSIX::_exit(1);
    }

    $pty->set_size(80,20);

    read_write_loop($webhandle, $pty->master, $queue, $pty);

    $pty->close();
    waitpid($pid,0);
    exit(0);
}

sub read_write_loop {
    my ($webhandle, $cmdhandle, $queue, $pty) = @_;

    my $select = new IO::Select;

    $select->add($webhandle);
    $select->add($cmdhandle);

    my @handles;

    # we may have already messages from the first read
    $queue = process_queue($queue, $cmdhandle, $pty);

    my $timeout = 5*60;

    while($select->count && scalar(@handles = $select->can_read($timeout))) {
        foreach my $h (@handles) {
            my $buf;
            my $n = $h->sysread($buf, 4096);

            if ($h == $webhandle) {
                if ($n && (length($queue) + $n) < MAX_QUEUE_LEN) {
                    $queue = process_queue($queue.$buf, $cmdhandle, $pty);
                } else {
                    return;
                }
            } elsif ($h == $cmdhandle) {
                if ($n) {
                    syswrite($webhandle, $buf);
                } else {
                    return;
                }
            }
        }
    }
}

sub process_queue {
    my ($queue, $handle, $pty) = @_;

    my $msg;
    while(length($queue)) {
        ($queue, $msg) = remove_message($queue, $pty);
        last if !defined($msg);
        syswrite($handle, $msg);
    }
    return $queue;
}


# we try to remove a whole message
# if we succeed, we return the remaining queue and the msg
# if we fail, the message is undef and the queue is not changed
sub remove_message {
    my ($queue, $pty) = @_;

    my $msg;
    my $type = substr $queue, 0, 1;

    if ($type eq '0') {
        # normal message
        my ($length) = $queue =~ m/^0:(\d+):/;
        my $begin = 3 + length($length);
        if (defined($length) && length($queue) >= ($length + $begin)) {
            $msg = substr $queue, $begin, $length;
            if (defined($msg)) {
                # msg contains now $length chars after 0:$length:
                $queue = substr $queue, $begin + $length;
            }
        }
    } elsif ($type eq '1') {
        # resize message
        my ($cols, $rows) = $queue =~ m/^1:(\d+):(\d+):/;
        if (defined($cols) && defined($rows)) {
            $queue = substr $queue, (length($cols) + length ($rows) + 4);
            eval { $pty->set_size($cols, $rows) if defined($pty) };
            warn $@ if $@;
            $msg = "";
        }
    } elsif ($type eq '2') {
        # ping
        $queue = substr $queue, 1;
        $msg = "";
    } else {
        # ignore other input
        $queue = substr $queue, 1;
        $msg = "";
    }

    return ($queue, $msg);
}

__PACKAGE__->register_method ({
    name => 'exec',
    path => 'exec',
    method => 'POST',
    description => "Connects a TCP Socket with a commandline",
    parameters => {
        additionalProperties => 0,
        properties => {
            port => {
                type => 'integer',
                description => "The port to listen on."
            },
            'extra-args' => get_standard_option('extra-args'),
        },
    },
    returns => { type => 'null'},
    code => sub {
        my ($param) = @_;

        my $cmd;
        if (defined($param->{'extra-args'})) {
            $cmd = [@{$param->{'extra-args'}}];
        } else {
            die "No command given\n";
        }

        my ($queue, $handle) = listen_and_authenticate($param->{port}, 10);

        run_pty($cmd, $handle, $queue);

        return undef;
    }});

our $cmddef = [ __PACKAGE__, 'exec', ['port', 'extra-args' ]];

1;