#! /usr/bin/env perl

use v5.36;  # builtin, say, signatures
no  warnings 'experimental';
use autodie;

our $etc_ttys      = '/etc/ttys';
our $etc_ttys_orig = '/etc/ttys.orig';

package main                       v0.1.0;
package autologin_tty::common_subs v0.1.0;
package autologin_tty::get         v0.1.0;
package autologin_tty::set         v0.1.0;
package autologin_tty::noautologin v0.1.0;
package autologin_tty::exec        v0.1.0;


package main;

sub version {
	return __PACKAGE__->VERSION  }

sub usage {
	require File::Basename;
	require English;
	my $name = File::Basename::basename( $English::PROGRAM_NAME );
	return <<~ "END";
		usage:
		  $name <subcommand> <arguments>
		  $name -h|--help 
		  $name -v|--version 
		subcommands and arguments:
		  get         <tty|F_key>
		  set         <tty|F_key> <user> <command> [command_args] ...
		  noautologin <tty|F_key> 
		  exec                    <user> <command> [command_args] ... <tty>
		subcommand description:
		  get - print /etc/ttys line for the given tty or F key
		  set - configure /etc/ttys to run a custom command instead of a login prompt
		  noautologin - revert specified tty to default login prompt,
		    original tty config is taken from /etc/ttys.orig
		    which gets created by `set` subcommand; do not delete the .orig file
		  exec - prepare tty and exec command as a given user
		    tty gets auto-appended to arguments by init(1), so 2nd field in /etc/ttys
		    only stores path to this script, user, command and command arguments
		examples:
		  # set ttyC0 on Ctrl+Alt+F1 to autorun interactive ksh as user johndoe, either example:
		    $name set ttyC0 johndoe /bin/ksh -i
		    $name set F1    johndoe /bin/ksh -i
		  # VM console: set tty00 to autorun tmux as root:
		    $name set tty00 root /usr/bin/tmux
		  # revert ttyC0 on Ctrl+Alt+F1 to default login prompt, either example:
		    $name noautologin ttyC0
		    $name noautologin F1
		counter-examples:
		  # `exec` subcommand is to be run automatically at boot, do not run it manually!
		  # prepare tty and exec as configured,
		  # no F key handling here, only direct tty device name:
		    $name exec johndoe /bin/ksh -i   ttyC0
		    $name exec root    /usr/bin/tmux ttyC0
		  # do not try to use quotes to group commands
		  # this will not work due to spacing and quoting working against us
		  # instead, create a wrapper script 
		  # e.g. having exited an autolaunched executable, get into the shell:
		    echo '#! /bin/ksh'  >> /opt/my-prog-autologin
		    echo '/opt/my-prog' >> /opt/my-prog-autologin
		    echo '/bin/ksh -i'  >> /opt/my-prog-autologin
		    chmod +x               /opt/my-prog-autologin
		    $name set ttyC0 root   /opt/my-prog-autologin
		END
	}

sub main( @args ){
	main::argparse( @args )->();  }

sub argparse( @args ){
	for ( CORE::shift @args ){
		return do {
			unless (     defined $_         ){ sub { CORE::print STDERR          main::usage(); CORE::exit 1     }}
			elsif  (m{^  exec            $}x){ sub {                    autologin_tty::exec::main       ( @args )}}
			elsif  (m{^  get             $}x){ sub {                    autologin_tty::get::main        ( @args )}}
			elsif  (m{^  set             $}x){ sub {                    autologin_tty::set::main        ( @args )}}
			elsif  (m{^  noautologin     $}x){ sub {                    autologin_tty::noautologin::main( @args )}}
			elsif  (m{^( -v | --version )$}x){ sub { CORE::say   STDOUT          main::version()                 }} 
			elsif  (m{^( -h | --help    )$}x){ sub { CORE::print STDOUT          main::usage()                   }} 
			else                             { sub { CORE::print STDERR          main::usage(); CORE::exit 1     }}  }}}


package autologin_tty::common_subs;

