#!/usr/bin/perl -wT
#
# TWiki Enterprise Collaboration Platform, http://TWiki.org/
#
# Copyright (C) 2005 Garage Games
# Copyright (C) 2005-2007 Crawford Currie http://c-dot.co.uk
# and TWiki Contributors.
# 
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version. For
# more details read LICENSE in the root of this distribution.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
#
# As per the GPL, removal of this notice is prohibited.


BEGIN {
    # Set default current working directory (needed for mod_perl)
    if( $ENV{"SCRIPT_FILENAME"} && $ENV{"SCRIPT_FILENAME"} =~ /^(.+)\/[^\/]+$/ ) {
        chdir $1;
    }
    # Set library paths in @INC, at compile time
    unshift @INC, '.';
    require 'setlib.cfg';
}

use Unicode::MapUTF8;
use MIME::Base64;
use TWiki::UI;
use TWiki::Users;


# Shibboleth adaptions implemented 
# by Lukas Haemmerle (SWITCH), lukas.haemmerle@switch.ch
# 2008.01.27:  Updated version with GMT support

######################################################################
#                     START EDIT SECTION
###################################################################### 

# Names of Shibboleth attribute in environment (%ENV)
my $ShibGivenName = 'givenName';
my $ShibSurname = 'surname';
my $ShibEmail = 'mail';
my $ShibIdentifier = 'uniqueID';
my $ShibHomeOrg = 'homeOrganization';
my $ShibAddress = 'postalAddress';

######################################################################
#                     END EDIT SECTION
######################################################################   

######################################################################
#                     GMT START EDIT SECTION
###################################################################### 
=head
# Uncomment this if you want to use the SWITCH Group Management Tool (GMT) 
# in order to add users to TWiki groups based on GMT information
# Also see: http://www.switch.ch/aai/support/tools/gmt.html

use gmt_mod;

$GMTHost = "www.switch.ch";
$GMTPort = "80";
$GMTPath = "/gmt/interface/index.php";
$GMTSharedKey="41a9d9e4e89b6469f720997572bcf81c070d188c56b4d5059184bde4849de351";

# Create new object (host, port, path_to_mod_interface)
$GMT = GMT->new($GMTHost, $GMTPort, $GMTPath, $GMTSharedKey);


%GMT2TWikiMapping = ( 
	'Lib-Cons', 'LibConsGroup',
	'SWITCH_general', 'SwitchGroup',
	);
=cut

######################################################################
#                     GMT END EDIT SECTION
######################################################################   

my $TwikiFirstName = Unicode::MapUTF8::from_utf8({ -string => $ENV{$ShibGivenName}, -charset => 'ISO-8859-1' }) || '';

my $TwikiSurName = Unicode::MapUTF8::from_utf8({ -string => $ENV{$ShibSurname}, -charset => 'ISO-8859-1' }) || '';

my $TwikiEmail = Unicode::MapUTF8::from_utf8({ -string => $ENV{$ShibEmail}, -charset => 'ISO-8859-1' }) || 'aai@switch.ch';

my $TwikiCompany = Unicode::MapUTF8::from_utf8({ -string => $ENV{$ShibHomeOrg}, -charset => 'ISO-8859-1' }) || '';

 # Modify the company name (remove the tld part and make uppercase)
$TwikiCompany =~ /^([^.]+)[.]+([^ .]+)$/;
$TwikiCompany = uc($1); 

my $TwikiCountry = 'Switzerland';

my $TwikiCompanyURL = 'http://www.'.Unicode::MapUTF8::from_utf8({ -string => $ENV{$ShibHomeOrg}, -charset => 'ISO-8859-1' }).'/'  || 'Unknown';

my $TwikiCity = Unicode::MapUTF8::from_utf8({ -string => $ENV{$ShibAddress}, -charset => 'ISO-8859-1' }) || 'Unknown';
$TwikiCity =~ s/\$/, /g;

my $ShibUserID = Unicode::MapUTF8::from_utf8({ -string => $ENV{ $ShibIdentifier}, -charset => 'ISO-8859-1' }) || '';

my $TwikiHearWhere = '';

