nordugrid-arc-gridmap-utils 5.4.2-1build1 / usr / sbin / nordugridmap

#!/usr/bin/perl

#
# nordugridmap - generates grid-mapfile(s) based on configuration
#

binmode STDIN;
binmode STDOUT;

use Getopt::Long;
use POSIX qw(strftime);
use Time::localtime;
use File::Temp qw(tempfile);
use File::Path;
use Storable;
use URI;
use XML::DOM;
use LWP::UserAgent;
use LWP::Protocol::https;
use SOAP::Lite;
use SOAP::Transport::HTTP;

# please use this when developing
use warnings;
use strict;

use constant {
    # debug level constants
    FATAL   => 0,
    ERROR   => 1,
    WARNING => 2,
    INFO    => 3,
    VERBOSE => 4,
    DEBUG   => 5,
    # nordugridmap internals
    VERSION     => "3.0",
    USERAGENT   => "nordugridmap"
};

#
# GET COMMAND LINE OPTIONS AND SET DEFAULTS
#

# define configuration flags 
my %config_flags = (
    'mapuser_processing'    => 0, # overwrite = 1, keep = 0
    'cache_enabled'         => 1,
    'log_to_file'           => 1,
    'voms_use_soap'         => 1, # voms_method: soap = 1, get = 0
    'allow_empty_unixid'    => 0
);

my $debug_level = 2;
my $fetch_url_timeout = 15;
my $opt_help;
my $opt_test;
my $fileopt = $ENV{ARC_CONFIG}||="/etc/arc.conf";

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

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

# print at DEBUG level to STDERR when using testing mode
if ($opt_test) {
    $debug_level = 5;
    $config_flags{'log_to_file'} = 0;
    &Logger("Nordugridmap is running in a testing mode. There will be no gridmaps altered.", DEBUG);
}

#
# CONFIG FILE PARSER (ARC.CONF INI FORMAT EXPECTED)
#

unless (open (CONFIGFILE, "<$fileopt")) {
    &Logger("Can't open $fileopt configuration file",FATAL);
}

my %parsedconfig = ();
my $blockname;
my $blockindex=0;
my $lineindex=0;

while (my $line =<CONFIGFILE>) {
    $lineindex++;
    next if $line =~/^#/;
    next if $line =~/^$/;
    next if $line =~/^\s+$/;

    # parse block name
    if ($line =~/\[([^\/]+).*\]/ ) {
        $blockindex++;
        $blockname = $1;
        unless ( $blockname =~ /^(common|nordugridmap)$/ ) {
            $blockname = sprintf("%s_%03i",$1,$blockindex);
        }
        $parsedconfig{$blockname}{'configline'} = $lineindex;
        next;
    }

    # skip every block not related to nordugridmap
    next unless ( $blockname =~/^(common|nordugridmap|vo_)/ );

    # get variable = "value"
    next unless ( $line =~/^(\w+)\s*=\s*"(.*)"\s*$/ );
    my $variable_name=$1;
    my $variable_value=$2;

    if ( $blockname =~/^vo_/ ) {
        # 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";
        }
    }

    # store values to hash: $parsedconfig{blockname[_blockindex]}{variable_name}
    unless ($parsedconfig{$blockname}{$variable_name}) {
        $parsedconfig{$blockname}{$variable_name} = $variable_value;
    } else {
        $parsedconfig{$blockname}{$variable_name} .= '[separator]' . $variable_value;
    }
}

close CONFIGFILE;

# 
# CHECK CONFIGURATION FOR REQUIRED INFO
# 

# check [vo] blocks exists
my @blocknames_tmp = (keys %parsedconfig);
unless ( grep /^vo_/, @blocknames_tmp) {
    &Logger("There are no [vo] blocks are found in the $fileopt configuration file", FATAL);
}

# general configurable options (order: [nordugridmap] -> [common] -> $ENV -> defaults);
my $capath          = $parsedconfig{"nordugridmap"}{"x509_cert_dir"} ||
                      $parsedconfig{"common"}{"x509_cert_dir"} ||
                      $ENV{X509_CERT_DIR} ||
                      "/etc/grid-security/certificates/";
my $x509cert        = $parsedconfig{'nordugridmap'}{'x509_user_cert'} ||
                      $parsedconfig{'common'}{'x509_user_cert'} ||
                      $ENV{X509_USER_CERT} ||
                      "/etc/grid-security/hostcert.pem";
my $x509key         = $parsedconfig{'nordugridmap'}{'x509_user_key'} ||
                      $parsedconfig{'common'}{'x509_user_key'} ||
                      $ENV{X509_USER_KEY} ||
                      "/etc/grid-security/hostkey.pem";
my $default_mapfile = $parsedconfig{'nordugridmap'}{'gridmap'} ||
                      $parsedconfig{'common'}{'gridmap'} ||
                      "/etc/grid-security/grid-mapfile";
my $mapfile_owner   = $parsedconfig{'nordugridmap'}{'gridmap_owner'} ||
                      $parsedconfig{'grid-manager'}{'user'} ||
                      "root";
my $mapfile_group   = $parsedconfig{'nordugridmap'}{'gridmap_group'} ||
                      "root";
my $mapfile_chmod   = $parsedconfig{'nordugridmap'}{'gridmap_permissions'} || 
                      "0600";
my $logfile         = $parsedconfig{'nordugridmap'}{'logfile'} ||
                      "/var/log/arc/nordugridmap.log";