sub argparse_only_tty( @args ){
	my $result = { ok => builtin::true };

	@args == 1 or do {
		$result->{ok} = builtin::false;
		push $result->{message}->@*, q{Wrong arg count}  };

	my ( $tty ) = @args;
	$tty = autologin_tty::common_subs::F_to_tty( $tty );  # convert e.g. "F1" to "ttyC0"
	unless ( $tty->{ok} ){ $result = $tty }
	else {
	        $tty = $tty->{payload};
		-c "/dev/$tty" or do {
			$result->{ok} = builtin::false;
			push $result->{message}->@*, qq{tty device "/dev/$tty" not found};  }}

	if ( $result->{ok} ){ $result->{payload} = [ $tty ]}
	return $result;  }

sub F_to_tty( $tty ){
	return do {
		unless ( defined $tty ){{
			ok      => builtin::false,
			message => [ qq{Argument <tty|F_key> not specified} ]  }}
		elsif ( 'F' eq CORE::substr( $tty, 0, 1 )){
			my $after_F = CORE::substr( $tty, 1 );
			if ( List::Util::first { $_ == $after_F } 1 .. 6 ){{
				ok      => builtin::true,
				payload => 'ttyC' . do {
					   if ( 1 <= $after_F <= 10 ){ --$after_F }  # 1 .. 6 actually
					elsif (      $after_F == 11 ){ 'a'        }
					elsif (      $after_F == 12 ){ 'b'        }
					else                         { die        }  }}}
			else {{
				ok      => builtin::false,
				message => [ qq{Key "$tty" is not among supported: F1 to F6} ]  }}}
		else {{
			ok      => builtin::true,
			payload => $tty  }}}}

sub read_line( $tty, $file ){
	my $tty_line;
	CORE::open my $filehandle, '<', $file;
	while ( $tty_line = <$filehandle> ){
		last if CORE::substr( $tty_line, 0, CORE::length($tty) ) eq $tty  }
	CORE::close $filehandle;
	return $tty_line;  }

sub set( $tty, $subref ){
	my @lines    = autologin_tty::common_subs::slurp   ( $etc_ttys     );
	my $line_ref = autologin_tty::common_subs::line_ref( $tty, \@lines );
	defined $line_ref or do {
		return {
			ok      => builtin::false,
			message => [ qq{File "$etc_ttys" does not mention tty "$tty"} ]  }};
	$line_ref->$* = $subref->( line_ref => $line_ref );
	autologin_tty::common_subs::spurt( $etc_ttys, @lines );
	return { ok => builtin::true };  }

sub slurp( $file ){
	open my $filehandle, '<', $file;
	my @lines = <$filehandle>;
	close $filehandle;
	return @lines;  }

sub line_ref( $tty, $lines_arrayref ){
	for ( $lines_arrayref->@* ){
		if ( substr( $_, 0, length($tty) ) eq $tty ){
			return \$_;  }}
	return undef;  }

sub spurt( $file, @lines ){
	my ( $filehandle, $file_tmp ) = autologin_tty::set::tempfile( $file );
	# open $filehandle, '>', $file_tmp;
	CORE::print $filehandle @lines;
	CORE::close $filehandle;
	CORE::rename $file_tmp, $file;  }


package autologin_tty::get;

sub main( @args ){
	my $tty;
	my $argparsed = autologin_tty::common_subs::argparse_only_tty( @args );
	if ( $argparsed->{ok} ){( $tty ) = $argparsed->{payload}->@* }
	else {
		CORE::say STDERR $_ for $argparsed->{message}->@*;
		CORE::exit 1  }

	CORE::print autologin_tty::common_subs::read_line( $tty, $etc_ttys );  }


package autologin_tty::set;

my $etc_passwd;

sub main( @args ){
	{	no warnings 'once';  # $English::OSNAME
		require English;
		$English::OSNAME =~ m{^ OpenBSD $}ix or do {
			CORE::say STDERR 'This is an OpenBSD-targeted script and not meant for other OSes. Quitting'; 
			CORE::exit 1;  }};

	require List::Util;  # List::Util::first in sub ttyC_ and group_match

	my ( $tty, $user, @command );
	my $argparsed = autologin_tty::set::argparse( @args );
	if ( $argparsed->{ok} ){( $tty, $user, @command ) = $argparsed->{payload}->@* }
	else {
		CORE::say STDERR $_ for $argparsed->{message}->@*;
		CORE::exit 1  }

	-f $etc_ttys_orig or do {
		require File::Copy;
		File::Copy::copy( $etc_ttys, $etc_ttys_orig );  };

	my $subref = autologin_tty::set::set__tty_line( $tty, $user, \@command );
	my $set    = autologin_tty::common_subs::set          ( $tty, $subref );
	if ( $set->{ok} ){
		CORE::print autologin_tty::common_subs::read_line( $tty, $etc_ttys );  }
	else {
		CORE::say STDERR $_ for $set->{message}->@*;
		CORE::exit 1;  }}

