#! /usr/bin/perl -W
#
# ts-shell - Simple terminal server shell to access systems over IUCV
#
# This script can be used as login shell for users to restrict
# IUCV-based terminal access to other systems.
#
# Copyright IBM Corp. 2008, 2017
#
# s390-tools is free software; you can redistribute it and/or modify
# it under the terms of the MIT license. See LICENSE for details.
#
use strict;
use warnings;
use File::Basename;
use Getopt::Long qw(:config no_ignore_case);
use Scalar::Util qw(tainted);
use Term::ReadLine;
use POSIX;

$ENV{'PERL5LIB'} = "";
$ENV{'PERL5OPT'} = "";
$ENV{'PERLLIB'} = "";
$ENV{'PERL_USE_UNSAFE_INC'} = "";
delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};

$ENV{'PERL_RL'} = " o=0";   # use best avail. readline
$ENV{'PATH'} = "/bin:/sbin:/usr/bin:/usr/sbin";
$ENV{'LESSSECURE'} = 1;     # let less run in "secure" mode
my $ts_shell = fileparse($0, qr/\.[^.]+/);
$SIG{__WARN__} = sub { print STDERR "$ts_shell: $_[0]"; };
$SIG{__DIE__}  = sub { print STDERR "$ts_shell: $_[0]"; exit 255; };

# Terminal server configuration settings
my %config = (
	# general options
	'conffile'	=>	"@sysconf_path@/ts-shell.conf",
	'authfile'	=>	"@sysconf_path@/ts-authorization.conf",
	'sysfile'	=>	"@sysconf_path@/ts-systems.conf",
	'auditfile'	=>	"@sysconf_path@/ts-logsys.conf",
	'auditdir'	=>	"@var_path@/log/ts-shell",
	'iucvconn'	=>	"@iucvconn_path@/iucvconn",
	'prompt'	=>	getpwuid($>) . '@'."$ts_shell> ",
	'pager'		=>	"/usr/bin/less",
	# runtime options
	'rl'		=>	undef,		# terminal readline (rl)
	'user'		=>	getpwuid($>),	# user name
	'groups'	=>	[],		# user groups (list ref)
	'service'	=>	"lnxhvc0",	# default service
	'auth_func'	=>	sub { return -1; },	# no authorization
	'regex'		=>	[],		# re to match systems (list ref)
	'systems'	=>	[],		# system list (list reference)
	'services'      =>      [qw/lnxhvc0/],	# services list (completion)
	'termsys'	=>	{},		# global ts sys list (hash ref)
	'auditsys'	=>	{},		# audit ts sys list (hash ref)
);


sub main();
sub help();
sub usage();
sub version();
sub intro();
sub auth_global($$);
sub auth_regex($$);
sub auth_list($$);
sub get_auditlog_file($$$);
sub cmd_connect($\%);
sub cmd_service($\%);
sub cmd_list(\%);
sub rl_cmd_completion($$$);
sub list_regex_match($);
sub updateConfiguration(\%$);
sub checkConfiguration(\%);
sub loadAuthorization(\%);
sub readFile($$);
sub log_debug($);
sub log_error($);
sub log_info($);
sub pager($);