my $cachedir        = $parsedconfig{'nordugridmap'}{'cachedir'} ||
                      "/var/spool/nordugrid/gridmapcache/";
my $cache_maxlife   = $parsedconfig{'nordugridmap'}{'cachetime'} ||
                      3 * 24 * 60 * 60; # three days old

&set_numeric_value(\$debug_level, 'debug', '0 to 5') unless $opt_test;
&set_numeric_value(\$fetch_url_timeout, 'fetch_timeout', 'numeric integers');

&set_configuration_flag('cache_enabled','cache_enable','yes','no');
&set_configuration_flag('mapuser_processing','mapuser_processing','overwrite','keep');
&set_configuration_flag('allow_empty_unixid','allow_empty_unixid','yes','no');
&set_configuration_flag('voms_use_soap','voms_method','soap','get');

&set_configuration_flag('log_to_file', 'log_to_file', 'yes', 'no') unless $opt_test;

#
# ENABLE/DISABLE FEATURES DEPEND ON CONFIGURATION
#

# redirect log to file
if ( $config_flags{'log_to_file'} ) {
    open ( STDERR, ">> $logfile" ) or &Logger("Cannot open logfile '$logfile' for writting. Exiting.", FATAL);
    &Logger("Starting grid-mapfiles processing cycle", INFO);
}

# if cache enabled ensure cache directory exists and writable
if ( $config_flags{'cache_enabled'} ) {
    # check cachedir exists
    unless ( -d $cachedir ) {
        &Logger("Cache directory does not exists. Trying to create...", WARNING);
        eval { mkpath($cachedir) };
        if ($@) {
            &Logger("Failed to create cache directory $cachedir", FATAL);
        }
        &Logger("Cache directory $cachedir has been created", INFO);
    }
    &Logger("Cache directory $cachedir is not writable", FATAL) unless -w $cachedir;
}

#
# PROCESS [VO] BLOCKS DEPENDENCIES
#

# generate a list of all external sources to fetch
# generate a list of [vo] blocks dependencies
my %sources_list = (); 
my %sources_deps = ();
my %generated_blocks = ();

# process blocks defined in arc.conf
foreach my $block (sort(keys %parsedconfig)) {
    next unless $block =~ /^vo_/;
    my $voname = &get_vo_name($block);
    $sources_deps{"vo://".$voname} = &get_block_sources($block, \%sources_list, \%generated_blocks);
}

# process blocks generated authomaticaly on the previous step
foreach my $block (sort(keys %generated_blocks)) {
    $sources_deps{"vo://".$block} = &get_block_sources($block, \%sources_list, \%generated_blocks, \%generated_blocks);
    $parsedconfig{$block} = $generated_blocks{$block};
}

# ensure loop-free configuration
my %dryrun_sources_data = %sources_list;
&process_vo_blocks(\%sources_deps, \%dryrun_sources_data, 1);

#
# FETCH SOURCES AND ASSEMBLE GRIDMAPS
#

# fetch all sources 
my %sources_data = ();
&fetch_sources(\%sources_list, \%sources_data);

# assemble [vo] blocks gridmap lists
&process_vo_blocks(\%sources_deps, \%sources_data);

# assemble gridmapfiles
my %mapfile_data = ();
&process_mapfiles(\%mapfile_data, \%sources_data);

# write mapfiles to disk
if ( $opt_test ) {
    &write_mapfiles_data(\%mapfile_data, 1);
} else {
    &write_mapfiles_data(\%mapfile_data, 0, $mapfile_owner, $mapfile_group, $mapfile_chmod);
}

# END OF MAIN ROUTINE :-)

#
# GENERAL CONFIGURATION PARSER SUBROUTINES
#

# get VO name for [vo] block
sub get_vo_name {
    my $block = shift;
    if ( $parsedconfig{$block}{'vo'} ) {
        return $parsedconfig{$block}{'vo'};
    } else {
        &Logger("Parameter 'vo' is required but not set inside the [vo] block. Please check your configuratinon ($fileopt line $parsedconfig{$block}{'configline'})", FATAL, "ConfigParser");
    }
}

# set configuration flags in %config_flags based on [nordugridmap] parsed configuration
sub set_configuration_flag {
    my ( $flag_name, $option_name, $value_yes, $value_no ) = @_;
    if ( defined $parsedconfig{'nordugridmap'}{$option_name} ) {
        if ( $parsedconfig{'nordugridmap'}{$option_name} eq $value_yes ) {
            $config_flags{$flag_name} = 1;
        } elsif ( $parsedconfig{'nordugridmap'}{$option_name} eq $value_no ) {
            $config_flags{$flag_name} = 0;
        } else {
            my $text_def = $config_flags{$flag_name} ? $value_yes : $value_no;
            &Logger("Unrecognized value for option '$option_name' in [nordugridmap] configuration. Valid valueas are: '$value_yes' or '$value_no'. Using default '$text_def'", WARNING, "ConfigParser");
        }
    }
}

# return numeric value of [nordugridmap] parsed configuration option
sub set_numeric_value {
    my ( $ref_var, $option_name, $value_valid ) = @_;

    if ( defined $parsedconfig{'nordugridmap'}{$option_name} ) {
        if ( $parsedconfig{'nordugridmap'}{$option_name} =~ /^\d+$/ ) {
            $$ref_var = $parsedconfig{'nordugridmap'}{$option_name};
        } else {
            &Logger("Unrecognized value for option '$option_name' in [nordugridmap] configuration. Valid valueas are: $value_valid. Using default value: $$ref_var.", WARNING, "ConfigParser");
        }
    } 
}