my $TwikiComment = 'I am a wiki user from '.$TwikiCompany;

my $TwikiDefaultGroup = 'SwitchGroup';

$query = new CGI();


# Check wether we have enough information to at least generate
# a valid wikiname
if (
	! $ENV{$ShibGivenName} ||
	  $ENV{$ShibGivenName} eq '' ||
	! $ENV{$ShibSurname} ||
	  $ENV{$ShibSurname} eq '' ||
	! $ENV{$ShibIdentifier} ||
	  $ENV{$ShibIdentifier} eq ''  
	)
{
	&printError('Unable to create a valid Wiki name', 
	'This version of TWIKI was adapted to work with Shibboleth. 
To properly work, it is required that TWiki has access to some attribute provided
by Shibboleth (e.g. your first name, last name and a unique identifier at minimum).
Unfortunately some or all information is missing. Maybe becuase your home 
organization (e.g. your university) cannot provide some attribute or because the 
Service Provider is not configured properly.
Please contact the administrator of this TWiki instance.');

}

# The WikiName should be unique, so this will generate WikiNames for 
# multiple users with the same name like this: LukasHaemmerle, LukasHaemmerle1, LukasHaemmerle2, ...

my $UserList = '../data/.htpasswd';
my %TwikiUserMap;
open(READ,$UserList) or &printError('Error Opening File', '
Error while opening TWiki user mapping file '.$UserList.': '.$!.'
Please contact the administrator of this TWiki instance.');

while(defined($i = <READ>)) 
{
	chop($i);
	@record = split(/:/, $i);
	$TwikiUserMap{$record[2]} = $record[0];
}
close(READ);


# Check wether this user already has an entry in user map
if (!$TwikiUserMap{$ShibUserID}){
	
	# Generation of the WikiName is not trivial because
	# the WikiName must follow a certain syntax and
	# is used as part of an URL. Therefore we generate
	# a temporary first and surname
	my $tfn = $TwikiFirstName;
	my $tsn = $TwikiSurName;

	# Replace some exotic characters that could be part of the name
	%ISO_8859_1_ACCENT_FILTERS = (
			192 => 'A', 193 => 'A', 194 => 'A', 195 => 'A', 196 => 'Ae', 197 => 'A', 
			198 => 'AE', 199 => 'C', 
			200 => 'E', 201 => 'E', 202 => 'E', 203 => 'E',
			204 => 'I', 205 => 'I', 206 => 'I', 207 => 'I',
			209 => 'N', 
			210 => 'O', 211 => 'O', 212 => 'O', 213 => 'O', 214 => 'Oe', 216 => 'O',
			217 => 'U', 218 => 'U', 219 => 'U', 220 => 'Ue', 
			221 => 'Y', 223 => 'ss',
			224 => 'a', 225 => 'a', 226 => 'a', 227 => 'a', 228 => 'ae', 229 => 'a',
			230 => 'ae', 231 => 'c',
			232 => 'e', 233 => 'e', 234 => 'e', 235 => 'e',
			236 => 'i', 237 => 'i', 238 => 'i', 239 => 'i',
			241 => 'n',
			242 => 'o', 243 => 'o', 244 => 'o', 245 => 'o', 246 => 'oe', 248 => 'o', 
			249 => 'u', 250 => 'u', 251 => 'u', 252 => 'ue',
			253 => 'y', 255 => 'y'
		);    

	foreach $myOrd (keys(%ISO_8859_1_ACCENT_FILTERS))
	{
		my $x = chr($myOrd);
		my $y = $ISO_8859_1_ACCENT_FILTERS{$myOrd};
		$tfn =~ s/$x/$y/g;
		$tsn =~ s/$x/$y/g;
	   
	}
	
	# Now delete any other non wiki-conform character
	$tfn =~ tr/a-zA-Z0-9//dc;
	$tsn =~ tr/a-zA-Z0-9//dc;
	
	# Make sure that the first letter is uppercase
	$tfn = ucfirst($tfn);
	$tsn = ucfirst($tsn);
	$TwikiName = $tfn.$tsn;
	
	# Now you should have a WikiName like 'LukasHaemmerle';
	my $NameCounter = 1;
	my $tmpTwikiName = $TwikiName;
	
	# We have to check wether the generated WikiName is unique
	# Since all mappings are sequential (UserName, UserName2, UserName3, ...)
	# We have to go through the list only once
	foreach $userID (keys(%TwikiUserMap))
	{
		if (
			$tmpTwikiName eq $TwikiUserMap{$userID} &&
			$userID ne $ShibUserID
			)
		{
			$NameCounter++;
			$tmpTwikiName = $TwikiName.$NameCounter;
		}
	}
	
	# tmpWikiName should now be unique
	$TwikiName = $tmpTwikiName;
	
	
	# The users shouldn't have to deal with passwords
	# since they already are authenticated by Shibboleth
	# Therefore we generate a random password
	my $TwikiPassword = '';
	my $PasswordCharacters = "abcdefghijkmnopqrstuvwxyzABCDEFGHJKLMNPQRSTUVWXYZ23456789-";
	for (my $i = 0; $i < 10; $i++){
		$TwikiPassword .= substr($PasswordCharacters, rand(length($PasswordCharacters)),1);
	}
	
	$TwikiUserMap{$ShibUserID} = $TwikiName;
	
	# Store user in .htpasswd
	open(WRITE,">>".$UserList) or die "Error while opening TWiki user mapping file '$UserList': $!\n";
	print WRITE $TwikiName.':'.$TwikiPassword.':'.$ShibUserID."\n";
	close(WRITE);
} 

# Get username that should be available at this point
my $user = $TwikiUserMap{$ShibUserID};
my $session = new TWiki( $user, $query );
my $url = $session->getScriptUrl(
	0, 'view', $session->{webName}, $session->{topicName} );

$url .= ( '?' . $query->query_string() ) if $query->query_string();

# Check whether we have to add the user to a group based on GMT information
if (defined($GMT)){
	# Get users group
	@GMTgroups = $GMT->getUserGroups($ENV{ $ShibIdentifier});
	foreach my $group (@GMTgroups){
		# Check whether there is a mapping
		if (exists($GMT2TWikiMapping{$group})){
			$message .= "Checking mapping: $group $_ -> $GMT2TWikiMapping{$group}\n";
			
			# Then check if user already is member of this group
			if ($session->{users}->isInGroup($user, $GMT2TWikiMapping{$group})){
				#$message .= "$user already is member of $GMT2TWikiMapping{$group}\n";
			} else {
				$message .= "$user has to be added to $GMT2TWikiMapping{$group}\n";
				&addUser($user, $GMT2TWikiMapping{$group});
			}
		}
		
		# Removing a user from a group because he was removed from a GMT group
		# is currently not supported 
	}
}


# Go to requested page instead 
if ($session->{cgiQuery}->param( 'origurl' )){
	$url = $session->{cgiQuery}->param( 'origurl' );
}

# Redirect
$session->redirect( $url );

################################################################################
# Added TWiki error printing function for Shibboleth module
sub printError(){
	my $title = shift;
	my $message = shift;

	 print <<EOM;
Content-Type: text/html

<h2>$title</h2>
<p>
$message<br>
Please contact the administrator of this TWiki instance.
</p>

EOM
	exit;
}

#-------------------------------------------------------------------------------
# Original TWiki logon subroutine
sub logon {
    my $session = shift;
    $session->{users}->{loginManager}->login( $session->{cgiQuery}, $session );
}

#-------------------------------------------------------------------------------
# Add user to Group

sub addUser(){
	my $user = shift;
	my $group = shift;
	
	$groupFile = $TWiki::cfg{DataDir}."/".$TWiki::cfg{UsersWebName}."/".$group.".txt";
	open FILE, "<", $groupFile or die $!;
	$content = "";
	while (my $line = <FILE>) {
		if ($line =~ /Set\s+GROUP\s+\=/){
			# Remove line break
			chop($line);
			
			# Add this user 
			$line .= ", ".$TWiki::cfg{UsersWebName}.".".$user."\n";
		}
		
		$content .= $line;
	}
	close FILE;
	
	# Store file
	open FILE, ">", $groupFile or die $!;
	print FILE $content;
	close FILE;
	
}