#!/usr/bin/env perl
#
# OpenXPKI Meta Configuration Tool
#
# Written by Martin Bartosch for the OpenXPKI project 2006
# Copyright (c) 2006 by The OpenXPKI Project
# $Revision: 984 $
#

our $VERSION = '0.9.$Revision: 984 $';
$VERSION =~ s{ \$ Revision: \s* (\d+) \s* \$ \z }{$1}xms;

use warnings;
use strict;
use English;


###########################################################################
# OpenXPKI Deployment tools
# Written by Martin Bartosch for the OpenXPKI project 2006
# Copyright (c) 2006 by The OpenXPKI Project
# $Revision: 984 $

package OpenXPKI::Deployment;

use Template;
use English;

# use Smart::Comments;

sub expand {
    my $config = shift;
    my $param = shift;

    my $orig = $param;

    # regex matching a parenthesised expression, from perlre
    my $re;
    $re = qr{
	\(
	    (?:
	     (?> [^()]+ )    # Non-parens without backtracking
	     |
	     (??{ $re })     # Group with matching parens
	     )*
	     \)
	 }x;

    while (my ($variable) = ($param =~ m{ \$($re) }xms)) {
	$variable =~ s/\((.*)\)/$1/;
	my $unexpanded_variable = $variable;

	$variable = expand($config, $variable);
	my ($section, $key) = split(m{\.}xms, $variable);

	if (! exists $config->{$section}) {
	    warn("Configuration section '$section' does not exist");
	    return undef;
	} 
	
	if (! defined $key) {
	    # return configuration subtree if the whole section was referenced
	    if ($param eq '$(' . $unexpanded_variable . ')') {
		return $config->{$section};
	    } else {
		warn("ERROR: Section reference ('$section') in string context is not allowed.");
		return undef;
	    }
	}

	if (! exists $config->{$section}->{$key}) {
	    warn("Configuration entry '$key' does not exist in section '$section'");
	    #return undef;
	    return "";
	} 

	my $value;
	if (ref $config->{$section}->{$key} eq "") {
	    $value = $config->{$section}->{$key};
	} else {
	    # this is OK if no surrounding string content is present
	    if ($param eq '$(' . $unexpanded_variable . ')') {
		return $config->{$section}->{$key};
	    }

	    # attempt to insert multi-value into string -> concatenate content
	    warn("WARNING: Expanding multi-value ('$key' in section '$section') in string context");
	    $value = join('', @{$config->{$section}->{$key}});
	}

	$param =~ s{ \$\(\Q$variable\E\) }{$value}xms;
	$param = expand($config, $param);
#	if (! defined $param || ($param eq "")) {
#	    #warn("Could not expand configuration setting '$orig'.");
#	    return "";
#	}
    }

    return $param;
}


# flatten configuration (expand all indirect values)
sub flatten_config {
    my $configref = shift;
    my $newconfig = {};
    foreach my $section (keys %{$configref}) {
	foreach my $key (keys %{$configref->{$section}}) {
	    $newconfig->{$section}->{$key} 
	    = expand($configref, $configref->{$section}->{$key});
	}
    }
    return $newconfig;
}

sub process_template {
    my $params = shift;

    if (! exists $params->{VARS} || (ref $params->{VARS} ne 'HASH')) {
	warn "Parameter VARS not specified.";
	return;
    }

    if (! exists $params->{FILENAME} || (ref $params->{FILENAME} ne '')) {
	warn "Parameter FILENAME not specified.";
	return;
    }

    my %options = (    
	PRE_CHOMP => 1, # remove whitespace before directives
	RELATIVE => 1,
	ABSOLUTE => 1,
	PLUGIN_BASE => 'OpenXPKI::Template::Plugin',
	);

    if (exists $params->{INCLUDE} && (ref $params->{INCLUDE} eq 'ARRAY')) {
	$options{INCLUDE_PATH} = $params->{INCLUDE};
    }

    my $template = Template->new(\%options);

    $template->process($params->{FILENAME}, 
		       $params->{VARS}, 
		       $params->{OUTFILE})
	|| do {
	    my $error = $template->error();
	    print STDERR "File:       " . $params->{FILENAME} . "\n";
	    print STDERR "Error type: " . $error->type() . "\n";
	    print STDERR "Error info: " . $error->info() . "\n";
	    print STDERR "Error msg:  " . $error . "\n";
	    return;
    };

    return 1;
}