# return boolean flag value in specified %options_hash
sub get_source_flag {
    my ( $ref_options_hash, $flag_name, $option_name, $value_yes, $value_no ) = @_;
    if ( defined $ref_options_hash->{$option_name} ) {
        return 1 if ( $ref_options_hash->{$option_name} eq $value_yes );
        return 0 if ( $ref_options_hash->{$option_name} eq $value_no );
        my $text_def = $config_flags{$flag_name} ? $value_yes : $value_no;
        &Logger("Unrecognized value for source-specific option '$option_name'. Valid valueas are: '$value_yes' or '$value_no'. Using globaly configured value '$text_def'", WARNING, "ConfigParser");
    }
    return $config_flags{$flag_name};
}

#
# MAPPING PROCESSING SUBROUTINES
#

# assemble grid-mapfiles data
sub process_mapfiles {
    my ( $ref_mapfile_data, $ref_sources_data ) = @_;

    foreach my $block (sort(keys %parsedconfig)) {
        next unless $block =~ /^vo_/;
        my $gmf = $parsedconfig{$block}{'file'} || $default_mapfile;

        next if $gmf eq '/dev/null';
        next if defined $ref_mapfile_data->{$gmf};

        &Logger("Assembling gridmap file: $gmf", INFO, "AssembleGridMapfile");
        $ref_mapfile_data->{$gmf} = {};

        my @vo_blocks_list = &get_file_vo_sources($gmf);
        foreach my $source ( @vo_blocks_list ) {
            foreach my $dn ( keys %{$ref_sources_data->{$source}} ) {
                unless ( defined $ref_mapfile_data->{$gmf}->{$dn} ) {
                    $ref_mapfile_data->{$gmf}->{$dn} = $ref_sources_data->{$source}->{$dn}->{'mapuser'};
                } else {
                    &Logger("Entry '$dn' already exists in $gmf gridmapfile. Skiped.", DEBUG, "AssembleGridMapfile");
                }
            }
        }
    }
}

# asseble [vo] blocks mapping data
sub process_vo_blocks {
    my ($ref_sources_deps, $ref_sources_data, $dryrun) = @_;

    my $blocks_unfinished = 1;
    my $blocks_processed = 1;

    # loop until all [vo] blocks are processed
    while ( $blocks_unfinished ) {
        if ( $blocks_processed == 0 ) {
            &Logger("Loop detected in the [vo] blocks dependencied. Please review you configuration.", FATAL, "AssembleBlockData");
        }

        # initial values
        $blocks_unfinished = 0;
        $blocks_processed = 0;

        foreach my $block (sort(keys %parsedconfig)) {
            next unless $block =~ /^vo_/;

            my $vo_name = &get_vo_name($block);
            my $vo_ref = "vo://" . $vo_name;
            next if defined $ref_sources_data->{$vo_ref};
            $blocks_unfinished++;

            # check all sources fetched or already assembled
            my $undefined_cnt = 0;
            foreach my $source ( @{$ref_sources_deps->{$vo_ref}} ) {
                $undefined_cnt++ unless defined $ref_sources_data->{$source};
            }

            # assemble [vo] block gridmap
            unless ( $undefined_cnt ) {
                unless ( $dryrun ) {
                    # get [vo] block parameters
                    my $mapped_user = "";

                    if ( $parsedconfig{$block}{'mapped_unixid'} ) {
                        $mapped_user = $parsedconfig{$block}{'mapped_unixid'};
                    }

                    # define [vo] block filter if any
                    my @Rules = ();
                    if ( $parsedconfig{$block}{'filter'} ) {
                        my @filters = split /\[separator\]/, $parsedconfig{$block}{'filter'};
                        foreach my $filter_entry (@filters) {
                            push @Rules, $filter_entry;
                        }
                        # if we allow certain people, deny becomes last option
                        if ( ($parsedconfig{$block}{'filter'} =~ /allow/) ) {
                            push @Rules, "deny *";
                        }
                    } else {
                        # no filters - allow all
                        push @Rules, "allow *";
                    }

                    # print block parameters summary on debug
                    &Logger("Assembling DNs list for the [vo] block $vo_name (mapped_unixid=$mapped_user)", DEBUG, "AssembleBlockData");

                    # process all sources
                    $ref_sources_data->{$vo_ref} = {};
                    foreach my $source ( @{$ref_sources_deps->{$vo_ref}} ) {
                        foreach my $dn ( keys %{$ref_sources_data->{$source}} ) {
                            my %source_dn_hash = %{$ref_sources_data->{$source}->{$dn}};
                            unless ( defined $ref_sources_data->{$vo_ref}->{$dn} ) {
                                # check DN is filtered
                                next unless &rule_match($dn, \@Rules);
                                # check mapping user exists for record
                                if ( $config_flags{'mapuser_processing'} || ! defined $source_dn_hash{'mapuser'} ) {
                                    if ( $mapped_user eq "" ) {
                                        unless ( $config_flags{'allow_empty_unixid'} ) {
                                            &Logger("There is no mapping for DN '$dn' in [vo] block $vo_name. Skiping record.", WARNING, "AssembleBlockData");
                                            next;
                                        } else {
                                            &Logger("Using empty mapping for DN '$dn' in [vo] block $vo_name.", VERBOSE, "AssembleBlockData");
                                        }
                                    }
                                }

                                # if we are still here - add entry
                                $ref_sources_data->{$vo_ref}->{$dn} = \%source_dn_hash;
                                # always map to common user on 'rewrite' mapuser processing
                                if ( $config_flags{'mapuser_processing'} || ! defined $ref_sources_data->{$vo_ref}->{$dn}->{'mapuser'} ) {
                                        $ref_sources_data->{$vo_ref}->{$dn}->{'mapuser'} = $mapped_user;
                                }
                                &Logger("Adding mapping entry '$dn -> $ref_sources_data->{$vo_ref}->{$dn}->{'mapuser'}' for the '$vo_name' [vo] block.", DEBUG, "AssembleBlockData");
                                # maintain information about where record is come from
                                unless ( defined $ref_sources_data->{$vo_ref}->{$dn}->{'source'} ) {
                                    $ref_sources_data->{$vo_ref}->{$dn}->{'source'} = $source;
                                }
                            } else {
                                &Logger("Mapping for '$dn' entry already exists for the '$vo_name' [vo] block. Skiped.", DEBUG, "AssembleBlockData");
                            }
                        }
                    }
                } else {
                    $ref_sources_data->{$vo_ref} = 1;
                }
                $blocks_processed++;
            }
        }
    }
}