# main() - Terminal server program
#
# The program loads the system authorizations for the effective user id,
# and then initializes the term readline environment and starts the shell.
#
sub main()
{
	unless (GetOptions("v|version" => sub { version(); exit 0; },
	 		   "h|help"    => sub { usage();   exit 0; })) {
		log_error "Enter '$ts_shell --help' for more information";
		exit 1;
	}

	unless (-t STDIN) {
		log_error "The $ts_shell requires a terminal to run on";
		exit 1;
	}

	unless ($config{user}) {
		log_error "Resolving the name of user ID $> failed";
		exit 2;
	}

	# update ts-shell configuration
	unless (readFile($config{conffile},
			sub { updateConfiguration(%config, $_); })) {
		log_error "Reading the ts-shell configuration file " .
			  "$config{conffile} failed: $!";
		exit 3;
	}
	checkConfiguration(%config);

	# load list of systems the ts-shell is allowed to use; and
	# hash the systems names in uppercase
	unless (readFile($config{sysfile},
			 sub { $config{termsys}->{uc $_} = 1; })) {
		log_error "Reading $config{sysfile} failed: $!";
		exit 4;
	}

	# load list of systems for for that auditing should be enabled
	# hash the system names in uppercase
	unless (readFile($config{auditfile},
			 sub { $config{auditsys}->{uc $_} = 1; })) {
		log_error "Reading $config{auditsys} failed: $!";
		exit 5;
	}

	# retrieve user group membership and load authorizations
	my %uniq_groups = ();
	# $) returns egid twice, so we hash group names to avoid dups
	foreach(map {$_ = getgrgid($_)} split / /, $)) {
		$uniq_groups{$_} = 1;
	}
	push @{$config{groups}}, keys %uniq_groups;

	# finally, load user specific authorization data from file
	unless (loadAuthorization(%config)) {
		log_error "Reading $config{authfile} failed: $!";
		exit 5;
	}

	# set up terminal readline
	$config{rl} = new Term::ReadLine 'Terminal Server Shell';
	$config{rl}->Attribs->{'completion_function'} = \&rl_cmd_completion;
	select ($config{rl}->OUT || \*STDOUT);

	# setup signal handler to ignore SIGINT
	my $sigint = POSIX::SigAction->new(sub { return 1; },
					   POSIX::SigSet->new(),
					   &POSIX::SA_NODEFER);
	POSIX::sigaction(&POSIX::SIGINT, $sigint);

	log_debug "User: $config{user} / Groups: $) [@{$config{groups}}]";
	log_debug("Using Term::ReadLine backend: " . $config{rl}->ReadLine);

	intro();
	SHELL: while (defined($_ = $config{rl}->readline($config{prompt}))) {
		chomp;
		s/^\s+|\s+$//;
		next if /^$/;
		SWITCH: {
			/^(?:q|quit|exit)/  and last SHELL;
			/^help/		    and help(), last SWITCH;
			/^version/	    and version(), last SWITCH;
			/^(?:list|ls)/	    and cmd_list(%config), last SWITCH;
			/^terminal\s*(\w*)/ and cmd_service($1, %config), last SWITCH;

			if (/^connect\s*(\w*$|\w+\s+\w+)/) {
				cmd_connect($1, %config);
				last SWITCH;
			}

			log_error "$_ is not a known command";
		}
		$config{rl}->addhistory($_)
			if (/\S/ && !$config{rl}->Features->{autohistory});
	}
	exit 0;
}

# updateConfiguration() - Load ts-shell configuration from ts-shell.conf
#
# %cfg:		Hash reference to terminal server configuration
# $line:	Configuration line (key = value pair)
#
# The routine updates the ts-shell configuration based on configuration lines
# from the ts-shell.conf file.
#
sub updateConfiguration(\%$)
{
	my ($cfg, $line) = @_;
	my ($option, $value) = split /\s*=\s*/, $line;

	$cfg->{sysfile}   = $value if $option =~ /^ts-systems$/;
	$cfg->{authfile}  = $value if $option =~ /^ts-authorization$/;
	$cfg->{auditdir}  = $value if $option =~ /^transcript-directory$/;
	$cfg->{auditfile} = $value if $option =~ /^transcript-systems$/;
	$cfg->{pager}     = $value if $option =~ /^pager$/;
	$cfg->{iucvconn}  = $value if $option =~ /^iucvconn$/;
}

# checkConfiguration() - Validate and untaint configuration values
#
# Called once after readFile() has finished populating %cfg from
# ts-shell.conf.  Validates each security-sensitive path and untaints
# it via a regex capture so Perl taint mode permits later filesystem use.
#
# %cfg:	Hash reference to terminal server configuration
#
sub checkConfiguration(\%)
{
	my $cfg = shift;

	# Validate pager to untaint for later use
	unless ($cfg->{pager} =~ m#^(/[\w./-]+)$#) {
		log_error "Invalid pager configuration";
		exit 6;
	}
	$cfg->{pager} = $1;

	# Validate iucvconn path to untaint for later use
	unless ($cfg->{iucvconn} =~ m#^(/[\w./-]+)$#) {
		log_error "Invalid iucvconn configuration";
		exit 7;
	}
	$cfg->{iucvconn} = $1;

	# Validate transcript-directory to untaint for later use
	unless ($cfg->{auditdir} =~ m#^(/[\w./-]+)$#) {
		log_error "Invalid transcript-directory configuration";
		exit 8;
	}
	$cfg->{auditdir} = $1;

	# Untaint user name (tainted by getpwuid) for use in filesystem paths
	($cfg->{user}) = ($cfg->{user} =~ /^([\w.-]+)$/);
}

