package Debian::Adduser::Backend::Kerberos5;

# Handle actions in Krb5.

# Copyright (C) 2006-2008 Davor Ocelic <docelic@mail.inet.hr>

use strict;
use warnings;

require Exporter;

use Debian::Adduser::Init qw/:gettext :exprs/;
use Debian::Adduser::Common qw/invalidate_nscd checkname :exec :check/;
use Debian::Adduser::Common qw/user_is_member :reporting/;
use Debian::Adduser::Common qw/:find_ids ch_gecos ask_passwd/;
use Debian::Adduser::Config qw/:cfg/;

our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw( ) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw( );

sub new {
	my $class = shift;
	my $self  = {};

	bless $self, $class;
}


###########################################################################
# Add user
#
sub adduser_check {
	WU 'new_user', R('ARGV0');

	printv q{Going to add Kerberos5 principal `%s' ...}, R('new_user');

	if (defined getkrbnam(R 'new_user')){
		dief q{The Kerberos5 principal `%s' already exists.}, R('new_user')
	}

	if (R 'new_policy' and not defined getkrbpol(R 'new_policy')){
		dief q{The Kerberos5 policy `%s' does not exist.}, R('new_policy')
	}

    1
}

sub adduser_exec_check { 1 }

sub adduser_execute {
	my $princ = R 'new_user';
	my $policy = R 'new_policy' ? '-policy ' . R 'new_policy' : '';

	my @cmd = (
      R 'cmd_sudo', R 'cmd_kadmin',
			( R 'authname' ? ( '-p', R 'authname' ) : undef ),
			( R 'authpw'   ? ( '-w', R 'authpw'   ) : undef ),
      '-q', 'ank '   . $policy . ' -randkey ' . $princ ,
		);
	@cmd = grep { defined } @cmd;

	my @undocmd = (
      R 'cmd_sudo', R 'cmd_kadmin',
			( R 'authname' ? ( '-p', R 'authname' ) : undef ),
			( R 'authpw'   ? ( '-w', R 'authpw' )   : undef ),
      '-q', 'delprinc -force ' . $princ                ,
		);
	@undocmd = grep { defined } @undocmd;

	invoke
		[ q{Adding Kerberos5 principal `%s' ...}, R('new_user')      ],
		[ @cmd                                                       ],
		[ @undocmd                                                   ];

		# Deal with passphrase
    if (!R 'found_sys_opt' and R 'ask_passwd' and !R 'new_passwd') {
        printv q{Setting user's Kerberos password ...};

        W 'new_passwd', ask_passwd('new user password');
    }

		my $pw = R 'new_passwd';

		if ($pw) { $pw = "-pw $pw" }
		else { $pw = '-randkey' }

	@cmd = (
      R 'cmd_sudo', R 'cmd_kadmin',
			( R 'authname' ? ( '-p', R 'authname' ) : undef ),
			( R 'authpw'   ? ( '-w', R 'authpw' )   : undef ),
      '-q', 'cpw ' . $pw . ' ' . $princ                ,
		);
	@cmd = grep { defined } @cmd;

	invoke
		[ q{Setting user's Kerberos5 password ...}                   ],
		[ @cmd                                                       ];

	1
}


###########################################################################
# Delete user
#
sub deluser_check {
	WU 'existing_user', R('ARGV0');

	printv q{Going to delete Kerberos5 principal `%s' ...}, R('existing_user');

	if (!defined getkrbnam(R 'existing_user')){
		dief q{The Kerberos5 principal `%s' does not exist.}, R('existing_user')
	}

	# Save kerberos policy for the user. We will need it for undo action.
	my $output = '';

	my @cmd = (
      R 'cmd_sudo', R 'cmd_kadmin',
			( R 'authname' ? ( '-p', R 'authname' ) : undef ),
			( R 'authpw'   ? ( '-w', R 'authpw'   ) : undef ),
      '-q', 'getprinc ' . R 'existing_user'            ,
		);
	@cmd = grep { defined } @cmd;

	systemcall @cmd, { output => \$output };

	$output =~ /^Policy: (\S+)/s;
	if ( defined $1 and $1 ne '[none]' ) { WU 'existing_policy', $1 }

  1
}

sub deluser_execute {
	my $princ = R 'existing_user';
	my $policy = R 'existing_policy' ? '-policy ' . R 'existing_policy' : '';

	my @cmd = (
      R 'cmd_sudo', R 'cmd_kadmin',
			( R 'authname' ? ( '-p', R 'authname' ) : undef ),
			( R 'authpw'   ? ( '-w', R 'authpw' )   : undef ),
      '-q', 'delprinc -force ' . $princ                ,
		);
	@cmd = grep { defined } @cmd;

	my @undocmd = (
      R 'cmd_sudo', R 'cmd_kadmin',
			( R 'authname' ? ( '-p', R 'authname' ) : undef ),
			( R 'authpw'   ? ( '-w', R 'authpw'   ) : undef ),
      '-q', 'ank '   . $policy . ' -randkey ' . $princ ,
		);
	@undocmd = grep { defined } @undocmd;

	invoke
		[ q{Deleting Kerberos5 principal `%s' ...}, R('existing_user') ],
		[ @cmd                                                         ],
		[ @undocmd                                                     ];

	1
}

*delsysuser_check = \*deluser_check;
*delsysuser_execute = \*deluser_execute;
*addsysuser_check = \*adduser_check;
*addsysuser_execute = \*adduser_execute;
*addsysuser_exec_check = \*adduser_exec_check;

########################################################################
# Helpers below

sub getkrbnam {
    my $princ = shift;

		my $output = '';

		my @cmd = (
        R 'cmd_sudo', R 'cmd_kadmin',
				( R 'authname' ? ( '-p', R 'authname' ) : undef ),
				( R 'authpw'   ? ( '-w', R 'authpw' )   : undef ),
        '-q', 'getprinc ' . $princ                       ,
			);
		@cmd = grep { defined } @cmd;

		systemcall @cmd, { output => \$output };

		if ( $output =~
			/^get_principal: Principal does not exist while retrieving/) {
				return undef;
		}
		1
}

sub getkrbpol {
    my $pol = shift;

		my $output = '';

		my @cmd = (
        R 'cmd_sudo', R 'cmd_kadmin',
				( R 'authname' ? ( '-p', R 'authname' ) : undef ),
				( R 'authpw'   ? ( '-w', R 'authpw' )   : undef ),
        '-q', 'getpol ' . $pol                           ,
			);
		@cmd = grep { defined } @cmd;

		systemcall @cmd, { output => \$output };

		if ( $output =~
			/^get_policy: Policy does not exist while retrieving policy/) {
				return undef;
		}
		1
}