# write mapfiles to disk
sub write_mapfiles_data {
    my ( $ref_mapfile_data, $dryrun, $owner, $group, $chmod ) = @_;

    foreach my $mapfile ( keys %$ref_mapfile_data ) {
        unless ( $dryrun ) {
            my ($gmf, $tmp_mapfile) = tempfile($mapfile . "XXXXX", UNLINK => 1) or 
                &Logger("Cannot open temporary file to write $mapfile data", FATAL, "WriteMapfile");

            &Logger("Writting mapfile data to $mapfile", INFO, "WriteMapfile");

            while ( my ($dn, $map) = each(%{$ref_mapfile_data->{$mapfile}}) ) {
                print $gmf "\"$dn\" $map\n" or &Logger("Failed to write gridmap data (not enough disk space?) to temporary file $tmp_mapfile", FATAL, "WriteMapfile");
            }

            close($gmf);
	    my $uid = getpwnam($owner);
	    my $gid = getgrnam($group);
            chown $uid, $gid, $tmp_mapfile;
            chmod oct($chmod), $tmp_mapfile;
            rename $tmp_mapfile, $mapfile;
        } else {
            my $gmf_string = "";
            while ( my ($dn, $map) = each(%{$ref_mapfile_data->{$mapfile}}) ) {
                $gmf_string .= "    \"$dn\" $map\n";
            }
            &Logger("Printing mapfile content for $mapfile:\n$gmf_string", INFO, "WriteMapfile");
        }
    }
}

#
# SOURCES DEPENDENCIES TRACKING SUBROTINES
#

# return array of [vo] blocks required to generate gridmapfile
sub get_file_vo_sources {
    my $file_name = shift;
    my @file_vos_list = ();

    foreach my $block (sort(keys %parsedconfig)) {
        next unless $block =~ /^vo_/;
        if ( defined $parsedconfig{$block}{'file'} ) {
            next unless $parsedconfig{$block}{'file'} eq $file_name;
        } else {
            next unless $file_name eq $default_mapfile;
        }
        push @file_vos_list, "vo://".get_vo_name($block);
    }

    return @file_vos_list;
}

# extract optional per-source parameters from source string and return hash
# optional parameters will be removed from passed source string
sub get_source_params {
    my $ref_source = shift;
    my ( $source_str, $params_str ) = split '<', $$ref_source;
    # trim url without optional parameters and return back
    $source_str =~ s/^\s+//;
    $source_str =~ s/\s+$//;
    $$ref_source = $source_str;
    &Logger("Source URL is: $source_str", DEBUG, "ParseSourceURL");
    # create source parameters hash
    my %source_params = ();
    if ( defined $params_str ) {
        foreach my $param_record ( split ' ', $params_str ) {
            next unless ( $param_record =~/^(\w+)=(.+)$/ );
            &Logger("Processing source optional parameter '$1'=$2", DEBUG, "ParseSourceURL");
            $source_params{$1}=$2;
        }
    }
    return \%source_params;
}