1;

###########################################################################
package main;

use Pod::Usage;
use Getopt::Long;
use File::Spec;
use Config::Std;

use OpenXPKI::VERSION;

# use Smart::Comments;

my $have_io_prompt = 1;
my $data_offset;

eval {
    require IO::Prompt;
    import IO::Prompt;
};
if ($EVAL_ERROR) {
    $have_io_prompt = 0;
}

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

# returns array reference
sub get_sections {
    my @sections;
    seek DATA, ($data_offset ||= tell DATA), 0;

    my $entry;
  DATA:
    while (my $line = <DATA>) {
	chomp $line;
	last DATA if ($line eq '__END__');
	next DATA if ($line =~ m{ \A \s* \# }xms);
	
	# we assume that the DATA section contains a SECTION and an ECHO
	# statement
	if (defined $entry->{section} && defined $entry->{description}) {
	    push @sections, $entry;
	    $entry = {};
	}
	
	if ($line =~ m{ \A SECTION: \s* (\S+) }xms) {
	    $entry->{section} = $1;
	    next DATA;
	}
	if ($line =~ m{ \A ECHO: \s* (.*) }xms) {
	    $entry->{description} = $1;
	    next DATA;
	}
    }
    return \@sections;
}

# interactive configuration
sub query_config {
    my $params = shift;
    my $config = $params->{RAWCONFIG};
    my $active_sections = $params->{SECTIONS};
    my $oneshot = $params->{ONESHOT} || 0;

    if (! defined $config && (ref $config ne 'HASH')) {
	warn "Parameter RAWCONFIG missing or invalid";
	return;
    }

    if (defined $active_sections && (ref $active_sections ne 'HASH')) {
	warn "Invalid data type for parameter SECTIONS";
	return;
    }

    my $config_ok = 0;
    my $validator;
    while (! $config_ok) {
	my $section = "";
	
	seek DATA, ($data_offset ||= tell DATA), 0;

      DATA:
	while (my $line = <DATA>) {
	    chomp $line;
	    last DATA if ($line eq '__END__');
	    next DATA if ($line =~ m{ \A \s* \# }xms);
	    
	    if ($line =~ m{ \A SECTION: \s* (\S+) }xms) {
		$section = $1;
		next DATA;
	    }

	    # skip section?
	    if (defined $active_sections && ($section ne "")) {
		if (! $active_sections->{$section}) {
		    next DATA;
		}
	    }

	    if ($line =~ m{ \A \s* \z }xms) {
		# propagate empty lines to output for formatting
		print "\n";
		next DATA;
	    }
	    
	    if ($line =~ m{ \A ECHO: \s* (.*) }xms) {
		print "$1\n";
		next DATA;
	    }

	    if ($line =~ m{ \A \s* VALIDATE: \s* (.*) }xms) {
		$validator = $1;
		next DATA;
	    }

	    my ($key) = ($line =~ m{ \A \s* (.*) }xms);
	    my $text = $key;
	    if ($key =~ m{ \A (.*?):\s*(.*) }xms) {
		($key, $text) = ($1, $2);
	    }
	    
	    my $multivalue = 0;
	    if ($key =~ s{ \@ \z}{}xms) {
		$multivalue = 1;
	    }

	    # useless...?
	    if (! defined $config->{$section}->{$key}) {
		#warn "Section $section, key $key does not exist in configuration.";
	    }

	    my @values;
	    if (ref $config->{$section}->{$key} eq 'ARRAY') {
		$multivalue = 1;
		@values = @{$config->{$section}->{$key}};
	    } else {
		@values = ( $config->{$section}->{$key} );
	    }
	    
	    my $prompt = $text || $key;

	    if ($multivalue) {
		print "> NOTE: This is a multi-valued setting with the following current values:\n";
		foreach my $entry (@values) {
		    print "> $entry\n";
		}
		print "> To delete an existing entry: enter '*DELETE'\n";
		# print "> To stop entering values:     enter '*DONE'\n";
	    }
	    
	    # each configentry...
	    my $configentry_finished = 0;
	    # ... can have one or more values which may be ok or not
	    my $value_ok = 0;
	    my $entry_index = 0;
	  VALUE:
	    while(! $configentry_finished) {
		my @default = ();
		if (defined $values[$entry_index]) {
		    @default = (-default => $values[$entry_index]);
		};
		
		if (prompt("$prompt: ", 
			   @default,
		    )) {
		    
		    $value_ok = 1;
		    if (defined $validator) {
			if (! eval $validator) {
			    # validation failed
			    $value_ok = 0;
			    print "ERROR: Value not acceptable\n";
				next VALUE;
			}
			$validator = undef;
		    }
		    ### $_
		    if ($_ ne "") {
			if ($_ eq '*DELETE') {
			    splice(@values, $entry_index, 1);
			} elsif ($_ eq '*DONE') {
			    ## splice...
			    splice(@values, $entry_index);
			    ## @values
			    ## $entry_index
			    $configentry_finished = 1;
			} else {
			    $values[$entry_index] = $_;
			}
		    }
		}
		## @values
		
		if (! $multivalue) {
		    $configentry_finished = 1;
		}

		$entry_index++;

		if ($entry_index > scalar(@values)) {
#		    $entry_index = 0;
#		    print "> Restarting multi-value query, enter '*DONE' do leave\n";
		    $configentry_finished = 1;
		}

	    }

	    ### finally...
	    ### @values
	    # propagate changes to configuration
	    if (scalar @values <= 1) {
		if (defined $values[0]) {
		    $config->{$section}->{$key} = $values[0];
		} else {
		    $config->{$section}->{$key} = '';
		}
	    } else {
		$config->{$section}->{$key} = \@values;
	    }

	}


	if ($oneshot) {
	    $config_ok = 1;
	} else {
	    print "\n\n";
	    $config_ok = prompt("Everything OK ('n' to repeat)? (y/n) ", -yes_no);
	}
    }

    return 1;
}



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

my %params;

GetOptions(\%params,
	   qw(
	      help|?
	      man
	      cfg|cfgfile|conf|config=s
              version
	      writecfg=s
              interactive
              includesection=s@
              excludesection=s@
              sectionsmenu
              dstdir|destdir=s
              file=s@
              includedir|include=s@
              getcfgvalue|getcfg|get=s@
              setcfgvalue|setcfg|set=s@
              delcfgvalue|delcfg|del=s@
              force
	      )) or pod2usage(-verbose => 0);

if ($params{version}) {
    my ($vol, $dir, $file) = File::Spec->splitpath($0);
    print "OpenXPKI Core Version: $OpenXPKI::VERSION::VERSION\n";
    print "$file Version: $VERSION\n";
    exit 0;
}

pod2usage(-exitstatus => 0, -verbose => 2) if $params{man};
pod2usage(-verbose => 1) if ($params{help}
			      ||  (! exists $params{cfg}));


my @includedirs;
if (exists $params{includedir}) {
    push @includedirs, @{$params{includedir}};
}

my $rawconfig;
read_config($params{cfg} => $rawconfig);

# allow deleting config values
if (exists $params{delcfgvalue}) {
    # also allow comma separated list of objects to delete instead of multiple
    # calls to --delcfgvalue
    @{$params{delcfgvalue}} = split(m{,}, join(',', @{$params{delcfgvalue}}));

  ENTRY:
    foreach my $entry (@{$params{delcfgvalue}}) {

	my ($section, $key) = split(m{\.}xms, $entry);
	if (defined $section 
	    && defined $key
	    && exists $rawconfig->{$section}->{$key}) {

	    delete $rawconfig->{$section}->{$key};
	}
    }
}

# allow overriding config values
if (exists $params{setcfgvalue}) {
  ENTRY:
    foreach my $entry (@{$params{setcfgvalue}}) {
	my ($var, $value) = ($entry =~ m{\A (.*?) = (.*) }xms);
	my ($section, $key) = split(m{\.}xms, $var);
	$rawconfig->{$section}->{$key} = $value;
    }
}

my %active_sections;

if (exists $params{includesection}) {
    @{$params{includesection}} = split(m{,}, join(',', @{$params{includesection}}));
    foreach my $section (@{$params{includesection}}) {
	if (exists $rawconfig->{$section}) {
	    $active_sections{$section} = 1;
	} else {
	    warn "Section $section does not exist in configuration";
	}
    }
} else {
    # all sections by default
    %active_sections = map { $_ => 1 } keys %{$rawconfig};
}

if (exists $params{excludesection}) {
    @{$params{excludesection}} = split(m{,}, join(',', @{$params{excludesection}}));
    foreach my $section (@{$params{excludesection}}) {
	if (exists $rawconfig->{$section}) {
	    delete $active_sections{$section};
	} else {
	    warn "Section $section does not exist in configuration";
	}
    }
}


# will contain the flattened configuration later
my $config;

if ($params{interactive}) {
    # interactive configuration
    if (! $have_io_prompt) {
	die "IO::Prompt not installed, interactive configuration not supported. Stopped";
    }
    
    if (! exists $params{writecfg}) {
	die "Interactive configuration requires --writecfg";
    }
    
    die "File $params{writecfg} already exists. Stopped" if (-e $params{writecfg} && (! defined $params{force}));

    if (! defined $params{sectionsmenu}) {
	# sequential configuration
	print "\n";
	print "Entering interactive OpenXPKI configuration.\n\n";
	print "Hit 'Return' to accept the displayed default.\n";
	print "(You will be able to repeat the configuration procedure with your changed\n";
	print "settings if you made a mistake.)\n";

	query_config(
	    {
		RAWCONFIG => $rawconfig,
		SECTIONS  => \%active_sections,
		ONESHOT   => 0,
	    });
	
    } else {
	# show a main menu and let the user select the sections
	my $sections = get_sections();

	my @menu;
	my %section_map;
	foreach my $entry (@{$sections}) {
	    if (defined $active_sections{$entry->{section}}) {
		push @menu, $entry->{description};
		$section_map{$entry->{description}} = $entry->{section};
	    }
	}
	push @menu, "Exit";

      SECTIONMENU:
	while (1) {
	    prompt("Select section to configure", -menu => \@menu);
	    next SECTIONMENU unless defined $_;
	    last SECTIONMENU if ($_ eq "Exit");

	    query_config(
		{
		    RAWCONFIG => $rawconfig,
		    SECTIONS  => { $section_map{$_} => 1 },
		    ONESHOT   => 1,
		});
	    
	}
    }

    $config = OpenXPKI::Deployment::flatten_config($rawconfig);
    if (prompt("Write modified config? (Y/N) ", -Yes_No)) {
	write_config($rawconfig => $params{writecfg});
    } else {
	print "Aborted configuration (unchanged)\n";
	exit 1;
    }

} else {
    # non-interactive use
    $config = OpenXPKI::Deployment::flatten_config($rawconfig);
    
    if ($params{writecfg}) {
	die "File $params{writecfg} already exists. Stopped" if (-e $params{writecfg} && (! defined $params{force}));
	write_config($rawconfig => $params{writecfg});
    }
}

if (exists $params{getcfgvalue}) {
    # also allow comma separated list of objects to get instead of multiple
    # calls to --getcfgvalue
    @{$params{getcfgvalue}} = split(m{,}, join(',', @{$params{getcfgvalue}}));

    my $error = 0;
  ENTRY:
    foreach my $entry (@{$params{getcfgvalue}}) {
	my ($section, $key) = split(m{\.}xms, $entry);
	if (defined $section 
	    && defined $key
	    && exists $config->{$section}->{$key}) {
	    my $value = $config->{$section}->{$key};
	    if (ref $value eq "") {
		print $config->{$section}->{$key} . "\n";
		next ENTRY;
	    }
	    if (ref $value eq "ARRAY") {
		print join("\n", @{$value}) . "\n";;
		next ENTRY;
	    }
	    warn("Could not dereference configuration entry '$entry' (complex data type)");
	    $error++;
	} else {
	    warn("Configuration entry '$entry' not defined");
	    $error++;
	    print "\n";
	}
    }
    if ($error > 0) {
	exit 1;
    }
    exit 0;
}

# mode, owner and group of meta configuration file
my ($mode, $uid, $gid) = (stat $params{cfg})[2, 4, 5];

FILE:
foreach my $filename (@{$params{file}}) {
    my ($volume, $dirs, $basename) = File::Spec->splitpath($filename);

    my $outfile;
    if (defined $params{dstdir}) {
	$outfile = File::Spec->catfile($params{dstdir}, $basename);
	if (-e $outfile) {
	    if (! $params{force}) {
		warn("Target file $outfile already exists.");
		next FILE;
	    }
	}
    }
    if (! OpenXPKI::Deployment::process_template(
	      {
		  FILENAME => $filename,
		  MODE     => $mode,
		  UID      => $uid,
		  GID      => $gid,
		  VARS     => $config,
		  INCLUDE  => [ '.',
				File::Spec->catpath($volume, $dirs), 
			       @includedirs,
		      ],
		  OUTFILE  => $outfile,
	      })) {
	die "Could not process template file $filename. Stopped";
    }

    if (defined $outfile) {
	if ($REAL_USER_ID == 0) {
	    chown $uid, $gid, $outfile;
	}
	
	chmod $mode, $outfile;
    }
}

__DATA__
# Interactive configuration layout

SECTION: dir
ECHO: Directories

  prefix
  sysconfdir
  localstatedir
  openxpkistatedir
  tmpdir
  installprefix: installprefix (only for package builds)

SECTION: file
ECHO: Auxiliary programs and files

  VALIDATE: (-x $_ && (`$_ version` =~ /0\.9\.8/))
  openssl: OpenSSL Binary (0.9.8 or higher)


SECTION: server
ECHO: OpenXPKI server settings

  runuser
  rungroup


SECTION: database
ECHO: Database setup

  VALIDATE: m{ \A \d+ \z }xms
  server_id: Server ID (unique for each distinct node)
  VALIDATE: m{ \A \d+ \z }xms
  server_shift: Server shift (must be the same for all nodes)
  VALIDATE: m{ \A (?:SQLite|Oracle|DB2|MySQL|PostgreSQL) }xms
  type: Database type (SQLite, DB2, Oracle, MySQL, PostgreSQL)
  name: Database name
  host
  port
  user
  passwd
  namespace

SECTION: ldappublic
ECHO: LDAP options setup

  VALIDATE: m{ \A (?:yes|no) }xms
  use_ldap: Use LDAP flag (yes or no)
  excluded_roles: Excluded roles (comma separated)
  server: LDAP server name
  port: Port 
  version: Version 
  login: DN of the OpenXPKI LDAP account
  password: Password (plain text or {SHA})
  VALIDATE: m{ \A (?:yes|no) }xms
  use_tls: Use TLS flag (yes or no)
  VALIDATE: m{ \A (?:yes|no) }xms
  use_sasl: Use SASL authentication flag (yes or no) 
  suffix@: LDAP suffixes
  client_cert: Path to OpenXPKI certificate for TLS
  client_key: Path to OpenXPKI key for TLS
  ca_cert: Path to CA certificate for TLS 
  VALIDATE: m{ \A (?:EXTERNAL|DIGEST-MD5) }xms
  sasl_mechanism: SASL mechanism for authentication (EXTERNAL or DIGEST-MD5)

SECTION: deployment
ECHO: Deployment options

  VALIDATE: m{ \A (?:all-in-one|multi-file) \z }xms
  xmlstyle: XML Configuration style (all-in-one or multi-file)

SECTION: global
ECHO: Global configuration
  pkirealm@: PKI Realms (symbolic keyword for any PKI Realm to be enabled)
  

__END__

=head1 NAME

openxpki-metaconf - OpenXPKI meta configuration utility

=head1 USAGE

openxpki-metaconf [OPTIONS]

 Options:
   --help              Brief help message
   --man               Full documentation
   --version           Print program version and exit
   --config FILE       Use configuration from FILE (mandatory)
   --version           Print version information and exit
   --writecfg FILE     Write updated configuration to FILE
   --interactive       Enter interactive configuration mode (default: batch 
                       mode)
   --force             Overwrite files without asking
   --includesection SECTIONSPEC
   --excludesection SECTIONSPEC
                       Explicitly include/exclude sections in interactive 
                       configuration
                       
   --sectionsmenu      Menu-driven configuration (default: sequential config)
   --destdir DIR       Write processed files to this directory
   --file FILE         Process input file FILE via Template Toolkit with
                       the settings specified in the current configuration
   --includedir DIR    Include directories for Template processing
   --getcfgvalue VALUE Configuration value to get from current configuration
   --setcfgvalue VALUE Configuration value to set in current configuration
   --delcfgvalue VALUE Configuration value to delete in current configuration

=head1 OPTIONS

=over 8

=item B<--help>

Print a brief help message and exits.

=item B<--man>

Prints the manual page and exits.

=item B<--config FILE>

Read configuration file FILE. This option is mandatory.

=back

=head1 DESCRIPTION

B<openxpki-metaconf> generates a usable OpenXPKI configuration from
a set of base templates. The parameters that are inserted into the
configuration are taken from a configuration file and can be modified
interactively.