#!/usr/bin/perl

#
#	nordugridmap
#

binmode STDIN;
binmode STDOUT;

use lib '/usr/lib/perl5/site_perl/5.005';
use lib '/usr/lib/perl5/site_perl/5.6.0';

use Getopt::Long;
use Net::LDAP;
use URI;
use XML::DOM;
use LWP::UserAgent;
use File::Temp;

my $fileopt         = "/etc/arc.conf";
my $capath          = $ENV{X509_CERT_DIR}||="/etc/grid-security/certificates/";
my $x509cert        = $ENV{X509_USER_CERT}||="/etc/grid-security/hostcert.pem";
my $x509key         = $ENV{X509_USER_KEY}||="/etc/grid-security/hostkey.pem";
my %member_hash     = ();
my @VOgroups;
my @rules;

GetOptions("help" => \$opt_help,
	   "test" => \$opt_test,
	   "config=s" => \$fileopt);


if ($opt_help) {
    &printHelp;
    exit(1);
}


# determine $GLOBUS_LOCATION
unless (defined  ($GLOBUS_LOCATION = $ENV{GLOBUS_LOCATION}) ) {
    open (SYSCONFGLOBUS, "</etc/sysconfig/globus");
    while  (my $line =<SYSCONFGLOBUS>) {
	$line =~ m/GLOBUS_LOCATION\s*=\s*(\S+)/;
	$GLOBUS_LOCATION = $1;
    }
    close SYSCONFGLOBUS;
}
unless (defined $GLOBUS_LOCATION ) {
    $GLOBUS_LOCATION = "/opt/globus/";
}


# find an openssl
$openssl_command = `which openssl 2>/dev/null`;
chomp $openssl_command;
if ($? != 0) {
    $openssl_command = "$GLOBUS_LOCATION/bin/openssl";
}


# Configuration file processing parse the arc.conf directly into a
# hash $parsedconfig{blockname_blockindex}{variable_name}
unless (open (CONFIGFILE, "<$fileopt")) {
    die "Can't open $fileopt configuration file\n";
}
my $blockname;
my $blockindex=0;
while (my $line =<CONFIGFILE>) {
    next if $line =~/^#/;
    next if $line =~/^$/;
    next if $line =~/^\s+$/;

    if ($line =~/\[([^\/]+).*\]/ ) {
	$blockindex++;
	$blockname = sprintf("%s_%03i",$1,$blockindex);
	next;
    }

    unless ($line =~ /=\s*".*"\s*$/) {
	next;
    }

    # skip every non [vo] block
    next unless $blockname =~ /^vo_/;

    $line =~m/^(\w+)\s*=\s*"(.*)"\s*$/;
    $variable_name=$1;
    $variable_value=$2;

    # special parsing for the local grid-mapfile
    if ($variable_name eq "localmapfile") {
	$variable_name = "source";
	$variable_value = "file://" . $variable_value;
    }

    # special parsing for the nordugrid VO: source="nordugrid"
    if (($variable_name eq "source") && ($variable_value eq "nordugrid")) {
	$variable_value = "vomss://voms.ndgf.org:8443/voms/nordugrid.org";
    }

    unless ($parsedconfig{$blockname}{$variable_name}) {
	$parsedconfig{$blockname}{$variable_name} = $variable_value;
    }
    else {
	$parsedconfig{$blockname}{$variable_name} .= "[separator]".$variable_value;
    }
}

close CONFIGFILE;

@blocknames_tmp = (keys %parsedconfig);
unless ( grep /^vo_/, @blocknames_tmp) {
    print "NO [vo] blocks were found in the $fileopt configuration file\n";
    exit;
}

$buffer_file = File::Temp::tempfile();

# LOOP over the config [vo] blocks, generate one mapfile per [vo] block
foreach $block (keys %parsedconfig) {
    next unless $block =~ /^vo_/;
    @ca_list = ();
    @VOgroups = ();
    @rules = ();
    %member_hash = ();
    my $gmf = "/etc/grid-security/grid-mapfile";
    my $require_issuerdn = "no";
    my $default_lcluser = "";

    #read values from the parsedconfig hash
    if ( $parsedconfig{$block}{"file"} ) {
	$gmf = $parsedconfig{$block}{"file"};
    }
    if ( $parsedconfig{$block}{"require_issuerdn"} ) {
	$require_issuerdn = $parsedconfig{$block}{"require_issuerdn"};
    }
    if ( $parsedconfig{$block}{"mapped_unixid"} ) {
	$default_lcluser = $parsedconfig{$block}{"mapped_unixid"};
    }

    my @urls = split /\[separator\]/, $parsedconfig{$block}{"source"};
    foreach my $listentry (@urls) {
	push @VOgroups, [$listentry, $default_lcluser];
    }

    my @filters = split /\[separator\]/, $parsedconfig{$block}{"filter"};
    foreach my $listentry (@filters) {
	@rules = (@rules, $listentry);
    }

    if ( ! ($parsedconfig{$block}{"filter"} =~ /allow/) ) {
	@rules = (@rules, "allow *");
    }
    else {
	@rules = (@rules, "deny *");
    }

    # do some printout for test mode
    if ( $opt_test ) {
	print     "\nCONFIGURATION FILE: $fileopt\n";
	print       "VO BLOCK ID       : $parsedconfig{$block}{id}\n";
	foreach $VOgroup (@VOgroups) {
	    print   "SOURCE (URL)      : @{ $VOgroup }[0]\n";
	}
	foreach $rule (@rules) {
	    print   "ACL               : $rule\n";
	}
	print       "MAPPED UNIXID: $default_lcluser\n";
	print       "GENERATED GRID-MAPFILE: $gmf\n";
	print       "REQUIRE_ISSUERDN: $require_issuerdn\n";
    }

    #collect the Authentication information, get the list of supported Certificate Authorities

    $ENV{"LD_LIBRARY_PATH"}="$GLOBUS_LOCATION/lib";
    @certfiles= `ls $capath/*.0 2>/dev/null`;

    foreach $cert (@certfiles) {
	$ca_sn=`$openssl_command x509 -noout -subject -in $cert`;
	$ca_sn=~s/subject= //;
	chomp($ca_sn);
	push @ca_list, $ca_sn;
    }

    # fill the %ca_list hash
    print "SUPPORTED Certificate Authorities:\n" if ($opt_test and $require_issuerdn eq "yes");
    for (@ca_list) {
	$ca_list{$_}++;
	print " $_\n" if ($opt_test and $require_issuerdn eq "yes");
    }

    # process the VO URLs specified in the [vo] block
    &vo_block;

    # Write out the generated mappings to the buffer file
    print $buffer_file "[$gmf]\n";
    foreach $subj (sort {$a cmp $b} keys(%member_hash)) {
	print $buffer_file "\"$subj\"::$member_hash{$subj}\n";
    }
    print $buffer_file "\n";

    # end of the [VO] block loop
}

seek($buffer_file, 0, 0);

# preparing the grid-mapfiles from the buffer file
# we use $bufferhash{filename}{subject_name}=mapping_value hash of hashes
print "\n############ Merging the mappings of the [vo] blocks #######\n" if $opt_test;
my $filename;
while (my $line =<$buffer_file>) {
    next if $line =~/^#/;
    next if $line =~/^$/;

    if ($line =~/\[(.+)\]/ ) {
	$filename = $1;
	next;
    }

    ($subject_name, $mapping_value) = split /::/, $line;

    unless ($bufferhash{$filename}{$subject_name}) {
	$bufferhash{$filename}{$subject_name} = $mapping_value;
    }
    else {
	print "$subject_name is not added to $filename (already exists)\n" if $opt_test;
    }
}

close $buffer_file;

foreach $target_mapfile (keys %bufferhash) {
    print "\n############ THE GENERATED GRID-MAPFILE: $target_mapfile #####\n" if $opt_test;
    my $target_mapfile_tmp = $target_mapfile."_tmp";

    if (! $opt_test){
	open (GMF, "> $target_mapfile_tmp" ) || die "unable to write to $target_mapfile_tmp\n";
    }

    foreach $subj (keys %{ $bufferhash{$target_mapfile} } ) {
	if ($opt_test){
	    print "$subj $bufferhash{$target_mapfile}{$subj}";
	}
	else {
	    print GMF "$subj $bufferhash{$target_mapfile}{$subj}";
	}
    }
    close(GMF) if !($opt_test);

    rename $target_mapfile_tmp, $target_mapfile;
}

############Processing a [vo] block from the arc.conf ############
sub vo_block {
    foreach $VOgroup (@VOgroups) {
	$lcluser = @{ $VOgroup }[1];
	if (!defined $lcluser || $lcluser eq ""){
	    $lcluser = $default_lcluser;
	}
	($conn, $void, $host, $base) = split /\//, @{ $VOgroup }[0];

	if ( lc($conn) eq "vomss:" or lc($conn) eq "voms:" ){
	    my $code;
	    my $ref_Subject;
	    my @Subject;
	    my $subject;
	    my $uri_string;
	    my $uri;

	    $uri_string = @{ $VOgroup }[0];

	    $uri = URI->new($uri_string);

	    ($code, $ref_Subject) = &voms_subjects(\$uri);

	    if ($code) {
		warn "There was an error processing the VOMS VO:\n   $uri\n";
		next;
	    }

	    @Subject = @$ref_Subject;

	    foreach $subject (@Subject) {
		$subject =~ /CN=(.*)/i;
		$cn = $1;
		&rule_match($subject, $cn, $lcluser);
	    }
	}
	elsif (lc($conn) eq "ldap:"){
	    my ($host, $port) = split /:/, $host;
	    if ($port == "") { $port=389 }
	    $ldap = Net::LDAP ->new($host, port => $port, timeout => "15");
	    if ( $@ ) {
		print "VO Group ldap://$host is unreachable:\n $@ \n";
		next;
	    }
	    &memberSearch;
	}
	elsif (lc($conn) eq "http:" or lc($conn) eq "https:") {
	    my $url = @{ $VOgroup }[0];

	    # Detect if curl(1) is available and is new enough (>=7.9.8)
	    my $curl = 1;
	    if (open(TMPFILE, " curl -V|head -1|")) {
		my ($cmd, $version, $major, $minor, $patch);
		while (<TMPFILE>) {
		    chomp;
		    ($cmd,$version) = split (/ /);
		    ($major, $minor, $patch ) = split /\./,$version;
		}
		close(TMPFILE);
		# curl 7.9.8 was the first version to support capath
		if ( $major < 7) { $curl = 0 };
		if ( $major == 7 && $minor < 9 ) { $curl = 0};
		if ( $major == 7 && $minor == 9 && $patch < 8 ) { $curl = 0 };
		print "\n############ Entries from URL: $url ############\n" if $opt_test;
	    }
	    else {
		$curl=0;
	    }

	    # Use curl if available - otherwise use s_client/wget/cat based on protocol https/http/file
	    if ($curl == 1) {
		if (!open(TMPFILE, "curl -s --fail --capath $capath $url |")) {
		    warn "Couldn't access $url\n";
		    next;
		}
	    }
	    else {
		if (lc($conn) eq "http:") {
		    if (!open(TMPFILE, "wget --quiet -O - $url |")) {
			warn "Couldn't access $url using wget\n";
			next;
		    }
		}
		elsif (lc($conn) eq "https:") {
		    # https default port is 443
		    my ($host, $port) = split /:/, $host;
		    if ($port == "") { $port=443 }
		    $port = ":$port";
		    if (!open (TMPFILE, "printf \"GET $url HTTP/1.0\n\n\" | $openssl_command s_client -crlf -CApath $capath -connect $host$port -cert $x509cert -key $x509key -quiet 2>/dev/null |")) {
			warn "Couldn't access $url using s_client\n";
			next;
		    }
		    # Skipping HTTP header
		    while (<TMPFILE>) {
			last if ( $_ =~ /^\r$/ );
			next;
		    }
		}
	    }

	    binmode TMPFILE;
	    my $count = 0;
	    while (<TMPFILE>) {
		$count++;
		chomp;
		my ($subj, $issuer) = split (/\s+"(.*)"/);
		$subj =~ s/"(.*)"/$1/g;
		$subj =~ /CN=(.*)/i;
		$cn = $1;

		$issuer =~ s/"(.*)"/$1/g if $issuer;

		if ( $require_issuerdn eq "yes") {
		    if ( !$issuer ) {
			print "$cn has no issuer information, discarded\n" if $opt_test;
			next;
		    }
		    if ($issuer and not &authenticated($cn, $issuer,%ca_list)) {
			next;
		    }
		}
		&rule_match($subj, $cn, $lcluser);
	    }
	    close (TMPFILE);
	    if ($count == 0) {
		print "### WARNING: no information retrieved from $url\n";
	    }
	}
	elsif (lc($conn) eq "file:") {
	    my $file = @{ $VOgroup }[0];
	    $file =~ s!^.*://[^/]*!!;
	    &read_gmf_local($file);
	}
	else {
	    print "\n############$conn URL is not supported, the source entry \"@{ $VOgroup }[0]\" is discarded\n" if $opt_test;
	}
    }
}


############ MEMBER SEARCH ############
sub memberSearch{
    $mesg = $ldap->search(base => $base,
			  timelimit => 120,
			  filter => "member=*");
    warn ($mesg->error, " with $base") if $mesg->code;

    foreach $groupServer ($mesg->all_entries) {
	$dn = $groupServer->dn();
	@allMembers = $groupServer->get_value('member');
	print "\n############ Entries from the GroupDN: $dn ############\n" if $opt_test;

	foreach $member (@allMembers){
	    $mesg2 = $ldap->search(base => $member,
				   timelimit => 120,
				   filter => "cn=*");
	    die ($mesg->error, " with $base") if $mesg->code;
	    $entry = $mesg2->entry(0);

	    if (!$entry){
		print   "Warning: \"$member\" not found\n" if $opt_test;
		next;
	    }

	    $subj = "";
	    $issuer="";
	    @Subj = $entry->get_value('description');
	    $cn = $entry->get_value('cn');
	    $issuer = $entry->get_value('nordugrid-issuerDN');

	    if ( $require_issuerdn eq "yes" ) {
		if ( !$issuer ) {
		    print "$cn has no issuer information, discarded\n" if $opt_test;
		    next;
		}
		next if ($issuer and not &authenticated($cn, $issuer,%ca_list));
	    }

	    foreach $_ (@Subj) {
		if($_ =~ /^subject=\s*(.*)/){
		    $subj = $1;
		    last;
		}
	    }
	    if ($subj eq ""){
		print   "Warning: \"subject=\" not found in description of $cn\n" if $opt_test;
		next;
	    }
	    &rule_match($subj, $cn, $lcluser);
	}
    }
}


############ Match against our rules ############
sub rule_match {
    my ($subj, $cn, $lcluser) = @_;

    $subjReg = $subj;
    $subjReg =~ s/\@/\\\@/g;
    $subjReg = lc($subjReg);
    foreach $rule (@rules) {
	($action, $acl) = split / /, $rule, 2;
	$acl =~ s/\@/\\\@/g;
	$acl =~ s/\*/.\*/g;
	$acl = lc($acl);
	if ($subjReg =~ /$acl/) {
	    if ($action eq "deny") {
		print "$cn denied by rule $acl\n" if $opt_test;
	    }
	    elsif (! exists $member_hash{$subj}) {
		$member_hash{$subj} = $lcluser;
		print "$cn allowed by rule $acl\n" if $opt_test;
	    }
	    else {
		print "$cn denied (already exists)\n" if $opt_test;
	    }
	    last;
	}
    }
}


############ Check the Authentication ############
sub authenticated {
    my ($cn, $issuer, %ca_list) = @_;
    $issuer=~s/\s+$//;
    if($ca_list{$issuer}) {
	print "The certificate of $cn issued by $issuer is Authenticated\n" if $opt_test;
	return "yes";
    }
    else {
	print "$cn is denied (certificates issued by $issuer are NOT Authenticated) \n" if $opt_test;
	return 0;
    }

}

############ Obtain SNs from a VOMS database through soap ###########
sub voms_subjects($) {
    my $uri = ${shift()};
    my $scheme;
    my $io_socket_ssl_version;
    my $parser;
    my $doc;
    my $retval;
    my $user;
    my $ua;
    my $res;
    my $subject;
    my $error_mesg;
    my @Subject;

    @Subject = ();

    $scheme = $uri->scheme;

    $parser = new XML::DOM::Parser;

    if ($scheme eq 'vomss') {

	# setting up x509 environment
	if ($<) {
	    $ENV{HTTPS_CERT_FILE} = $ENV{X509_USER_CERT} || $ENV{HOME}.'/.globus/usercert.pem';
	    $ENV{HTTPS_KEY_FILE}  = $ENV{X509_USER_KEY} || $ENV{HOME}.'/.globus/userkey.pem';
	}
	else {
	    $ENV{HTTPS_CERT_FILE} = $ENV{X509_USER_CERT} || '/etc/grid-security/hostcert.pem';
	    $ENV{HTTPS_KEY_FILE}  = $ENV{X509_USER_KEY} || '/etc/grid-security/hostkey.pem';
	}

	$ENV{HTTPS_CA_DIR} = $ENV{X509_CERT_DIR} || '/etc/grid-security/certificates';
	$ENV{https_proxy} = undef;
	$ENV{HTTPS_PROXY} = undef;
	$ENV{HTTPS_VERSION} = 3;

	if ($IO::Socket::SSL::VERSION) {
	    $io_socket_ssl_version = $IO::Socket::SSL::VERSION;
	    $IO::Socket::SSL::VERSION = undef;
	}
    }

    $scheme =~ s/^voms/http/;
    $uri->scheme($scheme);

    $uri->path($uri->path.'/services/VOMSCompatibility');
    if ( $uri->query() ) {
	$uri->query_form(method    => 'getGridmapUsers',
			 container => $uri->query() );
    }
    else {
	$uri->query_form(method => 'getGridmapUsers');
    }


    $ua = LWP::UserAgent->new(timeout => "15");

    $res = $ua->get($uri,
		    'Cache-Control' => 'no-cache',
		    'Pragma'        => 'no-cache');

    unless ($res->is_success) {
	$error_mesg = "voms search($uri) FAILED: ".$res->message;
	print "$error_mesg\n";
	return ($res->code, \@Subject);
    }

    eval { $doc = $parser->parse($res->content) };

    unless ($doc) {
	$error_mesg = "Parsing voms ($uri) XML response FAILED";
	print "$error_mesg\n";
	return ("333", \@Subject);
    }

    $retval = $doc->getElementsByTagName('soapenv:Body');

    if ($retval->getLength == 1) {
 	my $returnNode = $doc->getElementsByTagName('getGridmapUsersReturn')->item(0);
	for my $user ($returnNode->getChildNodes) {
	    if ($user->getNodeType == ELEMENT_NODE) {
		$subject = $user->getFirstChild->getData;
		push (@Subject, $subject);
	    }
	}
    }
    else {
	$error_mesg = "voms search($uri): No such object";
	print"$error_mesg\n";
	return ("444", \@Subject);
    }

    $doc->dispose;

    return ("0", \@Subject);
}


############ READ GRID-MAPFILE-LOCAL ############
sub read_gmf_local {
    my $gmf_local = shift();

    -e $gmf_local || die "File $gmf_local not found\n\n";
    -T $gmf_local || die "File $gmf_local not in text format\n\n";

    open(IN, "< $gmf_local") || die "Unable to open $gmf_local\n\n";
    binmode IN;

    print "\n############ Entries from the $gmf_local ############\n" if $opt_test;

    while ($f = <IN>) {
	chop($f);

	if ($f =~ /^\s*\"(.+)\"\s+(.+)/) {
	    $subj    = $1;
	    $lcluser = $2;

	    print "\"$subj\" $lcluser\n" if $opt_test;

	    if (! exists $member_hash{$subj}) {
		$member_hash{$subj} = $lcluser;
	    }
	}
    }
    close(IN);
}


############ READ HELP ###########
sub printHelp {
    system("pod2text $0");
}

#################################

=pod

=head1 NAME

nordugridmap - generates grid-mapfile(s)

=head1 SYNOPSIS

B<nordugridmap> [B<-t>, B<--test>] [B<-h>, B<--help>]

=head1 DESCRIPTION


B<nordugridmap> is usually run as a crontab entry
in order to automatically generate mapfile(s).
For configuration information consult the arc.conf.template

=head1 OPTIONS

=over 4

=item B<-t>, B<--test>

Print the filter generated from the configuration file and
other debug informations including used configuration settings.
In this case the grid-mapfile(s) is not created.

=item B<-h>, B<--help>

Print a help screen.

=item B<-c>, B<--config>

Specifies the configuration file, by the default the /etc/arc.conf is used. B<nordugridmap>
processes all the [vo] blocks from the arc.conf.

=back

=head1 CREDITS
The early scripts were based on a modified version of the mkgridmap (v 1.6) script
written by the DataGrid - authorization team <sec-grid@infn.it>. Since then the script
has been considerably rewritten.

=head1 COMMENTS

balazs.konya@hep.lu.se

=cut