# return list of block dependencied and fill external sources list
sub get_block_sources {
    my ($block_id, $ref_sources_list, $ref_generated_blocks, $ref_confighash) = @_;
    # parsed arc.conf hash is used by default
    $ref_confighash = \%parsedconfig unless defined $ref_confighash;
    # array with block dependencied
    my @vo_sources_list = ();

    &Logger("Getting sources for VO block: $block_id", DEBUG, "GetInfoSources");
    my @urls = split /\[separator\]/, $ref_confighash->{$block_id}{'source'};
    foreach my $source (@urls) {
        &Logger("Found mapping source record: $source", DEBUG, "GetInfoSources");
        # get optional per-source parameters
        my $ref_source_params = &get_source_params(\$source);
        my $source_id = $source;
        # check sources is already in sources list
        if ( defined $ref_sources_list->{$source} ) {
            # if source parameters differ - use block_id prefix
            if ( &Storable::freeze($ref_source_params) ne &Storable::freeze($ref_sources_list->{$source}) ) {
                &Logger("Adding block ID prefix for duplicate source URL with different parameters set", DEBUG, "GetInfoSources");
                $source_id = "$block_id|$source";
            } else {
	            &Logger("Source URL is already defined", DEBUG, "GetInfoSources");
            }
        }
        # get source protocol
        my ( $protocol, $uri ) = $source =~ m/([-\w]+):\/\/(.*)/;
        $protocol = lc $protocol;
        # process URLs depend on protocol used
        if ( $protocol =~ /^vomss?$/i ) {
            # special handling for voms_fqan_map
            if ( defined $ref_confighash->{$block_id}{'voms_fqan_map'} ) {
                # FQANs defined for VOMS URL: generate URL for every FQAN
                my @fqans = split /\[separator\]/, $ref_confighash->{$block_id}{'voms_fqan_map'};
                my ( $voms_baseid, $dummy_fqan ) = $source_id =~ m/^([^\?]+)\??(.*)$/;
                foreach my $fqan_match ( @fqans ) {
                    my ( $fqan, $map_id ) = $fqan_match =~ m/^([^\s]+)\s+(.*)$/;
                    # create URL with specified FQAN
                    my $fqan_source_id = $voms_baseid . "?" . $fqan;
                    my ( $dummy_id, $fqan_source_url ) = $fqan_source_id =~ m/(\w+\|)?([^|]+)/;
                    &Logger("Generating FQAN-map source URL: $fqan_source_url (mapped to $map_id)", VERBOSE, "GetInfoSources");
                    # put mapped_unixid parameter
                    my %fqan_source_params = %$ref_source_params;
                    $fqan_source_params{'mapped_unixid'} = $map_id;
                    # save as [vo] block source
                    $ref_sources_list->{$fqan_source_id} = \%fqan_source_params;
                    push @vo_sources_list, $fqan_source_id;
                }
            }
            # standalone VOMS URL: retreive and use directly as VO source
            # FQANs before original URL to apply specific maps first
            $ref_sources_list->{$source_id} = $ref_source_params;
            push @vo_sources_list, $source_id;

        } elsif ( $protocol =~ /^(https?|ldap)$/i ) {
            # external sources: retreive and use directly as VO source
            $ref_sources_list->{$source_id} = $ref_source_params;
            push @vo_sources_list, $source_id;
        } elsif ( $protocol =~ /^file$/i ) {
            # local file: if created by nordugridmap - use [vo] blocks as VO sources
            #             if file is independent source - use directly
            my @file_vo_sources = &get_file_vo_sources($uri);
            if ( @file_vo_sources ) {
                push @vo_sources_list, @file_vo_sources;
            } else {
                if ( -e $uri ) {
                    $ref_sources_list->{$source_id} = $ref_source_params;
                    push @vo_sources_list, $source_id;
                } else {
                    &Logger("File source '$uri' does not exists. Ignoring.", WARNING, "GetInfoSources");
                }
            } 
        } elsif ( $protocol =~ /^vo$/i ) {
            # [vo] block: use directly as VO source
            push @vo_sources_list, $source_id;
        } else {
            &Logger("Unsupported protocol found: $source", WARNING, "GetInfoSources");
        }
    }
    return \@vo_sources_list;
}


#
# SUBROUTINES TO GET INFORMATION FROM DIFFERENT SOURCES
#

# fetch data from all sources in sources_list and put them to sources_data hash
sub fetch_sources {
    my ( $ref_sources_list, $ref_sources_data ) = @_;
    my $exit_code;
    my $ref_subjects;

    foreach my $source_id (keys %$ref_sources_list) {
        # separate optional block_id prefix from source URL
        my ( $block_id, $source ) = $source_id =~ m/(\w+\|)?([^|]+)/;
        # get source parameters
        my ( $protocol, $uri ) = $source =~ m/(\w+):\/\/(.*)/;
        my $ref_source_params = $ref_sources_list->{$source_id};
        # check source-specific cache control
        my $use_cache = &get_source_flag($ref_source_params, 'cache_enabled','cache_enable','yes','no');
        # get subjects from external URL
        if ( $protocol =~ /^vomss?$/i ) {
            ($exit_code, $ref_subjects) = &voms_subjects($source, $ref_source_params);
        } elsif ( $protocol =~ /^https?$/i ) {
            ($exit_code, $ref_subjects) = &http_subjects($source, $ref_source_params);
        } elsif ( $protocol =~ /^file$/i ) {
            ($exit_code, $ref_subjects) = &read_gridmap($uri, $ref_source_params);
        } else {
            &Logger("Unsupported protocol to fetch: $protocol", FATAL, "FetchSourcesData");
        }
        # check fetch result and try to save/load cache
        unless ( $exit_code ) {
            if ( $use_cache ) {
                &write_cached_subjects($source_id, $ref_subjects) unless $opt_test;
            }
        } else {
            &Logger("Fail to retreive data from URL: $source", WARNING, "FetchSourcesData");
            if ( $use_cache ) {
                my ($err_code, $cache_ref_subjects) = &read_cached_subjects($source_id);
                unless ($err_code) {
                    &Logger("Using locally cached data for URL: $source", INFO, "FetchSourcesData");
                    $ref_subjects = $cache_ref_subjects;
                }
            }
        }
        # put fetched results to sources_data hash
        $ref_sources_data->{$source_id} = $ref_subjects;
    }
}

