#!/usr/bin/perl -w
#------------------------------------------------------------------------------
# Location LDAP configuration CGI
#------------------------------------------------------------------------------

use strict;
use utf8;
use CGI;
use HTML::Template;
use TF::CommonUtils;
use TF::SingleLock;

binmode(STDOUT, ":utf8");

my $LOCATION = $ENV{'TF_LOCATION'} || '';
my $BRAND = $ENV{'TF_BRANDNAME'} || '';
my $TF_VERSION = $ENV{'TF_VERSION'} || '';
my $USERTYPE = $ENV{'TF_USERTYPE'} || 'normal';
my $LANGPARAM = TF::CommonUtils::getLangPriority();
my $TF_TOKEN = $ENV{'TF_TOKEN'} || undef;
my $CONFIG_ROOT = $ENV{'TF_CONFIG_ROOT'} || '/usr/local/teamfile/www/conf/conf.d';
my $LOCATION_NAME = $LOCATION;
$LOCATION_NAME =~ s/\///g;

my $TEMPLATE_NAME = 'ldapconf.tmpl.' . $LANGPARAM;
my $SETTINGS_URI = $LOCATION . '/.cgi-bin/admin/settings';
my $OVERRIDE_DIR = $CONFIG_ROOT . '/location-overrides/' . $LOCATION_NAME;
my $OVERRIDE_FILE = $OVERRIDE_DIR . '/ldap.conf';
my $BASE_FILE = $CONFIG_ROOT . '/new_' . $LOCATION_NAME . '.conf';
my $SERVER_DEFAULT_FILE = $CONFIG_ROOT . '/mod_dav_tf.conf.default';
my $SERVER_FILE = $CONFIG_ROOT . '/mod_dav_tf.conf';
my $LOCK_FILE = $OVERRIDE_DIR . '/.ldapconf.lock';

my @SECTIONS = (
	{ key => 'status', label_ja => '利用状態', label_en => 'Status' },
	{ key => 'connection', label_ja => '接続先', label_en => 'Connection' },
	{ key => 'search', label_ja => 'ユーザ検索', label_en => 'User search' },
	{ key => 'mapping', label_ja => '属性マッピング', label_en => 'Attribute mapping' },
	{ key => 'behavior', label_ja => '連携動作', label_en => 'Integration behavior' },
	{ key => 'exclude', label_ja => '除外ユーザ', label_en => 'Excluded users' },
);

my @DIRECTIVES = (
	def('TfLDAP', 'status', 'LDAP連携', 'LDAP integration', 'flag', 'off'),
	def('TfLDAPHost', 'connection', 'LDAPホスト', 'LDAP host', 'host', ''),
	def('TfLDAPHostPort', 'connection', 'ポート番号', 'Port', 'port', '389'),
	def('TfLDAPSSLSupport', 'connection', 'TLSを使用する', 'Use TLS', 'flag', 'off'),
	def('TfLDAPBaseDN', 'connection', 'Base DN', 'Base DN', 'text', ''),
	def('TfLDAPBindDN', 'connection', 'Bind DN', 'Bind DN', 'text', ''),
	def('TfLDAPBindPW', 'connection', 'Bindパスワード', 'Bind password', 'password', ''),
	def('TfLDAPUrl', 'connection', 'LDAP URL（高度な設定）', 'LDAP URL (advanced)', 'optional', ''),
	def('TfLDAPAttr', 'search', 'ログインID属性', 'Login ID attribute', 'attribute', 'uid'),
	def('TfLDAPFilter', 'search', '検索フィルタ', 'Search filter', 'text', 'objectclass=*'),
	def('TfLDAPScope', 'search', '検索範囲', 'Search scope', 'scope', 'sub'),
	def('TfLDAPMapUserAttr', 'mapping', 'ユーザID属性', 'User ID attribute', 'attribute', 'uid'),
	def('TfLDAPMapPasswordAttr', 'mapping', 'パスワード属性（高度な設定）', 'Password attribute (advanced)', 'optionalAttribute', 'userPassword'),
	def('TfLDAPMapFullNameAttr', 'mapping', '氏名属性', 'Full name attribute', 'attribute', 'CN'),
	def('TfLDAPMapMailAddAttr', 'mapping', 'メールアドレス属性', 'Mail attribute', 'attribute', 'mail'),
	def('TfLDAPMapCommentAttr', 'mapping', 'コメント属性', 'Comment attribute', 'optionalAttribute', 'description'),
	def('TfLDAPFoundCreate', 'behavior', '初回ログイン時にユーザを作成', 'Create user on first login', 'flag', 'on'),
	def('TfLDAPSyncProperty', 'behavior', 'LDAP属性を同期', 'Synchronize LDAP attributes', 'flag', 'on'),
	def('TfLDAPOptions', 'behavior', 'ユーザ作成オプション', 'User creation options', 'text', 'NotUserFolder NotDBFolder NotReposDBFolder UserNotFoundAction=disable NotGroupFolder MaxQuota=1024000'),
	def('TfLDAPAllowUser', 'exclude', '除外ユーザ', 'Excluded users', 'text', 'root ._sysexec_ .unknown_user'),
	def('TfLDAPAllowUserRegEx', 'exclude', '除外ユーザ正規表現', 'Excluded user regular expression', 'optional', ''),
);