# loadAuthorization() - Load system authorizations from file
#
# $cfg:		Hash reference to terminal server configuration
#
# The routine parses the authorization data for the effective user
# and stores the information in the configuration hash. Further, it
# sets the auth_func reference to either auth_list() or auth_regex()
# to abstract authorization checks.
#
sub loadAuthorization(\%)
{
	my $cfg = shift();

	return 0 unless open(AUTH, "<", $cfg->{authfile});

	AUTH_ENT: while (<AUTH>) {
		chomp;
		next if /^#/;		# ignore comments
		next if /^\s*$/;	# skip empty lines
		s/^\s+|\s+$//g;		# trim

		my $authorized = 0;
		my ($key, $val) = split /\s*=\s*/;

		# read authorization configuration for user and its groups
		if ($key =~ /^\Q$cfg->{user}\E$/) {
			$authorized = 1;
			log_debug "Found user: $key";

		} elsif ($key =~ /^@(\S+)$/) {
			my $group = $1;
			$authorized = 1 if grep {/^\Q${group}\E$/} @{$cfg->{groups}};
			log_debug "Found group: $key" if $authorized;
		}

		# skip line if there was no auth data for current user
		next unless $authorized;

		# build authorization policy and set auth_func
		if ($val =~ /^list:\s*(.+)$/) {
			if (@{$cfg->{regex}}) {
				log_error "Authorization by list is ignored because "
					  ."$cfg->{user} uses regular expressions "
					  ."($cfg->{authfile}:$.)";
				next AUTH_ENT;
			}

			$cfg->{auth_func} = \&auth_list;
			push @{$cfg->{systems}}, split /\s*[;,]\s*/, $1;

		} elsif ($val =~ /^file:(.+)$/) {
			if (@{$cfg->{regex}}) {
				log_error "Authorization by list is ignored because "
					. "$cfg->{user} uses regular expressions "
					. "($cfg->{authfile}:$.)";
				next AUTH_ENT;
			}

			$cfg->{auth_func} = \&auth_list;
			unless(readFile($1, sub { push @{$cfg->{systems}}, $_; })) {
				log_error "Reading $1 failed: $! "
					. "($cfg->{authfile}:$.)";
			}
		} elsif ($val =~ /^regex:(.+)$/) {
			if (@{$cfg->{systems}}) {
				log_error "Authorization by regular expression "
					. "is ignored because $cfg->{user} "
					. "uses lists ($cfg->{authfile}:$.)";
				next AUTH_ENT;
			}

			# check regex syntax and complain if it is not correct
			my $re = eval "qr/$1/io";
			if ($@) {
				log_error "An authorization entry is not a valid"
					. " regular expression "
					. "($cfg->{authfile}:$.):\n$@";
				next AUTH_ENT;
			}

			$cfg->{auth_func} = \&auth_regex;
			push @{$cfg->{regex}}, $re;

		} else {
			log_error "An authorization entry is not valid "
				. "($cfg->{authfile}:$.)";
		}
		log_debug "'$key' => '$val'";
	}
	close(AUTH);

	return 1;
}

# readFile() - Helper routine to read data from file
#
# The routine reads the file content, line by line, skips
# comments and empty lines. It calls a routine for each line
# containing data. The routine can access the data either
# using the first parameter or using the context variable $_.
#
# Error handling is up to the caller; the routine exits with
# zero if the file could not be opened. open() should set $!.
#
# $file:	File name
# $sub:		Reference to sub routine
#
sub readFile($$)
{
	my ($file, $sub) = @_;

	return 0 unless open(CONF, "<", "$file");
	while (<CONF>) {
		chomp;
		next if /^#/;		# ignore comments
		next if /^\s*$/;	# skip empty lines
		s/^\s+|\s+$//g;		# trim
		&{$sub}($_);		# execute sub in current context
	}
	close(CONF);
	return 1;
}

# auth_global() - Authorization check using global system list
#
# $guest:	Scalar reference to the guest name string
# $cfg:         Hash reference to terminal server configuration
#
sub auth_global($$)
{
	my ($guest, $cfg) = @_;

	return -1 unless $cfg->{termsys};

	# unstricted
	return  1 if exists $cfg->{termsys}->{'[*ALL*]'};
	# if restricted, check if system has been hashed (in uppercase)
	return  1 if exists $cfg->{termsys}->{uc $$guest};

	# guest has not been defined, so deny authorization request
	return -2;
}

# auth_regex() - Authorization check using a regex
#
# $guest:	Scalar reference to the guest name string
# $cfg:		Hash reference to terminal server configuration
#
sub auth_regex($$)
{
	my ($guest, $cfg) = @_;

	return -1 unless @{$cfg->{regex}};
	foreach my $re (@{$cfg->{regex}}) {
		return 1 if $$guest =~ /$re/; # $re has been compiled as //io
	}
	return  0;
}