# setup HTTPS SSL parameters
sub setup_https {
    # For Net::SSL
    $ENV{HTTPS_CERT_FILE} = $x509cert;
    $ENV{HTTPS_KEY_FILE}  = $x509key;
    $ENV{HTTPS_CA_DIR} = $capath;
    # For IO::Socket::SSL (LWP)
    if ( $IO::Socket::SSL::VERSION ) {
        IO::Socket::SSL::set_ctx_defaults(
            ca_path => $capath,
            use_cert => 1,
            key_file => $x509key,
            cert_file => $x509cert,
            verify_mode => 1
        );
    }
}

# get content of HTTP(S) URL
sub get_http_url {
    my $uri = shift;
    my $scheme = $uri->scheme;
    &Logger("Unsupported URL ($uri) passed to method", FATAL, "FetchSourcesData.HTTP") unless ( $scheme =~ /^https?$/ );

    # handle SSL environment
    &setup_https() if ($uri->scheme eq 'https');

    # create LWP object
    my $ua = LWP::UserAgent->new( agent => USERAGENT."/".VERSION,
                                  timeout => $fetch_url_timeout );
    # do GET query
    my $res = $ua->get($uri,
                    'Cache-Control' => 'no-cache',
                    'Pragma'        => 'no-cache');

    unless ($res->is_success) {
        &Logger("HTTP request failed for URL $uri:\n\t". $res->message, ERROR, "FetchSourcesData.HTTP");
        return 0;
    }

    return $res->content;
}

# HTTP(S) sources: expects plain text list of "DN" 
sub http_subjects {
    my ($url, $ref_source_params) = @_;
    my %Subjects = ();
   
    # get subjects from URL specified
    &Logger("Getting subjects from source: $url", DEBUG, "FetchSourcesData.HTTP");
    my $uri = URI->new($url);
    my $content = get_http_url($uri);
    unless ($content) {
       &Logger("Failed to get information from source: $url", ERROR, "FetchSourcesData.HTTP");
       return (1, \%Subjects);
    }

    my $count = 0;
    foreach my $line ( split /\n/, $content ) {
        next if $line =~ /^(\s)*$/;
        chomp($line);

        # "subject" should be the first and only one parsed parameter
        my ($subject, $dummy) = split (/\s+"(.*)"/, $line);
        $subject =~ s/"(.*)"/$1/g;

        $Subjects{$subject} = { 'subject'    => $subject };

        # mapped_unixid can be passed via optional parameters
        $Subjects{$subject}{'mapuser'} = $ref_source_params->{'mapped_unixid'} if defined $ref_source_params->{'mapped_unixid'};
        $count++;
    }

    &Logger("No information retreived from URL: $url", WARNING, "FetchSourcesData.HTTP") unless $count;
    return (0, \%Subjects);
}

# VOMS(S) methods wrapper
sub voms_subjects {
    my ($url, $ref_source_params) = @_;
    my $use_soap = &get_source_flag($ref_source_params, 'voms_use_soap', 'voms_method', 'soap', 'get');

    if ( $use_soap ) {
        return &voms_subjects_soap($url, $ref_source_params);
    } else {
        return &voms_subjects_get($url, $ref_source_params);
    }
}

# VOMS(S) sources: expect VOMS-Admin SOAP responce (SOAP:Lite implementation)
sub voms_subjects_soap {
    my ($url, $ref_source_params) = @_;
    my %Subjects = ();

    &Logger("Getting subjects from source: $url", DEBUG, "FetchSourcesData.VOMS");

    # get SOAP endpoint URL and container
    my ( $endpoint, $container ) = split(/\?/, $url, 2);
    $endpoint =~ s/^voms/http/;

    # handle SSL environment
    &setup_https() if $endpoint =~ /^https/;

    $endpoint .= '/services/VOMSCompatibility';
    my $soap_client;
    eval {
        $soap_client = SOAP::Lite->proxy($endpoint,
                                        agent => USERAGENT."/".VERSION,
                                        timeout => $fetch_url_timeout );
    };
    unless ( $soap_client ) {
        &Logger("Failed to connect to SOAP endpoint: $url", ERROR, "FetchSourcesData.VOMS");
        return (1, \%Subjects);
    }

    # call getGridmapUsers method
    my $soap_req;
    eval { 
        if ( $container ) {
            $soap_req = $soap_client->getGridmapUsers($container);
        } else {
            $soap_req = $soap_client->getGridmapUsers();
        }
    };

    unless ( $soap_client->transport->is_success ) {
        &Logger("SOAP transport failed for URL: $url. Error: ".$soap_client->transport->status, ERROR, "FetchSourcesData.VOMS");
        return (1, \%Subjects);
    }

    unless ($soap_req) {
        &Logger("SOAP responce parsing failed for URL: $url", ERROR, "FetchSourcesData.VOMS");
        return (3, \%Subjects);
    }

    if ( $soap_req->fault ) {
        &Logger("SOAP request failed for URL: $url. Returned error: ".$soap_req->faultstring, ERROR, "FetchSourcesData.VOMS");
        return (4, \%Subjects);
    }

    if ( ref($soap_req->result) ne 'ARRAY' ) {
        &Logger("SOAP returned non-array result for URL: $url", VERBOSE, "FetchSourcesData.VOMS");
        return (0, \%Subjects);
    }

    if ( ! @{$soap_req->result} ) {
        &Logger("SOAP returned empty result for URL: $url", VERBOSE, "FetchSourcesData.VOMS");
        return (0, \%Subjects);
    }

    foreach my $subject ( @{$soap_req->result} ) {
        $Subjects{$subject} = { 'subject' => $subject };
        # mapped_unixid can be passed via optional parameters
        $Subjects{$subject}{'mapuser'} = $ref_source_params->{'mapped_unixid'} if defined $ref_source_params->{'mapped_unixid'};
    }

    return (0, \%Subjects);
}