my @SERVER_DIRECTIVES = qw(TfLDAPCacheByte TfLDAPShmPath TfLDAPCacheTTL
	TfLDAPMaxMemBlocks TfLDAPMarkPercentage TfLDAPPurgePercentage
	TfLDAPCertAuthFile TfLDAPCertFileType TfLDAPSSLSupport);

my %MSG = $LANGPARAM eq 'ja' ? (
	invalid => '値が不正です', write => '設定の書き込みに失敗しました',
	nowrite => '設定ディレクトリに書き込みできません', busy => 'サーバがビジーです',
	saved => '設定を保存しました。反映にはApacheのgraceful restartが必要です。',
) : (
	invalid => 'Invalid value.', write => 'Failed to write settings.',
	nowrite => 'The settings directory is not writable.', busy => 'The server is busy.',
	saved => 'Settings were saved. An Apache graceful restart is required to apply them.',
);

if (!$LOCATION || $USERTYPE ne 'admin') {
	TF::CommonUtils::showAccessDeny();
	die '';
}

my $cgi = CGI->new;
if (!$cgi || $cgi->cgi_error) {
	TF::CommonUtils::showErrorPage($MSG{invalid}, $LANGPARAM);
	exit;
}

if (($cgi->param('hidCmd') || '') eq 'set') {
	storeSettings($cgi);
} else {
	showResponse($cgi, '');
}

sub def {
	my ($key, $section, $ja, $en, $type, $default) = @_;
	return { key => $key, section => $section, label_ja => $ja, label_en => $en,
		type => $type, default => $default };
}

sub storeSettings {
	my $cgi = shift;
	if (!defined $TF_TOKEN || ($cgi->param('hidcsrftoken') || '') ne $TF_TOKEN) {
		TF::CommonUtils::showErrorPage($MSG{invalid}, $LANGPARAM);
		return;
	}

	my %values;
	my %override;
	readDirectiveFile($OVERRIDE_FILE, \%override, 0);
	foreach my $item (@DIRECTIVES) {
		my $key = $item->{key};
		my $value = TF::CommonUtils::decodeUTF8($cgi->param($key) || '');
		$value =~ s/^\s+|\s+$//g;
		if ($item->{type} eq 'password' && $value eq '') {
			$values{$key} = $override{$key} if defined $override{$key};
			next;
		}
		if (!validateValue($item, $value)) {
			showResponse($cgi, "$MSG{invalid} ($key)");
			return;
		}
		$values{$key} = $value if $value ne '';
	}
	ensureRequiredExcludedUsers(\$values{'TfLDAPAllowUser'});
	if (lc($values{'TfLDAP'} || 'off') eq 'on'
		&& (!$values{'TfLDAPBaseDN'} || (!$values{'TfLDAPHost'} && !$values{'TfLDAPUrl'}))) {
		showResponse($cgi, $MSG{invalid} . ' (TfLDAPBaseDN / TfLDAPHost / TfLDAPUrl)');
		return;
	}

	if (!-d $OVERRIDE_DIR && !mkdirParents($OVERRIDE_DIR)) {
		TF::CommonUtils::showErrorPage($MSG{write}, $LANGPARAM);
		return;
	}
	if (!-w $OVERRIDE_DIR) {
		TF::CommonUtils::showErrorPage($MSG{nowrite}, $LANGPARAM);
		return;
	}
	my $lock = TF::SingleLock->new($LOCK_FILE);
	if (!$lock->waitForLocking(5)) {
		TF::CommonUtils::showErrorPage($MSG{busy}, $LANGPARAM);
		return;
	}
	my $tmp = $OVERRIDE_FILE . ".$$.tmp";
	if (!open(my $fh, '>', $tmp)) {
		$lock->release();
		TF::CommonUtils::showErrorPage($MSG{write}, $LANGPARAM);
		return;
	} else {
		binmode($fh, ':utf8');
		print $fh "# This file is managed by TeamFile CGI.\n# Location: $LOCATION_NAME\n\n";
		foreach my $item (@DIRECTIVES) {
			my $key = $item->{key};
			next if !defined $values{$key};
			print $fh sprintf("%-26s %s\n", $key, formatApacheValue($key, $values{$key}));
		}
		close($fh);
	}
	chmod(0600, $tmp);
	if (!rename($tmp, $OVERRIDE_FILE)) {
		unlink($tmp);
		$lock->release();
		TF::CommonUtils::showErrorPage($MSG{write}, $LANGPARAM);
		return;
	}
	$lock->release();
	showResponse($cgi, $MSG{saved});
}

