Connector
view release on metacpan or search on metacpan
# =========================================================================
# THIS FILE IS AUTOMATICALLY GENERATED BY MINILLA.
# DO NOT EDIT DIRECTLY.
# =========================================================================
use 5.008_001;
use strict;
use Module::Build::Tiny 0.035;
Build_PL();
1.55 2025-05-08T14:20:21Z
1.41 2021-07-27T15:23:07Z
- Change log entry for the next version
1.40 2021-07-27T14:29:48Z
- Change log entry for the next version
The "Artistic License"
Preamble
The intent of this document is to state the conditions under which a
Package may be copied, such that the Copyright Holder maintains some
semblance of artistic control over the development of the package,
while giving the users of the package the right to use and distribute
the Package in a more-or-less customary fashion, plus the right to make
reasonable modifications.
Definitions:
"Package" refers to the collection of files distributed by the
Copyright Holder, and derivatives of that collection of files
created through textual modification.
"Standard Version" refers to such a Package if it has not been
modified, or has been modified in accordance with the wishes
of the Copyright Holder as specified below.
"Copyright Holder" is whoever is named in the copyright or
copyrights for the package.
"You" is you, if you're thinking about copying or distributing
this Package.
"Reasonable copying fee" is whatever you can justify on the
basis of media cost, duplication charges, time of people involved,
and so on. (You will not be required to justify it to the
Copyright Holder, but only to the computing community at large
as a market that must bear the fee.)
"Freely Available" means that no fee is charged for the item
itself, though there may be fees involved in handling the item.
It also means that recipients of the item may redistribute it
under the same conditions they received it.
1. You may make and give away verbatim copies of the source form of the
Standard Version of this Package without restriction, provided that you
duplicate all of the original copyright notices and associated disclaimers.
2. You may apply bug fixes, portability fixes and other modifications
derived from the Public Domain or from the Copyright Holder. A Package
modified in such a way shall still be considered the Standard Version.
3. You may otherwise modify your copy of this Package in any way, provided
that you insert a prominent notice in each changed file stating how and
when you changed that file, and provided that you do at least ONE of the
following:
a) place your modifications in the Public Domain or otherwise make them
Freely Available, such as by posting said modifications to Usenet or
an equivalent medium, or placing the modifications on a major archive
site such as uunet.uu.net, or by allowing the Copyright Holder to include
your modifications in the Standard Version of the Package.
b) use the modified Package only within your corporation or organization.
c) rename any non-standard executables so the names do not conflict
with standard executables, which must also be provided, and provide
a separate manual page for each non-standard executable that clearly
documents how it differs from the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
4. You may distribute the programs of this Package in object code or
executable form, provided that you do at least ONE of the following:
a) distribute a Standard Version of the executables and library files,
together with instructions (in the manual page or equivalent) on where
to get the Standard Version.
b) accompany the distribution with the machine-readable source of
the Package with your modifications.
c) give non-standard executables non-standard names, and clearly
document the differences in manual pages (or equivalent), together
with instructions on where to get the Standard Version.
d) make other distribution arrangements with the Copyright Holder.
5. You may charge a reasonable copying fee for any distribution of this
Package. You may charge any fee you choose for support of this
Package. You may not charge a fee for this Package itself. However,
you may distribute this Package in aggregate with other (possibly
commercial) programs as part of a larger (possibly commercial) software
distribution provided that you do not advertise this Package as a
product of your own. You may embed this Package's interpreter within
an executable of yours (by linking); this shall be construed as a mere
form of aggregation, provided that the complete Standard Version of the
interpreter is so embedded.
6. The scripts and library files supplied as input to or produced as
output from the programs of this Package do not automatically fall
under the copyright of this Package, but belong to whoever generated
them, and may be sold commercially, and may be aggregated with this
Package. If such scripts or library files are aggregated with this
Package via the so-called "undump" or "unexec" methods of producing a
binary executable image, then distribution of such an image shall
neither be construed as a distribution of this Package nor shall it
fall under the restrictions of Paragraphs 3 and 4, provided that you do
not represent such an executable image as a Standard Version of this
Package.
7. C subroutines (or comparably compiled subroutines in other
languages) supplied by you and linked into this Package in order to
emulate subroutines and variables of the language defined by this
Package shall not be considered part of this Package, but are the
equivalent of input as in Paragraph 6, provided these subroutines do
not change the language in any way that would cause it to fail the
regression tests for the language.
8. Aggregation of this Package with a commercial distribution is always
permitted provided that the use of this Package is embedded; that is,
when no overt attempt is made to make this Package's interfaces visible
to the end user of the commercial distribution. Such use shall not be
construed as a distribution of this Package.
9. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.
10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
The End
Build.PL
Changes
LICENSE
META.json
README.md
build.mkd
cpanfile
gen-cpanfile.pl
lib/Connector.pm
lib/Connector/Builtin.pm
lib/Connector/Builtin/Authentication/LDAP.pm
lib/Connector/Builtin/Authentication/Password.pm
lib/Connector/Builtin/Authentication/PasswordScheme.pm
lib/Connector/Builtin/Env.pm
lib/Connector/Builtin/File/Path.pm
lib/Connector/Builtin/File/SCP.pm
lib/Connector/Builtin/File/Simple.pm
lib/Connector/Builtin/Inline.pm
lib/Connector/Builtin/Memory.pm
lib/Connector/Builtin/Null.pm
lib/Connector/Builtin/Static.pm
lib/Connector/Iterator.pm
lib/Connector/Multi.pm
lib/Connector/Multi/Merge.pm
lib/Connector/Multi/YAML.pm
lib/Connector/Proxy.pm
lib/Connector/Proxy/Authentication/KeyNanny.pm
lib/Connector/Proxy/Config/Std.pm
lib/Connector/Proxy/DBI.pm
lib/Connector/Proxy/HTTP.pm
lib/Connector/Proxy/JSON.pm
lib/Connector/Proxy/Net/FTP.pm
lib/Connector/Proxy/Net/LDAP.pm
lib/Connector/Proxy/Net/LDAP/DN.pm
lib/Connector/Proxy/Net/LDAP/Simple.pm
lib/Connector/Proxy/Net/LDAP/Single.pm
lib/Connector/Proxy/Net/SFTP.pm
lib/Connector/Proxy/Proc/SafeExec.pm
lib/Connector/Proxy/SOAP/Lite.pm
lib/Connector/Proxy/YAML.pm
lib/Connector/Role/LocalPath.pm
lib/Connector/Role/SSLUserAgent.pm
lib/Connector/Role/SessionCache.pm
lib/Connector/Tee.pm
lib/Connector/Types.pm
lib/Connector/Wrapper.pm
t/00-base.t
t/01-builtin-env.t
t/01-builtin-file-path.t
t/01-builtin-file-scp.t
t/01-builtin-file-simple.t
t/01-builtin-inline.t
t/01-builtin-memory.t
t/01-builtin-null.t
t/01-builtin-password-scheme.t
t/01-builtin-password.t
t/01-builtin-static.t
t/01-iterator.t
t/01-multi-merge.t
t/01-multi-reference.t
t/01-multi.t
t/01-proxy-config-std.t
t/01-proxy-ftp.t
t/01-proxy-http.t
t/01-proxy-json.t
t/01-proxy-net-ldap.t
t/01-proxy-proc-safeexec-uid.t2
t/01-proxy-proc-safeexec.t
t/01-proxy-yaml.t
t/01-tee.t
t/01-wrapper.t
t/10-proxy-dbi.t
t/config/01-iterator.yaml
t/config/01-multi-flat.conf
t/config/01-multi-flat.yaml
t/config/01-multi-merge.d/base.yaml
t/config/01-multi-sym1.conf
t/config/01-multi-sym1.yaml
t/config/01-multi-symlink-owners.yaml
t/config/01-multi-symlink-tokens.yaml
t/config/01-multi-yaml.yaml
t/config/01-proxy-config-versioned-1.conf
t/config/01-proxy-config-versioned-2.conf
t/config/01-proxy-net-ldap-config.yaml
t/config/01-tee.yaml
t/config/config.ini
t/config/config.json
t/config/config.yaml
t/config/file
t/config/password.txt
t/config/password2.txt
t/config/test.sh
vag-add-perl.sh
vag-provision.sh
vag-tests.sh
META.yml
MANIFEST
{
"abstract" : "a generic connection to a hierarchical-structured data set",
"author" : [
"Scott Hardin <mrscotty@cpan.org>"
],
"dynamic_config" : 0,
"generated_by" : "Minilla/v3.1.26",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
},
"name" : "Connector",
"no_index" : {
"directory" : [
"t",
"xt",
"inc",
"share",
"eg",
"examples",
"author",
"builder"
]
},
"prereqs" : {
"build" : {
"requires" : {
"Config::Merge" : "0",
"Config::Std" : "0",
"DBD::SQLite" : "0",
"DBI" : "0",
"ExtUtils::MakeMaker" : "6.59",
"IO::Socket::SSL" : "0",
"JSON" : "0",
"LWP::Protocol::https" : "0",
"LWP::UserAgent" : "0",
"Proc::SafeExec" : "0",
"Syntax::Keyword::Try" : "0",
"Template" : "0",
"Test::More" : "0",
"YAML" : "0"
}
},
"configure" : {
"requires" : {
"Module::Build::Tiny" : "0.035"
}
},
"develop" : {
"requires" : {
"Test::CPAN::Meta" : "0",
"Test::MinimumVersion::Fast" : "0.04",
"Test::PAUSE::Permissions" : "0.07",
"Test::Pod" : "1.41",
"Test::Spellunker" : "v0.2.7"
}
},
"runtime" : {
"recommends" : {
"Config::Std" : "0",
"DBI" : "0",
"IO::Socket::SSL" : "0",
"JSON" : "0",
"LWP::Protocol::https" : "0",
"LWP::UserAgent" : "0",
"Net::LDAP" : "0",
"Proc::SafeExec" : "0",
"Template" : "0",
"Text::CSV_XS" : "0",
"YAML" : "0"
},
"requires" : {
"Log::Log4perl" : "0",
"Moose" : "0",
"perl" : "5.010001"
}
}
},
"provides" : {
"Connector" : {
"file" : "lib/Connector.pm",
"version" : "1.55"
},
"Connector::Builtin" : {
"file" : "lib/Connector/Builtin.pm"
},
"Connector::Builtin::Authentication::LDAP" : {
"file" : "lib/Connector/Builtin/Authentication/LDAP.pm"
},
"Connector::Builtin::Authentication::Password" : {
"file" : "lib/Connector/Builtin/Authentication/Password.pm"
},
"Connector::Builtin::Authentication::PasswordScheme" : {
"file" : "lib/Connector/Builtin/Authentication/PasswordScheme.pm"
},
"Connector::Builtin::Env" : {
"file" : "lib/Connector/Builtin/Env.pm"
},
"Connector::Builtin::File::Path" : {
"file" : "lib/Connector/Builtin/File/Path.pm"
},
"Connector::Builtin::File::SCP" : {
"file" : "lib/Connector/Builtin/File/SCP.pm"
},
"Connector::Builtin::File::Simple" : {
"file" : "lib/Connector/Builtin/File/Simple.pm"
},
"Connector::Builtin::Inline" : {
"file" : "lib/Connector/Builtin/Inline.pm"
},
"Connector::Builtin::Memory" : {
"file" : "lib/Connector/Builtin/Memory.pm"
},
"Connector::Builtin::Null" : {
"file" : "lib/Connector/Builtin/Null.pm"
},
"Connector::Builtin::Static" : {
"file" : "lib/Connector/Builtin/Static.pm"
},
"Connector::Iterator" : {
"file" : "lib/Connector/Iterator.pm"
},
"Connector::Multi" : {
"file" : "lib/Connector/Multi.pm"
},
"Connector::Multi::Merge" : {
"file" : "lib/Connector/Multi/Merge.pm"
},
"Connector::Multi::YAML" : {
"file" : "lib/Connector/Multi/YAML.pm"
},
"Connector::Proxy" : {
"file" : "lib/Connector/Proxy.pm"
},
"Connector::Proxy::Authentication::KeyNanny" : {
"file" : "lib/Connector/Proxy/Authentication/KeyNanny.pm"
},
"Connector::Proxy::Config::Std" : {
"file" : "lib/Connector/Proxy/Config/Std.pm"
},
"Connector::Proxy::DBI" : {
"file" : "lib/Connector/Proxy/DBI.pm"
},
"Connector::Proxy::HTTP" : {
"file" : "lib/Connector/Proxy/HTTP.pm"
},
"Connector::Proxy::JSON" : {
"file" : "lib/Connector/Proxy/JSON.pm"
},
"Connector::Proxy::Net::FTP" : {
"file" : "lib/Connector/Proxy/Net/FTP.pm"
},
"Connector::Proxy::Net::LDAP" : {
"file" : "lib/Connector/Proxy/Net/LDAP.pm"
},
"Connector::Proxy::Net::LDAP::DN" : {
"file" : "lib/Connector/Proxy/Net/LDAP/DN.pm"
},
"Connector::Proxy::Net::LDAP::Simple" : {
"file" : "lib/Connector/Proxy/Net/LDAP/Simple.pm"
},
"Connector::Proxy::Net::LDAP::Single" : {
"file" : "lib/Connector/Proxy/Net/LDAP/Single.pm"
},
"Connector::Proxy::Net::SFTP" : {
"file" : "lib/Connector/Proxy/Net/SFTP.pm"
},
"Connector::Proxy::Proc::SafeExec" : {
"file" : "lib/Connector/Proxy/Proc/SafeExec.pm"
},
"Connector::Proxy::SOAP::Lite" : {
"file" : "lib/Connector/Proxy/SOAP/Lite.pm"
},
"Connector::Proxy::YAML" : {
"file" : "lib/Connector/Proxy/YAML.pm"
},
"Connector::Role::LocalPath" : {
"file" : "lib/Connector/Role/LocalPath.pm"
},
"Connector::Role::SSLUserAgent" : {
"file" : "lib/Connector/Role/SSLUserAgent.pm"
},
"Connector::Role::SessionCache" : {
"file" : "lib/Connector/Role/SessionCache.pm"
},
"Connector::Tee" : {
"file" : "lib/Connector/Tee.pm"
},
"Connector::Types" : {
"file" : "lib/Connector/Types.pm"
},
"Connector::Wrapper" : {
"file" : "lib/Connector/Wrapper.pm"
}
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/whiterabbitsecurity/connector/issues"
},
"homepage" : "https://github.com/whiterabbitsecurity/connector",
"repository" : {
"type" : "git",
"url" : "https://github.com/whiterabbitsecurity/connector.git",
"web" : "https://github.com/whiterabbitsecurity/connector"
}
},
"version" : "1.55",
"x_contributors" : [
"Martin Bartosch <m.bartosch@cynops.de>",
"Martin Bartosch <mbartosch@whiterabbitsecurity.com>",
"Oliver Welter <github@oliwel.de>",
"Oliver Welter <mail@oliwel.de>",
"Oliver Welter <owelter@whiterabbitsecurity.com>",
"Paweł Tomulik <ptomulik@meil.pw.edu.pl>",
"Scott Hardin <scott@hnsc.de>",
"Scott Hardin <shardin@whiterabbitsecurity.com>",
"Scott T. Hardin <scott-1@hnsc.de>",
"Scott T. Hardin <scott.hardin@hnsc.de>"
],
"x_serialization_backend" : "JSON::PP version 4.16",
"x_static_install" : 1
}
---
abstract: 'a generic connection to a hierarchical-structured data set'
author:
- 'Scott Hardin <mrscotty@cpan.org>'
build_requires:
Config::Merge: '0'
Config::Std: '0'
DBD::SQLite: '0'
DBI: '0'
ExtUtils::MakeMaker: '6.59'
IO::Socket::SSL: '0'
JSON: '0'
LWP::Protocol::https: '0'
LWP::UserAgent: '0'
Proc::SafeExec: '0'
Syntax::Keyword::Try: '0'
Template: '0'
Test::More: '0'
YAML: '0'
configure_requires:
Module::Build::Tiny: '0.035'
dynamic_config: 0
generated_by: 'Minilla/v3.1.26, CPAN::Meta::Converter version 2.150010'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: Connector
no_index:
directory:
- t
- xt
- inc
- share
- eg
- examples
- author
- builder
provides:
Connector:
file: lib/Connector.pm
version: '1.55'
Connector::Builtin:
file: lib/Connector/Builtin.pm
Connector::Builtin::Authentication::LDAP:
file: lib/Connector/Builtin/Authentication/LDAP.pm
Connector::Builtin::Authentication::Password:
file: lib/Connector/Builtin/Authentication/Password.pm
Connector::Builtin::Authentication::PasswordScheme:
file: lib/Connector/Builtin/Authentication/PasswordScheme.pm
Connector::Builtin::Env:
file: lib/Connector/Builtin/Env.pm
Connector::Builtin::File::Path:
file: lib/Connector/Builtin/File/Path.pm
Connector::Builtin::File::SCP:
file: lib/Connector/Builtin/File/SCP.pm
Connector::Builtin::File::Simple:
file: lib/Connector/Builtin/File/Simple.pm
Connector::Builtin::Inline:
file: lib/Connector/Builtin/Inline.pm
Connector::Builtin::Memory:
file: lib/Connector/Builtin/Memory.pm
Connector::Builtin::Null:
file: lib/Connector/Builtin/Null.pm
Connector::Builtin::Static:
file: lib/Connector/Builtin/Static.pm
Connector::Iterator:
file: lib/Connector/Iterator.pm
Connector::Multi:
file: lib/Connector/Multi.pm
Connector::Multi::Merge:
file: lib/Connector/Multi/Merge.pm
Connector::Multi::YAML:
file: lib/Connector/Multi/YAML.pm
Connector::Proxy:
file: lib/Connector/Proxy.pm
Connector::Proxy::Authentication::KeyNanny:
file: lib/Connector/Proxy/Authentication/KeyNanny.pm
Connector::Proxy::Config::Std:
file: lib/Connector/Proxy/Config/Std.pm
Connector::Proxy::DBI:
file: lib/Connector/Proxy/DBI.pm
Connector::Proxy::HTTP:
file: lib/Connector/Proxy/HTTP.pm
Connector::Proxy::JSON:
file: lib/Connector/Proxy/JSON.pm
Connector::Proxy::Net::FTP:
file: lib/Connector/Proxy/Net/FTP.pm
Connector::Proxy::Net::LDAP:
file: lib/Connector/Proxy/Net/LDAP.pm
Connector::Proxy::Net::LDAP::DN:
file: lib/Connector/Proxy/Net/LDAP/DN.pm
Connector::Proxy::Net::LDAP::Simple:
file: lib/Connector/Proxy/Net/LDAP/Simple.pm
Connector::Proxy::Net::LDAP::Single:
file: lib/Connector/Proxy/Net/LDAP/Single.pm
Connector::Proxy::Net::SFTP:
file: lib/Connector/Proxy/Net/SFTP.pm
Connector::Proxy::Proc::SafeExec:
file: lib/Connector/Proxy/Proc/SafeExec.pm
Connector::Proxy::SOAP::Lite:
file: lib/Connector/Proxy/SOAP/Lite.pm
Connector::Proxy::YAML:
file: lib/Connector/Proxy/YAML.pm
Connector::Role::LocalPath:
file: lib/Connector/Role/LocalPath.pm
Connector::Role::SSLUserAgent:
file: lib/Connector/Role/SSLUserAgent.pm
Connector::Role::SessionCache:
file: lib/Connector/Role/SessionCache.pm
Connector::Tee:
file: lib/Connector/Tee.pm
Connector::Types:
file: lib/Connector/Types.pm
Connector::Wrapper:
file: lib/Connector/Wrapper.pm
recommends:
Config::Std: '0'
DBI: '0'
IO::Socket::SSL: '0'
JSON: '0'
LWP::Protocol::https: '0'
LWP::UserAgent: '0'
Net::LDAP: '0'
Proc::SafeExec: '0'
Template: '0'
Text::CSV_XS: '0'
YAML: '0'
requires:
Log::Log4perl: '0'
Moose: '0'
perl: '5.010001'
resources:
bugtracker: https://github.com/whiterabbitsecurity/connector/issues
homepage: https://github.com/whiterabbitsecurity/connector
repository: https://github.com/whiterabbitsecurity/connector.git
version: '1.55'
x_contributors:
- 'Martin Bartosch <m.bartosch@cynops.de>'
- 'Martin Bartosch <mbartosch@whiterabbitsecurity.com>'
- 'Oliver Welter <github@oliwel.de>'
- 'Oliver Welter <mail@oliwel.de>'
- 'Oliver Welter <owelter@whiterabbitsecurity.com>'
- 'Paweł Tomulik <ptomulik@meil.pw.edu.pl>'
- 'Scott Hardin <scott@hnsc.de>'
- 'Scott Hardin <shardin@whiterabbitsecurity.com>'
- 'Scott T. Hardin <scott-1@hnsc.de>'
- 'Scott T. Hardin <scott.hardin@hnsc.de>'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
x_static_install: 1
# NAME
Connector - a generic connection to a hierarchical-structured data set
# DESCRIPTION
The Connector is generic connection to a data set, typically configuration
data in a hierarchical structure. Each connector object accepts the get(KEY)
method, which, when given a key, returns the associated value from the
connector's data source.
Typically, a connector acts as a proxy to a simple data source like
YAML, Config::Std, or to a more complex data source
like an LDAP server or Proc::SafeExec. The standard calling convention
via get(KEY) makes the connectors interchangeable.
In addition, a set of meta-connectors may be used to combine multiple
connectors into more complex chains. The Connector::Multi, for example,
allows for redirection to delegate connectors via symbolic links. If
you have a list of connectors and want to use them in a load-balancing,
round-robin fashion or have the list iterated until a value is found,
use Connector::List and choose the algorithm to perform.
# SYNOPSIS
use Connector::MODULENAME;
my $conn = Connector::MODULENAME->new( {
LOCATION => $path_to_config_for_module,
});
my $val = $conn->get('full.name.of.key');
## Connector Class
This is the base class for all Connector implementations. It provides
common helper methods and performs common sanity checking.
Usually this class should not be instantiated directly.
# CONFIGURATION
## die\_on\_undef
Set to true if you want the connector to die when a query reaches a non-exisiting
node. This will affect calls to get/get\_list/get\_hash and will not affect
values that are explicitly set to undef (if supported by the connector!).
# Accessor Methods
Each accessor method is valid only on special types of nodes. If you call them
on a wrong type of node, the connector may retunr unexpected result or simply die.
## exists
## get
Basic method to obtain a scalar value at the leaf of the config tree.
my $value = $connector->get('smartcard.owners.tokenid.bob');
Each implementation must also accept an arrayref as path. The path is
contructed from the elements. The default behaviour allows strings using
the delimiter character inside an array element. If you want each array
element to be parsed, you need to pass "RECURSEPATH => 1" to the constructor.
my $value = $connector->get( [ 'smartcard','owners','tokenid','bob.builder' ] );
Some implementations accept control parameters, which can be passed by
_params_, which is a hash ref of key => value pairs.
my $value = $connector->get( 'smartcard.owners.tokenid.bob' , { version => 1 } );
## get\_list
This method is only valid if it is called on a "n-1" depth node representing
an ordered list of items (array). The return value is an array with all
values present below the node.
my @items = $connector->get_list( 'smartcard.owners.tokenid' );
## get\_size
This method is only valid if it is called on a "n-1" depth node representing
an ordered list of items (array). The return value is the number of elements
in this array (including undef elements if they are explicitly given).
my $count = $connector->get_size( 'smartcard.owners.tokens.bob' );
If the node does not exist, 0 is returned.
## get\_hash
This method is only valid if it is called on a "n-1" depth node representing
a key => value list (hash). The return value is a hash ref.
my %data = %{$connector->get_hash( 'smartcard.owners.tokens.bob' )};
## get\_keys
This method is only valid if it is called on a "n-1" depth node representing
a key => value list (hash). The return value is an array holding the
values of all keys (including undef elements if they are explicitly given).
my @keys = $connector->get_keys( 'smartcard.owners.tokens.bob' );
If the node does not exist, an empty list is returned.
## get\_reference \[deprecated\]
Rarely used, returns the value of a reference node. Currently used by
Connector::Multi in combination with Connector::Proxy::Config::Versioned
to create internal links and cascaded connectors. See Connector::Multi
for details.
## set
The set method is a "all in one" implementation, that is used for either type
of value. If the value is not a scalar, it must be passed by reference.
$connector->set('smartcard.owners.tokenid.bob', $value, $params);
The _value_ parameter holds a scalar or ref to an array/hash with the data to
be written. _params_ is a hash ref which holds additional parameters for the
operation and can be undef if not needed.
# STRUCTURAL METHODS
## get\_meta
This method returns some structural information about the current node as
hash ref. At minimum it must return the type of node at the current path.
Valid values are _scalar, list, hash, reference_. The types match the
accessor methods given above (use `get` for _scalar_).
my $meta = $connector->get_meta( 'smartcard.owners' );
my $type = $meta->{TYPE};
When you call a proxy connector without sufficient arguments to perform the
query, you will receive a value of _connector_ for type. Running a get\_\*
method against such a node will cause the connector to die!
## cleanup
Advise connectors to close, release or flush any open handle or sessions.
Should be called directly before the program terminates. Connectors might
be stale and not respond any longer after this was called.
# IMPLEMENTATION GUIDELINES
You SHOULD use the \_node\_not\_exists method if the requested path does not exist
or has an undefined value. This will internally take care of the _die\_on\_undef_
setting and throw an exception or return undef. So you can just write:
if (path not exists || not defined val) {
return $self->_node_not_exists( pathspec );
}
As connectors are often used in eval constructs where the error messages
are swallowed you SHOULD log a verbose error before aborting with
die/confess. You can use the \_log\_and\_die method for this purpose. It will
send a message to the logger on error level before calling "die $message".
## path building
You should always pass the first parameter to the private `_build_path`
method. This method converts any valid path spec representation to a valid
path. It takes care of the RECURSEPATH setting and returns the path
elements as list.
## Supported methods
The methods get, get\_list, get\_size, get\_hash, get\_keys, set, get\_meta are
routed to the appropriate connector.
You MUST implement at minimum one of the three data getters, if get\_list/get\_keys
is omited, the base class will do a get\_list/get\_keys call and return the info
which will be a correct result but might be expensive, so you can provide your
own implementiation if required.
You MUST also implement the get\_meta method. If you have a connector with a
fixed type, you MAY check if the particular path exists and return
the result of _\_node\_not\_exists_.
## cleanup
Connectors that keep locks or use long-lived sessions that are not
bound to the lifetime of the perl process should implement this method
and cleanup their mess. While it would be nice, that connectors can be
revived after cleanup was called, this is not a strict requirement.
# AUTHORS
Scott Hardin <mrscotty@cpan.org>
Martin Bartosch
Oliver Welter
# COPYRIGHT
Copyright 2013/2021 White Rabbit Security Gmbh
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
# Managing build with Minilla
minil test - run test cases
minil dist - make your dist tarball
minil install - install your dist
minil release - release your dist to CPAN
# To build a release:
Note: Replace '1.10' in the examples below with the current version.
* Switch to develop branch and update it with latest commits
* Start release branch
Set the connver to the new version number:
```
connver=1.10
git flow release start $connver develop
```
* Merge in any remote work (optional)
```
git remote update
git merge <remote-branch>
```
* Run unit tests
```
minil test
```
* Bump version number in lib/Connector.pm
```
perl -i -pe "s{our \\\$VERSION = .+}{our \\\$VERSION = '$connver';};" \
lib/Connector.pm
minil dist
git add lib/Connector.pm META.json
git commit -m "bump version to $connver"
```
* Make any last-minute fixes and re-test
```
minil test
```
* Finalize release (write the version number in the TAG\_MSG)
```
git flow release finish -m "$connver" "$connver"
git push origin develop master "$connver"
```
* Build tarball
```
minil dist
```
* Upload tarball to https://pause.perl.org
```
minil release
```
# If the build env is not already set up, run the following:
```
curl -L http://install.perlbrew.pl | bash
echo "source $HOME/perl5/perlbrew/etc/bashrc" >> $HOME/.bashrc
source $HOME/perl5/perlbrew/etc/bashrc
perlbrew available
# Note: Adjust perl version based on results from 'perlbrew available'
perlbrew install perl-5.19.5
perlbrew switch perl-5.19.5
perlbrew install-cpanm
cpanm Module::Install
cpanm --installdeps --notest .
```
## To set up a new perl version
```
perlbrew install perl-5.32.0
perlbrew use perl-5.32.0
cpanm Module::Install
cpanm --installdeps --notest .
```
requires 'Log::Log4perl';
requires 'Moose';
requires 'perl', '5.010001';
recommends 'Config::Std';
recommends 'DBI';
recommends 'IO::Socket::SSL';
recommends 'JSON';
recommends 'LWP::Protocol::https';
recommends 'LWP::UserAgent';
recommends 'Net::LDAP';
recommends 'Proc::SafeExec';
recommends 'Template';
recommends 'Text::CSV_XS';
recommends 'YAML';
on build => sub {
requires 'Config::Merge';
requires 'Config::Std';
requires 'DBD::SQLite';
requires 'DBI';
requires 'ExtUtils::MakeMaker', '6.59';
requires 'IO::Socket::SSL';
requires 'JSON';
requires 'LWP::Protocol::https';
requires 'LWP::UserAgent';
requires 'Proc::SafeExec';
requires 'Syntax::Keyword::Try';
requires 'Template';
requires 'Test::More';
requires 'YAML';
};
on develop => sub {
requires 'Test::CPAN::Meta';
requires 'Test::MinimumVersion::Fast', '0.04';
requires 'Test::PAUSE::Permissions', '0.04';
requires 'Test::Pod', '1.41';
requires 'Test::Spellunker', 'v0.2.7';
};
gen-cpanfile.pl view on Meta::CPAN
use CPAN::Meta;
use Data::Dumper;
use Module::CPANfile;
my $meta = CPAN::Meta->load_file('MYMETA.json');
my $file = Module::CPANfile->from_prereqs($meta->prereqs);
$file->save('cpanfile');
# load to recreate with round-trip
$file = Module::CPANfile->load('cpanfile');
$file = Module::CPANfile->from_prereqs($file->prereq_specs);
$file->save('cpanfile');
lib/Connector.pm view on Meta::CPAN
# Connector
#
# A generic abstraction for accessing information.
#
# Written by Scott Hardin, Martin Bartosch and Oliver Welter for the OpenXPKI project 2012
#
package Connector;
# This is the earliest version we've tested on and we need at least 5.10
# because of the '//' operator in one of the sub-modules.
use 5.010001;
our $VERSION = '1.55';
use strict;
use warnings;
use English;
use Data::Dumper;
use Log::Log4perl;
use Moose;
use Connector::Types;
has LOCATION => (
is => 'ro',
isa => 'Connector::Types::Location',
required => 1,
);
# In order to clear the prefix, call the accessor with undef as argument
has PREFIX => (
is => 'rw',
isa => 'Connector::Types::Key|ArrayRef|Undef',
# build and store an array of the prefix in _prefix_path
trigger => sub {
my ($self, $prefix, $old_prefix) = @_;
if (defined $prefix) {
my @path = $self->_build_path($prefix);
$self->__prefix_path(\@path);
} else {
$self->__prefix_path([]);
}
}
);
has DELIMITER => (
is => 'rw',
isa => 'Connector::Types::Char',
default => '.',
);
has RECURSEPATH => (
is => 'rw',
isa => 'Bool',
default => '0',
);
# internal representation of the instance configuration
# NB: this should be a private variable and not accessible from outside
# an instance.
# TODO: figure out how to protect it.
has _config => (
is => 'rw',
lazy => 1,
init_arg => undef, # not settable via constructor
builder => '_build_config',
);
has log => (
is => 'rw',
lazy => 1,
init_arg => undef, # not settable via constructor
builder => '_build_logger',
);
# this instance variable is set in the trigger function of PREFIX.
# it contains an array representation of PREFIX (assumed to be delimited
# by the DELIMITER character)
has _prefix_path => (
is => 'rw',
isa => 'ArrayRef',
init_arg => undef,
default => sub { [] },
writer => '__prefix_path',
lazy => 1
);
# weather to die on undef or just fail silently
# implemented in _node_not_exists
has 'die_on_undef' => (
is => 'rw',
isa => 'Bool',
default => 0,
);
# This is the foo that allows us to just milk the connector config from
# the settings fetched from another connector.
around BUILDARGS => sub {
my $orig = shift;
my $class = shift;
my $args = $_[0];
if ( ref($args) eq 'HASH'
&& defined($args->{CONNECTOR})
&& defined($args->{TARGET}) ) {
my $conn = $args->{CONNECTOR};
delete $args->{CONNECTOR};
my @targ = $conn->_build_path( $args->{TARGET} );
delete $args->{TARGET};
my $meta = $class->meta;
my $log = $conn->log(); # Logs to the parent that is initialising us
$log->trace( 'Wrapping connector - config at ' . join ".", @targ ) ;
for my $attr ( $meta->get_all_attributes ) {
my $attrname = $attr->name();
next if $attrname =~ m/^_/; # skip apparently internal params
# allow caller to override params in CONNECTOR
if ( not exists($args->{$attrname}) ) {
my $meta = $conn->get_meta( [ @targ , $attrname ] );
$log->trace( ' Check for ' . $attrname . ' - meta is ' . Dumper $meta );
next unless($meta && $meta->{TYPE});
if ($meta->{TYPE} eq 'scalar') {
$args->{$attrname} = $conn->get( [ @targ , $attrname ] );
} elsif ($meta->{TYPE} eq 'list') {
my @tmp = $conn->get_list( [ @targ , $attrname ] );
$args->{$attrname} = \@tmp;
} elsif ($meta->{TYPE} eq 'hash') {
$args->{$attrname} = $conn->get_hash( [ @targ , $attrname ] );
} else {
$log->warn( ' Unexpected type '.$meta->{TYPE}.' for attribute ' . $attrname );
}
}
}
$log->trace( 'Wrapping connector - arglist ' .Dumper \@_ );
}
return $class->$orig(@_);
};
# subclasses must implement this to initialize _config
sub _build_config { return; };
sub _build_logger {
return Log::Log4perl->get_logger("connector");
};
# helper function: build a path from the given input. does not take PREFIX
# into account
sub _build_path {
my $self = shift;
my @arg = @_;
my @path;
# Catch old call format
if (scalar @arg > 1) {
die "Sorry, we changed the API (pass scalar or array ref but not array)";
}
my $location = shift @arg;
if (not $location) {
@path = ();
} elsif (ref $location eq '') {
# String path - split at delimiter
my $delimiter = $self->DELIMITER();
@path = split(/[$delimiter]/, $location);
} elsif (ref $location ne "ARRAY") {
# Nothing else than arrays allowed beyond this point
die "Invalid data type passed in argument to _build_path";
} elsif ($self->RECURSEPATH()) {
foreach my $item (@{$location}) {
push @path, $self->_build_path( $item );
}
} else {
# Atomic path, the array is the result
@path = @{$location};
}
$self->log()->trace( 'path created ' . Dumper \@path );
if (wantarray) {
return @path;
} elsif ($self->RECURSEPATH()) {
return join $self->DELIMITER(), @path;
} else {
die "Sorry, we changed the API, request a list and join yourself or set RECURSEPATH in constructor";
}
}
# same as _build_config, but prepends PREFIX
sub _build_path_with_prefix {
my $self = shift;
my $location = shift;
if (not $location) {
return @{$self->_prefix_path()};
} else {
return (@{$self->_prefix_path()}, ($self->_build_path( $location )));
}
}
# return the prefix as string (using DELIMITER)
sub _get_prefix {
my $self = shift;
return join($self->DELIMITER(), @{$self->_prefix_path()});
}
# This is a helper to handle non exisiting nodes
# By default we just return undef but you can configure the connector
# to die with an error
sub _node_not_exists {
my $self = shift;
my $path = shift || '';
$path = join ("|", @{$path}) if (ref $path eq "ARRAY");
$self->log()->debug('Node does not exist at ' . $path );
if ($self->die_on_undef()) {
confess("Node does not exist at " . $path );
}
return;
}
sub _log_and_die {
my $self = shift;
my $message = shift;
my $log_message = shift || $message;
$self->log()->error($log_message);
die $message;
}
# Subclasses can implement these to save resources
sub get_size {
my $self = shift;
my @node = $self->get_list( shift );
if (!@node) {
return 0;
}
return scalar @node;
}
sub get_keys {
my $self = shift;
my $node = $self->get_hash( shift );
if (!defined $node) {
return @{[]};
}
if (ref $node ne "HASH") {
die "requested path looks not like a hash";
}
return keys (%{$node});
}
# Generic, should be implemented in child classes to save resources
sub exists {
my $self = shift;
my @args = @_;
my @path = $self->_build_path_with_prefix( $args[0] );
my $meta;
my $result;
eval {
$meta = $self->get_meta( @args );
if (!$meta || !$meta->{TYPE}) {
$result = undef;
} elsif ($meta->{TYPE} eq 'scalar') {
$result = defined $self->get( @args );
} elsif ($meta->{TYPE} eq 'list') {
my @tmp = $self->get_list( @args );
$result = (@tmp && scalar @tmp > 0);
} elsif ($meta->{TYPE} eq 'hash') {
$result = defined $self->get_hash( @args );
} elsif ($meta->{TYPE} eq 'connector') {
$result = 1;
} elsif ($meta->{TYPE} eq 'reference') {
$result = 1;
} else {
$self->log()->warn( ' Unexpected type '.$meta->{TYPE}.' for exist on path ' . join ".", @path );
}
};
$self->log()->debug("Got eval error ($EVAL_ERROR) for exist on path " . join ".", @path ) if ($EVAL_ERROR);
return $result;
}
# subclasses must implement get and/or set in order to do something useful
sub get { shift; die "No get() method defined"; };
sub get_list { shift; die "No get_list() method defined"; };
sub get_hash { shift; die "No get_hash() method defined"; };
sub get_meta { shift; die "No get_meta() method defined"; };
sub get_reference { shift; die "No get_reference() method defined [deprecated]"; };
sub set { shift; die "No set() method defined"; };
sub cleanup {};
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 NAME
Connector - a generic connection to a hierarchical-structured data set
=head1 DESCRIPTION
The Connector is generic connection to a data set, typically configuration
data in a hierarchical structure. Each connector object accepts the get(KEY)
method, which, when given a key, returns the associated value from the
connector's data source.
Typically, a connector acts as a proxy to a simple data source like
YAML, Config::Std, or to a more complex data source
like an LDAP server or Proc::SafeExec. The standard calling convention
via get(KEY) makes the connectors interchangeable.
In addition, a set of meta-connectors may be used to combine multiple
connectors into more complex chains. The Connector::Multi, for example,
allows for redirection to delegate connectors via symbolic links. If
you have a list of connectors and want to use them in a load-balancing,
round-robin fashion or have the list iterated until a value is found,
use Connector::List and choose the algorithm to perform.
=head1 SYNOPSIS
use Connector::MODULENAME;
my $conn = Connector::MODULENAME->new( {
LOCATION => $path_to_config_for_module,
});
my $val = $conn->get('full.name.of.key');
=head2 Connector Class
This is the base class for all Connector implementations. It provides
common helper methods and performs common sanity checking.
Usually this class should not be instantiated directly.
=head1 CONFIGURATION
=head2 die_on_undef
Set to true if you want the connector to die when a query reaches a non-exisiting
node. This will affect calls to get/get_list/get_hash and will not affect
values that are explicitly set to undef (if supported by the connector!).
=head1 Accessor Methods
Each accessor method is valid only on special types of nodes. If you call them
on a wrong type of node, the connector may retunr unexpected result or simply die.
=head2 exists
=head2 get
Basic method to obtain a scalar value at the leaf of the config tree.
my $value = $connector->get('smartcard.owners.tokenid.bob');
Each implementation must also accept an arrayref as path. The path is
contructed from the elements. The default behaviour allows strings using
the delimiter character inside an array element. If you want each array
element to be parsed, you need to pass "RECURSEPATH => 1" to the constructor.
my $value = $connector->get( [ 'smartcard','owners','tokenid','bob.builder' ] );
Some implementations accept control parameters, which can be passed by
I<params>, which is a hash ref of key => value pairs.
my $value = $connector->get( 'smartcard.owners.tokenid.bob' , { version => 1 } );
=head2 get_list
This method is only valid if it is called on a "n-1" depth node representing
an ordered list of items (array). The return value is an array with all
values present below the node.
my @items = $connector->get_list( 'smartcard.owners.tokenid' );
=head2 get_size
This method is only valid if it is called on a "n-1" depth node representing
an ordered list of items (array). The return value is the number of elements
in this array (including undef elements if they are explicitly given).
my $count = $connector->get_size( 'smartcard.owners.tokens.bob' );
If the node does not exist, 0 is returned.
=head2 get_hash
This method is only valid if it is called on a "n-1" depth node representing
a key => value list (hash). The return value is a hash ref.
my %data = %{$connector->get_hash( 'smartcard.owners.tokens.bob' )};
=head2 get_keys
This method is only valid if it is called on a "n-1" depth node representing
a key => value list (hash). The return value is an array holding the
values of all keys (including undef elements if they are explicitly given).
my @keys = $connector->get_keys( 'smartcard.owners.tokens.bob' );
If the node does not exist, an empty list is returned.
=head2 get_reference [deprecated]
Rarely used, returns the value of a reference node. Currently used by
Connector::Multi in combination with Connector::Proxy::Config::Versioned
to create internal links and cascaded connectors. See Connector::Multi
for details.
=head2 set
The set method is a "all in one" implementation, that is used for either type
of value. If the value is not a scalar, it must be passed by reference.
$connector->set('smartcard.owners.tokenid.bob', $value, $params);
The I<value> parameter holds a scalar or ref to an array/hash with the data to
be written. I<params> is a hash ref which holds additional parameters for the
operation and can be undef if not needed.
=head1 STRUCTURAL METHODS
=head2 get_meta
This method returns some structural information about the current node as
hash ref. At minimum it must return the type of node at the current path.
Valid values are I<scalar, list, hash, reference>. The types match the
accessor methods given above (use C<get> for I<scalar>).
my $meta = $connector->get_meta( 'smartcard.owners' );
my $type = $meta->{TYPE};
When you call a proxy connector without sufficient arguments to perform the
query, you will receive a value of I<connector> for type. Running a get_*
method against such a node will cause the connector to die!
=head2 cleanup
Advise connectors to close, release or flush any open handle or sessions.
Should be called directly before the program terminates. Connectors might
be stale and not respond any longer after this was called.
=head1 IMPLEMENTATION GUIDELINES
You SHOULD use the _node_not_exists method if the requested path does not exist
or has an undefined value. This will internally take care of the I<die_on_undef>
setting and throw an exception or return undef. So you can just write:
if (path not exists || not defined val) {
return $self->_node_not_exists( pathspec );
}
As connectors are often used in eval constructs where the error messages
are swallowed you SHOULD log a verbose error before aborting with
die/confess. You can use the _log_and_die method for this purpose. It will
send a message to the logger on error level before calling "die $message".
=head2 path building
You should always pass the first parameter to the private C<_build_path>
method. This method converts any valid path spec representation to a valid
path. It takes care of the RECURSEPATH setting and returns the path
elements as list.
=head2 Supported methods
The methods get, get_list, get_size, get_hash, get_keys, set, get_meta are
routed to the appropriate connector.
You MUST implement at minimum one of the three data getters, if get_list/get_keys
is omited, the base class will do a get_list/get_keys call and return the info
which will be a correct result but might be expensive, so you can provide your
own implementiation if required.
You MUST also implement the get_meta method. If you have a connector with a
fixed type, you MAY check if the particular path exists and return
the result of I<_node_not_exists>.
=head2 cleanup
Connectors that keep locks or use long-lived sessions that are not
bound to the lifetime of the perl process should implement this method
and cleanup their mess. While it would be nice, that connectors can be
revived after cleanup was called, this is not a strict requirement.
=head1 AUTHORS
Scott Hardin <mrscotty@cpan.org>
Martin Bartosch
Oliver Welter
=head1 COPYRIGHT
Copyright 2013/2021 White Rabbit Security Gmbh
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
lib/Connector/Builtin.pm view on Meta::CPAN
# Connector::Builtin
#
# Proxy class for builtin connector modules
#
# Written by Scott Hardin and Martin Bartosch for the OpenXPKI project 2012
#
package Connector::Builtin;
use strict;
use warnings;
use English;
use Moose;
extends 'Connector';
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 NAME
Connector::Builtin
=head1 DESCRIPTION
This is the base class for all Connector::Builtin implementations.
lib/Connector/Builtin/Authentication/LDAP.pm view on Meta::CPAN
# Connector::Builtin::Authentication::LDAP
#
# Authenticate users against LDAP directory.
package Connector::Builtin::Authentication::LDAP;
use strict;
use warnings;
use English;
use Template;
use Data::Dumper;
use Net::LDAP;
use Moose;
extends 'Connector::Proxy::Net::LDAP';
# if we use direct bind we dont need base or filter
has '+base' => (
required => 0
);
has '+filter' => (
required => 0
);
#
# Authentication-specific options
#
has userattr => (
is => 'rw',
isa => 'Str',
default => 'uid',
);
has groupattr => (
is => 'rw',
isa => 'Str',
default => 'member',
);
has groupdn => (
is => 'rw',
isa => 'Str',
);
has indirect => (
is => 'rw',
isa => 'Bool',
default => 1,
);
has ambiguous => (
is => 'rw',
isa => 'Bool',
default => 0,
);
# NOTE: it returns undef in case of error, or ref to an array of user DNs
# it MAY return an empty array if user is not found
sub _search_user {
my $self = shift;
my $user = shift;
my $ldap = $self->ldap();
$self->log()->debug('Searching LDAP databse for user "'.$user. '"');
my $result = $self->_run_search({ LOGIN => $user }, { noattrs => 1 });
if($result->is_error()) {
$self->log()->error('LDAP search returned error code '.$result->code.' (error: '.$result->error_desc().')');
return undef;
} else {
$self->log()->debug('LDAP search returned '.$result->count . (($result->count ==1) ? ' entry' : ' entries'));
}
if($self->groupdn()) {
$self->log()->debug('Group check requested, groupdn: "'.$self->groupdn().'", groupattr: "'.$self->groupattr().'"');
}
my @entries;
for my $entry ($result->entries()) {
my $dn = $entry->dn();
if(defined $self->groupdn()) {
if(!$self->_check_user_group($dn)) {
next;
}
}
push @entries, $dn;
}
return unless(@entries);
$self->log()->debug('Found '.scalar @entries.' LDAP entries matching the user "'.$user.'"');
if (@entries > 1 && !$self->ambiguous()) {
$self->log()->error('Ambiguous search result');
return $self->_node_not_exists($user);
}
return \@entries;
}
sub _check_user_group {
my $self = shift;
my $dn = shift;
my $ldap = $self->ldap();
$self->log()->debug('Checking if "'.$dn.'" belongs to group "'.$self->groupdn().'"');
my $result = $ldap->compare($self->groupdn(), attr => $self->groupattr(), value => $dn);
if($result->is_error()) {
$self->log()->error('LDAP compare returned error code '.$result->code.' (error: '.$result->error_desc().')');
return 0;
}
if($result->code != 6) { # !compareTrue
$self->log()->debug('User "'.$dn.'" does not belong to group "'.$self->groupdn().'"');
return 0;
}
$self->log()->debug('User "'.$dn.'" belongs to group "'.$self->groupdn().'"');
return 1
}
sub _check_user_password {
my $self = shift;
my $userdns = shift;
my $password = shift;
my $ldap = $self->ldap;
my $userdn;
foreach my $dn (@$userdns) {
# Try to bind to $dn
$self->log()->debug('Trying to bind to dn: '.$dn);
my $mesg = $ldap->bind($dn, password => $password);
if($mesg->is_error()) {
$self->log()->debug('LDAP bind to '.$dn.' returned error code '.$mesg->code.' (error: '.$mesg->error_desc().')');
} else {
$self->log()->debug('LDAP bind to '.$dn.' succeeded');
$userdn = $dn;
last;
}
}
# restore the connection using the orginal credentials
$self->rebind();
if(!defined $userdn) {
$self->log()->warn('Authentication failed');
return 0;
} else {
$self->log()->info('User successfuly authenticated: (dn: '.$userdn.')');
return $userdn;
}
}
sub get {
my $self = shift;
my $arg = shift;
my $params = shift;
my @args = $self->_build_path( $arg );
my $user = shift @args;
my $password = $params->{password};
if(!$user) {
$self->log()->warn('Missing user name');
return undef;
}
# enforce valueencoding, see RFC4515, note that we allow non-ascii (utf-8) characters
# I assume that Net::LDAP->search() escapes them internally as needed
if (!($user =~ /^([\x01-\x27\x2B-\x5B\x5D-\x7F]|[^[:ascii:]]|\\[0-9a-fA-F][0-9a-fA-F])*$/)) {
$self->log()->warn('Invalid chars in username ("'.$user.'")');
return undef;
}
# let's check if we were instructed to search for the auth user
if($self->indirect()) {
my $result = $self->_search_user( $user );
if(!defined $result) {
$self->log()->warn('User not found in LDAP database');
return $self->_node_not_exists($user);
}
return $self->_check_user_password($result, $password);
}
# direct bind = username is the DN to bind
my $res = $self->_check_user_password([$user], $password);
# we can not check if the user or the password is wrong
return unless($res);
# if we are here we have a successful direct bind, we now check
# for the group using the bound connection, this requires that the
# user himself has access permissions on the group objects
if($self->groupdn()) {
if(!$self->_check_user_group($user)) {
$self->log()->warn('User was authenticated but is not member of this group');
return $self->_node_not_exists($user);
}
}
return $res;
}
sub get_meta {
my $self = shift;
# If we have no path, we tell the caller that we are a connector
my @path = $self->_build_path( shift );
if (scalar @path == 0) {
return { TYPE => "connector" };
}
return {TYPE => "scalar" };
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 NAME
Connector::Builtin::Authentication::LDAP
=head1 DESCRIPTION
Connector (see perldoc I<Connector>) to authenticate users against LDAP.
Supports simple authentication (via LDAP bind), SASL authentication is not
supported.
The module allows for direct bind or indirect bind (with preliminary user
search). Direct bind is the most straightforward method, but it requires
users to know their Distinguished Names (DNs) in LDAP. Indirect bind is more
convenient for users, but it involves LDAP database search, which requires read
access to larger parts of LDAP directory (so LDAP ACLs must be set properly to
allow indirect bind).
The module implements group participation checking. With this option enabled,
only users that belong to a predefined group may pass the authentication.
The group is stored in LDAP directory (it may be for example an entry of
type I<groupOfUniqueNames> with the group participants listed in attribute
I<uniqueMember>).
When requesting indirect bind, the internal user search may return multiple
DNs. By default this is treated as an error (because of ambiguity) and results
with authentication failure. This may be changed by setting a parameter named
I<ambiguous>, in which case the module will try to consecutively bind to each
DN from the search result.
The indirect bind may be configured to use custom search filter, instead of
the default one. This allows to incorporate additional restrictions on users
based on their attributes stored in LDAP.
=head2 Usage
The username is the first component of the path, the password needs to be
passed in the extended parameters using the key password.
Example:
$connector->get('username', { password => 'mySecret' } );
To configure module for direct bind, the connector object should be created
with parameter I<indirect> => 0. This is the simplest authentication method
and requires least parameters to be configured.
Example:
my $connector = Connector::Builtin::Authentication::LDAP->new({
LOCATION => 'ldap://ldap.example.org',
indirect => 0
})
my $result = $connector->get(
'uid=jsmith,ou=people,dc=example,dc=org',
{ password => 'secret' }
);
Indirect bind, which is default, searches through the LDAP directory. This
usually requires read access to database, and is performed by a separate user.
We'll call that user I<binddn>. For indirect-bind authentication, one usually
has to provide DN and password of the existing I<binddn> user.
Example:
my $connector = Connector::Builtin::Authentication::LDAP->new({
LOCATION => 'ldap://ldap.example.org',
binddn => 'cn=admin,dc=example,dc=org',
password => 'binddnPassword'
})
my $result = $connector->get('jsmith', { password => 'secret' });
Two parameters are used to check group participation: I<groupdn> and
I<groupattr>. The I<groupdn> parameter specifies DN of a group entry and the
I<groupattr> specifies an attribute of the I<groupdn> object where group
participants are listed. If you specify I<groupdn>, the group participation
check is enabled.
Example:
# Assume, we have in LDAP:
#
# dn: cn=vip,dc=example,dc=org
# objectClass: groupOfNames
# member: uid=jsmith,ou=people,dc=example,dc=org
#
my $connector = Connector::Builtin::Authentication::LDAP->new({
LOCATION => 'ldap://ldap.example.org',
indirect => 0,
binddn => 'cn=admin,dc=example,dc=org',
password => 'binddnPassword',
groupdn => 'cn=vip,dc=example,dc=org',
})
my $result = $connector->get(
'uid=jsmith,ou=people,dc=example,dc=org',
{ password => 'secret' }
);
Note, that in this case we have provided I<binddn> despite the direct-bind
authentication was used. This is, because we needed read access to the
C<cn=vip,dc=example,dc=org> entry (the group object).
The indirect-bind method accepts custom filters for user search.
Example:
my $connector = Connector::Builtin::Authentication::LDAP->new({
LOCATION => 'ldap://ldap.example.org',
binddn => 'cn=admin,dc=example,dc=org',
password => 'binddnPassword',
filter => '(&(uid=[% LOGIN %])(accountStatus=active))'
})
my $result = $connector->get('jsmith', { password => 'secret' });
You may substitute user name by using I<[% LOGIN %]> template parameter,
as shown in the above example.
=head2 Configuration
Below is the full list of configuration options.
=head3 Connection options
See Connector::Proxy::Net::LDAP
=head3 SSL Connection options
=over 8
=item B<verify> => 'none' | 'optional' | 'require'
How to verify the server's certificate:
none
The server may provide a certificate but it will not be checked - this
may mean you are be connected to the wrong server
optional
Verify only when the server offers a certificate
require
The server must provide a certificate, and it must be valid.
If you set B<verify> to optional or I<require>, you must also set either
B<cafile> or B<capath>. The most secure option is require.
=item B<sslversion> => 'sslv2' | 'sslv3' | 'sslv23' | 'tlsv1'
This defines the version of the SSL/TLS protocol to use. Defaults to 'tlsv1'.
=item B<ciphers> => CIPHERS
Specify which subset of cipher suites are permissible for this connection,
using the standard OpenSSL string format. The default behavior is to keep the
decision on the underlying cryptographic library.
=item B<capath> => '/path/to/servercerts/'
See B<cafile>.
=item B<cafile> => '/path/to/servercert.pem'
When verifying the server's certificate, either set B<capath> to the pathname
of the directory containing CA certificates, or set B<cafile> to the filename
containing the certificate of the CA who signed the server's certificate. These
certificates must all be in PEM format.
=item B<clientcert> => '/path/to/cert.pem'
See B<clientkey>.
=item B<clientkey> => '/path/to/key.pem'
If you want to use the client to offer a certificate to the server for SSL
authentication (which is not the same as for the LDAP Bind operation) then set
B<clientcert> to the user's certificate file, and B<clientkey> to the user's
private key file. These files must be in PEM format.
=item B<checkcrl> => 1
=back
=head3 BindDN
=over 8
=item B<binddn> => DN
Distinguished Name of the LDAP entry used to search LDAP database for users
being authenticated (indirect bind) and check their group participation.
=item B<password> => PASSWORD
Password for the B<binddn> user.
=back
=head3 Search options (indirect bind)
=over 8
=item B<timelimit> => N
A timelimit that restricts the maximum time (in seconds) allowed for a search.
A value of 0 (the default), means that no timelimit will be requested.
=item B<sizelimit> => N
A sizelimit that restricts the maximum number of entries to be returned as a
result of the search. A value of 0, and the default, means that no restriction
is requested. Servers may enforce a maximum number of entries to return.
=item B<base> => DN
The DN that is the base object entry relative to which the search is to be
performed.
=item B<filter> => TEMPLATESTRING
A filter that defines the conditions an entry in the directory must meet in
order for it to be returned by the search. This may be a (template) string or a
Net::LDAP::Filter object.
=item B<scope> => 'base' | 'one' | 'sub' | 'subtree' | 'children'
By default the search is performed on the whole tree below the specified base
object. This maybe changed by specifying a scope parameter with one of the
following values:
base
Search only the base object.
one
Search the entries immediately below the base object.
sub
subtree
Search the whole tree below (and including) the base object. This is
the default.
children
Search the whole subtree below the base object, excluding the base object itself.
Note: children scope requires LDAPv3 subordinate feature extension.
=back
=head3 Other options
=over 8
=item B<userattr> => ATTRNAME
If the search B<filter> (for indirect bind) is not specified, it is constructed
internally as I<"($userattr=[% LOGIN %])">, where I<$userattr> represents the
value of B<userattr> parameter.
=item B<groupattr> => ATTRNAME
If B<groupdn> is specified by caller, the B<groupattr> defines an attribute
within B<groupdn> object which shall be compared against the DN of the user
being authenticated in order to check its participation to the group. Defaults
to I<'member'>.
=item B<groupdn> => DN
DN of an LDAP entry which defines a group of users allowed to be authenticated.
If not defined, the group participation is not checked.
=item B<indirect> => 1 | 0
Use indirect bind (default). Set to I<0> to disable indirect bind and use
direct bind.
=item B<ambiguous> => 0 | 1
Accept ambiguous search results when doing indirect-bind authentication. By
default, this option is disabled.
=back
=head2 Return values
Returns the DN of the matched entry, 0 if the user is found but the
password does not match and undef if the user is not found (or it's found
but group check failed).
=head2 Limitations
User names are limited to so called I<valueencoding> syntax defined by RFC4515.
We allow non-ascii (utf-8) characters and non-printable characters. Invalid
names are treated as not found.
=cut
# vim: set expandtab tabstop=4 shiftwidth=4:
lib/Connector/Builtin/Authentication/Password.pm view on Meta::CPAN
# Connector::Builtin::Authentication::Password
#
# Check passwords against a unix style password file
#
package Connector::Builtin::Authentication::Password;
use strict;
use warnings;
use English;
use Data::Dumper;
use Moose;
extends 'Connector::Builtin';
sub _build_config {
my $self = shift;
if (! -r $self->{LOCATION}) {
confess("Cannot open input file " . $self->{LOCATION} . " for reading.");
}
return 1;
}
sub get {
my $self = shift;
my $arg = shift;
my $params = shift;
my @path = $self->_build_path( $arg );
my $user = shift @path;
my $password = $params->{password};
if (!$user) {
$self->log()->error('No username');
die "no username given";
}
if (!$password) {
$self->log()->error('No password');
die "no password given";
}
$self->log()->debug('verify password for ' . $user );
if ($user =~ /[^a-zA-Z0-9_\-\.\@]/) {
$self->log()->error('Invalid chars in username ('.$user.')');
return $self->_node_not_exists( $user );
}
my $filename = $self->{LOCATION};
if (! -r $filename || ! open FILE, "$filename") {
$self->log()->error('Can\'t open/read from file ' . $filename);
die 'Can\'t open/read from file ' . $filename;
}
while (<FILE>) {
if (/^$user:/) {
chomp;
my @t = split(/:/, $_, 3);
$self->log()->trace('found line ' . Dumper @t);
#if ($password eq $t[1]) {
if (not defined $t[1]) {
$self->log()->info('Password value not defined for ' . $user);
return 0;
}
if (crypt($password, $t[1]) eq $t[1]) {
$self->log()->info('Password accepted for ' . $user);
return 1;
} else {
$self->log()->info('Password mismatch for ' . $user);
return 0;
}
}
}
return $self->_node_not_exists( $user );
}
sub get_meta {
my $self = shift;
# If we have no path, we tell the caller that we are a connector
my @path = $self->_build_path( shift );
if (scalar @path == 0) {
return { TYPE => "connector" };
}
return {TYPE => "scalar" };
}
sub exists {
my $self = shift;
# No path = connector root which always exists
my @path = $self->_build_path( shift );
if (scalar @path == 0) {
return 1;
}
my $user = shift @path;
my $filename = $self->{LOCATION};
if (! -r $filename || ! open FILE, "$filename") {
$self->log()->error('Can\'t open/read from file ' . $filename);
return 0;
}
while (<FILE>) {
if (/^$user:/) {
return 1;
}
}
return 0;
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 Name
Connector::Builtin::Authentication::Password
=head1 Description
Lightweight connector to check passwords against a unix style password file.
Path to the password file is taken from LOCATION.
=head2 Usage
The username is the first component of the path, the password needs to be
passed in the extended parameters using the key password.
Example:
$connector->get('username', { password => 'mySecret' } );
=head2 Return values
1 if the password matches, 0 if the user is found but the password does not
match and undef if the user is not found.
The connector will die if the password file is not readable or if one of
the parameters is missing.
=head2 Limitations
Usernames are limited to [a-zA-Z0-9_\-\.], invalid names are treated as not
found.
lib/Connector/Builtin/Authentication/PasswordScheme.pm view on Meta::CPAN
# Connector::Builtin::Authentication::PasswordScheme
#
# Check passwords against a file with salted hashes and scheme prefix
#
package Connector::Builtin::Authentication::PasswordScheme;
use strict;
use warnings;
use English;
use Data::Dumper;
use MIME::Base64;
use Digest::SHA;
use Digest::MD5;
use Moose;
extends 'Connector::Builtin';
sub _build_config {
my $self = shift;
if (! -r $self->{LOCATION}) {
confess("Cannot open input file " . $self->{LOCATION} . " for reading.");
}
return 1;
}
sub get {
my $self = shift;
my $arg = shift;
my $params = shift;
my @path = $self->_build_path( $arg );
my $user = shift @path;
my $password = $params->{password};
if (!$user) {
$self->log()->error('No username');
die "no username given";
}
if (!$password) {
$self->log()->error('No password');
die "no password given";
}
$self->log()->debug('verify password for ' . $user );
if ($user =~ /[^a-zA-Z0-9_\-\.\@]/) {
$self->log()->error('Invalid chars in username ('.$user.')');
return $self->_node_not_exists( $user );
}
my $filename = $self->{LOCATION};
if (! -r $filename || ! open FILE, "$filename") {
$self->log()->error('Can\'t open/read from file ' . $filename);
die 'Can\'t open/read from file ' . $filename;
}
while (<FILE>) {
if (/^$user:/) {
chomp;
my @t = split(/:/, $_, 3);
$self->log()->trace('found line ' . Dumper @t);
# This code is mainly a copy of OpenXPKI::Server::Authentication::Password
# but we do not support unsalted passwords
# digest specified in RFC 2307 userPassword notation?
my $encrypted;
my $scheme;
if ($t[1] =~ m{ \{ (\w+) \} (.+) }xms) {
$scheme = lc($1);
$encrypted = $2;
} else {
$self->log()->error('unparsable entry ' . $t[1]);
return 0;
}
my ($computed_secret, $salt);
eval {
if ($scheme eq 'ssha') {
$salt = substr(decode_base64($encrypted), 20);
my $ctx = Digest::SHA->new();
$ctx->add($password);
$ctx->add($salt);
$computed_secret = encode_base64($ctx->digest() . $salt, '');
} elsif ($scheme eq 'smd5') {
$salt = substr(decode_base64($encrypted), 16);
my $ctx = Digest::MD5->new();
$ctx->add($password);
$ctx->add($salt);
$computed_secret = encode_base64($ctx->digest() . $salt, '');
} elsif ($scheme eq 'crypt') {
$computed_secret = crypt($password, $encrypted);
} else {
$self->log()->error('unsupported scheme' . $scheme);
return 0;
}
};
$self->log()->debug('eval failed ' . $EVAL_ERROR->message()) if ($EVAL_ERROR);
if (! defined $computed_secret) {
$self->log()->error('unable to compute secret using scheme ' . $scheme);
return 0;
}
##! 2: "ident user ::= $account and digest ::= $computed_secret"
$computed_secret =~ s{ =+ \z }{}xms;
$encrypted =~ s{ =+ \z }{}xms;
## compare passphrases
if ($computed_secret eq $encrypted) {
$self->log()->info('Password accepted for ' . $user);
return 1;
} else {
$self->log()->info('Password mismatch for ' . $user);
return 0;
}
}
}
return $self->_node_not_exists( $user );
}
sub get_meta {
my $self = shift;
# If we have no path, we tell the caller that we are a connector
my @path = $self->_build_path( shift );
if (scalar @path == 0) {
return { TYPE => "connector" };
}
return {TYPE => "scalar" };
}
sub exists {
my $self = shift;
# No path = connector root which always exists
my @path = $self->_build_path( shift );
if (scalar @path == 0) {
return 1;
}
my $user = shift @path;
my $filename = $self->{LOCATION};
if (! -r $filename || ! open FILE, "$filename") {
$self->log()->error('Can\'t open/read from file ' . $filename);
return 0;
}
while (<FILE>) {
if (/^$user:/) {
return 1;
}
}
return 0;
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 Name
Connector::Builtin::Authentication::PasswordScheme
=head1 Description
Lightweight connector to check passwords against a password file holding
username/password pairs where the password is encrypted using a salted hash.
Password notation follows RFC2307 ({scheme}saltedpassword) but we support
only salted schemes: smd5, ssha and crypt.
=head2 Usage
The username is the first component of the path, the password needs to be
passed in the extended parameters using the key password.
Example:
$connector->get('username', { password => 'mySecret' } );
=head2 Return values
1 if the password matches, 0 if the user is found but the password does not
match and undef if the user is not found.
The connector will die if the password file is not readable or if one of
the parameters is missing.
=head2 Limitations
Usernames are limited to [a-zA-Z0-9_\-\.], invalid names are treated as not
found.
lib/Connector/Builtin/Env.pm view on Meta::CPAN
# Connector::Builtin::Env
#
# Read values from the environment
#
# Written by Oliver Welter for the OpenXPKI project 2014
#
package Connector::Builtin::Env;
use strict;
use warnings;
use English;
use File::Spec;
use Data::Dumper;
use Moose;
extends 'Connector::Builtin';
has '+LOCATION' => ( required => 0 );
has prefix => (
is => 'rw',
isa => 'Str',
default => ''
);
sub get {
my $self = shift;
my $key = shift;
my $val = $self->_get_node( $key );
if (!defined $val) {
return $self->_node_not_exists( $key );
}
return $val;
}
sub get_meta {
my $self = shift;
return { TYPE => "scalar" };
}
sub exists {
my $self = shift;
my $val = $self->_get_node( shift );
return defined $val;
}
sub _get_node {
my $self = shift;
my $prefix = $self->prefix();
my $key = shift;
# We expect only a scalar key, so this is a fast and valid conversion
$key = $key->[0] if (ref $key eq 'ARRAY');
return $ENV{$prefix.$key};
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 Name
Connector::Builtin::Env
=head1 Description
Return the contents of a environment value.
The value of LOCATION is not used.
=head2 Configuration
Connector::Builtin::Env->new({
'LOCATION' => 'Not Used'
'prefix' => 'optional prefix to be prepended to all keys',
});
lib/Connector/Builtin/File/Path.pm view on Meta::CPAN
# Connector::Builtin::File::Path
#
# Proxy class for accessing files
#
# Written by Oliver Welter for the OpenXPKI project 2012
#
package Connector::Builtin::File::Path;
use strict;
use warnings;
use English;
use File::Spec;
use Data::Dumper;
use Template;
use Moose;
extends 'Connector::Builtin';
with 'Connector::Role::LocalPath';
has content => (
is => 'rw',
isa => 'Str',
);
has ifexists => (
is => 'rw',
isa => 'Str',
default => 'replace'
);
has user => (
is => 'rw',
isa => 'Str',
default => ''
);
has group => (
is => 'rw',
isa => 'Str',
default => ''
);
has mode => (
is => 'rw',
isa => 'Str',
default => ''
);
sub _build_config {
my $self = shift;
if (! -d $self->{LOCATION}) {
confess("Cannot open directory " . $self->{LOCATION} );
}
return 1;
}
# return the content of the file
sub get {
my $self = shift;
my $path = shift;
my $filename = $self->_sanitize_path( $path );
if (! -r $filename) {
return $self->_node_not_exists( $path );
}
my $content = do {
local $INPUT_RECORD_SEPARATOR;
open my $fh, '<', $filename;
<$fh>;
};
return $content;
}
sub get_meta {
my $self = shift;
# If we have no path, we tell the caller that we are a connector
my @path = $self->_build_path_with_prefix( shift );
if (scalar @path == 0) {
return { TYPE => "connector" };
}
return {TYPE => "scalar" };
}
sub exists {
my $self = shift;
# No path = connector root which always exists
my @path = $self->_build_path_with_prefix( shift );
if (scalar @path == 0) {
return 1;
}
my $filename = $self->_sanitize_path( \@path );
return -r $filename;
}
# return the content of the file
sub set {
my $self = shift;
my $file = shift;
my $data = shift;
my $filename = $self->_sanitize_path( $file, $data );
my $content;
if ($self->content()) {
$self->log()->debug('Process template for content ' . $self->content());
my $template = Template->new({});
$data = { DATA => $data } if (ref $data eq '');
$template->process( \$self->content(), $data, \$content) || die "Error processing content template.";
} else {
if (ref $data ne '') {
die "You need to define a content template if data is not a scalar";
}
$content = $data;
}
my $mode = $self->ifexists();
if ($mode eq 'fail' && -f $filename) {
die "File $filename exists";
}
if ($mode eq 'silent' && -f $filename) {
return;
}
my $uid = -1;
my $gid;
if (my $user = $self->user()) {
$uid = getpwnam($user) or die "$user not known";
$gid = -1;
}
if (my $group = $self->group()) {
$gid = getgrnam($group) or die "$group not known";
}
if ($mode eq 'append' && -f $filename) {
open (FILE, ">>",$filename) || die "Unable to open file for appending";
} else {
open (FILE, ">", $filename) || die "Unable to open file for writing";
}
print FILE $content;
close FILE;
if (my $filemode = $self->mode()) {
if ($filemode =~ m{\A[0-7]{4}\z}) {
chmod (oct($filemode), $filename) || die "Unable to change mode to $filemode";
} else {
die "Given mode string '$filemode' is not valid";
}
}
if ($gid) {
chown ($uid, $gid, $filename) || die "Unable to chown $filename to $uid/$gid";
}
#FIXME - some error handling might not hurt
return 1;
}
sub _sanitize_path {
my $self = shift;
my $inargs = shift;
my $data = shift;
my @args = $self->_build_path_with_prefix( $inargs );
my $file = $self->_render_local_path( \@args, $data );
my $filename = $self->{LOCATION}.'/'.$file;
$self->log()->debug('Filename evaluated to ' . $filename);
return $filename;
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 Name
Connector::Builtin::File::Path
=head1 Description
Highly configurable file writer/reader.
=head1 Parameters
=over
=item LOCATION
The base directory where the files are located. This parameter is mandatory.
=item file/path
Pattern for Template Toolkit to build the filename.
The path components are available in the key ARGS. In set mode the unfiltered
data is available in key DATA.
See also Connector::Role::LocalPath
=item content
Pattern for Template Toolkit to build the content. The data is passed
"as is". If data is a scalar, it is wrapped into a hash using DATA as key.
=item ifexists
=over 2
=item * append: opens the file for appending write.
=item * fail: call C<die>
=item * silent: fail silently.
=item * replace: replace the file with the new content.
=back
=item mode
Filesystem permissions to apply to the file when a file is written using the
set method. Must be given in octal notation, e.g. 0644. Default is to not set
the permissions and rely on the systems umask.
=item user / group
Name of a user / group that the file should belong to.
=back
=head1 Supported Methods
=head2 set
Write data to a file.
$conn->set('filename', { NAME => 'Oliver', 'ROLE' => 'Administrator' });
See the file parameter how to control the filename.
By default, files are silently overwritten if they exist. See the I<ifexists>
parameter for an alternative behaviour.
=head2 get
Fetch data from a file. See the file parameter how to control the filename.
my $data = $conn->get('filename');
=head1 Example
my $conn = Connector::Builtin::File::Path->new({
LOCATION: /var/data/
file: [% ARGS.0 %].txt
content: Hello [% NAME %]
});
$conn->set('test', { NAME => 'Oliver' });
Results in a file I</var/data/test.txt> with the content I<Hello Oliver>.
lib/Connector/Builtin/File/SCP.pm view on Meta::CPAN
package Connector::Builtin::File::SCP;
use strict;
use warnings;
use English;
use File::Spec;
use File::Temp qw(tempfile tempdir);
use Proc::SafeExec;
use Data::Dumper;
use Template;
use Moose;
extends 'Connector::Builtin';
with 'Connector::Role::LocalPath';
has noargs => (
is => 'rw',
isa => 'Bool',
default => 0,
);
has file => (
is => 'rw',
isa => 'Str',
);
has path => (
is => 'rw',
isa => 'Str',
);
has content => (
is => 'rw',
isa => 'Str',
);
has command => (
is => 'rw',
isa => 'Str',
default => '/usr/bin/scp'
);
has identity => (
is => 'rw',
isa => 'Str',
default => ''
);
has sshconfig => (
is => 'rw',
isa => 'Str',
default => ''
);
has port => (
is => 'rw',
isa => 'Str',
default => ''
);
has timeout => (
is => 'rw',
isa => 'Int',
default => 30
);
has preserve => (
is => 'rw',
isa => 'Bool',
default => 0,
);
has _scp_option => (
is => 'rw',
isa => 'ArrayRef',
lazy => 1,
builder => '_init_scp_option',
);
has filemode => (
is => 'rw',
isa => 'Str',
default => ''
);
sub _build_config {
my $self = shift;
if (! -d $self->{LOCATION}) {
confess("Cannot open directory " . $self->{LOCATION} );
}
return 1;
}
sub _init_scp_option {
my $self = shift;
my @options;
push @options, '-P'. $self->port() if ($self->port());
push @options, '-F'. $self->sshconfig() if ($self->sshconfig());
push @options, '-i'. $self->identity() if ($self->identity());
push @options, '-p' if ($self->preserve());
return \@options;
}
# return the content of the file
sub get {
my $self = shift;
my $path = shift;
my $source = $self->_sanitize_path( $path );
# We need to double encode the backslash escape (for local and remote)
$source =~ s/\\/\\/g;
my $tmpdir = tempdir( CLEANUP => 1 );
my ($fh, $target) = tempfile( DIR => $tmpdir );
my $res = $self->_transfer($source, $target );
# soemthing went wrong
if ($res) {
unlink $target if (-e $target);
return $self->_node_not_exists();
}
# read the content from temporary file
my $content = do {
local $INPUT_RECORD_SEPARATOR;
open my $fh, '<', $target;
<$fh>;
};
unlink $target;
return $content;
}
sub get_meta {
my $self = shift;
# If we have no path, we tell the caller that we are a connector
# but if noargs is set, we behave like a scalar...
my @path = $self->_build_path_with_prefix( shift );
if (scalar @path == 0 && !$self->noargs()) {
return { TYPE => "connector" };
}
return {TYPE => "scalar" };
}
sub exists {
my $self = shift;
# No path = connector root which always exists
my @path = $self->_build_path_with_prefix( shift );
if (scalar @path == 0) {
return 1;
}
return 1;
}
# return the content of the file
sub set {
my $self = shift;
my $file = shift;
my $data = shift;
my $content;
if ($self->content()) {
$self->log()->debug('Process template for content ' . $self->content());
my $template = Template->new({});
$data = { DATA => $data } if (ref $data eq '');
$template->process( \$self->content(), $data, \$content) || die "Error processing content template.";
} else {
if (ref $data ne '') {
die "You need to define a content template if data is not a scalar";
}
$content = $data;
}
my $tmpdir = tempdir( CLEANUP => 1 );
my ($fh, $source) = tempfile( DIR => $tmpdir );
open FILE, ">$source" || die "Unable to open file for writing";
print FILE $content;
close FILE;
if ($self->filemode()) {
my $mode = $self->filemode();
$mode = oct($mode) if $mode =~ /^0/;
chmod $mode, $source;
}
my $target = $self->_sanitize_path( $file, $data );
my $res = $self->_transfer( $source, $target );
if ($res) {
die sprintf("Unable to transfer data (EC %01d)", $res);
}
return 1;
}
sub _transfer {
my $self = shift;
my $source = shift;
my $target = shift;
my %filehandles;
my $stdout = File::Temp->new();
$filehandles{stdout} = \*$stdout;
my $stderr = File::Temp->new();
$filehandles{stderr} = \*$stderr;
# compose the system command to execute
my @cmd = @{$self->_scp_option()};
unshift @cmd, $self->command();
push @cmd, $source;
push @cmd, $target;
$self->log()->debug("scp command: " . join(" ",@cmd));
local $SIG{'CHLD'} = 'DEFAULT';
my $command = Proc::SafeExec->new({
exec => \@cmd,
no_autowait => 1,
%filehandles,
});
eval{
local $SIG{ALRM} = sub { die "alarm\n" };
alarm $self->timeout();
$command->wait();
};
alarm 0;
if ($EVAL_ERROR) {
$self->log()->debug($EVAL_ERROR);
$self->log()->error("SCP tranfer timed out");
return 2;
}
if ($command->exit_status() != 0) {
$self->log()->error("SCP tranfer failed, exit status was " . $command->exit_status());
return 1;
}
return 0;
}
sub _sanitize_path {
my $self = shift;
my $inargs = shift;
my $data = shift;
my $host = $self->{LOCATION};
if ($self->noargs()) {
$self->log()->debug('Skip filename rendering, noargs options is set');
return $host;
}
if (!$self->path() && !$self->file()) {
$self->log()->error('Neither target pattern nor noargs set');
die "You must set either file or path or use the noargs option.";
}
my @args = $self->_build_path_with_prefix( $inargs );
my $file = $self->_render_local_path( \@args, $data );
my $filename;
# check if the LOCATION already has a path spec
if ($host !~ /:/) {
# if the file name has a leading slash, just concat with :
if ($file =~ /^\//) {
$filename = $host.':'.$file;
# otherwise add ~/ for users home
} else {
$filename = $host.':~/'.$file;
}
} else {
# if a path spec is given, check if it has a trailing slash
if ($host !~ /\/$/) {
$host .= '/';
}
$filename = $host.$file;
}
$self->log()->debug('Filename evaluated to ' . $filename);
$filename =~ s/ /\\ /g;
return $filename;
}
1;
__END__
=head1 Name
Connector::Builtin::File::SCP
=head1 Description
Read/Write files to/from a remote host using SCP.
=head1 Parameters
=over
=item LOCATION
The target host specification, minimal the hostname, optional including
username and a base path specification. Valid examples are:
my.remote.host
otheruser@my.remote.host
my.remote.host:/tmp
otheruser@my.remote.host:/tmp
Note: If the connector is called with arguments, those are used to build a
filename / path which is appended to the target specification. If you call
the connector without arguments, you need to set the noargs parameter and
must LOCATION point to a file (otherwise you will end up with the temporary
file name used as target name).
=item noargs
Set to true, if you want to use the value given by LOCATION as final
target. This makes additional path arguments and the file/path parameter
useless.
=item file
Pattern for Template Toolkit to build the filename. The connector path
components are available in the key ARGS. In set mode the unfiltered
data is also available in key DATA. The result is appended to LOCATION.
NB: For security reasons, only word, space, dash, underscore and dot are
allowed in the filename. If you want to include a directory, add the path
parameter instead!
=item path
Same as file, but allows the directory seperator (slash and backslash)
in the resulting filename. Use this for the full path including the
filename as the file parameter is not used, when path is set!
=item filemode (set mode only)
By default, the file is created with restrictive permissions of 0600. You
can set other permissions using filemode. Due to perls lack for variable
types, you must give this either as octal number with leading zero or as
string without the leading zero. Otherwise you might get wrong permissions.
=item content
Pattern for Template Toolkit to build the content. The data is passed
"as is". If data is a scalar, it is wrapped into a hash using DATA as key.
=item command, optional
Path to the scp command, default is /usr/bin/scp.
=item port, optional
Port to connect to, added with "-P" to the command line.
=item identity, optional
Path to an ssh identity file, added with "-i" to the command line.
=item sshconfig, optional
Path to an ssh client configuration, added with "-F" to the command line.
=item timeout, optional
Abort the transfer after timeout seconds.
=item preserve, optional
Boolean, adds the "-p" option to the scp command (some servers seem to
require this to carry over the permissions).
=back
=head1 Supported Methods
=head2 set
Write data to a file.
$conn->set('filename', { NAME => 'John Doe', 'ROLE' => 'Administrator' });
See the file parameter how to control the filename.
=head2 get
Fetch data from a file. See the file parameter how to control the filename.
my $data = $conn->set('filename');
=head1 Example
my $conn = Connector::Builtin::File::SCP->new({
LOCATION => 'localhost:/var/data',
file => '[% ARGS.0 %].txt',
content => ' Hello [% NAME %]',
filemode => 0644
});
$conn->set('test', { NAME => 'John Doe' });
Results in a file I</var/data/test.txt> with the content I<Hello John Doe>.
=head1 A note on security
To enable the scp transfer, the file is created on the local disk using
tempdir/tempfile. The directory is created with permissions only for the
current user, so no other user than root and yourself is able to see the
content. The tempfile is cleaned up immediatly, the directory is handled
by the internal garbage collection.
lib/Connector/Builtin/File/Simple.pm view on Meta::CPAN
# Connector::Builtin::File::Simple
#
# Proxy class for accessing simple file
#
# Written by Martin Bartosch for the OpenXPKI project 2012
#
package Connector::Builtin::File::Simple;
use strict;
use warnings;
use English;
use File::Spec;
use Data::Dumper;
use Moose;
extends 'Connector::Builtin';
sub get {
my $self = shift;
my $filename = $self->{LOCATION};
if (! -r $filename) {
return $self->_node_not_exists( );
}
my $content = do {
local $INPUT_RECORD_SEPARATOR;
open my $fh, '<', $filename;
<$fh>;
};
return $content;
}
sub get_meta {
my $self = shift;
return { TYPE => "scalar" };
}
sub exists {
my $self = shift;
my $filename = $self->{LOCATION};
return -r $filename;
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 Name
Connector::Builtin::File::Simple
=head1 Description
Return the contents of the file given by the LOCATION parameter.
The path argument is discarded.
lib/Connector/Builtin/Inline.pm view on Meta::CPAN
package Connector::Builtin::Inline;
use strict;
use warnings;
use English;
use Data::Dumper;
use Moose;
extends 'Connector::Builtin::Memory';
sub _build_config {
my $self = shift;
return $self->data();
}
has 'data' => (
is => 'ro',
required => 1,
);
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 Name
Connector::Builtin::Inline
=head1 Description
Inherits from Memory and loads the structure given to I<data> as
initial value.
=head1 Parameters
=over
=item LOCATION
Not used / required.
=item data
The payload of the connector, can be HashRef, ArrayRef or any scalar.
=back
lib/Connector/Builtin/Memory.pm view on Meta::CPAN
# Connector::Builtin::Memory
#
# Proxy class for reading YAML configuration
#
# Written by Scott Hardin, Martin Bartosch and Oliver Welter
# for the OpenXPKI project 2012
#
# THIS IS NOT WORKING IN A FORKING ENVIRONMENT!
package Connector::Builtin::Memory;
use strict;
use warnings;
use English;
use Data::Dumper;
use Moose;
extends 'Connector::Builtin';
has '+LOCATION' => ( required => 0 );
has 'primary_attribute' => (
is => 'ro',
isa => 'Str',
predicate => 'has_primary_attribute',
);
sub _build_config {
my $self = shift;
$self->_config( {} );
}
sub _get_node {
my $self = shift;
my @path = $self->_build_path_with_prefix( shift );
$self->log()->trace('get node for path'. Dumper \@path);
my $ptr = $self->_config();
while ( scalar @path ) {
my $entry = shift @path;
if ( ref $ptr eq 'HASH' && exists $ptr->{$entry} ) {
my $type = ref $ptr->{$entry};
if ( $type eq 'HASH' || $type eq 'ARRAY' || scalar @path == 0) {
$ptr = $ptr->{$entry};
}
else {
$self->log()->debug("tried to walk over unexpected node type: $type");
return $self->_node_not_exists( $entry );
}
}
elsif ( ref $ptr eq 'ARRAY' && $entry =~ m{\A\d+\z} && exists $ptr->[$entry] ) {
my $type = ref $ptr->[$entry];
if ( $type eq 'HASH' || $type eq 'ARRAY' || scalar @path == 0) {
$ptr = $ptr->[$entry];
}
else {
$self->log()->debug("tried to walk over unexpected node type: $type");
return $self->_node_not_exists( $entry );
}
} else {
return $self->_node_not_exists($entry);
}
}
return $ptr;
}
sub get {
my $self = shift;
my $value = $self->_get_node( shift );
return $self->_node_not_exists() unless (defined $value);
if (ref $value ne '') {
die "requested value is not a scalar"
unless ($self->has_primary_attribute() && ref $value eq 'HASH');
return $self->_node_not_exists()
unless (defined $value->{$self->primary_attribute});
die "primary_attribute is not a scalar"
unless (ref $value->{$self->primary_attribute} eq '');
return $value->{$self->primary_attribute};
}
return $value;
}
sub get_size {
my $self = shift;
my $node = $self->_get_node( shift );
return 0 unless(defined $node);
if ( ref $node ne 'ARRAY' ) {
die "requested value is not a list"
}
return scalar @{$node};
}
sub get_list {
my $self = shift;
my $path = shift;
my $node = $self->_get_node( $path );
return $self->_node_not_exists( $path ) unless(defined $node);
if ( ref $node ne 'ARRAY' ) {
die "requested value is not a list"
}
return @{$node};
}
sub get_keys {
my $self = shift;
my $path = shift;
my $node = $self->_get_node( $path );
return @{[]} unless(defined $node);
if ( ref $node ne 'HASH' ) {
die "requested value is not a hash"
}
return keys %{$node};
}
sub get_hash {
my $self = shift;
my $path = shift;
my $node = $self->_get_node( $path );
return $self->_node_not_exists( $path ) unless(defined $node);
if ( ref $node ne 'HASH' ) {
die "requested value is not a hash"
}
return { %$node };
}
sub get_meta {
my $self = shift;
my $node = $self->_get_node( shift );
$self->log()->trace('get_node returned '. Dumper $node);
if (!defined $node) {
# die_on_undef already handled by get_node
return;
}
my $meta = {};
if (ref $node eq '') {
$meta = {TYPE => "scalar", VALUE => $node };
} elsif (ref $node eq "SCALAR") {
$meta = {TYPE => "reference", VALUE => $$node };
} elsif (ref $node eq "ARRAY") {
$meta = {TYPE => "list", VALUE => $node };
} elsif (ref $node eq "HASH") {
my @keys = keys(%{$node});
$meta = {TYPE => "hash", VALUE => \@keys };
} elsif (blessed($node) && $node->isa('Connector')) {
$meta = {TYPE => "connector", VALUE => $node };
} else {
die "Unsupported node type: " . ref $node;
}
return $meta;
}
sub exists {
my $self = shift;
my $value = 0;
eval {
$value = defined $self->_get_node( shift );
};
return $value;
}
sub set {
my $self = shift;
my @path = $self->_build_path_with_prefix( shift );
my $value = shift;
my $ptr = $self->_config();
while (scalar @path > 1) {
my $entry = shift @path;
if (!exists $ptr->{$entry}) {
$ptr->{$entry} = {};
} elsif (ref $ptr->{$entry} ne "HASH") {
confess('Try to step over a value node at ' . $entry);
}
$ptr = $ptr->{$entry};
}
my $entry = shift @path;
if (!defined $value) {
delete $ptr->{$entry};
return;
}
if (exists $ptr->{$entry}) {
if (ref $ptr->{$entry} ne ref $value) {
confess('Try to override data type at node ' . $entry);
}
}
$ptr->{$entry} = $value;
return 1;
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 Name
Connector::Builtin::Memory
=head1 Description
A connector implementation to allow memory based caching
=head1 Parameters
=over
=item LOCATION
Not used
=item primary_attribute
If your data consists of hashes as leaf nodes, set this to the name of
the node that is considered the primary attribute, e.g. the name of a
person. If you now access the key on the penultimate level using I<get>
you will receive the value of this attribute back.
user1234:
name: John Doe
email: john.doe@acme.com
When you call I<get(user1234)> on this structure, the connector will
usually die with a "not a scalar" error. With I<primary_attribute = name>
you will get back I<John Doe>.
=back
lib/Connector/Builtin/Null.pm view on Meta::CPAN
# Connector::Builtin::Null
package Connector::Builtin::Null;
use strict;
use warnings;
use English;
use Moose;
extends 'Connector::Builtin';
has '+LOCATION' => ( required => 0 );
sub get {
my $self = shift;
return undef;
}
sub get_list {
my $self = shift;
return ();
}
sub get_size {
my $self = shift;
return 0;
}
sub get_keys {
my $self = shift;
return ();
}
sub get_hash {
my $self = shift;
return undef;
}
sub set {
my $self = shift;
return 1;
}
sub exists {
my $self = shift;
return 0;
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 Name
Connector::Builtin::Null
=head1 Description
This is mainly useful to replace active connectors in test setups.
Handles each request as access to a non-existing items.
Set requests return boolean true, input is discarded.
lib/Connector/Builtin/Static.pm view on Meta::CPAN
# Connector::Builtin::Static
#
# Simple connector returning a static value for all requests
#
package Connector::Builtin::Static;
use strict;
use warnings;
use English;
use Moose;
extends 'Connector::Builtin';
sub get {
my $self = shift;
my $arg = shift;
return $self->{LOCATION};
}
sub get_meta {
my $self = shift;
return { TYPE => "scalar", VALUE => $self->{LOCATION} };
}
sub exists {
my $self = shift;
return 1;
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 Name
Connector::Builtin::Simple
=head1 Description
Return a static value regardless of the requested key.
Set the value using the "LOCATION" parameter. Supports only
scalar values using the get/get_meta call.
lib/Connector/Iterator.pm view on Meta::CPAN
package Connector::Iterator;
use strict;
use warnings;
use English;
use Moose;
use DateTime;
use Data::Dumper;
extends 'Connector';
has 'BASECONNECTOR' => ( is => 'ro', required => 1 );
# Location must not be used
has '+LOCATION' => ( required => 0, 'isa' => 'Undef' );
has target => (
is => 'rw',
isa => 'Undef|ArrayRef',
lazy => 1,
builder => '_init_target',
);
has skip_on_error => (
is => 'rw',
isa => 'Bool',
default => 0,
);
sub _init_target {
my $self = shift;
# the connectors prefix points to the root node of the target list
my @target_node = $self->_build_path_with_prefix();
if (!$self->BASECONNECTOR()->exists( \@target_node )) {
$self->log()->warn( 'Target node does not exists ' . join(".", \@target_node) );
return;
}
$self->log()->debug( 'Node with targets' . Dumper \@target_node );
my @targets = $self->BASECONNECTOR()->get_keys( \@target_node );
if (!scalar @targets) {
$self->log()->warn( 'No targets found!' );
return;
}
$self->log()->debug( 'Targets ' . Dumper \@targets );
return \@targets;
}
sub set {
my $self = shift;
my $item = shift;
my $data = shift;
my $targets = $self->target();
if (!$targets) {
$self->log()->error( 'No targets found!' );
return $self->_node_not_exists();
}
my @item_path = $self->_build_path( $item );
$self->log()->debug( 'Item path' . Dumper \@item_path);
# Initialize the base connector
my $baseconn = $self->BASECONNECTOR();
my $result;
foreach my $target (@{$targets}) {
$self->log()->debug( 'Publication to ' . $target . ' with item ' . Dumper $item );
my @publication_target = $self->_build_path_with_prefix( [ $target, @item_path ] );
$result->{$target} = '';
my $res;
if ($self->skip_on_error()) {
eval{ $res = $baseconn->set( \@publication_target , $data ); };
if ($EVAL_ERROR) {
$EVAL_ERROR =~ /\A(.{1,200})/;
$result->{$target} = $1;
}
} else {
$res = $baseconn->set( \@publication_target , $data );
}
$self->log()->debug('Publication result: ' . Dumper $res );
}
return $result;
}
1;
__END__;
=head1 Name
Connector::Iterator
=head1 Description
Helper to perform a I<set> operation over a list of connector endpoints
while handing errors individually for each connector. The return value
is a hashref with the processed target names as key and an empty value
if no errors occured and the exception message if the target failed. You
must set I<skip_on_error> to enable handling of expcetions, otherwise
they just bubble up and terminate execution of the loop.
Intended use case: write the same data to multiple targets by using
multiple connectors. Failed write attemps can be skipped or queued
and redone
=head2 Supported methods
set
=head1 Configuration Example
my $target = OpenXPKI::Connector::Iterator->new({
BASECONNECTOR => $config,
PREFIX => $prefix
});
$target->set( [ $data->{issuer}{CN}[0] ], $data );
=head1 OPTIONS
=over
=item BASECONNECTOR
Reference to the connector for the underlying config.
=item PREFIX
The full path to the node above the targets.
=item target
List of targets to iterate thru, must be single path elements!
=item skip_on_error
By default, exceptions from the called connectors bubble up, the loop
over the targets terminate. If set, all connectors are processed and
any exceptions are returned in the result.
=back
lib/Connector/Multi.pm view on Meta::CPAN
# Connector::Multi
#
# Connector class capable of dealing with multiple personalities.
#
# Written by Scott Hardin and Martin Bartosch for the OpenXPKI project 2012
#
package Connector::Multi;
use strict;
use warnings;
use English;
use Moose;
use Connector::Wrapper;
extends 'Connector';
has 'BASECONNECTOR' => ( is => 'ro', required => 1 );
has '+LOCATION' => ( required => 0 );
has '_cache' => ( is => 'rw', required => 0, isa => 'HashRef', builder => '_init_cache' );
sub _init_cache {
my $self = shift;
$self->_cache( { 'node' => {} } );
}
sub _build_config {
my $self = shift;
# Our config is merely a hash of connector instances
my $config = {};
my $baseconn = $self->BASECONNECTOR();
my $baseref;
if ( ref($baseconn) ) { # if it's a ref, assume that it's a Connector
$baseref = $baseconn;
} else {
eval "use $baseconn;1" or die "Error use'ing $baseconn: $@";
$baseref = $baseconn->new({ LOCATION => $self->LOCATION() });
}
$config->{''} = $baseref;
$self->_config($config);
}
# Proxy calls
sub get {
my $self = shift;
unshift @_, 'get';
return $self->_route_call( @_ );
}
sub get_list {
my $self = shift;
unshift @_, 'get_list';
return $self->_route_call( @_ );
}
sub get_size {
my $self = shift;
unshift @_, 'get_size';
return $self->_route_call( @_ );
}
sub get_hash {
my $self = shift;
my @args = @_;
unshift @_, 'get_hash';
my $hash = $self->_route_call( @_ );
return $hash unless (ref $hash); # undef
# This assumes that all connectors that can handle references
my @path;
foreach my $key (keys %{$hash}) {
# Connector in leaf - resolv it!
if (ref $hash->{$key} eq 'SCALAR') {
@path = $self->_build_path( $args[0] ) unless(@path);
$hash->{$key} = $self->get( [ @path , $key ] );
}
}
return $hash;
}
sub get_keys {
my $self = shift;
unshift @_, 'get_keys';
return $self->_route_call( @_ );
}
sub set {
my $self = shift;
unshift @_, 'set';
return $self->_route_call( @_ );
}
sub get_meta {
my $self = shift;
unshift @_, 'get_meta';
return $self->_route_call( @_ );
}
sub exists {
my $self = shift;
unshift @_, 'exists';
return $self->_route_call( @_ );
}
sub cleanup {
my $self = shift;
foreach my $cache_id (keys %{$self->_config()}) {
# do not cleanup the base connector
next unless ($cache_id);
eval {
$self->_config()->{$cache_id}->cleanup();
$self->log()->debug("Cleanup ok on $cache_id");
};
delete $self->_config()->{$cache_id};
$self->log()->warn("Error on cleanup in $cache_id: $EVAL_ERROR") if ($EVAL_ERROR);
}
}
sub _route_call {
my $self = shift;
my $call = shift;
my $location = shift;
my @args = @_;
my $delim = $self->DELIMITER();
my $conn = $self->_config()->{''};
if ( ! $conn ) {
die "ERR: no default connector for Connector::Multi";
}
my @prefix = ();
my @suffix = $self->_build_path_with_prefix( $location );
my $ptr_cache = $self->_cache()->{node};
$self->log()->debug('Call '.$call.' in Multi to '. join('.', @suffix));
while ( @suffix > 0 ) {
my $node = shift @suffix;
push @prefix, $node;
# Easy Cache - skip all inner nodes, that are not a connector
# that might fail if you mix real path and complex path items
my $path = join($delim, @prefix);
if (exists $ptr_cache->{$path}) {
next;
}
my $meta = $conn->get_meta($path);
if ( $meta && $meta->{TYPE} eq 'reference' ) {
if ( $meta->{VALUE} =~ m/^([^:]+):(.+)$/ ) {
my $schema = $1;
my $target = $2;
if ( $schema eq 'connector' ) {
$conn = $self->get_connector($target);
if ( ! $conn ) {
$self->_log_and_die("Connector::Multi: error creating connector for '$target': $@");
}
$self->log()->debug("Dispatch to connector at $target");
# Push path on top of the argument array
unshift @args, \@suffix;
return $conn->$call( @args );
} elsif ( $schema eq 'env' ) {
$self->log()->debug("Fetch from ENV with key $target");
# warn if the path is not empty
$self->log()->warn(sprintf("Call redirected to ENV but path is not final (%s)!", join(".",@suffix))) if (@suffix > 0);
if (!exists $ENV{$target}) {
return $self->_node_not_exists();
}
return $ENV{$target};
} else {
$self->_log_and_die("Connector::Multi: unsupported schema for symlink: $schema");
}
} else {
# redirect
my @target = split(/[$delim]/, $meta->{VALUE});
# relative path - shift one item from prefix for each dot
if ($target[0] eq '') {
$self->log()->debug("Relative redirect at prefix " . join ".", @prefix);
while ($target[0] eq '') {
$self->_log_and_die("Relative path length exceeds prefix length") unless (scalar @prefix);
pop @prefix;
shift @target;
}
} else {
$self->log()->debug(sprintf("Plain redirect at prefix %s to %s", join(".", @prefix), $meta->{VALUE}));
@prefix = ();
}
unshift @suffix, @target;
$self->log()->debug("Final redirect target " . join ".", @suffix);
unshift @args, [ @prefix, @suffix ];
return $self->$call( @args );
}
} elsif ( $meta && $meta->{TYPE} eq 'connector' ) {
my $conn = $meta->{VALUE};
$self->log()->debug("Got conncetor reference of type ". ref $conn);
$self->log()->debug("Dispatch to connector at " . join(".", @prefix));
# Push path on top of the argument array
unshift @args, \@suffix;
return $conn->$call( @args );
} else {
$ptr_cache->{$path} = 1;
}
}
# Push path on top of the argument array
unshift @args, [ @prefix, @suffix ];
return $conn->$call( @args );
}
sub get_wrapper() {
my $self = shift;
my $location = shift;
return Connector::Wrapper->new({ BASECONNECTOR => $self, TARGET => $location });
}
# getWrapper() is deprecated - use get_wrapper() instead
sub getWrapper() {
my $self = shift;
warn "using deprecated call to getWrapper - use get_wrapper instead";
$self->get_wrapper(@_);
}
sub get_connector {
my $self = shift;
my $target = shift;
# the cache needs to store the absolute path including the prefix
my @path = $self->_build_path( $target );
my $cache_id = join($self->DELIMITER(), $self->_build_path_with_prefix( \@path ));
my $conn = $self->_config()->{$cache_id};
if ( ! $conn ) {
# Note - we will use ourselves to read the connectors instance information
# this allows to put other connectors inside a connector definition but
# also lets connector definition paths depend on PREFIX!
my $class = $self->get( [ @path, 'class' ] );
if (!$class) {
my $prefix = $self->_get_prefix() || '-';
$self->_log_and_die("Nested connector without class ($target/$prefix)");
}
$self->log()->debug("Initialize connector $class at $target");
eval "use $class;1" or $self->_log_and_die("Error use'ing $class: $@");
$conn = $class->new( { CONNECTOR => $self, TARGET => $target } );
$self->_config()->{$cache_id} = $conn;
$self->log()->trace("Add connector to cache: $cache_id") if ($self->log()->is_trace());
} elsif ($self->log()->is_trace()) {
$self->log()->trace("Got connector for $target from cache $cache_id");
}
return $conn;
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 NAME
Connector::Multi
=head1 DESCRIPTION
This class implements a Connector that is capable of dealing with dynamically
configured Connector implementations and symlinks.
The underlying concept is that there is a primary (i.e.: boot) configuration
source that Multi accesses for get() requests. If the request returns a reference
to a SCALAR, Multi interprets this as a symbolic link. The content of the
link contains an alias and a target key.
=head1 Examples
=head2 Connector References
In this example, we will be using a YAML configuration file that is accessed
via the connector Connector::Proxy::YAML.
From the programmer's view, the configuration should look something like this:
smartcards:
tokens:
token_1:
status: ACTIVATED
token_2:
status: DEACTIVATED
owners:
joe:
tokenid: token_1
bob:
tokenid: token_2
In the above example, calling get('smartcards.tokens.token_1.status') returns
the string 'ACTIVATED'.
To have the data fetched from an LDAP server, we can redirect the
'smartcards.tokens' key to the LDAP connector using '@' to indicate symlinks.
Our primary configuration source for both tokens and owners would contain
the following entries:
smartcards:
tokens@: connector:connectors.ldap-query-token
owners@: connector:connectors.ldap-query-owners
With the symlink now in the key, Multi must walk down each level itself and
handle the symlink. When 'smartcards.tokens' is reached, it reads the contents
of the symlink, which is an alias to a connector 'ldap-query-token'. The
connector configuration is in the 'connectors' namespace of our primary data source.
connectors:
ldap-query-tokens:
class: Connector::Proxy::Net::LDAP
basedn: ou=smartcards,dc=example,dc=org
uri: ldaps://example.org
bind_dn: uid=user,ou=Directory Users,dc=example,dc=org
password: secret
connectors:
ldap-query-owners:
class: Connector::Proxy::Net::LDAP
basedn: ou=people,dc=example,dc=org
uri: ldaps://example.org
bind_dn: uid=user,ou=Directory Users,dc=example,dc=org
password: secret
=head2 Builtin Environment Connector
Similar to connector you can define a redirect to read a value from the
environment.
node1:
key@: env:OPENPKI_KEY_FROM_ENV
calling get('node1.key') will return the value of the environment variable
`OPENPKI_KEY_FROM_ENV`.
If the environment variable is not set, undef is returned. Walking over such a
node raises a warning but will silently swallow the remaining path components
and return the value of the node.
=head2 Inline Redirects
It is also possible to reference other parts of the configuration using a
kind of redirect/symlink.
node1:
node2:
key@: shared.key1
shared:
key1: secret
The '@' sign indicates a symlink similar to the example given above but
there is no additional keyword in front of the value and the remainder of
the line is treated as an absolute path to read the value from.
If the path value starts with the path separator (default 'dot'), then the
path is treated as a relative link and each dot means "one level up".
node1:
node2:
key2@: ..node2a.key
node2a:
key1@: .key
key: secret
=head1 SYNOPSIS
The parameter BASECONNECTOR may either be a class instance or
the name of the class, in which case the additional arguments
(e.g.: LOCATION) are passed to the base connector.
use Connector::Multi;
my $multi = Connector::Multi->new( {
BASECONNECTOR => $base,
});
my $tok = $multi->get('smartcard.owners.bob.tokenid');
or...
use Connector::Multi;
my $multi = Connector::Multi->new( {
LOCATION => $path_to_internal_config_git_repo,
});
my $tok = $multi->get('smartcard.owners.bob.tokenid');
You can also pass the path as an arrayref, where each element can be a path itself
my $tok = $multi->get( [ 'smartcard.owners', 'bob.tokenid' ]);
*Preset Connector References*
If you create your config inside your code you and have a baseconnector that
can handle object references (e.g. Connector::Builtin::Memory), you can
directly set the value of a node to a blessed reference of a Connector class.
my $sub = Connector::Proxy::Net::LDAP->new( {
basedn => "ou=smartcards,dc=example,dc=org"
});
$base->set('smartcard.tokens', $sub )
=head1 OPTIONS
When creating a new instance, the C<new()> constructor accepts the
following options:
=over 8
=item BASECONNECTOR
This is a reference to the Connector instance that Connector::Multi
uses at the base of all get() requests.
=item PREFIX
You can set a PREFIX that is prepended to all path. There is one important
caveat to mention: Any redirects made are relative to the prefix set so you can
use PREFIX only if the configuration was prepared to work with it (e.g. to split
differnet domains and switch between them using a PREFIX).
Example:
branch:
foo@: connector:foobar
foobar:
class: ....
Without a PREFIX set, this will return "undef" as the connector is not defined
at "foobar".
my $bar = $multi->get( [ 'branch', 'foo', 'bar' ]);
This will work and return the result from the connector call using "bar" as key:
my $multi = Connector::Multi->new( {
BASECONNECTOR => $base,
PREFIX => "branch",
});
my $bar = $multi->get( [ 'branch', 'foo', 'bar' ]);
Note: It is B<DANGEROUS> to use a dynamic PREFIX in the BASECONNECTOR as
Connector::Multi stores created sub-connectors in a cache using the path as key.
It is possible to change the prefix of the class itself during runtime.
=back
=head1 Supported methods
=head2 get, get_list, get_size, get_hash, get_keys, set, get_meta
Those are routed to the appropriate connector.
=head2 get_connector
Return the instance of the connector at this node
=head2 get_wrapper
Return a wrapper around this node. This is like setting a prefix for all
subsequent queries.
my $wrapper = $conn->get_wrapper('test.node');
$val = $wrapper->get('foo');
Is the same as
$val = $conn->get_wrapper('test.node.foo');
lib/Connector/Multi/Merge.pm view on Meta::CPAN
package Connector::Multi::Merge;
use strict;
use warnings;
use English;
use Config::Merge;
use Data::Dumper;
use Moose;
extends 'Connector::Builtin::Memory';
has '+LOCATION' => ( required => 1 );
sub _build_config {
my $self = shift;
# Skip the workflow directories
my $cm = Config::Merge->new( $self->LOCATION() );
my $cmref = $cm->();
my $tree = $self->cm2tree($cmref);
return $tree;
}
# Traverse the tree read from Config::Merge and replace the "@" keys by
# scalar references
sub cm2tree {
my $self = shift;
my $cm = shift;
if ( ref($cm) eq 'HASH' ) {
my $ret = {};
foreach my $key ( keys %{$cm} ) {
if ( $key =~ m{ (?: \A @ (.*?) @ \z | \A @ (.*) | (.*?) @ \z ) }xms ) {
my $match = $1 || $2 || $3;
# make it a ref to an anonymous scalar so we know it's a symlink
$ret->{$match} = \$cm->{$key};
} else {
$ret->{$key} = $self->cm2tree( $cm->{$key} )
}
}
return $ret;
}
elsif ( ref($cm) eq 'ARRAY' ) {
my $ret = [];
my $i = 0;
foreach my $entry ( @{$cm} ) {
$ret->[ $i++ ] = $self->cm2tree($entry);
}
return $ret;
}
else {
return $cm;
}
}
1;
__DATA__
=head1 Name
Connector::Multi::Merge
=head1 Description
This is a glue connector to create the required reference syntax for
Connector::Multi based on a backend configuration handled by Config::Merge.
LOCATION is passed over as path to Config::Merge and must point to the
root node of the config directory.
Internally, the constructor walks down the whole tree and translates
all keys starting or ending with the "@" character into references as
understood by Connector::Multi.
=head1 CONFIGURATION
There is no special configuration besides the mandatory LOCATION property.
=head1 Example
my $backend = Connector::Multi::Merge->new({
LOCATION = /etc/myconfigtree/
})
my $multi = Connector::Multi->new({
BASECONNECTOR => $backend
})
lib/Connector/Multi/YAML.pm view on Meta::CPAN
package Connector::Multi::YAML;
use strict;
use warnings;
use English;
use YAML;
use Data::Dumper;
use Moose;
extends 'Connector::Builtin::Memory';
has '+LOCATION' => ( required => 1 );
sub _build_config {
my $self = shift;
# File not exist or not readable
my $file = $self->LOCATION();
if ( ! ( ( -e $file ) && ( -r $file ) ) ) {
die 'configuration file '.$file.' not found ';
}
my $yaml = YAML::LoadFile( $file );
my $config = $self->makeRefs($yaml);
return $config;
}
# Traverse the tree read from the YAML file and replace the "@" keys by
# scalar references
sub makeRefs {
my $self = shift;
my $config = shift;
if ( ref($config) eq 'HASH' ) {
my $ret = {};
foreach my $key ( keys %{$config} ) {
if ( $key =~ m{ (?: \A @ (.*?) @ \z | \A @ (.*) | (.*?) @ \z ) }xms ) {
my $match = $1 || $2 || $3;
# make it a ref to an anonymous scalar so we know it's a symlink
$ret->{$match} = \$config->{$key};
} else {
$ret->{$key} = $self->makeRefs( $config->{$key} );
}
}
return $ret;
}
elsif ( ref($config) eq 'ARRAY' ) {
my $ret = [];
my $i = 0;
foreach my $entry ( @{$config} ) {
$ret->[ $i++ ] = $self->makeRefs($entry);
}
return $ret;
}
else {
return $config;
}
}
1;
__DATA__
=head1 Name
Connector::Multi::YAML
=head1 Description
This is a glue connector to create the required reference syntax for
Connector::Multi based on a backend configuration handled by YAML.
LOCATION is passed over as file to load by YAML.
Internally, the constructor walks down the whole tree and translates
all keys starting or ending with the "@" character into references as
understood by Connector::Multi.
=head1 CONFIGURATION
There is no special configuration besides the mandatory LOCATION property.
=head1 Example
my $backend = Connector::Multi::YAML->new({
LOCATION = /etc/myconfig.yaml
})
my $multi = Connector::Multi->new({
BASECONNECTOR => $backend
})
lib/Connector/Proxy.pm view on Meta::CPAN
# Connector::Proxy
#
# Proxy class for attaching other CPAN modules
#
# Written by Scott Hardin and Martin Bartosch for the OpenXPKI project 2012
#
package Connector::Proxy;
use strict;
use warnings;
use English;
use Moose;
use Connector::Wrapper;
extends 'Connector';
has LOOPBACK => (
is => 'ro',
isa => 'Connector|Connector::Wrapper',
reader => 'conn',
required => 0,
);
around BUILDARGS => sub {
my $orig = shift;
my $class = shift;
my $args = $_[0];
if ( ref($args) eq 'HASH'
&& defined($args->{CONNECTOR})
&& defined($args->{TARGET}) ) {
my %arg = %{$args};
$arg{'BASECONNECTOR'} = $arg{CONNECTOR};
delete $arg{CONNECTOR};
$args->{LOOPBACK} = Connector::Wrapper->new( %arg );
}
return $class->$orig(@_);
};
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 Name
Connector
=head1 Description
This is the base class for all Connector::Proxy implementations.
=head1 Developer Info
When creating the connector, all class attributes that have a corresponding config
item are initialised with the given values.
All configuration options, that are denoted on the same level as the connector
definition are accessible inside the class using C<$self->conn()->get()>.
lib/Connector/Proxy/Authentication/KeyNanny.pm view on Meta::CPAN
# Connector::Proxy::Authentication::Password
#
# Check given authentication passwords against KeyNanny
#
package Connector::Proxy::Authentication::KeyNanny;
use strict;
use warnings;
use English;
use Data::Dumper;
use KeyNanny::Connector;
use Moose;
extends 'Connector::Proxy';
has keynanny => (
is => 'ro',
isa => 'KeyNanny::Connector',
lazy => 1,
builder => '_init_keynanny',
);
sub _init_keynanny {
my $self = shift;
return KeyNanny::Connector->new({
LOCATION => $self->LOCATION(),
});
}
sub get {
my $self = shift;
my $arg = shift;
my $params = shift;
my @path = $self->_build_path_with_prefix( $arg );
my $user = $path[ (scalar @path) - 1 ];
my $password = $params->{password};
if (!$user) {
$self->log()->error('No username');
die "no username given";
}
if (!$password) {
$self->log()->error('No password');
die "no password given";
}
if ($user =~ /[^a-zA-Z0-9_\-\.]/) {
$self->log()->error('Invalid chars in username ('.$user.')');
return $self->_node_not_exists( $user );
}
my $knpath = join("/", @path );
$self->log()->debug('verify password for ' . $user . ', path ' . $knpath );
# Keynanny uses the slash as seperator
my $secret;
eval {
$secret = $self->keynanny()->get( $knpath );
};
if ($EVAL_ERROR) {
$self->log()->error('Error talking to keynanny ' . $EVAL_ERROR);
return $self->_node_not_exists( $user );
}
if (!$secret) {
return $self->_node_not_exists( $user );
} elsif ($secret eq $password) {
$self->log()->info('Password accepted for ' . $user);
return 1;
} else {
$self->log()->info('Password mismatch for ' . $user);
return 0;
}
}
sub get_meta {
my $self = shift;
# If we have no path, we tell the caller that we are a connector
my @path = $self->_build_path( shift );
if (scalar @path == 0) {
return { TYPE => "connector" };
}
return {TYPE => "scalar" };
}
sub exists {
my $self = shift;
my $arg = shift;
if ((scalar @{$arg}) == 0) {
return 1;
}
my @path = $self->_build_path_with_prefix( $arg );
my $secret = $self->keynanny()->get( join("/", @path ) );
if ($secret) {
return 1;
} else {
return 0;
}
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 Name
Connector::Proxy::Authentication::KeyNanny
=head1 Description
Lightweight connector to check passwords against a Keynanny daemon.
LOCATION must point to the keynannyd socket file, PREFIX can be set
and is added in front of the username to build the keynanny path.
Note that prefix must be given in connector syntax (dot seperator).
=head2 Usage
The username is the last component of the path, the password needs to be
passed in the extended parameters using the key password.
Example:
$connector->get('username', { password => 'mySecret' } );
=head2 Return values
1 if the password matches, 0 if the user is found but the password does not
match and undef if the user is not found.
The connector will die if keynanny is unreachable.
=head2 Limitations
Usernames are limited to [a-zA-Z0-9_\-\.], invalid names are treated as not
found.
lib/Connector/Proxy/Config/Std.pm view on Meta::CPAN
# Connector::Proxy::Config::Std
#
# Proxy class for reading Config::Std configuration
#
# Written by Scott Hardin and Martin Bartosch for the OpenXPKI project 2012
#
package Connector::Proxy::Config::Std;
use strict;
use warnings;
use English;
use Config::Std;
use Data::Dumper;
use Moose;
extends 'Connector::Proxy';
sub _build_config {
my $self = shift;
my $config;
read_config($self->LOCATION(), $config);
$self->_config($config);
}
sub get {
my $self = shift;
my @path = $self->_build_path_with_prefix( shift );
# Config::Std does not allow nested data structures, emulate that
# by separating last element from path and using that as key
# in the section defined by the remaining prefix
my $key = pop @path;
my $section = $self->_build_section_name_from_path( @path);
return $self->_config()->{$section}->{$key};
}
sub _get_node {
my $self = shift;
my @path = $self->_build_path_with_prefix( shift );
my $fullpath = $self->_build_section_name_from_path( @path);
return $self->_config()->{$fullpath};
}
sub get_size {
my $self = shift;
my $node = $self->get( shift );
if (!defined $node) {
return 0;
}
if (ref $node ne "ARRAY") {
die "requested path looks not like a list";
}
return scalar @{$node};
}
sub get_list {
my $self = shift;
my $path = shift;
# List is similar to scalar, the last path item is a hash key
# in the section of the remaining prefix
my $node = $self->get( $path );
if (!defined $node) {
return $self->_node_not_exists( $path );
}
if (ref $node ne "ARRAY") {
die "requested path looks not like a hash";
}
return @{$node};
}
sub get_keys {
my $self = shift;
my $node = $self->_get_node( shift );
if (!defined $node) {
return @{[]};
}
if (ref $node ne "HASH") {
die "requested path looks not like a hash";
}
return keys (%{$node});
}
sub get_hash {
my $self = shift;
my $path = shift;
my $node = $self->_get_node( $path );
if (!defined $node) {
return $self->_node_not_exists($path);
}
if (ref $node ne "HASH") {
die "requested path looks not like a hash";
}
return $node;
}
sub get_meta {
my $self = shift;
my $origin = shift;
my @path = $self->_build_path_with_prefix( $origin );
# We dont have a real tree, so we look if there is a config entry
# that has the full path as key
my $section = $self->_build_section_name_from_path( @path );
# As top node iteration is not supported we report a connector
if (!$section) {
return { 'TYPE' => 'connector'};
}
# This is either a hash or undef
my $node = $self->_config()->{$section};
my $meta;
# Array and scalar exist one level above
if (!defined $node) {
my $key = pop @path;
$section = $self->_build_section_name_from_path( @path );
$node = $self->_config()->{$section}->{$key};
if (!defined $node) {
return $self->_node_not_exists( \@path );
}
if (ref $node eq '') {
$meta = {TYPE => "scalar", VALUE => $node };
} elsif (ref $node eq "SCALAR") {
# I guess thats not supported
$meta = {TYPE => "reference", VALUE => $$node };
} elsif (ref $node eq "ARRAY") {
$meta = {TYPE => "list", VALUE => $node };
} else {
die "Unsupported node type";
}
} elsif (ref $node eq "HASH") {
$meta = {TYPE => "hash" };
} else {
die "Unsupported node type";
}
return $meta;
}
sub exists {
my $self = shift;
my @path = $self->_build_path_with_prefix( shift );
# No path always exists
if (!@path) {
return 1;
}
# Test if it is a section
my $section = $self->_build_section_name_from_path( @path );
if ($self->_config()->{$section}) {
return 1;
}
# Test if it is a node
my $key = pop @path;
$section = $self->_build_section_name_from_path( @path );
if (defined $self->_config()->{$section}->{$key}) {
return 1;
}
return 0;
}
# might be refined to use a section delimiter different from connector
sub _build_section_name_from_path {
my $self = shift;
return join( $self->DELIMITER() , @_ );
}
no Moose;
__PACKAGE__->meta->make_immutable;
1;
__END__
=head1 Name
Connector::Proxy::Config::Std
=head1 Description
( run in 0.567 second using v1.01-cache-2.11-cpan-a838e43af63 )