# VOMS(S) sources: expect VOMS-Admin SOAP responce (GET+XML manual parser implementation)
sub voms_subjects_get {
    my ($url, $ref_source_params) = @_;
    my %Subjects = ();

    &Logger("Getting subjects from source: $url", DEBUG, "FetchSourcesData.VOMS");

    # create proper HTTP(S) URL
    my $uri = URI->new($url);
    my $scheme = $uri->scheme;
    $scheme =~ s/^voms/http/;
    $uri->scheme($scheme);

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

    # get URI content
    my $content = get_http_url($uri);
    return ( 1, \%Subjects) unless $content;

    # parse result on success
    my $parser = new XML::DOM::Parser;
    my $doc;
    eval { $doc = $parser->parse($content) };

    unless ($doc) {
        &Logger("Parsing VOMS ($url) XML response FAILED", ERROR, "FetchSourcesData.VOMS");
        return ( 3, \%Subjects);
    }

    my $retval = $doc->getElementsByTagName('soapenv:Body');
    my $subject;
    if ($retval->getLength == 1) {
        my $returnNode = $doc->getElementsByTagName('getGridmapUsersReturn')->item(0);
        for my $user ($returnNode->getChildNodes) {
            if ($user->getNodeType == ELEMENT_NODE) {
                $subject = undef;
                eval { $subject = $user->getFirstChild->getData };
                if ( defined $subject ) {
                    $Subjects{$subject} = { 'subject' => $subject };
                    # mapped_unixid can be passed via optional parameters
                    $Subjects{$subject}{'mapuser'} = $ref_source_params->{'mapped_unixid'} if defined $ref_source_params->{'mapped_unixid'};
                } else {
                    &Logger("Found subject that cannot be parsed from VOMS XML ($url)", ERROR, "FetchSourcesData.VOMS");
                }
            }
        }
    } else {
        &Logger("VOMS search($uri): No such object", ERROR, "FetchSourcesData.VOMS");
        return ( 4, \%Subjects);
    }

    $doc->dispose;

    return (0, \%Subjects);
}

# Mapfile sources: expect local gridmap-file
sub read_gridmap {
    my ($gridmap_file, $ref_source_params) = @_;
    my %Subjects = ();

    &Logger("Getting subjects from source: file://$gridmap_file", DEBUG, "FetchSourcesData.LocalFile");

    if (! -e $gridmap_file) {
        &Logger("File $gridmap_file not found", ERROR, "FetchSourcesData.LocalFile");
        return (1, \%Subjects);
    }
    if (! -T $gridmap_file) {
        &Logger("File $gridmap_file not in text format", ERROR, "FetchSourcesData.LocalFile");
        return (2, \%Subjects);
    }

    unless (open(IN, "< $gridmap_file")) {
        &Logger("Unable to open $gridmap_file", ERROR, "FetchSourcesData.LocalFile");
        return (3, \%Subjects);
    }
    binmode IN;

    # mapped_unixid can be passed via optional parameters, overwriting is controlled by 'mapuser_processing' option
    my $def_mapuser = ( defined $ref_source_params->{'mapped_unixid'} ) ? $ref_source_params->{'mapped_unixid'} : 0;
    my $map_overwrite = &get_source_flag($ref_source_params, 'mapuser_processing','mapuser_processing','overwrite','keep');

    while (my $f = <IN>) {
        chomp($f);

        if ($f =~ /^\s*\"((\/[^\/]+)+)"\s+([^\s]+)\s*$/) {
            # record match: "/user/DN" mapping
            my $subject = $1;
            my $mapuser = $3;
            $mapuser = $def_mapuser if ( $def_mapuser && $map_overwrite );
            $Subjects{$subject} = { 'subject' => $subject,
                                    'mapuser' => $mapuser };
        } elsif ($f =~ /^\s*\"((\/[^\/]+)+)\"\s*$/) {
            # record match: "/user/DN/only"
            my $subject = $1;
            $Subjects{$subject} = { 'subject' => $subject };
            $Subjects{$subject}{'mapuser'} = $def_mapuser if ( $def_mapuser );
        } elsif ($f =~ /^\s*((\/[^\/\s]+)+)\s+([^\s]+)\s*$/) {
            # record match: /user/DN/no_spaces mapping
            my $subject = $1;
            my $mapuser = $3;
            $mapuser = $def_mapuser if ( $def_mapuser && $map_overwrite );
            $Subjects{$subject} = { 'subject' => $subject,
                                    'mapuser' => $mapuser };
        } elsif ($f =~ /^\s*((\/[^\/\s]+)+)\s*$/) {
            # record match: /user/DN/no_spaces/only
            my $subject = $1;
            $Subjects{$subject} = { 'subject' => $subject };
            $Subjects{$subject}{'mapuser'} = $def_mapuser if ( $def_mapuser );
        } else { 
            &Logger("Skipping missformed record '$f' in file $gridmap_file", WARNING, "FetchSourcesData.LocalFile");
        }
    }
    close(IN);
    return (0, \%Subjects);
}

