1# OpenXPKI::Config
2#
3# Written 2012 by Oliver Welter for the OpenXPKI project
4# Copyright (C) 2012 by The OpenXPKI Project
5#
6
7package OpenXPKI::Config;
8
9use strict;
10use warnings;
11use English;
12use Moose;
13use OpenXPKI::Config::Backend;
14use OpenXPKI::Exception;
15use OpenXPKI::Debug;
16use OpenXPKI::Server::Context qw( CTX );
17use Data::Dumper;
18use Log::Log4perl;
19
20# Make sure the underlying connector is recent
21use Connector 1.43;
22
23extends 'Connector::Multi';
24
25has '+BASECONNECTOR' => (
26    is => 'rw',
27    isa => 'Connector',
28    lazy => 1,
29    default => sub {
30        my $self = shift;
31        return $self->backend();
32    },
33);
34
35has backend => (
36    is => 'rw',
37    isa => 'Connector',
38    init_arg => 'backend',
39    lazy => 1,
40    default => sub {
41        my $self = shift;
42        return OpenXPKI::Config::Backend->new(LOCATION => $self->config_dir);
43    },
44);
45
46has credential_backend => (
47    is => 'rw',
48    isa => 'Bool',
49    default => 0
50    );
51
52# Here we do the chain loading of a serialized/signed config
53sub BUILD {
54    my $self = shift;
55    my $args = shift;
56
57    # when we are here, the BASECONNECTOR is already initialized which is
58    # usually an instance of O::C::Backend. We now probe if there is a
59    # node called "bootstrap" and if so we replace the current backend
60    if ($self->backend()->exists('bootstrap')) {
61
62        # this is a connector definition
63        my $bootstrap = $self->backend()->get_hash('bootstrap');
64
65        my $class = $bootstrap->{class} || 'OpenXPKI::Config::Loader';
66        if ($class !~ /\A(\w+\:\:)+\w+\z/) {
67            die "Invalid class name $class";
68        }
69        ##! 16: 'Config bootstrap ' . Dumper $bootstrap
70        eval "use $class;1;" or die "Unable to bootstrap config, can not use $class: $@";
71
72        delete $bootstrap->{class};
73
74        my $conn = $class->new( $bootstrap );
75        $self->backend( $conn );
76    }
77
78    # we initialize the checksum before injecting the code ref to avoid setting
79    # $Storable::Deparse and to have the same hash with openxpkiadm
80    $self->backend()->checksum();
81
82    # If the node credential is defined on the top level we make assume
83    # it contains a connector specification to create a globally available
84    # node to receive passwords from
85    if ($self->backend()->exists('credentials')) {
86        my $conn = $self->backend();
87        my $meta = $conn->get_meta('credentials');
88        if ($meta->{TYPE} ne "hash" || !$conn->exists('credentials.class')) {
89            warn "Found credential node but it does not look like a connector specification"
90        } else {
91            # There is a dragon inside! We read the connector details and
92            # afterwards delete the node and write back the preinitialized
93            # connector. This makes assumptions on the internal cache and might
94            # also not work with other backend classes.
95            $self->credential_backend(1);
96            my $cc = $self->get_connector('credentials');
97            $self->_init_cache();
98            # as it is not allowed to change the type we need to unset it first
99            $conn->set('credentials' => undef);
100            # now we directly attach the connector to it
101            $conn->set('credentials' => $cc);
102            Log::Log4perl->get_logger('system')->info("Added credential connector");
103        }
104    }
105
106    # check if the system node is present
107    $self->backend()->exists('system') || die "Loaded config does not contain system node.";
108
109}
110
111has 'config_dir' => (
112    is => 'ro',
113    isa => 'Str',
114    lazy => 1,
115    default => '/etc/openxpki/config.d',
116);
117
118before '_route_call' => sub {
119
120    my $self = shift;
121    my $call = shift;
122    my $path = shift;
123    my $location;
124
125    # Location can be a string or an array
126    if (ref $path eq "ARRAY") {
127        $location = @{$path}[0];
128        ##! 8: 'Location was array - shifted: ' . Dumper $location
129    } else {
130        $location = $path;
131    }
132
133    ##! 16: "_route_call interception on $location "
134    # system or realm acces - no prefix
135    if ( substr ($location, 0, 6) eq 'system' || substr($location, 0, 5) eq 'realm' || substr($location, 0, 8) eq 'endpoint') {
136        ##! 16: "_route_call: system or explicit realm value, reset connector offsets"
137        $self->PREFIX('');
138    } elsif (substr($location, 0, 11) eq "credentials" && $self->credential_backend()) {
139        ##! 16: "_route_call: request for credential"
140        $self->PREFIX('');
141    } else {
142        my $session = CTX('session');
143        # there is no realm during init - hide tree by setting non existing prefix
144        my $pki_realm = $session->data->pki_realm;
145        if ($pki_realm) {
146            ##! 16: "_route_call: realm value, set prefix to " . $pki_realm
147            $self->PREFIX( [ 'realm', $pki_realm ] );
148        } else {
149            $self->PREFIX( "startup" );
150        }
151    }
152
153    ##! 8: 'Full path: ' . Dumper $path
154};
155
156sub checksum {
157    my $self = shift;
158    $self->BASECONNECTOR()->_config(); # makes sure the backend is initialized
159    return $self->BASECONNECTOR()->checksum();
160}
161
162sub get_version {
163    my $self = shift;
164    CTX('log')->deprecated->error('Call to get_version in config layer');
165    return '';
166}
167
168sub get_head_version {
169    CTX('log')->deprecated->error('Call to get_head_version in config layer');
170}
171
172sub update_head {
173    my $self = shift;
174    CTX('log')->deprecated->error('Call to update_head in config layer');
175    return '';
176}
177
178sub get_scalar_as_list {
179    my $self = shift;
180    my $path = shift;
181    my @values;
182    my $meta = $self->get_meta( $path );
183
184    return unless(defined $meta);
185
186    ##! 16: 'node meta ' . Dumper $meta
187    if ($meta->{TYPE} eq 'list') {
188        @values = $self->get_list( $path );
189    } elsif ($meta->{TYPE} eq 'scalar') {
190        my $val = ( $self->get( $path ) );
191        @values = ( $val ) if (defined $val);
192    } else {
193        CTX('log')->system()->error("get_scalar_as_list got invalid node type");
194
195    }
196    ##! 16: 'values ' . Dumper @values
197    return @values;
198}
199
200sub get_inherit {
201
202    ##! 1: 'start'
203    my $self = shift;
204    my $path = shift;
205    my $val;
206
207    # Shortcut - check if the full path exists
208    $val = $self->get($path);
209    return $val if (defined $val);
210
211    # Path does not exist - look for "inherit" keyword
212    my ($pre, $section, $key);
213    my @prefix;
214
215    if (ref $path eq "") {
216        $path =~ /^(.*)\.([\w-]+)\.([\w-]+)$/;
217        $key = $3;
218        $section = $2;
219        @prefix = $self->_build_path( $1 );
220    } else {
221        my @path = @{$path};
222        $key = pop @path;
223        $section = pop @path;
224        @prefix = @path;
225    }
226
227    ##! 16: "split path $prefix - $section - inherit"
228
229    $section = $self->get( [ @prefix , $section, 'inherit' ] );
230    while ($section) {
231        ##! 16: 'Section ' . $section
232        $val = $self->get( [ @prefix , $section, $key ]);
233        return $val if (defined $val);
234        $section = $self->get( [ @prefix , $section, 'inherit' ] );
235   }
236
237    ##! 8: 'nothing found'
238    return undef;
239
240}
241
242no Moose;
243__PACKAGE__->meta->make_immutable;
244
2451;
246__DATA__
247
248=head1 NAME
249
250OpenXPKI::Config - Connector based configuration layer
251
252=head1 SYNOPSIS
253
254    use OpenXPKI::Config;
255
256    my $cfg = OpenXPKI::Config->new(); # defaults to /etc/openxpki/config.d
257    print "Param1=", $cfg->get('subsystem1.group1.param1'), "\n";
258
259You can also specify a different directory holding the configuration:
260
261    my $cfg = OpenXPKI::Config->new(config_dir => "/tmp/openxpki");
262
263=head1 DESCRIPTION
264
265The new config layer can be seen as a three dimensional system, where the
266axes are path, version and realm. The path is passed in as parameter to the
267I<get_*> methods inherited from the parent class Connector::Multi.
268
269Version and realm are automagically set from the session context.
270The version equals to the commit hash of the Config::Versioned base
271repository. The realm is prepended to the path.
272
273Therefore,a call to I<subsystem1.group1.param1> is resolved to the node
274I18N_OPENXPKI_DEPLOYMENT_MY_REALM_ID.subsystem1.group1.param1.
275
276Exception: The namespace B<system> is a reserved word and is not affected by
277version/realm mangling. A call to a value below system is always executed on
278the current head version and the root context.
279
280=head1 Methods
281
282=head2 update_head, get_version, get_head_version
283
284No longer supported
285
286=head2 checksum
287
288Print out the checksum of the current backend, might not be available
289with all backends.
290
291=head2 walkQueryPoints
292
293Removed - use Connector::Tee instead
294
295=head3 parameters
296
297=over 8
298
299=item prefix
300
301The path where the resolver configuration is found.
302
303=item query
304
305The query string to append to the path
306
307=item call
308
309The call executed on each resolver node, possible values are all get_*
310methods which are supported by the used connectors. The default is I<get>.
311
312=back
313
314=head3 output
315
316Returns a hash structure holding the result of the first non-empty call and
317the of the resolver which returned the result
318
319   return { 'VALUE' => $result, 'SOURCE' => $resolver }
320
321To query the same path again, put the resolver name into the path:
322
323   my $value = $conn->get( "$prefix.$resolver.$query" )
324
325=head3 configuration
326
327You need to provide the list of resolvers as an ordered list along with
328the data.
329
330  mydata:
331    resolvers:
332     - testing
333     - repo1
334     - repo2
335
336    testing:
337       foo: 1234
338       bar: 5678
339
340    repo1@: connector:connectors.primary-repo
341    repo2@: connector:connectors.fallback-repo
342
343=head2 get_inherit
344
345Fetch a single value from a block using inheritance (like the crypto config).
346
347The query
348
349    $conn->get_inherit('token.ca-signer.backend')
350
351will lookup the C<inherit> key and use the value to replace the next-to-last
352path component with it to look up the value again. It will finally return
353the value found at token.default.backend. The method walks upwards untill
354it either finds the expected key or it does not find another C<inherit>.
355Note: As we can not distinguish an undef value from an unexisiting key, you
356need to set the empty string to blank an entry.
357
358=head3 configuration
359
360  token:
361    default:
362      backend: OpenXPKI::Crypto::Backend::OpenSSL
363      key: /etc/openxpki/ca/default.pem
364
365
366    ca-signer:
367      inherit: default
368      key: key: /etc/openxpki/ca/mykey.pem
369