#!/usr/bin/perl 

#	
#	nordugridmap 
#

binmode STDIN;
binmode STDOUT;
binmode STDERR;

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;

my $nordugrid_vo    = "grid-vo.nordugrid.org";
my $nordugrid_base  = "ou=People,dc=nordugrid,dc=org";
my $port            = "389";
my $TLSport         = "636";
my $default_lcluser = "nordugridtest";
my $fileopt         = "/etc/grid-security/nordugridmap.conf";
my $gmf		    = "/etc/grid-security/grid-mapfile";
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 $all_nordugrid_user = "yes";
my $require_issuerdn = "no";
my %member_hash     = ();
my @VOgroups;
my @rules;

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


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

&readConf;

&printConf if $opt_test;

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

#default values
$GLOBUS_LOCATION ||= $ENV{GLOBUS_LOCATION} ||= "/opt/globus/";
$ENV{"LD_LIBRARY_PATH"}="$GLOBUS_LOCATION/lib";
$openssl_command= "$GLOBUS_LOCATION/bin/openssl x509 -noout -subject -in "; 

@certfiles= `ls $capath/*.0`;

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

my %ca_list;
print "##### Supported Certificate Authorities ####\n" if $opt_test;
for (@ca_list) {    
  $ca_list{$_}++;
  print $_, "\n" if $opt_test;
}

# read the Grid mappings from the local-grid-mapfile first    
&read_gmf_local if $gmf_local;


############ FOREACH VO GROUP ############
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 "ldap:"){						  
       $ldap = Net::LDAP ->new($host, port => $port, timeout => "15") or 
       die "VO Group ldap://$host is unreachable\n\n"; 
       &memberSearch;     
   }
   elsif (lc($conn) eq "http:" or lc($conn) eq "https:" or lc($conn) eq "file:") {
	my $tmpfile = "/tmp/gridmap.$$";
	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 STDERR "############ 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 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;
		}

	    } elsif (lc($conn) eq "file:") {
		my $file = $url;
		$file =~ s!^.*//[^/]*!!;
		if (!open (TMPFILE, "cat $file |")) {
		    warn "Couldn't access $url\n";
		    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 (!$issuer and $require_issuerdn eq "yes") {
     	      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";
	}
   }									  
   else{								  
       warn "############ Connection $conn is not supported, the group entry \"@{ $VOgroup }\" is discarded\n\n" if $opt_test;
   }
}

############ TAKE ALL USERS FROM THE NORDUGRID VO ###############

unless (lc($all_nordugrid_user) eq "no") {

  $ldap = Net::LDAP ->new($nordugrid_vo,timeout => "15") or die "VO ldap://$nordugrid_vo is unreachable\n\n";

  $mesg = $ldap->search (base => $nordugrid_base, 
  	  		filter => "(objectClass=organizationalPerson)",
			timelimit => 240);
  die ($mesg->error,  " on $nordugrid_vo") if $mesg->code; 

  print STDERR "############ Entries from the NorduGrid VO ############\n" if $opt_test;
  	  
  foreach $entry ($mesg->all_entries) {
      $subj = "";
      $issuer="";
      @Subj = $entry->get_value('description');
      $cn = $entry->get_value('cn');  				 
      $issuer = $entry->get_value('nordugrid-issuerDN');
      
      
      if (!$issuer and $require_issuerdn eq "yes") {
          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 STDERR "Warning: illegal user entry of $cn\n" if $opt_test;
     	  next;
      }
      &rule_match($subj,$cn, $default_lcluser);    
  }
}


############ GRID-MAPFILE ############
print STDERR "############ THE GENERATED GRID-MAPFILE ############\n" if $opt_test;

if (! $opt_test){
    open (GMF, "> $gmf" ) || die "unable to write to $gmf\n";
    binmode GMF;
}
foreach $subj (keys(%member_hash)) {
   if ($opt_test){       
   	print STDERR "\"$subj\" $member_hash{$subj}\n"
   }
   else{
   	print GMF "\"$subj\" $member_hash{$subj}\n";
   }
}
close(GMF) if !($opt_test);

############ MEMBER SEARCH ############
sub memberSearch{
    $mesg = $ldap->search(base => $base, 
    			  timelimit => 120,
    			  filter => "member=*" );
    die ($mesg->error, " with $base") if $mesg->code; 
    
    foreach $groupServer ($mesg->all_entries) {
	$dn = $groupServer->dn();
	@allMembers = $groupServer->get_value('member');
	print STDERR "############ 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 STDERR "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 (!$issuer and $require_issuerdn eq "yes") {
     	      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 STDERR "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 STDERR "$cn denied by rule $acl\n" if $opt_test;
	  } elsif (! exists $member_hash{$subj}) {                      
		$member_hash{$subj} = $lcluser;			  
		print STDERR "$cn allowed by rule $acl\n" if $opt_test;
	  } else {
		print STDERR "$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;     	
  } 																    		

}

############ READ GRID-MAPFILE-LOCAL ############
sub read_gmf_local {
    -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 STDERR "############ Entries from the $gmf_local ############\n" if $opt_test;

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

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

	    print STDERR "\"$subj\" $lcluser\n" if $opt_test;
	
	    if (! exists $member_hash{$subj}) {
		$member_hash{$subj} = $lcluser;
	    }
	}
    }
    close(IN);
}

############ READ CONF ############
sub readConf {
    $den = 0;
    $all = 0;

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

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

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

	#remove comments
        next if $f =~/^#/; 
	
	@lines = split " ", $f,2;

	if (lc($lines[0]) eq "group") {
	    if ($lines[1]=~/"(.+)"\s*(\w*$)/) {
	       my $groupurl=$1;
	       my $unixmapping=$2; 	    
	       @VOgroups = (@VOgroups, [$groupurl, $unixmapping]);
	    }
	    else {
	       ($groupurl,$unixmapping) = split " ", $lines[1], 2;
	       @VOgroups = (@VOgroups, [$groupurl, $unixmapping]);
	    }
	}
	elsif (lc($lines[0]) eq "allow") {
 	    $rule = $f;
	    @rules = (@rules, $rule);
	    $all++;	        
	}
	elsif (lc($lines[0]) eq "deny") {
	    $rule = ("$lines[0] $lines[1]");
	    @rules = (@rules, $rule);
	    $den++;	    
	}
	elsif (lc($lines[0]) eq "default_lcluser") {
	    $default_lcluser = $lines[1];
	}
	elsif (lc($lines[0]) eq "gmf_local") {
	    $gmf_local = $lines[1];
	}
	elsif (lc($lines[0]) eq "gmf") {
	    $gmf = $lines[1];
	}
	elsif (lc($lines[0]) eq "all_nordugrid_user") {
	    $all_nordugrid_user= $lines[1];
	}
	elsif (lc($lines[0]) eq "require_issuerdn") {
	    $require_issuerdn= $lines[1];
	}	
	elsif (lc($lines[0]) eq "capath") {
	    $capath= $lines[1];
	}	
	
	elsif (lc($lines[0]) eq "") {
	    next;
	}
	else {
	    print STDERR "Option $lines[0] unknown\n";
	}
    }

    close(IN);

    if ($all == 0) {
	@rules = (@rules, "allow *");
    }
    else {
	@rules = (@rules, "deny *");
    }
}

############ PRINT CONF ###########
sub printConf {
    print     STDERR "############ CONFIGURATION ############\n" if $opt_test;
    print     STDERR "CONFIGURATION FILE: $fileopt\n";
    foreach $VOgroup (@VOgroups) {
	print STDERR "GROUP             : @{ $VOgroup }\n";
    }
    foreach $rule (@rules) {
	print STDERR "ACL               : $rule\n";
    }
    print     STDERR "DEFAULT LOCAL USER: $default_lcluser\n";
    print     STDERR "GRID-MAPFILE-LOCAL: $gmf_local\n" if $gmf_local;
    print     STDERR "GRID-MAPFILE: $gmf\n";
    print     STDERR "ALL_NORDUGRID_USER: $all_nordugrid_user\n";
    print     STDERR "REQUIRE_ISSUERDN: $require_issuerdn\n";
}

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

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

=pod

=head1 NAME

nordugridmap - generates grid-mapfile for the sites of the NorduGrid Testbed

=head1 SYNOPSIS

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

=head1 DESCRIPTION


B<nordugridmap> is run by NorduGrid sites (usually as a crontab entry) 
in order to automatically generate their grid-mapfile.
For further information please refer to the Authorization document.

=head1 OPTIONS

=over 4

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

Print the filter generated from the configuration file and
other debug informations. In this case the grid-mapfile is not created.

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

Print a help screen.

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

Specifies the configuration file, the default is  /etc/grid-security/nordugridmap.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@quark.lu.se 

=cut