# auth_list() - Authorization check using a list of systems
#
# $guest:	Scalar reference to the guest name string
# $cfg:		Hash reference to terminal server configuration
#
sub auth_list($$)
{
	my ($guest, $cfg) = @_;

	return -1 unless @{$cfg->{systems}};
	return 1 if grep(/^\s*\Q$$guest\E\s*$/i, @{$cfg->{systems}});
	return 0;
}

# get_auditlog_file() - Set file path for session transcript
#
# Return false if an error has occurred; otherwise true.
#
# $filepath:	Scalar reference to file path variable
# $guest:	Name of the virtual guest machine
# $cfg:		Hash reference to terminal server configuration
sub get_auditlog_file($$$)
{
	my ($filepath, $guest, $cfg) = @_;

	unless (exists $cfg->{auditsys}->{'[*ALL*]'} ||
	     	exists $cfg->{auditsys}->{uc $guest}) {
		$$filepath = "";
		return 1;		# no transcript, return success
	}

	# check and create log directory for user
	unless (-d "$cfg->{auditdir}/$cfg->{user}") {
		unless (mkdir "$cfg->{auditdir}/$cfg->{user}") {
			log_error "Creating the session transcript directory "
				. "$cfg->{auditdir}/$cfg->{user} failed: $!";
			$$filepath = "";
			return 0;	# return error
		}
	}

	# validate and sanitize guest directory
	$guest = uc $guest;
	unless ($guest =~ /^([A-Z0-9@#\$_-]{1,8})$/) {
		log_error "Creating session file path failed for guest: $guest";
		return 0;     # return error
	}

	# construct the file path
	$$filepath  = "$cfg->{auditdir}/$cfg->{user}/" . $guest . "_";
	$$filepath .= strftime '%F-%H%M%S', localtime;

	log_debug "Session transcript file: $$filepath";

	return 1;			# return success
}

# cmd_connect() - Perform auth check; and on success, connect to system
#
# $guest:	Name of the virtual guest machine
# $cfg:		Hash reference to terminal server configuration
#
sub cmd_connect($\%)
{
	my ($params, $cfg) = @_;
	my $service        = $cfg->{service};

	unless (length($params)) {
		log_error "The z/VM guest name is missing";
		return;
	}

	my ($guest, $srv) = split /\s+/, $params;
	$service = $srv if $srv && $srv =~ /^\w{1,8}$/;

	# check authorization:
	# The auth_func contract is to return a code, that must be one of:
	#	-2:	ts-shell is not permitted to connect to the guest
	#	-1:	The user does not have any authorization policy
	#	 0:	User does not have authorization to connect to guest
	#	 1:	User is permitted to connect to guest (success)
	# Other return codes are not allowed!
	#
	# call auth_func to check authorization
	my  $rc = &{$cfg->{auth_func}}(\$guest, $cfg);

	# if the user is authorized, finally check if the system is
	# (globally) restricted to be used by the terminal server
	$rc = auth_global(\$guest, $cfg) if $rc > 0;

	if ($rc == -2) {
		log_error "$ts_shell is not configured to connect to $guest";
		return;
	}
	if ($rc == -1) {
		log_error "You are not authorized to connect to "
			. "any z/VM virtual machines";
		return;
	}
	if ($rc == 0) {
		log_error "You are not authorized to connect to $guest";
		return;
	}

	# construct iucvconn command line
	my @iucvconn = ("$cfg->{iucvconn}");

	# check if the terminal session to $guest requires session logging
	my $session_path = "";
	# return if get_auditlog_file() failed
	return unless get_auditlog_file(\$session_path, $guest, $cfg);
	push @iucvconn, "-s", $session_path if $session_path;

	# add $guest name and terminal identifier (service)
	push @iucvconn, $guest, $service;

	log_info "Connecting to $guest (terminal identifier: $service)...";
	if (-x $cfg->{iucvconn}) {
		system @iucvconn;
		log_info "Connection ended";
	} else {
		log_error "Running $cfg->{iucvconn} failed: $!";
	}
}

# cmd_service() - Show / set service/terminal name to identify remote terminal
#
# $new:		New terminal name; can be empty
# %cfg:		Hash reference to terminal server configuration
#
sub cmd_service($\%)
{
	my ($new, $cfg) = @_;

	unless ($new) {
		print "$cfg->{service}\n";
		return;
	}

	if ($new =~ /^\w{1,8}$/) {
		$cfg->{service} = $new;
		# push new service for cmd completion
		unless (grep /$new/, @{$cfg->{services}}) {
			push @{$cfg->{services}}, $new;
		}
	} else {
		log_error("Terminal identifier $new is not valid");
		log_error("Terminal identifiers consist of up to " .
			  "eight alphanumerical characters");
	}
}

# cmd_list() - List system authorization for effective user
#
# $cfg:		Hash reference to terminal server configuration
#
sub cmd_list(\%)
{
	my $cfg = shift();

	if (@{$cfg->{regex}}) {
		pager sub {
			print "Regular expressions for your authorization:\n";
			print "$_\n" foreach (@{$cfg->{regex}});
			my $matches = list_regex_match($cfg);
			if (@$matches) {
				print "\nYou are authorized to connect to ".
				      "these z/VM guest virtual machines:\n";
				print "$_\n" foreach (@$matches);
			}
		};
	} elsif (@{$cfg->{systems}}) {
		pager sub {
			foreach (@{$cfg->{systems}}) {
				printf "$_\n" if auth_global(\$_, $cfg) > 0;
			}
		};
	} else {
		log_error "You are not authorized to connect to " .
			  "any z/VM virtual machines";
	}
}

sub log_debug($)
{
	print STDERR "[DEBUG] " . shift() . "\n" if $ENV{'TS_SHELL_DEBUG'};
}

sub log_error($)
{
	print STDERR "$ts_shell: " . shift() . "\n";
}

sub log_info($)
{
	print "$ts_shell: " . shift() . "\n";
}

sub pager($)
{
	my $eval = shift();

	unless (open(PAGER, '|-', "$config{'pager'}")) {
		eval &$eval;
		return;
	}
	my $old_out = select PAGER;
	eval &$eval;
	select $old_out;
	close (PAGER);
}

sub intro()
{
  print <<EoIntro;
Welcome to the Terminal Server shell.
Type 'help' to get a list of available commands.


EoIntro
}

sub version()
{
	print <<EoVersion
Terminal Server Shell, version @S390_TOOLS_RELEASE@
Copyright IBM Corp. 2008, 2017

EoVersion
}

sub help()
{
	print STDERR <<EoHelp;
Terminal Server shell help

Available commands:
	list			List authorizations.
	connect <vm_guest>	Connect to specified z/VM guest virtual machine.
	terminal [<identifier>]	Display or set the terminal identifier.
	q | quit | exit		Exit the current shell session.
	help			Display help information.
	version			Display version information.

EoHelp
}

sub usage()
{
	printf <<EoUsage;
Usage: ts-shell [-h|--help] [-v|--version]

Options:
	-h, --help	Print help information, then exit.
	-v, --version	Print version information, then exit.
EoUsage
}


# list_regex_match() - Helper routine to get a list of systems that match regex
#
# $cfg:		Hash reference to terminal server configuration
# $listref:	List reference to store result
sub list_regex_match($)
{
	my $cfg      = shift();
	my %uniq_sys = ();
	my @result   = ();

	return \@result if exists $cfg->{termsys}->{'[*ALL*]'};

	# get a list of systems if ts shell runs unrestricted
	foreach my $re (@{$cfg->{regex}}) {
		foreach (grep (/$re/, keys %{$cfg->{termsys}})) {
			$uniq_sys{$_} = 1;
		}
	}
	push @result, (keys %uniq_sys);
	return \@result;
}

# rl_cmd_completion() - Term::ReadLine completion for ts-shell commands
#
# $text:	Text to complete
# $line:	Line buffer
# $start:	offset
#
sub rl_cmd_completion($$$)
{
	my ($text, $line, $start) = @_;
	my @cmds = qw/help version list connect terminal quit exit/;

	# complete commands
	return grep (/^$text/, @cmds) unless $start;

	# complete terminal names for service and optionally for connect command
	if ($line =~ /^(?:terminal|connect\s+\w+)\s+(?:\w+)?$/) {
		return grep (/^$text/, @{$config{services}});
	}

	# complete systems for connect command
	if ($line =~ /^connect\s+(\w+)?$/) {
		my $systems = [];	# list ref for completion

		# complete for simple lists
		if (@{$config{systems}}) {
			foreach my $sys (@{$config{systems}}) {
				if (auth_global(\$sys, \%config) > 0) {
					push @$systems, $sys;
				}
			}
		# complete if ts shell uses regex's
		} elsif (@{$config{regex}}) {
			$systems = list_regex_match(\%config);
		}
		return grep {/^$text/} @$systems;
	}
	return ();
}

# start the terminal server shell
&main();

__DATA__
__END__
# vim: set ai noet ts=8 sw=8 tw=80: