#!/usr/bin/perl
use feature "switch";
use Switch;
use strict;
use warnings;
use perunServicesInit;
use perunServicesUtils;
use MIME::Base64;
use Encode;
no if $] >= 5.017011, warnings => 'experimental::smartmatch';

local $::SERVICE_NAME = "ad_group_mu_ucn";
local $::PROTOCOL_VERSION = "3.0.0";
my $SCRIPT_VERSION = "3.0.5";

sub addMemberToGroup;
sub processWorkplaces;
sub processGroup;
sub createGroup;
sub processTree;
sub writeDebug;

perunServicesInit::init;
my $DIRECTORY = perunServicesInit::getDirectory;
my $fileName = "$DIRECTORY/$::SERVICE_NAME".".ldif";
my $baseDnFileName = "$DIRECTORY/baseDN";

# Get hierarchical data without expired members
my $data = perunServicesInit::getHashedDataWithGroups;
my $DEBUG = 0;

#Constants
our $A_LOGIN; *A_LOGIN = \'urn:perun:user_facility:attribute-def:virt:login';
our $A_F_BASE_DN;  *A_F_BASE_DN = \'urn:perun:facility:attribute-def:def:adBaseDN';
our $A_F_GROUP_BASE_DN;  *A_F_GROUP_BASE_DN = \'urn:perun:facility:attribute-def:def:adGroupBaseDN';
our $A_R_GROUP_NAME;  *A_R_GROUP_NAME = \'urn:perun:resource:attribute-def:def:adGroupName';
our $A_G_GROUP_NAME_COMPUTED; *A_G_GROUP_NAME_COMPUTED = \'urn:perun:group:attribute-def:virt:adGroupName';
# Tree / Workplace / Group (Default)
our $A_R_REPRESENTATION;  *A_R_REPRESENTATION = \'urn:perun:resource:attribute-def:def:adResourceRepresentation';
our $A_MR_V_IS_BANNED;  *A_MR_V_IS_BANNED = \'urn:perun:member_resource:attribute-def:virt:isBanned';
our $A_MEMBER_STATUS; *A_MEMBER_STATUS = \'urn:perun:member:attribute-def:core:status';
our $A_R_ALLOW_INACTIVE;  *A_R_ALLOW_INACTIVE = \'urn:perun:resource:attribute-def:def:allowInactiveMembers';

our $STATUS_VALID;      *STATUS_VALID =        \'VALID';
our $STATUS_EXPIRED;    *STATUS_EXPIRED =      \'EXPIRED';

our $A_R_ADOUNAME; *A_R_ADOUNAME = \'urn:perun:resource:attribute-def:def:adOuName';
our $A_G_INETCISPR; *A_G_INETCISPR = \'urn:perun:group:attribute-def:def:inetCispr';
our $A_G_DESCRIPTION; *A_G_DESCRIPTION = \'urn:perun:group:attribute-def:core:description';
our $A_R_DESCRIPTION; *A_R_DESCRIPTION = \'urn:perun:resource:attribute-def:core:description';

# Default description of group in Active Directory
my $defaultDescription = "no-desc in Perun";
# Default representation of resource in Active Directory
my $defaultRepresentation = "group";

# check uniquness of group names on the same level of tree structure
our $uniqueNamesOfGroupsInTreeStructure = {};

# CHECK ON FACILITY ATTRIBUTES
if (!defined($data->getFacilityAttributeValue( attrName => $A_F_GROUP_BASE_DN ))) {
	exit 1;
}
if (!defined($data->getFacilityAttributeValue( attrName => $A_F_BASE_DN ))) {
	exit 1;
}
my $baseGroupDN = $data->getFacilityAttributeValue( attrName => $A_F_GROUP_BASE_DN );
my $baseDN = $data->getFacilityAttributeValue( attrName => $A_F_BASE_DN );
my $baseDNforSpecial = "OU=Services,OU=Perun,OU=MU,DC=ucn,DC=muni,DC=cz";

#
# PRINT BASE_DN FILE
#
open FILE,">:encoding(UTF-8)","$baseDnFileName" or die "Cannot open $baseDnFileName: $! \n";
print FILE $baseGroupDN;
close(FILE);

our $groups = {};
our $usersByGroups = {};

# FOR EACH RESOURCE
foreach my $resourceId ($data->getResourceIds()) {
	# Default value for representation is "group".
	# Possible values: tree / workplace / group (Default)
	my $representation = lc ($data->getResourceAttributeValue( resource => $resourceId, attrName => $A_R_REPRESENTATION ) || $defaultRepresentation);

	writeDebug("Resource ID: $resourceId (represented as: $representation)", 0);

	switch($representation){
		case "tree"			{processTree($resourceId)}
		case "workplace" 	{processWorkplaces($resourceId)}
		case "group" 		{processGroup($resourceId)}
	}
}

#
# Print group data LDIF
#
open FILE,">:encoding(UTF-8)","$fileName" or die "Cannot open $fileName: $! \n";

for my $group (sort keys %$groups) {

	print FILE "dn: CN=" . $group . "," . $groups->{$group}->{$A_R_ADOUNAME} . "\n";
	print FILE "cn: " . $group . "\n";
	print FILE "samAccountName: " . $group . "\n";
	print FILE "description:" . checkBase64($groups->{$group}->{"description"}) . "\n";
	print FILE "info: perun\@muni.cz\n";
	print FILE "objectClass: group\n";
	print FILE "objectClass: top\n";

	my @groupMembers = sort keys %{$usersByGroups->{$group}};
	for my $member (@groupMembers) {
		print FILE "member: " . $member . "\n";
	}

	# there must be empty line after each entry
	print FILE "\n";

}

close FILE;

perunServicesInit::finalize;

####################
# Helper functions #
####################

sub addMemberToGroup {
	my $memberId = shift;
	my $group = shift;
	my $resourceId = shift;

	my $login = $data->getUserFacilityAttributeValue( member => $memberId, attrName => $A_LOGIN );
	my $isBanned = $data->getMemberResourceAttributeValue( member => $memberId, resource => $resourceId, attrName => $A_MR_V_IS_BANNED );

	my $allowInactiveMembers = $data->getResourceAttributeValue( resource => $resourceId, attrName => $A_R_ALLOW_INACTIVE );
	my $memberStatus = $data->getMemberAttributeValue( member => $memberId, attrName => $A_MEMBER_STATUS );

	# Add only VALID members or EXPIRED members if allowed by Resource
	return unless ( ($memberStatus eq $STATUS_VALID) || (($memberStatus eq $STATUS_EXPIRED) && $allowInactiveMembers) );

	addMember($login, $group, $isBanned)
}

sub processTree {
	my $resourceId = shift;

	foreach my $groupId ( $data->getGroupIdsForResource( resource => $resourceId ) ) {
		writeDebug("Process Tree Group: $groupId", 1);
		my $group = $data->getGroupAttributeValue(group => $groupId, attrName => $A_G_GROUP_NAME_COMPUTED);

		#check if the name is unique through all resources
		if ($uniqueNamesOfGroupsInTreeStructure->{$group}) {
			die "Duplicity of group names in tree structure has been found for name '$group'!\n";
		}
		$uniqueNamesOfGroupsInTreeStructure->{$group} = 1;

		my $description = $data->getGroupAttributeValue( group => $groupId, attrName => $A_G_DESCRIPTION );
		my $adOuName = $data->getResourceAttributeValue( resource => $resourceId, attrName => $A_R_ADOUNAME );

		writeDebug("Obtained data group '$group'.", 2);
		createGroup($group, $description, $adOuName);

		writeDebug("Continue to add members", 3);
		for my $memberId ( $data->getMemberIdsForResourceAndGroup( resource => $resourceId, group => $groupId )) {
			addMemberToGroup($memberId, $group, $resourceId);
		}
	}


}

sub processWorkplaces {
	my $resourceId = shift;

	foreach my $groupId ( $data->getGroupIdsForResource( resource => $resourceId ) ) {
		writeDebug("Process Workplace Group: $groupId", 1);

		my $inetCispr = $data->getGroupAttributeValue( group => $groupId, attrName => $A_G_INETCISPR );
		my $group = "Wplace-$inetCispr";
		my $description = $data->getGroupAttributeValue( group => $groupId, attrName => $A_G_DESCRIPTION );

		writeDebug("Obtained data group '$group'.", 2);
		createGroup($group, $description, undef);

		writeDebug("Continue to add members", 3);
		for my $memberId ( $data->getMemberIdsForResourceAndGroup( resource => $resourceId, group => $groupId )) {
			addMemberToGroup($memberId, $group, $resourceId);
		}
	}
}

sub processGroup {
	my $resourceId = shift;

	my $group = $data->getResourceAttributeValue( resource => $resourceId, attrName => $A_R_GROUP_NAME );
	my $description = $data->getResourceAttributeValue( resource => $resourceId, attrName => $A_R_DESCRIPTION );
	my $adOuName = $data->getResourceAttributeValue( resource => $resourceId, attrName => $A_R_ADOUNAME );

	writeDebug("Process Standard Group: '$group'", 1);
	createGroup($group, $description, $adOuName);

	writeDebug("Continue to add members", 3);
	foreach my $memberId ($data->getMemberIdsForResource( resource => $resourceId )) {
		addMemberToGroup($memberId, $group, $resourceId);
	}
}

sub createGroup {
	my $name = shift;
	my $description = shift;
	my $adOuName = shift;

	# Ensure that there is one group with specific name
	$groups->{$name}->{"description"} =  $description || $defaultDescription;
	# Is expected that adOuName and baseGroupDN cotains valid DN.
	# The groups can be created in custom DN path, if the adOuName is not specified
	# baseGroupDN should be used.
	$groups->{$name}->{$A_R_ADOUNAME} = $adOuName || $baseGroupDN;
	writeDebug("Group created", 3);
}

sub addMember {
	my $login = shift;
	my $group = shift;
	my $isBanned = shift;

	#skip banned members
	return if $isBanned;

	# allow only UČO, 9UČO and s-[smth] logins

	if ($login =~ /^9[0-9]{6}$/ or $login =~ /^[0-9]{1,6}$/) {

		# store UČO and 9UČO users
		$usersByGroups->{$group}->{"CN=" . $login . "," . $baseDN} = 1

	} elsif ($login =~ /^s-/) {

		# store "s-[something]" users - hack to be compatible with existing accounts
		$usersByGroups->{$group}->{"CN=" . $login . "," . $baseDNforSpecial} = 1

	}
}

sub writeDebug {
	my $message = shift;
	my $indentation = shift;

	return unless $DEBUG;

	print "\t" x $indentation;
	print $message . "\n";
}

# method checks if value starts with SAFE-INIT-CHAR and then continue with SAFE-CHAR
# if not then it encode to Base64 with ":: " prefix
sub checkBase64 {
	my $value = shift;

	if ($value =~ /^[\x01-\x09\x0B-\x0C\x0E-\x1F\x21-\x39\x3B\x3D-\x7F][\x01-\x09\x0B-\x0C\x0E-\x7F]*$/){
		return " " . $value;
	}
	return ": " . encode_base64(Encode::encode_utf8($value), '');
}