sub showResponse {
	my ($cgi, $status) = @_;
	my %values;
	readDirectiveFile($BASE_FILE, \%values, 0);
	readDirectiveFile($OVERRIDE_FILE, \%values, 0);
	my %server;
	readDirectiveFile($SERVER_DEFAULT_FILE, \%server, 1);
	readDirectiveFile($SERVER_FILE, \%server, 1);

	my @sections;
	foreach my $section (@SECTIONS) {
		my @rows;
		foreach my $item (@DIRECTIVES) {
			next if $item->{section} ne $section->{key};
			my $value = defined $values{$item->{key}} ? $values{$item->{key}} : $item->{default};
			$value = '' if $item->{type} eq 'password';
			push @rows, rowFor($item, $value, exists $values{$item->{key}});
		}
		push @sections, { title => localized($section), rows => \@rows };
	}
	my @server_rows;
	foreach my $key (@SERVER_DIRECTIVES) {
		push @server_rows, { key => $key, value => escape(defined $server{$key} ? $server{$key} : '-') };
	}

	my $template = findTemplateFile($TEMPLATE_NAME);
	my $fh;
	if (!open($fh, '<', $template)) {
		TF::CommonUtils::showTemplateOpenErr($LANGPARAM);
		return;
	}
	binmode($fh, ':utf8');
	my $html = HTML::Template->new(filehandle => $fh, case_sensitive => 1, die_on_bad_params => 0);
	$html->param(brandname => $BRAND, backUri => $SETTINGS_URI, token => $TF_TOKEN,
		tfversion => $TF_VERSION,
		status => $status, sections => \@sections, serverSettings => \@server_rows,
		passwordConfigured => (defined $values{TfLDAPBindPW} && $values{TfLDAPBindPW} ne '') ? 1 : 0);
	print $cgi->header(-charset => 'utf-8');
	print $html->output;
	close($fh);
}

sub rowFor {
	my ($item, $value, $configured) = @_;
	return {
		key => $item->{key}, label => localized($item), value => escape($value),
		isToggle => $item->{key} eq 'TfLDAP' || $item->{key} eq 'TfLDAPSSLSupport',
		isFlag => $item->{type} eq 'flag' && $item->{key} ne 'TfLDAP' && $item->{key} ne 'TfLDAPSSLSupport',
		isScope => $item->{type} eq 'scope',
		isPassword => $item->{type} eq 'password', isText => $item->{type} !~ /^(flag|scope|password)$/,
		isAllowUsers => $item->{key} eq 'TfLDAPAllowUser',
		isPlainText => $item->{type} !~ /^(flag|scope|password)$/ && $item->{key} ne 'TfLDAPAllowUser',
		onSelected => lc($value) eq 'on', offSelected => lc($value) ne 'on',
		baseSelected => lc($value) eq 'base', oneSelected => lc($value) eq 'one', subSelected => lc($value) eq 'sub',
		configured => $configured,
		passwordPlaceholder => $LANGPARAM eq 'ja'
			? ($configured ? '設定済み（変更時のみ入力）' : '未設定')
			: ($configured ? 'Configured (enter only to change)' : 'Not configured'),
	};
}

