diff options
Diffstat (limited to 'servers/slapd/back-perl')
| -rw-r--r-- | servers/slapd/back-perl/Makefile.in | 46 | ||||
| -rw-r--r-- | servers/slapd/back-perl/README | 24 | ||||
| -rw-r--r-- | servers/slapd/back-perl/SampleLDAP.pm | 171 | ||||
| -rw-r--r-- | servers/slapd/back-perl/add.c | 62 | ||||
| -rw-r--r-- | servers/slapd/back-perl/asperl_undefs.h | 38 | ||||
| -rw-r--r-- | servers/slapd/back-perl/bind.c | 80 | ||||
| -rw-r--r-- | servers/slapd/back-perl/close.c | 59 | ||||
| -rw-r--r-- | servers/slapd/back-perl/compare.c | 80 | ||||
| -rw-r--r-- | servers/slapd/back-perl/config.c | 255 | ||||
| -rw-r--r-- | servers/slapd/back-perl/delete.c | 59 | ||||
| -rw-r--r-- | servers/slapd/back-perl/init.c | 177 | ||||
| -rw-r--r-- | servers/slapd/back-perl/modify.c | 97 | ||||
| -rw-r--r-- | servers/slapd/back-perl/modrdn.c | 63 | ||||
| -rw-r--r-- | servers/slapd/back-perl/perl_back.h | 82 | ||||
| -rw-r--r-- | servers/slapd/back-perl/proto-perl.h | 43 | ||||
| -rw-r--r-- | servers/slapd/back-perl/search.c | 122 |
16 files changed, 1458 insertions, 0 deletions
diff --git a/servers/slapd/back-perl/Makefile.in b/servers/slapd/back-perl/Makefile.in new file mode 100644 index 0000000..31e2715 --- /dev/null +++ b/servers/slapd/back-perl/Makefile.in @@ -0,0 +1,46 @@ +# Makefile.in for back-perl +# $OpenLDAP$ +## This work is part of OpenLDAP Software <http://www.openldap.org/>. +## +## Copyright 1998-2021 The OpenLDAP Foundation. +## Portions Copyright 1999 John C. Quillan. +## All rights reserved. +## +## Redistribution and use in source and binary forms, with or without +## modification, are permitted only as authorized by the OpenLDAP +## Public License. +## +## A copy of this license is available in the file LICENSE in the +## top-level directory of the distribution or, alternatively, at +## <http://www.OpenLDAP.org/license.html>. + +SRCS = init.c search.c close.c config.c bind.c compare.c \ + modify.c add.c modrdn.c delete.c +OBJS = init.lo search.lo close.lo config.lo bind.lo compare.lo \ + modify.lo add.lo modrdn.lo delete.lo + +LDAP_INCDIR= ../../../include +LDAP_LIBDIR= ../../../libraries + +BUILD_OPT = "--enable-perl" +BUILD_MOD = @BUILD_PERL@ +PERL_CPPFLAGS = @PERL_CPPFLAGS@ + +mod_DEFS = -DSLAPD_IMPORT +MOD_DEFS = $(@BUILD_PERL@_DEFS) +MOD_LIBS = @MOD_PERL_LDFLAGS@ + +shared_LDAP_LIBS = $(LDAP_LIBLDAP_R_LA) $(LDAP_LIBLBER_LA) +NT_LINK_LIBS = -L.. -lslapd $(@BUILD_LIBS_DYNAMIC@_LDAP_LIBS) +UNIX_LINK_LIBS = $(@BUILD_LIBS_DYNAMIC@_LDAP_LIBS) + +LIBBASE = back_perl + +XINCPATH = -I.. -I$(srcdir)/.. +XDEFS = $(PERL_CPPFLAGS) $(MODULES_CPPFLAGS) + +all-local-lib: ../.backend + +../.backend: lib$(LIBBASE).a + @touch $@ + diff --git a/servers/slapd/back-perl/README b/servers/slapd/back-perl/README new file mode 100644 index 0000000..0959b44 --- /dev/null +++ b/servers/slapd/back-perl/README @@ -0,0 +1,24 @@ +Differences from 2.0 Perl API: + +- Perl 5.6 is supported + +- backend methods return actual LDAP result codes, not + true/false; this gives the Perl module finer control + of the error returned to the client + +- a filterSearchResults configuration file directive was + added to tell the backend glue that the results returned + from the Perl module are candidates only + +- the "init" method is called after the backend has been + initialized - this lets you do some initialization after + *all* configuration file directives have been read + +- the interface for the search method is improved to + pass the scope, deferencing policy, size limit, etc. + See SampleLDAP.pm for details. + +These changes were sponsored by myinternet Limited. + +Luke Howard <lukeh@padl.com> + diff --git a/servers/slapd/back-perl/SampleLDAP.pm b/servers/slapd/back-perl/SampleLDAP.pm new file mode 100644 index 0000000..bd25913 --- /dev/null +++ b/servers/slapd/back-perl/SampleLDAP.pm @@ -0,0 +1,171 @@ +# This is a sample Perl module for the OpenLDAP server slapd. +# $OpenLDAP$ +## This work is part of OpenLDAP Software <http://www.openldap.org/>. +## +## Copyright 1998-2021 The OpenLDAP Foundation. +## Portions Copyright 1999 John C. Quillan. +## All rights reserved. +## +## Redistribution and use in source and binary forms, with or without +## modification, are permitted only as authorized by the OpenLDAP +## Public License. +## +## A copy of this license is available in the file LICENSE in the +## top-level directory of the distribution or, alternatively, at +## <http://www.OpenLDAP.org/license.html>. + +# Usage: Add something like this to slapd.conf: +# +# database perl +# suffix "o=AnyOrg,c=US" +# perlModulePath /directory/containing/this/module +# perlModule SampleLDAP +# +# See the slapd-perl(5) manual page for details. +# +# This demo module keeps an in-memory hash {"DN" => "LDIF entry", ...} +# built in sub add{} & co. The data is lost when slapd shuts down. + +package SampleLDAP; +use strict; +use warnings; +use POSIX; + +$SampleLDAP::VERSION = '1.01'; + +sub new { + my $class = shift; + + my $this = {}; + bless $this, $class; + print {*STDERR} "Here in new\n"; + print {*STDERR} 'Posix Var ' . BUFSIZ . ' and ' . FILENAME_MAX . "\n"; + return $this; +} + +sub init { + return 0; +} + +sub search { + my $this = shift; + my ( $base, $scope, $deref, $sizeLim, $timeLim, $filterStr, $attrOnly, + @attrs ) + = @_; + print {*STDERR} "====$filterStr====\n"; + $filterStr =~ s/\(|\)//gm; + $filterStr =~ s/=/: /m; + + my @match_dn = (); + for my $dn ( keys %{$this} ) { + if ( $this->{$dn} =~ /$filterStr/imx ) { + push @match_dn, $dn; + last if ( scalar @match_dn == $sizeLim ); + + } + } + + my @match_entries = (); + + for my $dn (@match_dn) { + push @match_entries, $this->{$dn}; + } + + return ( 0, @match_entries ); + +} + +sub compare { + my $this = shift; + my ( $dn, $avaStr ) = @_; + my $rc = 5; # LDAP_COMPARE_FALSE + + $avaStr =~ s/=/: /m; + + if ( $this->{$dn} =~ /$avaStr/im ) { + $rc = 6; # LDAP_COMPARE_TRUE + } + + return $rc; +} + +sub modify { + my $this = shift; + + my ( $dn, @list ) = @_; + + while ( @list > 0 ) { + my $action = shift @list; + my $key = shift @list; + my $value = shift @list; + + if ( $action eq 'ADD' ) { + $this->{$dn} .= "$key: $value\n"; + + } + elsif ( $action eq 'DELETE' ) { + $this->{$dn} =~ s/^$key:\s*$value\n//im; + + } + elsif ( $action eq 'REPLACE' ) { + $this->{$dn} =~ s/$key: .*$/$key: $value/im; + } + } + + return 0; +} + +sub add { + my $this = shift; + + my ($entryStr) = @_; + + my ($dn) = ( $entryStr =~ /dn:\s(.*)$/m ); + + # + # This needs to be here until a normalized dn is + # passed to this routine. + # + $dn = uc $dn; + $dn =~ s/\s*//gm; + + $this->{$dn} = $entryStr; + + return 0; +} + +sub modrdn { + my $this = shift; + + my ( $dn, $newdn, $delFlag ) = @_; + + $this->{$newdn} = $this->{$dn}; + + if ($delFlag) { + delete $this->{$dn}; + } + return 0; + +} + +sub delete { + my $this = shift; + + my ($dn) = @_; + + print {*STDERR} "XXXXXX $dn XXXXXXX\n"; + delete $this->{$dn}; + return 0; +} + +sub config { + my $this = shift; + + my (@args) = @_; + local $, = ' - '; + print {*STDERR} @args; + print {*STDERR} "\n"; + return 0; +} + +1; diff --git a/servers/slapd/back-perl/add.c b/servers/slapd/back-perl/add.c new file mode 100644 index 0000000..a7cf33a --- /dev/null +++ b/servers/slapd/back-perl/add.c @@ -0,0 +1,62 @@ +/* $OpenLDAP$ */ +/* This work is part of OpenLDAP Software <http://www.openldap.org/>. + * + * Copyright 1999-2021 The OpenLDAP Foundation. + * Portions Copyright 1999 John C. Quillan. + * Portions Copyright 2002 myinternet Limited. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted only as authorized by the OpenLDAP + * Public License. + * + * A copy of this license is available in file LICENSE in the + * top-level directory of the distribution or, alternatively, at + * <http://www.OpenLDAP.org/license.html>. + */ + +#include "perl_back.h" + +int +perl_back_add( + Operation *op, + SlapReply *rs ) +{ + PerlBackend *perl_back = (PerlBackend *) op->o_bd->be_private; + int len; + int count; + + PERL_SET_CONTEXT( PERL_INTERPRETER ); + ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex ); + ldap_pvt_thread_mutex_lock( &entry2str_mutex ); + + { + dSP; ENTER; SAVETMPS; + + PUSHMARK(sp); + XPUSHs( perl_back->pb_obj_ref ); + XPUSHs(sv_2mortal(newSVpv( entry2str( op->ora_e, &len ), 0 ))); + + PUTBACK; + + count = call_method("add", G_SCALAR); + + SPAGAIN; + + if (count != 1) { + croak("Big trouble in back_add\n"); + } + + rs->sr_err = POPi; + + PUTBACK; FREETMPS; LEAVE; + } + + ldap_pvt_thread_mutex_unlock( &entry2str_mutex ); + ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex ); + + send_ldap_result( op, rs ); + + Debug( LDAP_DEBUG_ANY, "Perl ADD\n", 0, 0, 0 ); + return( 0 ); +} diff --git a/servers/slapd/back-perl/asperl_undefs.h b/servers/slapd/back-perl/asperl_undefs.h new file mode 100644 index 0000000..73db78c --- /dev/null +++ b/servers/slapd/back-perl/asperl_undefs.h @@ -0,0 +1,38 @@ +/* $OpenLDAP$ */ +/* This work is part of OpenLDAP Software <http://www.openldap.org/>. + * + * Copyright 1999-2021 The OpenLDAP Foundation. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted only as authorized by the OpenLDAP + * Public License. + * + * A copy of this license is available in file LICENSE in the + * top-level directory of the distribution or, alternatively, at + * <http://www.OpenLDAP.org/license.html>. + */ + +/* This file is probably obsolete. If it is not, */ +/* #inclusion of it may have to be moved. See ITS#2513. */ + +/* This file is necessary because both PERL headers */ +/* and OpenLDAP define a number of macros without */ +/* checking wether they're already defined */ + +#ifndef ASPERL_UNDEFS_H +#define ASPERL_UNDEFS_H + +/* ActiveState Win32 PERL port support */ +/* set in ldap/include/portable.h */ +# ifdef HAVE_WIN32_ASPERL +/* The following macros are undefined to prevent */ +/* redefinition in PERL headers*/ +# undef gid_t +# undef uid_t +# undef mode_t +# undef caddr_t +# undef WIN32_LEAN_AND_MEAN +# endif +#endif + diff --git a/servers/slapd/back-perl/bind.c b/servers/slapd/back-perl/bind.c new file mode 100644 index 0000000..beefd4c --- /dev/null +++ b/servers/slapd/back-perl/bind.c @@ -0,0 +1,80 @@ +/* $OpenLDAP$ */ +/* This work is part of OpenLDAP Software <http://www.openldap.org/>. + * + * Copyright 1999-2021 The OpenLDAP Foundation. + * Portions Copyright 1999 John C. Quillan. + * Portions Copyright 2002 myinternet Limited. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted only as authorized by the OpenLDAP + * Public License. + * + * A copy of this license is available in file LICENSE in the + * top-level directory of the distribution or, alternatively, at + * <http://www.OpenLDAP.org/license.html>. + */ + +#include "perl_back.h" + + +/********************************************************** + * + * Bind + * + **********************************************************/ +int +perl_back_bind( + Operation *op, + SlapReply *rs ) +{ + int count; + + PerlBackend *perl_back = (PerlBackend *) op->o_bd->be_private; + + /* allow rootdn as a means to auth without the need to actually + * contact the proxied DSA */ + switch ( be_rootdn_bind( op, rs ) ) { + case SLAP_CB_CONTINUE: + break; + + default: + return rs->sr_err; + } + + PERL_SET_CONTEXT( PERL_INTERPRETER ); + ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex ); + + { + dSP; ENTER; SAVETMPS; + + PUSHMARK(SP); + XPUSHs( perl_back->pb_obj_ref ); + XPUSHs(sv_2mortal(newSVpv( op->o_req_dn.bv_val , op->o_req_dn.bv_len))); + XPUSHs(sv_2mortal(newSVpv( op->orb_cred.bv_val , op->orb_cred.bv_len))); + PUTBACK; + + count = call_method("bind", G_SCALAR); + + SPAGAIN; + + if (count != 1) { + croak("Big trouble in back_bind\n"); + } + + rs->sr_err = POPi; + + + PUTBACK; FREETMPS; LEAVE; + } + + ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex ); + + Debug( LDAP_DEBUG_ANY, "Perl BIND returned 0x%04x\n", rs->sr_err, 0, 0 ); + + /* frontend will send result on success (0) */ + if( rs->sr_err != LDAP_SUCCESS ) + send_ldap_result( op, rs ); + + return ( rs->sr_err ); +} diff --git a/servers/slapd/back-perl/close.c b/servers/slapd/back-perl/close.c new file mode 100644 index 0000000..6a64523 --- /dev/null +++ b/servers/slapd/back-perl/close.c @@ -0,0 +1,59 @@ +/* $OpenLDAP$ */ +/* This work is part of OpenLDAP Software <http://www.openldap.org/>. + * + * Copyright 1999-2021 The OpenLDAP Foundation. + * Portions Copyright 1999 John C. Quillan. + * Portions Copyright 2002 myinternet Limited. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted only as authorized by the OpenLDAP + * Public License. + * + * A copy of this license is available in file LICENSE in the + * top-level directory of the distribution or, alternatively, at + * <http://www.OpenLDAP.org/license.html>. + */ + +#include "perl_back.h" +#include "../config.h" +/********************************************************** + * + * Close + * + **********************************************************/ + +int +perl_back_close( + BackendInfo *bd +) +{ + perl_destruct(PERL_INTERPRETER); + perl_free(PERL_INTERPRETER); + PERL_INTERPRETER = NULL; +#ifdef PERL_SYS_TERM + PERL_SYS_TERM(); +#endif + + ldap_pvt_thread_mutex_destroy( &perl_interpreter_mutex ); + + return 0; +} + +int +perl_back_db_destroy( + BackendDB *be, + ConfigReply *cr +) +{ + PerlBackend *pb = be->be_private; + + ch_free( pb->pb_module_name ); + ber_bvarray_free( pb->pb_module_path ); + ber_bvarray_free( pb->pb_module_config ); + + free( be->be_private ); + be->be_private = NULL; + + return 0; +} diff --git a/servers/slapd/back-perl/compare.c b/servers/slapd/back-perl/compare.c new file mode 100644 index 0000000..193b9b3 --- /dev/null +++ b/servers/slapd/back-perl/compare.c @@ -0,0 +1,80 @@ +/* $OpenLDAP$ */ +/* This work is part of OpenLDAP Software <http://www.openldap.org/>. + * + * Copyright 1999-2021 The OpenLDAP Foundation. + * Portions Copyright 1999 John C. Quillan. + * Portions Copyright 2002 myinternet Limited. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted only as authorized by the OpenLDAP + * Public License. + * + * A copy of this license is available in file LICENSE in the + * top-level directory of the distribution or, alternatively, at + * <http://www.OpenLDAP.org/license.html>. + */ + +#include "perl_back.h" +#include "lutil.h" + +/********************************************************** + * + * Compare + * + **********************************************************/ + +int +perl_back_compare( + Operation *op, + SlapReply *rs ) +{ + int count, avalen; + char *avastr; + + PerlBackend *perl_back = (PerlBackend *)op->o_bd->be_private; + + avalen = op->orc_ava->aa_desc->ad_cname.bv_len + 1 + + op->orc_ava->aa_value.bv_len; + avastr = ch_malloc( avalen + 1 ); + + lutil_strcopy( lutil_strcopy( lutil_strcopy( avastr, + op->orc_ava->aa_desc->ad_cname.bv_val ), "=" ), + op->orc_ava->aa_value.bv_val ); + + PERL_SET_CONTEXT( PERL_INTERPRETER ); + ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex ); + + { + dSP; ENTER; SAVETMPS; + + PUSHMARK(sp); + XPUSHs( perl_back->pb_obj_ref ); + XPUSHs(sv_2mortal(newSVpv( op->o_req_dn.bv_val , op->o_req_dn.bv_len))); + XPUSHs(sv_2mortal(newSVpv( avastr , avalen))); + PUTBACK; + + count = call_method("compare", G_SCALAR); + + SPAGAIN; + + if (count != 1) { + croak("Big trouble in back_compare\n"); + } + + rs->sr_err = POPi; + + PUTBACK; FREETMPS; LEAVE; + } + + ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex ); + + ch_free( avastr ); + + send_ldap_result( op, rs ); + + Debug( LDAP_DEBUG_ANY, "Perl COMPARE\n", 0, 0, 0 ); + + return (0); +} + diff --git a/servers/slapd/back-perl/config.c b/servers/slapd/back-perl/config.c new file mode 100644 index 0000000..6caf446 --- /dev/null +++ b/servers/slapd/back-perl/config.c @@ -0,0 +1,255 @@ +/* $OpenLDAP$ */ +/* This work is part of OpenLDAP Software <http://www.openldap.org/>. + * + * Copyright 1999-2021 The OpenLDAP Foundation. + * Portions Copyright 1999 John C. Quillan. + * Portions Copyright 2002 myinternet Limited. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted only as authorized by the OpenLDAP + * Public License. + * + * A copy of this license is available in file LICENSE in the + * top-level directory of the distribution or, alternatively, at + * <http://www.OpenLDAP.org/license.html>. + */ + +#include "perl_back.h" +#include "../config.h" + +static ConfigDriver perl_cf; + +enum { + PERL_MODULE = 1, + PERL_PATH, + PERL_CONFIG +}; + +static ConfigTable perlcfg[] = { + { "perlModule", "module", 2, 2, 0, + ARG_STRING|ARG_MAGIC|PERL_MODULE, perl_cf, + "( OLcfgDbAt:11.1 NAME 'olcPerlModule' " + "DESC 'Perl module name' " + "EQUALITY caseExactMatch " + "SYNTAX OMsDirectoryString SINGLE-VALUE )", NULL, NULL }, + { "perlModulePath", "path", 2, 2, 0, + ARG_MAGIC|PERL_PATH, perl_cf, + "( OLcfgDbAt:11.2 NAME 'olcPerlModulePath' " + "DESC 'Perl module path' " + "EQUALITY caseExactMatch " + "SYNTAX OMsDirectoryString )", NULL, NULL }, + { "filterSearchResults", "on|off", 2, 2, 0, ARG_ON_OFF|ARG_OFFSET, + (void *)offsetof(PerlBackend, pb_filter_search_results), + "( OLcfgDbAt:11.3 NAME 'olcPerlFilterSearchResults' " + "DESC 'Filter search results before returning to client' " + "SYNTAX OMsBoolean SINGLE-VALUE )", NULL, NULL }, + { "perlModuleConfig", "args", 2, 0, 0, + ARG_MAGIC|PERL_CONFIG, perl_cf, + "( OLcfgDbAt:11.4 NAME 'olcPerlModuleConfig' " + "DESC 'Perl module config directives' " + "EQUALITY caseExactMatch " + "SYNTAX OMsDirectoryString )", NULL, NULL }, + { NULL } +}; + +static ConfigOCs perlocs[] = { + { "( OLcfgDbOc:11.1 " + "NAME 'olcDbPerlConfig' " + "DESC 'Perl DB configuration' " + "SUP olcDatabaseConfig " + "MUST ( olcPerlModulePath $ olcPerlModule ) " + "MAY ( olcPerlFilterSearchResults $ olcPerlModuleConfig ) )", + Cft_Database, perlcfg, NULL, NULL }, + { NULL } +}; + +static ConfigOCs ovperlocs[] = { + { "( OLcfgDbOc:11.2 " + "NAME 'olcovPerlConfig' " + "DESC 'Perl overlay configuration' " + "SUP olcOverlayConfig " + "MUST ( olcPerlModulePath $ olcPerlModule ) " + "MAY ( olcPerlFilterSearchResults $ olcPerlModuleConfig ) )", + Cft_Overlay, perlcfg, NULL, NULL }, + { NULL } +}; + +/********************************************************** + * + * Config + * + **********************************************************/ +int +perl_back_db_config( + BackendDB *be, + const char *fname, + int lineno, + int argc, + char **argv +) +{ + int rc = config_generic_wrapper( be, fname, lineno, argc, argv ); + /* backward compatibility: map unknown directives to perlModuleConfig */ + if ( rc == SLAP_CONF_UNKNOWN ) { + char **av = ch_malloc( (argc+2) * sizeof(char *)); + int i; + av[0] = "perlModuleConfig"; + av++; + for ( i=0; i<argc; i++ ) + av[i] = argv[i]; + av[i] = NULL; + av--; + rc = config_generic_wrapper( be, fname, lineno, argc+1, av ); + ch_free( av ); + } + return rc; +} + +static int +perl_cf( + ConfigArgs *c +) +{ + PerlBackend *pb = (PerlBackend *) c->be->be_private; + SV* loc_sv; + int count ; + int args; + int rc = 0; + char eval_str[EVAL_BUF_SIZE]; + struct berval bv; + + if ( c->op == SLAP_CONFIG_EMIT ) { + switch( c-> type ) { + case PERL_MODULE: + if ( !pb->pb_module_name ) + return 1; + c->value_string = ch_strdup( pb->pb_module_name ); + break; + case PERL_PATH: + if ( !pb->pb_module_path ) + return 1; + ber_bvarray_dup_x( &c->rvalue_vals, pb->pb_module_path, NULL ); + break; + case PERL_CONFIG: + if ( !pb->pb_module_config ) + return 1; + ber_bvarray_dup_x( &c->rvalue_vals, pb->pb_module_config, NULL ); + break; + } + } else if ( c->op == LDAP_MOD_DELETE ) { + /* FIXME: none of this affects the state of the perl + * interpreter at all. We should probably destroy it + * and recreate it... + */ + switch( c-> type ) { + case PERL_MODULE: + ch_free( pb->pb_module_name ); + pb->pb_module_name = NULL; + break; + case PERL_PATH: + if ( c->valx < 0 ) { + ber_bvarray_free( pb->pb_module_path ); + pb->pb_module_path = NULL; + } else { + int i = c->valx; + ch_free( pb->pb_module_path[i].bv_val ); + for (; pb->pb_module_path[i].bv_val; i++ ) + pb->pb_module_path[i] = pb->pb_module_path[i+1]; + } + break; + case PERL_CONFIG: + if ( c->valx < 0 ) { + ber_bvarray_free( pb->pb_module_config ); + pb->pb_module_config = NULL; + } else { + int i = c->valx; + ch_free( pb->pb_module_config[i].bv_val ); + for (; pb->pb_module_config[i].bv_val; i++ ) + pb->pb_module_config[i] = pb->pb_module_config[i+1]; + } + break; + } + } else { + PERL_SET_CONTEXT( PERL_INTERPRETER ); + switch( c->type ) { + case PERL_MODULE: + snprintf( eval_str, EVAL_BUF_SIZE, "use %s;", c->argv[1] ); + eval_pv( eval_str, 0 ); + + if (SvTRUE(ERRSV)) { + STRLEN len; + + snprintf( c->cr_msg, sizeof( c->cr_msg ), "%s: error %s", + c->log, SvPV(ERRSV, len )); + Debug( LDAP_DEBUG_ANY, "%s\n", c->cr_msg, 0, 0 ); + rc = 1; + } else { + dSP; ENTER; SAVETMPS; + PUSHMARK(sp); + XPUSHs(sv_2mortal(newSVpv(c->argv[1], 0))); + PUTBACK; + + count = call_method("new", G_SCALAR); + + SPAGAIN; + + if (count != 1) { + croak("Big trouble in config\n") ; + } + + pb->pb_obj_ref = newSVsv(POPs); + + PUTBACK; FREETMPS; LEAVE ; + pb->pb_module_name = ch_strdup( c->argv[1] ); + } + break; + + case PERL_PATH: + snprintf( eval_str, EVAL_BUF_SIZE, "push @INC, '%s';", c->argv[1] ); + loc_sv = eval_pv( eval_str, 0 ); + /* XXX loc_sv return value is ignored. */ + ber_str2bv( c->argv[1], 0, 0, &bv ); + value_add_one( &pb->pb_module_path, &bv ); + break; + + case PERL_CONFIG: { + dSP ; ENTER ; SAVETMPS; + + PUSHMARK(sp) ; + XPUSHs( pb->pb_obj_ref ); + + /* Put all arguments on the perl stack */ + for( args = 1; args < c->argc; args++ ) + XPUSHs(sv_2mortal(newSVpv(c->argv[args], 0))); + + ber_str2bv( c->line + STRLENOF("perlModuleConfig "), 0, 0, &bv ); + value_add_one( &pb->pb_module_config, &bv ); + + PUTBACK ; + + count = call_method("config", G_SCALAR); + + SPAGAIN ; + + if (count != 1) { + croak("Big trouble in config\n") ; + } + + rc = POPi; + + PUTBACK ; FREETMPS ; LEAVE ; + } + break; + } + } + return rc; +} + +int +perl_back_init_cf( BackendInfo *bi ) +{ + bi->bi_cf_ocs = perlocs; + + return config_register_schema( perlcfg, perlocs ); +} diff --git a/servers/slapd/back-perl/delete.c b/servers/slapd/back-perl/delete.c new file mode 100644 index 0000000..cb3b114 --- /dev/null +++ b/servers/slapd/back-perl/delete.c @@ -0,0 +1,59 @@ +/* $OpenLDAP$ */ +/* This work is part of OpenLDAP Software <http://www.openldap.org/>. + * + * Copyright 1999-2021 The OpenLDAP Foundation. + * Portions Copyright 1999 John C. Quillan. + * Portions Copyright 2002 myinternet Limited. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted only as authorized by the OpenLDAP + * Public License. + * + * A copy of this license is available in file LICENSE in the + * top-level directory of the distribution or, alternatively, at + * <http://www.OpenLDAP.org/license.html>. + */ + +#include "perl_back.h" + +int +perl_back_delete( + Operation *op, + SlapReply *rs ) +{ + PerlBackend *perl_back = (PerlBackend *) op->o_bd->be_private; + int count; + + PERL_SET_CONTEXT( PERL_INTERPRETER ); + ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex ); + + { + dSP; ENTER; SAVETMPS; + + PUSHMARK(sp); + XPUSHs( perl_back->pb_obj_ref ); + XPUSHs(sv_2mortal(newSVpv( op->o_req_dn.bv_val , op->o_req_dn.bv_len ))); + + PUTBACK; + + count = call_method("delete", G_SCALAR); + + SPAGAIN; + + if (count != 1) { + croak("Big trouble in perl-back_delete\n"); + } + + rs->sr_err = POPi; + + PUTBACK; FREETMPS; LEAVE; + } + + ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex ); + + send_ldap_result( op, rs ); + + Debug( LDAP_DEBUG_ANY, "Perl DELETE\n", 0, 0, 0 ); + return( 0 ); +} diff --git a/servers/slapd/back-perl/init.c b/servers/slapd/back-perl/init.c new file mode 100644 index 0000000..9715eb7 --- /dev/null +++ b/servers/slapd/back-perl/init.c @@ -0,0 +1,177 @@ +/* $OpenLDAP$ */ +/* This work is part of OpenLDAP Software <http://www.openldap.org/>. + * + * Copyright 1999-2021 The OpenLDAP Foundation. + * Portions Copyright 1999 John C. Quillan. + * Portions Copyright 2002 myinternet Limited. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted only as authorized by the OpenLDAP + * Public License. + * + * A copy of this license is available in file LICENSE in the + * top-level directory of the distribution or, alternatively, at + * <http://www.OpenLDAP.org/license.html>. + */ + +#include "perl_back.h" +#include "../config.h" + +#ifdef PERL_SYS_INIT3 +#include <ac/unistd.h> /* maybe get environ */ +extern char **environ; +#endif + +static void perl_back_xs_init LDAP_P((PERL_BACK_XS_INIT_PARAMS)); +EXT void boot_DynaLoader LDAP_P((PERL_BACK_BOOT_DYNALOADER_PARAMS)); + +PerlInterpreter *PERL_INTERPRETER = NULL; +ldap_pvt_thread_mutex_t perl_interpreter_mutex; + + +/********************************************************** + * + * Init + * + **********************************************************/ + +int +perl_back_initialize( + BackendInfo *bi +) +{ + char *embedding[] = { "", "-e", "0", NULL }, **argv = embedding; + int argc = 3; +#ifdef PERL_SYS_INIT3 + char **env = environ; +#else + char **env = NULL; +#endif + + bi->bi_open = NULL; + bi->bi_config = 0; + bi->bi_close = perl_back_close; + bi->bi_destroy = 0; + + bi->bi_db_init = perl_back_db_init; + bi->bi_db_config = perl_back_db_config; + bi->bi_db_open = perl_back_db_open; + bi->bi_db_close = 0; + bi->bi_db_destroy = perl_back_db_destroy; + + bi->bi_op_bind = perl_back_bind; + bi->bi_op_unbind = 0; + bi->bi_op_search = perl_back_search; + bi->bi_op_compare = perl_back_compare; + bi->bi_op_modify = perl_back_modify; + bi->bi_op_modrdn = perl_back_modrdn; + bi->bi_op_add = perl_back_add; + bi->bi_op_delete = perl_back_delete; + bi->bi_op_abandon = 0; + + bi->bi_extended = 0; + + bi->bi_chk_referrals = 0; + + bi->bi_connection_init = 0; + bi->bi_connection_destroy = 0; + + /* injecting code from perl_back_open, because using fonction reference (bi->bi_open) is not functional */ + Debug( LDAP_DEBUG_TRACE, "perl backend open\n", 0, 0, 0 ); + + if( PERL_INTERPRETER != NULL ) { + Debug( LDAP_DEBUG_ANY, "perl backend open: already opened\n", + 0, 0, 0 ); + return 1; + } + + ldap_pvt_thread_mutex_init( &perl_interpreter_mutex ); + +#ifdef PERL_SYS_INIT3 + PERL_SYS_INIT3(&argc, &argv, &env); +#endif + PERL_INTERPRETER = perl_alloc(); + perl_construct(PERL_INTERPRETER); +#ifdef PERL_EXIT_DESTRUCT_END + PL_exit_flags |= PERL_EXIT_DESTRUCT_END; +#endif + perl_parse(PERL_INTERPRETER, perl_back_xs_init, argc, argv, env); + perl_run(PERL_INTERPRETER); + return perl_back_init_cf( bi ); +} + +int +perl_back_db_init( + BackendDB *be, + ConfigReply *cr +) +{ + be->be_private = (PerlBackend *) ch_malloc( sizeof(PerlBackend) ); + memset( be->be_private, '\0', sizeof(PerlBackend)); + + ((PerlBackend *)be->be_private)->pb_filter_search_results = 0; + + Debug( LDAP_DEBUG_TRACE, "perl backend db init\n", 0, 0, 0 ); + + be->be_cf_ocs = be->bd_info->bi_cf_ocs; + + return 0; +} + +int +perl_back_db_open( + BackendDB *be, + ConfigReply *cr +) +{ + int count; + int return_code; + + PerlBackend *perl_back = (PerlBackend *) be->be_private; + + ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex ); + + { + dSP; ENTER; SAVETMPS; + + PUSHMARK(sp); + XPUSHs( perl_back->pb_obj_ref ); + + PUTBACK; + + count = call_method("init", G_SCALAR); + + SPAGAIN; + + if (count != 1) { + croak("Big trouble in perl_back_db_open\n"); + } + + return_code = POPi; + + PUTBACK; FREETMPS; LEAVE; + } + + ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex ); + + return return_code; +} + + +static void +perl_back_xs_init(PERL_BACK_XS_INIT_PARAMS) +{ + char *file = __FILE__; + dXSUB_SYS; + newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); +} + +#if SLAPD_PERL == SLAPD_MOD_DYNAMIC + +/* conditionally define the init_module() function */ +SLAP_BACKEND_INIT_MODULE( perl ) + +#endif /* SLAPD_PERL == SLAPD_MOD_DYNAMIC */ + + diff --git a/servers/slapd/back-perl/modify.c b/servers/slapd/back-perl/modify.c new file mode 100644 index 0000000..39eb563 --- /dev/null +++ b/servers/slapd/back-perl/modify.c @@ -0,0 +1,97 @@ +/* $OpenLDAP$ */ +/* This work is part of OpenLDAP Software <http://www.openldap.org/>. + * + * Copyright 1999-2021 The OpenLDAP Foundation. + * Portions Copyright 1999 John C. Quillan. + * Portions Copyright 2002 myinternet Limited. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted only as authorized by the OpenLDAP + * Public License. + * + * A copy of this license is available in file LICENSE in the + * top-level directory of the distribution or, alternatively, at + * <http://www.OpenLDAP.org/license.html>. + */ + +#include "perl_back.h" +#include <ac/string.h> + +int +perl_back_modify( + Operation *op, + SlapReply *rs ) +{ + PerlBackend *perl_back = (PerlBackend *)op->o_bd->be_private; + Modifications *modlist = op->orm_modlist; + int count; + int i; + + PERL_SET_CONTEXT( PERL_INTERPRETER ); + ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex ); + + { + dSP; ENTER; SAVETMPS; + + PUSHMARK(sp); + XPUSHs( perl_back->pb_obj_ref ); + XPUSHs(sv_2mortal(newSVpv( op->o_req_dn.bv_val , 0))); + + for (; modlist != NULL; modlist = modlist->sml_next ) { + Modification *mods = &modlist->sml_mod; + + switch ( mods->sm_op & ~LDAP_MOD_BVALUES ) { + case LDAP_MOD_ADD: + XPUSHs(sv_2mortal(newSVpv("ADD", STRLENOF("ADD") ))); + break; + + case LDAP_MOD_DELETE: + XPUSHs(sv_2mortal(newSVpv("DELETE", STRLENOF("DELETE") ))); + break; + + case LDAP_MOD_REPLACE: + XPUSHs(sv_2mortal(newSVpv("REPLACE", STRLENOF("REPLACE") ))); + break; + } + + + XPUSHs(sv_2mortal(newSVpv( mods->sm_desc->ad_cname.bv_val, + mods->sm_desc->ad_cname.bv_len ))); + + for ( i = 0; + mods->sm_values != NULL && mods->sm_values[i].bv_val != NULL; + i++ ) + { + XPUSHs(sv_2mortal(newSVpv( mods->sm_values[i].bv_val, mods->sm_values[i].bv_len ))); + } + + /* Fix delete attrib without value. */ + if ( i == 0) { + XPUSHs(sv_newmortal()); + } + } + + PUTBACK; + + count = call_method("modify", G_SCALAR); + + SPAGAIN; + + if (count != 1) { + croak("Big trouble in back_modify\n"); + } + + rs->sr_err = POPi; + + PUTBACK; FREETMPS; LEAVE; + } + + ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex ); + + send_ldap_result( op, rs ); + + Debug( LDAP_DEBUG_ANY, "Perl MODIFY\n", 0, 0, 0 ); + return( 0 ); +} + diff --git a/servers/slapd/back-perl/modrdn.c b/servers/slapd/back-perl/modrdn.c new file mode 100644 index 0000000..72708c3 --- /dev/null +++ b/servers/slapd/back-perl/modrdn.c @@ -0,0 +1,63 @@ +/* $OpenLDAP$ */ +/* This work is part of OpenLDAP Software <http://www.openldap.org/>. + * + * Copyright 1999-2021 The OpenLDAP Foundation. + * Portions Copyright 1999 John C. Quillan. + * Portions Copyright 2002 myinternet Limited. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted only as authorized by the OpenLDAP + * Public License. + * + * A copy of this license is available in file LICENSE in the + * top-level directory of the distribution or, alternatively, at + * <http://www.OpenLDAP.org/license.html>. + */ + +#include "perl_back.h" + +int +perl_back_modrdn( + Operation *op, + SlapReply *rs ) +{ + PerlBackend *perl_back = (PerlBackend *) op->o_bd->be_private; + int count; + + PERL_SET_CONTEXT( PERL_INTERPRETER ); + ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex ); + + { + dSP; ENTER; SAVETMPS; + + PUSHMARK(sp) ; + XPUSHs( perl_back->pb_obj_ref ); + XPUSHs(sv_2mortal(newSVpv( op->o_req_dn.bv_val , op->o_req_dn.bv_len ))); + XPUSHs(sv_2mortal(newSVpv( op->orr_newrdn.bv_val , op->orr_newrdn.bv_len ))); + XPUSHs(sv_2mortal(newSViv( op->orr_deleteoldrdn ))); + if ( op->orr_newSup != NULL ) { + XPUSHs(sv_2mortal(newSVpv( op->orr_newSup->bv_val , op->orr_newSup->bv_len ))); + } + PUTBACK ; + + count = call_method("modrdn", G_SCALAR); + + SPAGAIN ; + + if (count != 1) { + croak("Big trouble in back_modrdn\n") ; + } + + rs->sr_err = POPi; + + PUTBACK; FREETMPS; LEAVE ; + } + + ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex ); + + send_ldap_result( op, rs ); + + Debug( LDAP_DEBUG_ANY, "Perl MODRDN\n", 0, 0, 0 ); + return( 0 ); +} diff --git a/servers/slapd/back-perl/perl_back.h b/servers/slapd/back-perl/perl_back.h new file mode 100644 index 0000000..ac8f54a --- /dev/null +++ b/servers/slapd/back-perl/perl_back.h @@ -0,0 +1,82 @@ +/* $OpenLDAP$ */ +/* This work is part of OpenLDAP Software <http://www.openldap.org/>. + * + * Copyright 1999-2021 The OpenLDAP Foundation. + * Portions Copyright 1999 John C. Quillan. + * Portions Copyright 2002 myinternet Limited. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted only as authorized by the OpenLDAP + * Public License. + * + * A copy of this license is available in file LICENSE in the + * top-level directory of the distribution or, alternatively, at + * <http://www.OpenLDAP.org/license.html>. + */ + +#ifndef PERL_BACK_H +#define PERL_BACK_H 1 + +#include <EXTERN.h> +#include <perl.h> +#undef _ /* #defined by both Perl and ac/localize.h */ +#include "asperl_undefs.h" + +#include "portable.h" + +#include "slap.h" + +LDAP_BEGIN_DECL + +/* + * From Apache mod_perl: test for Perl version. + */ + +#if defined(pTHX_) || (PERL_REVISION > 5 || (PERL_REVISION == 5 && PERL_VERSION >= 6)) +#define PERL_IS_5_6 +#endif + +#define EVAL_BUF_SIZE 500 + +extern ldap_pvt_thread_mutex_t perl_interpreter_mutex; + +#ifdef PERL_IS_5_6 +/* We should be using the PL_errgv, I think */ +/* All the old style variables are prefixed with PL_ now */ +# define errgv PL_errgv +# define na PL_na +#else +# define call_method(m, f) perl_call_method(m, f) +# define eval_pv(m, f) perl_eval_pv(m, f) +# define ERRSV GvSV(errgv) +#endif + +#if defined( HAVE_WIN32_ASPERL ) || defined( USE_ITHREADS ) +/* pTHX is needed often now */ +# define PERL_INTERPRETER my_perl +# define PERL_BACK_XS_INIT_PARAMS pTHX +# define PERL_BACK_BOOT_DYNALOADER_PARAMS pTHX, CV *cv +#else +# define PERL_INTERPRETER perl_interpreter +# define PERL_BACK_XS_INIT_PARAMS void +# define PERL_BACK_BOOT_DYNALOADER_PARAMS CV *cv +# define PERL_SET_CONTEXT(i) +#endif + +extern PerlInterpreter *PERL_INTERPRETER; + + +typedef struct perl_backend_instance { + char *pb_module_name; + BerVarray pb_module_path; + BerVarray pb_module_config; + SV *pb_obj_ref; + int pb_filter_search_results; +} PerlBackend; + +LDAP_END_DECL + +#include "proto-perl.h" + +#endif /* PERL_BACK_H */ diff --git a/servers/slapd/back-perl/proto-perl.h b/servers/slapd/back-perl/proto-perl.h new file mode 100644 index 0000000..a770270 --- /dev/null +++ b/servers/slapd/back-perl/proto-perl.h @@ -0,0 +1,43 @@ +/* $OpenLDAP$ */ +/* This work is part of OpenLDAP Software <http://www.openldap.org/>. + * + * Copyright 1999-2021 The OpenLDAP Foundation. + * Portions Copyright 1999 John C. Quillan. + * Portions Copyright 2002 myinternet Limited. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted only as authorized by the OpenLDAP + * Public License. + * + * A copy of this license is available in file LICENSE in the + * top-level directory of the distribution or, alternatively, at + * <http://www.OpenLDAP.org/license.html>. + */ + +#ifndef PROTO_PERL_H +#define PROTO_PERL_H + +LDAP_BEGIN_DECL + +extern BI_init perl_back_initialize; + +extern BI_close perl_back_close; + +extern BI_db_init perl_back_db_init; +extern BI_db_open perl_back_db_open; +extern BI_db_destroy perl_back_db_destroy; +extern BI_db_config perl_back_db_config; + +extern BI_op_bind perl_back_bind; +extern BI_op_search perl_back_search; +extern BI_op_compare perl_back_compare; +extern BI_op_modify perl_back_modify; +extern BI_op_modrdn perl_back_modrdn; +extern BI_op_add perl_back_add; +extern BI_op_delete perl_back_delete; + +extern int perl_back_init_cf( BackendInfo *bi ); +LDAP_END_DECL + +#endif /* PROTO_PERL_H */ diff --git a/servers/slapd/back-perl/search.c b/servers/slapd/back-perl/search.c new file mode 100644 index 0000000..7c761ee --- /dev/null +++ b/servers/slapd/back-perl/search.c @@ -0,0 +1,122 @@ +/* $OpenLDAP$ */ +/* This work is part of OpenLDAP Software <http://www.openldap.org/>. + * + * Copyright 1999-2021 The OpenLDAP Foundation. + * Portions Copyright 1999 John C. Quillan. + * Portions Copyright 2002 myinternet Limited. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted only as authorized by the OpenLDAP + * Public License. + * + * A copy of this license is available in file LICENSE in the + * top-level directory of the distribution or, alternatively, at + * <http://www.OpenLDAP.org/license.html>. + */ + +#include "perl_back.h" + +/********************************************************** + * + * Search + * + **********************************************************/ +int +perl_back_search( + Operation *op, + SlapReply *rs ) +{ + PerlBackend *perl_back = (PerlBackend *)op->o_bd->be_private; + int count ; + AttributeName *an; + Entry *e; + char *buf; + int i; + + PERL_SET_CONTEXT( PERL_INTERPRETER ); + ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex ); + + { + dSP; ENTER; SAVETMPS; + + PUSHMARK(sp) ; + XPUSHs( perl_back->pb_obj_ref ); + XPUSHs(sv_2mortal(newSVpv( op->o_req_ndn.bv_val , op->o_req_ndn.bv_len))); + XPUSHs(sv_2mortal(newSViv( op->ors_scope ))); + XPUSHs(sv_2mortal(newSViv( op->ors_deref ))); + XPUSHs(sv_2mortal(newSViv( op->ors_slimit ))); + XPUSHs(sv_2mortal(newSViv( op->ors_tlimit ))); + XPUSHs(sv_2mortal(newSVpv( op->ors_filterstr.bv_val , op->ors_filterstr.bv_len))); + XPUSHs(sv_2mortal(newSViv( op->ors_attrsonly ))); + + for ( an = op->ors_attrs; an && an->an_name.bv_val; an++ ) { + XPUSHs(sv_2mortal(newSVpv( an->an_name.bv_val , an->an_name.bv_len))); + } + PUTBACK; + + count = call_method("search", G_ARRAY ); + + SPAGAIN; + + if (count < 1) { + croak("Big trouble in back_search\n") ; + } + + if ( count > 1 ) { + + for ( i = 1; i < count; i++ ) { + + buf = POPp; + + if ( (e = str2entry( buf )) == NULL ) { + Debug( LDAP_DEBUG_ANY, "str2entry(%s) failed\n", buf, 0, 0 ); + + } else { + int send_entry; + + if (perl_back->pb_filter_search_results) + send_entry = (test_filter( op, e, op->ors_filter ) == LDAP_COMPARE_TRUE); + else + send_entry = 1; + + if (send_entry) { + rs->sr_entry = e; + rs->sr_attrs = op->ors_attrs; + rs->sr_flags = REP_ENTRY_MODIFIABLE; + rs->sr_err = LDAP_SUCCESS; + rs->sr_err = send_search_entry( op, rs ); + rs->sr_flags = 0; + rs->sr_attrs = NULL; + rs->sr_entry = NULL; + if ( rs->sr_err == LDAP_SIZELIMIT_EXCEEDED || rs->sr_err == LDAP_BUSY ) { + goto done; + } + } + + entry_free( e ); + } + } + } + + /* + * We grab the return code last because the stack comes + * from perl in reverse order. + * + * ex perl: return ( 0, $res_1, $res_2 ); + * + * ex stack: <$res_2> <$res_1> <0> + */ + + rs->sr_err = POPi; + +done:; + PUTBACK; FREETMPS; LEAVE; + } + + ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex ); + + send_ldap_result( op, rs ); + + return 0; +} |