sub argparse( @args ){
	my $result = { ok => builtin::true };

	@args >= 3 or do {
		$result->{ok} = builtin::false;
		push $result->{message}->@*, q{Wrong arg count}  };

	my ( $tty, $user, @command ) = @args;

	$tty = autologin_tty::common_subs::F_to_tty( $tty );  # convert e.g. "F1" to "ttyC0"
	unless ( $tty->{ok} ){
		$result->{ok} = builtin::false;
		push $result->{message}->@*, $_ for $tty->{message}->@*;  }
	else {
	        $tty = $tty->{payload};
		unless ( -c "/dev/$tty" ){
			$result->{ok} = builtin::false;
			push $result->{message}->@*, qq{tty device "/dev/$tty" not found};  }}

	unless ( defined $user ){
		$result->{ok} = builtin::false;
		push $result->{message}->@*, q{Argument <user> not specified}  }
	else {
		unless ( defined ( $etc_passwd = User::pwent::getpwnam( $user ))){
			$result->{ok} = builtin::false;
			push $result->{message}->@*, qq{User "$user" not found};  }}

	unless ( defined $command[0] ){
		$result->{ok} = builtin::false;
		push $result->{message}->@*, q{Argument <command> not specified}  }
	else {
		unless ( -f $command[0] ){
			$result->{ok} = builtin::false;
			push $result->{message}->@*, qq{File "$command[0]" not found};  }
		else {
			unless ( defined $etc_passwd ){ die }  # handled above where $user
			else {
				# this is of no practical help when `$command[0] eq '/usr/bin/env'`
				unless ( autologin_tty::set::may_execute( $command[0] )){
					$result->{ok} = builtin::false;
					push $result->{message}->@*, qq{Command "$command[0]" not executable as user "$user"};  }}}}

	if ( $result->{ok} ){ $result->{payload} = [ $tty, $user, @command ]}
	return $result;  }

sub may_execute( $file_path ){
	require Fcntl;  # Permission constants S_IXUSR, S_IXGRP, S_IXOTH
	require File::stat;
	my $stat        = File::stat::stat( $file_path );
	my $group_match = sub { autologin_tty::set::group_match( $etc_passwd, $stat )};
	return do {
		   if ( $etc_passwd->uid == $stat->uid ){( $stat->mode & Fcntl::S_IXUSR() ) ? builtin::true : builtin::false }
		elsif ( $group_match->()               ){( $stat->mode & Fcntl::S_IXGRP() ) ? builtin::true : builtin::false }
		else                                    {( $stat->mode & Fcntl::S_IXOTH() ) ? builtin::true : builtin::false }  }}

sub group_match( $etc_passwd, $stat ){
	# files have exactly one group,
	# users have exactly one primary group and an arbitrary number of supplementary groups,
	# any user group to file group match defines permission to run the file

	require User::grent;  # `getgrgid` to read /etc/group
	my $supplementary_group_match = sub {
		List::Util::first
			{ $_ eq $etc_passwd->name }
			User::grent::getgrgid( $stat->gid )->members->@*  };
	return do {
		   if ( $etc_passwd->gid == $stat->gid ){ builtin::true  }
		elsif ( $supplementary_group_match->() ){ builtin::true  }
		else                                    { builtin::false }  }}

sub set__tty_line( $tty, $user, $command_arrayref ){
	return sub( %args ){
		my ( undef, undef, $type, undef ) = CORE::split m{\t+}, $args{line_ref}->$*;
		my $command;
		{	no warnings 'once';  # $English::PROGRAM_NAME
			$command = CORE::join ' ', $English::PROGRAM_NAME, 'exec', $user, $command_arrayref->@*;
			$command = CORE::join  '', '"', $command, '"';  }
		return CORE::join "\t", $tty, $command, $type, ('on' . "\n");  }}