#
# MATCHING AND FILTERING 
#

# check subject match against ACL rules
sub rule_match {
    my ($subj, $ref_Rules) = @_;
    my @Rules = @$ref_Rules;

    my $subjReg = $subj;
    $subjReg =~ s/\@/\\\@/g;

    foreach my $rule (@Rules) {
        my ($action, $acl) = split / /, $rule, 2;
        $acl =~ s/\@/\\\@/g;
        $acl =~ s/\*/.\*/g;
        if ($subjReg =~ /$acl/) {
            if ($action eq "deny") {
                &Logger("User '$subj' denied by rule 'deny $acl'", DEBUG, "FilterDN");
            } else {
                &Logger("User '$subj' allowed by rule 'allow $acl'", DEBUG, "FilterDN") if ( $acl ne ".*" );
                return 1;
            }
            last;
        }
    }
    return 0;
}

#
# CACHE OPERATIONS SUBROUTINES
#

# get source URL hash
sub urlhash {
    my $url = shift;
    # split the url into substrings of length 8 and run crypt on each substring
    my @chunks = ( $url =~ /.{1,8}/gs );
    my $result;
    foreach my $c (@chunks) {
        $result .= crypt $c, "arc";
    }
    $result =~ s/[\/|\.]//g;
    return $result;
}

# get cache location for source URL
sub get_subject_cache_location {
    my $url = shift;
    my $hash = &urlhash($url);
    my $file_location = $cachedir . "/" . $hash; 
    return $file_location;
}

# write cached values for source URL
sub write_cached_subjects {
    my ($url, $ref_subjects) = @_;
    my %Subjects = %$ref_subjects;

    my $cache_file = &get_subject_cache_location($url);

    &Logger("Writting cached subjects for $url to $cache_file", DEBUG, "SourceCaching");
    store($ref_subjects, $cache_file) or &Logger("Failed to write to the cache file $cache_file", WARNING, "SourceCaching");
}

# read cached values for source URL
sub read_cached_subjects {
    my $url = shift;

    my $cache_file = &get_subject_cache_location($url);

    unless ( -e $cache_file ) {
        &Logger("Cache file does not exists for URL: $url", VERBOSE, "SourceCaching");
        return 1;
    }

    my $mtime = (stat($cache_file))[9];
    if ($mtime + $cache_maxlife < time()) {
        &Logger("Rejecting to use cache, max lifetime exceeded", VERBOSE, "SourceCaching");
        eval { unlink($cache_file); };
        return 2;
    }

    &Logger("Getting subjects for $url from cache", DEBUG, "SourceCaching");
    my $ref_subjects;
    eval { $ref_subjects = retrieve($cache_file); };
    if ( defined $ref_subjects ) {
        return 0, $ref_subjects;
    }

    &Logger("Failed to get data from cache file for URL: $url", WARNING, "SourceCaching");
    eval { unlink($cache_file); };
    return 3;
}

#
# LOGGING FUNCTIONS
#

# convert debug level to number
sub debug_numericv {
    my $level = shift;
    return $level if ( $level =~ /\d/ );
    return 0 if $level =~ /^FATAL$/i;
    return 1 if $level =~ /^ERROR$/i;
    return 2 if $level =~ /^WARNING$/i;
    return 3 if $level =~ /^INFO$/i;
    return 4 if $level =~ /^VERBOSE$/i;
    return 5 if $level =~ /^DEBUG$/i;
    return 2; # WARNING level on syntax error
}

# get debug level string value
sub debug_stringv {
    my $level = shift;
    return "FATAL" if ( $level == 0 );
    return "ERROR" if ( $level == 1 );
    return "WARNING" if ( $level == 2 );
    return "INFO" if ( $level == 3 );
    return "VERBOSE" if ( $level == 4 );
    return "DEBUG" if ( $level == 5 );
}

# show message depending on threshold
sub Logger {
    my ( $text, $threshold, $subsystem ) = @_;
    $threshold = &debug_numericv($threshold);
    if ( $threshold <= $debug_level ) {
        my $timestring = strftime("%Y-%m-%d %H:%M:%S", @{ &localtime() } );
        $subsystem = ( defined $subsystem ) ? ".$subsystem" : "";
        printf STDERR "[%s] [Nordugridmap%s] [%s] [$$] %s\n", $timestring, $subsystem, &debug_stringv($threshold), $text;
    }
    # exit nordugridmap on FATAL errors
    exit (1) unless ( $threshold );
}

#
# DISPLAY NORDUGRIDMAP 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>] [ B<-c>, B<--config> FILE ]

=head1 DESCRIPTION


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

=head1 OPTIONS

=over 4

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

Does not actually create grid-mapfile(s), but perform test
run in debug mode. 

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

Print a help screen.

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

Specifies the configuration file to be used. By default the /etc/arc.conf is used. B<nordugridmap>
utilize [nordugridmap] section for general options fine-tuning and processes all the [vo] blocks from the config.

=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.

In Dec 2011 script logic was completely rewritten and B<nordugridmap> v 2.0 was born.

=head1 COMMENTS

balazs.konya@hep.lu.se, waananen@nbi.dk, manf@grid.org.ua

=cut