sub validateValue {
	my ($item, $value) = @_;
	return 0 if $value =~ /[\r\n\0]/;
	# Empty location values are omitted and continue to inherit the base setting.
	return 1 if $value eq '';
	return $value =~ /^(on|off)$/i if $item->{type} eq 'flag';
	return $value =~ /^(base|one|sub)$/i if $item->{type} eq 'scope';
	return $value =~ /^\d+$/ && $value >= 1 && $value <= 65535 if $item->{type} eq 'port';
	return $value =~ /^[A-Za-z][A-Za-z0-9._;-]*$/ if $item->{type} =~ /Attribute$/i || $item->{type} eq 'attribute';
	return $value =~ /^[A-Za-z0-9._:-]+$/ if $item->{type} eq 'host';
	return validateAllowUsers($value) if $item->{key} eq 'TfLDAPAllowUser';
	return validateOptions($value) if $item->{key} eq 'TfLDAPOptions';
	if ($item->{key} eq 'TfLDAPAllowUserRegEx' && $value ne '') {
		return eval { qr/$value/; 1 } ? 1 : 0;
	}
	return 1;
}

sub readDirectiveFile {
	my ($path, $values, $server_only) = @_;
	return if !$path || !-f $path || !open(my $fh, '<', $path);
	while (my $line = <$fh>) {
		$line =~ s/^\s+|\s+$//g;
		next if $line eq '' || $line =~ /^#/;
		next if $line !~ /^([A-Za-z][A-Za-z0-9]*)\s+(.+?)\s*$/;
		my ($key, $value) = ($1, $2);
		next if $server_only ? !isServerDirective($key) : !isLocationDirective($key);
		$value =~ s/\s+#.*$//;
		$value =~ s/^"(.*)"$/$1/;
		$value =~ s/^'(.*)'$/$1/;
		$values->{$key} = $value;
	}
	close($fh);
}

sub isLocationDirective { my $key = shift; foreach (@DIRECTIVES) { return 1 if $_->{key} eq $key; } return 0; }
sub isServerDirective { my $key = shift; foreach (@SERVER_DIRECTIVES) { return 1 if $_ eq $key; } return 0; }
sub localized { my $item = shift; return $item->{'label_' . $LANGPARAM} || $item->{label_en} || ''; }
sub escape {
	my $value = defined $_[0] ? $_[0] : '';
	return '0' if $value eq '0';
	return scalar TF::CommonUtils::escapeHTML($value, 0);
}

sub ensureRequiredExcludedUsers {
	my $value_ref = shift;
	my @users = grep { $_ ne '' } split(/\s+/, defined $$value_ref ? $$value_ref : '');
	my %seen = map { $_ => 1 } @users;
	foreach my $required (qw(root ._sysexec_ .unknown_user)) { push @users, $required if !$seen{$required}; }
	$$value_ref = join(' ', @users);
}

sub validateAllowUsers {
	my $value = shift;
	my @users = grep { $_ ne '' } split(/\s+/, $value);
	return 0 if !@users;
	foreach my $user (@users) { return 0 if $user !~ /^[-A-Za-z0-9_.@]+$/; }
	return 1;
}

sub validateOptions {
	my $value = shift;
	my @options = grep { $_ ne '' } split(/\s+/, $value);
	return 0 if !@options;
	foreach my $option (@options) {
		next if $option =~ /^(?:NotUserFolder|NotGroupFolder|NotDBFolder|NotReposDBFolder)$/i;
		next if $option =~ /^MaxQuota=\d+$/i;
		next if $option =~ /^UserNotFoundAction=(?:delete|disable)$/i;
		return 0;
	}
	return 1;
}

sub formatApacheValue {
	my ($key, $value) = @_;
	# AP_INIT_ITERATE directives must receive separate Apache arguments.
	return $value if $key eq 'TfLDAPAllowUser' || $key eq 'TfLDAPOptions';
	return quoteApacheValue($value);
}

sub quoteApacheValue {
	my $value = shift;
	if ($value =~ /[\s"#]/) { $value =~ s/\\/\\\\/g; $value =~ s/"/\\"/g; return '"' . $value . '"'; }
	return $value;
}

sub mkdirParents {
	my $dir = shift;
	my $path = '';
	foreach my $part (split(/\//, $dir)) {
		next if $part eq '';
		$path .= '/' . $part;
		next if -d $path;
		return 0 if !mkdir($path);
		chmod(0777, $path);
	}
	return 1;
}

sub findTemplateFile {
	my $name = shift;
	foreach my $path ("./tmpl/$name", "../tmpl/$name") { return $path if -f $path; }
	return "./tmpl/$name";
}