sub tempfile( $file ){
	require File::Spec::Functions;
	require File::Temp;

	my ( undef, $dir, $basename ) = File::Spec::Functions::splitpath( $file );
	return File::Temp::tempfile(
		($basename . '.XXXXXX'),
		DIR    => $dir,
		SUFFIX => '.tmp',
		UNLINK => builtin::true  );  }


package autologin_tty::noautologin;

sub main( @args ){
	-f $etc_ttys_orig or do {
		CORE::say STDERR qq{File "$etc_ttys_orig" not found.};
		CORE::say STDERR qq{Either no changes were made to "$etc_ttys" - then nothing to do,};
		CORE::say STDERR qq{or "$etc_ttys_orig" has been lost - then can not continue};
		CORE::exit 1;  };

	my $tty;
	my $argparsed = autologin_tty::common_subs::argparse_only_tty( @args );
	if ( $argparsed->{ok} ){( $tty ) = $argparsed->{payload}->@* }
	else {
		CORE::say STDERR $_ for $argparsed->{message}->@*;
		CORE::exit 1  }

	my $subref = autologin_tty::noautologin::set__tty_line( $tty          );
	my $set    = autologin_tty::common_subs::set          ( $tty, $subref );
	if ( $set->{ok} ){
		CORE::print autologin_tty::common_subs::read_line( $tty, $etc_ttys );  }
	else {
		CORE::say STDERR $_ for $set->{message}->@*;
		CORE::exit 1;  }}

sub set__tty_line( $tty ){
	return sub( %args ){
		return autologin_tty::common_subs::read_line( $tty, $etc_ttys_orig );  }}


package autologin_tty::exec;

use Fcntl;                # O_RDWR;
use IO::Tty 'TIOCSCTTY';
use POSIX;                # dup2, setgid, setsid, setuid
use User::pwent;          # `getpwnam` to read /etc/passwd

sub argparse( @args ){
	# checks should have been done by autologin_tty::set package
	# so only arg count check here
	# tty gets auto-appended by init(1), so arg count is +1
	unless ( @args >= 3 ){
		CORE::die 'usage: <user> <command> [command args] ... <tty>' . "\n";  }

	my $dev_tty    = '/dev/' . CORE::pop   @args;  # tty gets auto-appended by init(1)
	my $user       =           CORE::shift @args;
	my @command    =                       @args;
	
	return $dev_tty, $user, @command;  }

sub main( @args ){
	my ( $dev_tty, $user, @command ) = autologin_tty::exec::argparse( @args );

	my $etc_passwd = User::pwent::getpwnam $user;
	my $filehandle;
	my $filedescriptor;

	# Open the physical terminal device for read-write access without truncating it
	CORE::sysopen $filehandle, $dev_tty, Fcntl::O_RDWR;

	# Become a session leader (prereq for TIOCSCTTY)
	# If this fails, you might already be a session leader, which is okay, 
	# but you cannot be in a process group of another session.
	POSIX::setsid;

	# Set the controlling terminal
	# The third argument is ignored for TIOCSCTTY but must be present
	CORE::ioctl $filehandle, TIOCSCTTY, 0;

	# Redirect STDIN, STDOUT, STDERR to the new controlling tty
	$filedescriptor = CORE::fileno $filehandle;
	POSIX::dup2 $filedescriptor, 0;
	POSIX::dup2 $filedescriptor, 1;
	POSIX::dup2 $filedescriptor, 2;
	CORE::close $filehandle;

	POSIX::setgid $etc_passwd->gid;
	POSIX::setuid $etc_passwd->uid;

	$ENV{TERM}  = 'vt220';
	$ENV{USER}  = $user;
	$ENV{HOME}  = $etc_passwd->dir;
	$ENV{SHELL} = $etc_passwd->shell;

	CORE::chdir $ENV{HOME};

	CORE::say qq{as user "$user" exec: }, CORE::join( ' ', @command );
	CORE::exec @command;  }


package main;
main::main @ARGV;