From 6afbf70a80dc3cfac2405d9896993764e8954882 Mon Sep 17 00:00:00 2001 From: Quanah Gibson-Mount Date: Tue, 19 May 2026 23:13:22 +0000 Subject: [PATCH] ITS#10507 - Delete perl backend --- build/top.mk | 3 +- configure.ac | 53 ----- doc/guide/admin/aspell.en.pws | 1 - doc/guide/admin/backends.sdf | 17 -- doc/guide/admin/intro.sdf | 5 +- doc/guide/admin/slapdconf2.sdf | 1 - doc/guide/admin/slapdconfig.sdf | 1 - doc/guide/preamble.sdf | 2 - doc/man/man5/slapd-config.5 | 1 - doc/man/man5/slapd-perl.5 | 199 ------------------ doc/man/man5/slapd.backends.5 | 8 - doc/man/man5/slapd.conf.5 | 2 - servers/slapd/back-perl/Makefile.in | 46 ----- servers/slapd/back-perl/README | 24 --- servers/slapd/back-perl/SampleLDAP.pm | 171 ---------------- servers/slapd/back-perl/add.c | 62 ------ servers/slapd/back-perl/asperl_undefs.h | 38 ---- servers/slapd/back-perl/bind.c | 80 -------- servers/slapd/back-perl/close.c | 59 ------ servers/slapd/back-perl/compare.c | 80 -------- servers/slapd/back-perl/config.c | 256 ------------------------ servers/slapd/back-perl/delete.c | 59 ------ servers/slapd/back-perl/init.c | 176 ---------------- servers/slapd/back-perl/modify.c | 97 --------- servers/slapd/back-perl/modrdn.c | 63 ------ servers/slapd/back-perl/perl_back.h | 82 -------- servers/slapd/back-perl/proto-perl.h | 43 ---- servers/slapd/back-perl/search.c | 122 ----------- servers/slapd/overlays/slapover.txt | 4 +- 29 files changed, 6 insertions(+), 1749 deletions(-) delete mode 100644 doc/man/man5/slapd-perl.5 delete mode 100644 servers/slapd/back-perl/Makefile.in delete mode 100644 servers/slapd/back-perl/README delete mode 100644 servers/slapd/back-perl/SampleLDAP.pm delete mode 100644 servers/slapd/back-perl/add.c delete mode 100644 servers/slapd/back-perl/asperl_undefs.h delete mode 100644 servers/slapd/back-perl/bind.c delete mode 100644 servers/slapd/back-perl/close.c delete mode 100644 servers/slapd/back-perl/compare.c delete mode 100644 servers/slapd/back-perl/config.c delete mode 100644 servers/slapd/back-perl/delete.c delete mode 100644 servers/slapd/back-perl/init.c delete mode 100644 servers/slapd/back-perl/modify.c delete mode 100644 servers/slapd/back-perl/modrdn.c delete mode 100644 servers/slapd/back-perl/perl_back.h delete mode 100644 servers/slapd/back-perl/proto-perl.h delete mode 100644 servers/slapd/back-perl/search.c diff --git a/build/top.mk b/build/top.mk index 33eec433f4..58cfc41000 100644 --- a/build/top.mk +++ b/build/top.mk @@ -200,9 +200,8 @@ SECURITY_LIBS = $(SASL_LIBS) $(TLS_LIBS) $(AUTH_LIBS) MODULES_CPPFLAGS = @SLAPD_MODULES_CPPFLAGS@ MODULES_LDFLAGS = @SLAPD_MODULES_LDFLAGS@ MODULES_LIBS = @MODULES_LIBS@ -SLAPD_PERL_LDFLAGS = @SLAPD_PERL_LDFLAGS@ -SLAPD_LIBS = @SLAPD_LIBS@ @SLAPD_PERL_LDFLAGS@ @SLAPD_SLP_LIBS@ @SLAPD_GMP_LIBS@ +SLAPD_LIBS = @SLAPD_LIBS@ @SLAPD_SLP_LIBS@ @SLAPD_GMP_LIBS@ LLOADD_LIBS = @BALANCER_LIBS@ $(LEVENT_LIBS) # Our Defaults diff --git a/configure.ac b/configure.ac index 08d98f9724..ea3dc024a3 100644 --- a/configure.ac +++ b/configure.ac @@ -316,8 +316,6 @@ OL_ARG_ENABLE_BK(null, [null backend], no, [no yes mod], ol_enable_backends)dnl OL_ARG_ENABLE_BK(passwd, [passwd backend], no, [no yes mod], ol_enable_backends)dnl -OL_ARG_ENABLE_BK(perl, [perl backend], - no, [no yes mod], ol_enable_backends)dnl OL_ARG_ENABLE_BK(relay, [relay backend], yes, [no yes mod], ol_enable_backends)dnl OL_ARG_ENABLE_BK(sock, [sock backend], @@ -559,10 +557,6 @@ SLAPD_MODULES_CPPFLAGS= SLAPD_STATIC_BACKENDS="back-ldif back-monitor" SLAPD_DYNAMIC_BACKENDS= -SLAPD_PERL_LDFLAGS= -MOD_PERL_LDFLAGS= -PERL_CPPFLAGS= - SASL_LIBS= TLS_LIBS= WITH_TLS_TYPE=no @@ -654,45 +648,6 @@ fi AC_PROG_MAKE_SET LT_INIT(dlopen, win32-dll) -dnl ---------------------------------------------------------------- -dnl Perl -ol_link_perl=no -if test $ol_enable_perl != no ; then - AC_PATH_PROG(PERLBIN, perl, /usr/bin/perl) - - if test "no$PERLBIN" = "no" ; then - if test $ol_enable_perl = yes ; then - AC_MSG_ERROR([could not locate perl]) - fi - - else - PERL_CPPFLAGS="" - for opt in `$PERLBIN -MExtUtils::Embed -e ccopts`; do - case "$opt" in - "-flto=auto" | "-Wall" ) - continue;; - esac - PERL_CPPFLAGS="$PERL_CPPFLAGS $opt" - done - PERL_LDFLAGS="" - for opt in `$PERLBIN -MExtUtils::Embed -e ldopts`; do - case "$opt" in - "-lc" ) - continue;; - esac - PERL_LDFLAGS="$PERL_LDFLAGS $opt" - done - - if test x"$ol_enable_perl" = "xyes" ; then - SLAPD_PERL_LDFLAGS="$PERL_LDFLAGS" - else - MOD_PERL_LDFLAGS="$PERL_LDFLAGS" - fi - dnl should check perl version - ol_link_perl=yes - fi -fi - AC_PROG_CPP OL_MSVC @@ -2481,9 +2436,6 @@ if test "$ol_link_modules" != no ; then SLAPD_MODULES_LDFLAGS="-dlopen self" fi -if test "$ol_link_perl" = no ; then - ol_enable_perl=no -fi if test "$ol_link_wt" = no ; then ol_enable_wt=no fi @@ -2734,10 +2686,6 @@ AC_SUBST(SLAPD_STATIC_OVERLAYS) AC_SUBST(SLAPD_DYNAMIC_OVERLAYS) AC_SUBST(SLAPD_DYNAMIC_PWMODS) -AC_SUBST(PERL_CPPFLAGS) -AC_SUBST(SLAPD_PERL_LDFLAGS) -AC_SUBST(MOD_PERL_LDFLAGS) - AC_SUBST(SASL_LIBS) AC_SUBST(TLS_LIBS) AC_SUBST(WITH_TLS_TYPE) @@ -2791,7 +2739,6 @@ AC_CONFIG_FILES([Makefile:build/top.mk:Makefile.in:build/dir.mk] [servers/slapd/back-monitor/Makefile:build/top.mk:servers/slapd/modules.mk:servers/slapd/back-monitor/Makefile.in:build/mod.mk] [servers/slapd/back-null/Makefile:build/top.mk:servers/slapd/modules.mk:servers/slapd/back-null/Makefile.in:build/mod.mk] [servers/slapd/back-passwd/Makefile:build/top.mk:servers/slapd/modules.mk:servers/slapd/back-passwd/Makefile.in:build/mod.mk] -[servers/slapd/back-perl/Makefile:build/top.mk:servers/slapd/modules.mk:servers/slapd/back-perl/Makefile.in:build/mod.mk] [servers/slapd/back-relay/Makefile:build/top.mk:servers/slapd/modules.mk:servers/slapd/back-relay/Makefile.in:build/mod.mk] [servers/slapd/back-sock/Makefile:build/top.mk:servers/slapd/modules.mk:servers/slapd/back-sock/Makefile.in:build/mod.mk] [servers/slapd/back-wt/Makefile:build/top.mk:servers/slapd/modules.mk:servers/slapd/back-wt/Makefile.in:build/mod.mk] diff --git a/doc/guide/admin/aspell.en.pws b/doc/guide/admin/aspell.en.pws index 6865c7a21e..7951062273 100644 --- a/doc/guide/admin/aspell.en.pws +++ b/doc/guide/admin/aspell.en.pws @@ -1089,7 +1089,6 @@ nops PDUs baseObject bvecadd -perl inplace lossy pers diff --git a/doc/guide/admin/backends.sdf b/doc/guide/admin/backends.sdf index 21f346b35e..f23621471c 100644 --- a/doc/guide/admin/backends.sdf +++ b/doc/guide/admin/backends.sdf @@ -404,23 +404,6 @@ H3: Further Information {{slapd-passwd}}(5) -H2: Perl - -H3: Overview - -The Perl backend to {{slapd}}(8) works by embedding a {{perl}}(1) interpreter -into {{slapd}}(8). Any perl database section of the configuration file -{{slapd.conf}}(5) must then specify what Perl module to use. Slapd then creates -a new Perl object that handles all the requests for that particular instance of the backend. - -H3: back-perl Configuration - -LATER - -H3: Further Information - -{{slapd-perl}}(5) - H2: Relay diff --git a/doc/guide/admin/intro.sdf b/doc/guide/admin/intro.sdf index 8f5234a811..8d287a3338 100644 --- a/doc/guide/admin/intro.sdf +++ b/doc/guide/admin/intro.sdf @@ -406,8 +406,9 @@ with LDAP clients; and modules which handle specific tasks such as database operations. Because these two pieces communicate via a well-defined {{TERM:C}} {{TERM:API}}, you can write your own customized modules which extend {{slapd}} in numerous ways. Also, -a number of {{programmable database}} modules are provided. These -allow you to expose external data sources to {{slapd}}. +a {{programmable database}} module back-sock is provided. This +allows you to expose external data sources to {{slapd}} using arbitrary +programming languages. {{B:Threads}}: {{slapd}} is threaded for high performance. A single multi-threaded {{slapd}} process handles all incoming requests using diff --git a/doc/guide/admin/slapdconf2.sdf b/doc/guide/admin/slapdconf2.sdf index 5b23f1d07d..356aea7d38 100644 --- a/doc/guide/admin/slapdconf2.sdf +++ b/doc/guide/admin/slapdconf2.sdf @@ -371,7 +371,6 @@ meta Metadirectory backend monitor Monitor backend null Null backend passwd Provides read-only access to {{passwd}}(5) -perl Perl Programmable backend relay Relay backend sock Socket backend wt WiredTiger backend diff --git a/doc/guide/admin/slapdconfig.sdf b/doc/guide/admin/slapdconfig.sdf index 2e3210e1e2..f97c212a3c 100644 --- a/doc/guide/admin/slapdconfig.sdf +++ b/doc/guide/admin/slapdconfig.sdf @@ -271,7 +271,6 @@ meta Metadirectory backend monitor Monitor backend null Null backend passwd Provides read-only access to {{passwd}}(5) -perl Perl Programmable backend relay Relay backend sock Socket backend wt WiredTiger backend diff --git a/doc/guide/preamble.sdf b/doc/guide/preamble.sdf index 67dfaf43f4..3d5f2fb85e 100644 --- a/doc/guide/preamble.sdf +++ b/doc/guide/preamble.sdf @@ -103,7 +103,6 @@ Name|Long|Jump ANSI|American National Standards Institute|https://www.ansi.org/ BSI|British Standards Institute|https://www.bsigroup.com/en-GB/ COSINE|Co-operation and Open Systems Interconnection in Europe -CPAN|Comprehensive Perl Archive Network|https://www.cpan.org/ Cyrus|Project Cyrus|https://www.cyrusimap.org/ FSF|Free Software Foundation|https://www.fsf.org/ GNU|GNU Not Unix Project|https://www.gnu.org/ @@ -141,7 +140,6 @@ OpenLDAP FAQ|https://www.openldap.org/faq/ OpenLDAP ITS|https://bugs.openldap.org/ OpenLDAP Software|https://www.openldap.org/software/ OpenSSL|https://www.openssl.org/ -Perl|https://www.perl.org/ SDF|https://metacpan.org/release/sdf UMLDAP|https://web.archive.org/web/20160302011357/http://www.umich.edu/~dirsvcs/ldap/ldap.html !endblock diff --git a/doc/man/man5/slapd-config.5 b/doc/man/man5/slapd-config.5 index ff0deffefb..ed6510ea72 100644 --- a/doc/man/man5/slapd-config.5 +++ b/doc/man/man5/slapd-config.5 @@ -1243,7 +1243,6 @@ should be one of .BR monitor , .BR null , .BR passwd , -.BR perl , .BR relay , .BR sock , or diff --git a/doc/man/man5/slapd-perl.5 b/doc/man/man5/slapd-perl.5 deleted file mode 100644 index f0fddd5b12..0000000000 --- a/doc/man/man5/slapd-perl.5 +++ /dev/null @@ -1,199 +0,0 @@ -.TH SLAPD-PERL 5 "RELEASEDATE" "OpenLDAP LDVERSION" -.\" $OpenLDAP$ -.SH NAME -slapd\-perl \- Perl backend to slapd -.SH SYNOPSIS -ETCDIR/slapd.conf -.SH DESCRIPTION -The Perl backend to -.BR slapd (8) -works by embedding a -.BR perl (1) -interpreter into -.BR slapd (8). -Any perl database section of the configuration file -.BR slapd.conf (5) -must then specify what Perl module to use. -.B Slapd -then creates a new Perl object that handles all the requests for that -particular instance of the backend. -.LP -You will need to create a method for each one of the -following actions: -.LP -.nf - * new # creates a new object, - * search # performs the ldap search, - * compare # does a compare, - * modify # modifies an entry, - * add # adds an entry to backend, - * modrdn # modifies an entry's rdn, - * delete # deletes an ldap entry, - * config # module-specific config directives, - * init # called after backend is initialized. -.fi -.LP -Unless otherwise specified, the methods return the result code -which will be returned to the client. Unimplemented actions -can just return unwillingToPerform (53). -.TP -.B new -This method is called when the configuration file encounters a -.B perlmod -line. -The module in that line is then effectively `use'd into the perl -interpreter, then the \fBnew\fR method is called to create a new -object. -Note that multiple instances of that object may be instantiated, as -with any perl object. -.\" .LP -The -.B new -method receives the class name as argument. -.TP -.B search -This method is called when a search request comes from a client. -It arguments are as follows: -.nf - * object reference - * base DN - * scope - * alias dereferencing policy - * size limit - * time limit - * filter string - * attributes only flag (1 for yes) - * list of attributes to return (may be empty) -.fi -.LP -Return value: (resultcode, ldif-entry, ldif-entry, ...) -.TP -.B compare -This method is called when a compare request comes from a client. -Its arguments are as follows. -.nf - * object reference - * dn - * attribute assertion string -.fi -.LP -.TP -.B modify -This method is called when a modify request comes from a client. -Its arguments are as follows. -.nf - * object reference - * dn - * a list formatted as follows - ({ "ADD" | "DELETE" | "REPLACE" }, - attributetype, value...)... -.fi -.LP -.TP -.B add -This method is called when a add request comes from a client. -Its arguments are as follows. -.nf - * object reference - * entry in string format -.fi -.LP -.TP -.B modrdn -This method is called when a modrdn request comes from a client. -Its arguments are as follows. -.nf - * object reference - * dn - * new rdn - * delete old dn flag (1 means yes) -.fi -.LP -.TP -.B delete -This method is called when a delete request comes from a client. -Its arguments are as follows. -.nf - * object reference - * dn -.fi -.LP -.TP -.B config -This method is called once for each perlModuleConfig line in the -.BR slapd.conf (5) -configuration file. -Its arguments are as follows. -.nf - * object reference - * array of arguments on line -.fi -.LP -Return value: nonzero if this is not a valid option. -.TP -.B init -This method is called after backend is initialized. -Its argument is as follows. -.nf - * object reference -.fi -.LP -Return value: nonzero if initialization failed. -.SH CONFIGURATION -These -.B slapd.conf -options apply to the PERL backend database. -That is, they must follow a "database perl" line and come before any -subsequent "backend" or "database" lines. -Other database options are described in the -.BR slapd.conf (5) -manual page. -.TP -.B perlModulePath /path/to/libs -Add the path to the @INC variable. -.TP -.B perlModule ModName -`Use' the module name ModName from ModName.pm -.TP -.B filterSearchResults -Search results are candidates that need to be filtered (with the -filter in the search request), rather than search results to be -returned directly to the client. -.TP -.B perlModuleConfig -Invoke the module's config method with the given arguments. -.SH EXAMPLE -There is an example Perl module `SampleLDAP' in the slapd/back\-perl/ -directory in the OpenLDAP source tree. -.SH ACCESS CONTROL -The -.B perl -backend does not honor any of the access control semantics described in -.BR slapd.access (5); -all access control is delegated to the underlying PERL scripting. -Only -.B read (=r) -access to the -.B entry -pseudo-attribute and to the other attribute values of the entries -returned by the -.B search -operation is honored, which is performed by the frontend. -.SH WARNING -The interface of this backend to the perl module MAY change. -Any suggestions would greatly be appreciated. - -Note: in previous versions, any unrecognized lines in the slapd.conf -file were passed to the perl module's config method. This behavior is -deprecated (but still allowed for backward compatibility), and the -perlModuleConfig directive should instead be used to invoke the -module's config method. This compatibility feature will be removed at -some future date. -.SH FILES -.TP -ETCDIR/slapd.conf -default slapd configuration file -.SH SEE ALSO -.BR slapd.conf (5), -.BR slapd (8), -.BR perl (1). diff --git a/doc/man/man5/slapd.backends.5 b/doc/man/man5/slapd.backends.5 index 4488011854..59df9ef097 100644 --- a/doc/man/man5/slapd.backends.5 +++ b/doc/man/man5/slapd.backends.5 @@ -76,13 +76,6 @@ It serves up user account information from the system .BR passwd (5) file. .TP -.B perl -This backend embeds a -.BR perl (1) -interpreter into slapd. -It runs Perl subroutines to implement LDAP operations. -This backend is deprecated. -.TP .B relay This backend is experimental. It redirects LDAP operations to another database @@ -117,7 +110,6 @@ default slapd configuration directory .BR slapd\-monitor (5), .BR slapd\-null (5), .BR slapd\-passwd (5), -.BR slapd\-perl (5), .BR slapd\-relay (5), .BR slapd\-wt (5), .BR slapd.conf (5), diff --git a/doc/man/man5/slapd.conf.5 b/doc/man/man5/slapd.conf.5 index 9279616a66..ad00d466f8 100644 --- a/doc/man/man5/slapd.conf.5 +++ b/doc/man/man5/slapd.conf.5 @@ -1320,7 +1320,6 @@ should be one of .BR monitor , .BR null , .BR passwd , -.BR perl , .BR relay , .BR sock , or @@ -1350,7 +1349,6 @@ should be one of .BR monitor , .BR null , .BR passwd , -.BR perl , .BR relay , .BR sock , or diff --git a/servers/slapd/back-perl/Makefile.in b/servers/slapd/back-perl/Makefile.in deleted file mode 100644 index a6eae6aa88..0000000000 --- a/servers/slapd/back-perl/Makefile.in +++ /dev/null @@ -1,46 +0,0 @@ -# Makefile.in for back-perl -# $OpenLDAP$ -## This work is part of OpenLDAP Software . -## -## Copyright 1998-2026 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 -## . - -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_MOD)_DEFS) -MOD_LIBS = @MOD_PERL_LDFLAGS@ - -shared_LDAP_LIBS = $(LDAP_LIBLDAP_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 deleted file mode 100644 index 1e14a308c1..0000000000 --- a/servers/slapd/back-perl/README +++ /dev/null @@ -1,24 +0,0 @@ -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, dereferencing policy, size limit, etc. - See SampleLDAP.pm for details. - -These changes were sponsored by myinternet Limited. - -Luke Howard - diff --git a/servers/slapd/back-perl/SampleLDAP.pm b/servers/slapd/back-perl/SampleLDAP.pm deleted file mode 100644 index 18849c7dd0..0000000000 --- a/servers/slapd/back-perl/SampleLDAP.pm +++ /dev/null @@ -1,171 +0,0 @@ -# This is a sample Perl module for the OpenLDAP server slapd. -# $OpenLDAP$ -## This work is part of OpenLDAP Software . -## -## Copyright 1998-2026 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 -## . - -# 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 deleted file mode 100644 index dff6c271f6..0000000000 --- a/servers/slapd/back-perl/add.c +++ /dev/null @@ -1,62 +0,0 @@ -/* $OpenLDAP$ */ -/* This work is part of OpenLDAP Software . - * - * Copyright 1999-2026 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 - * . - */ - -#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" ); - return( 0 ); -} diff --git a/servers/slapd/back-perl/asperl_undefs.h b/servers/slapd/back-perl/asperl_undefs.h deleted file mode 100644 index be77e4aead..0000000000 --- a/servers/slapd/back-perl/asperl_undefs.h +++ /dev/null @@ -1,38 +0,0 @@ -/* $OpenLDAP$ */ -/* This work is part of OpenLDAP Software . - * - * Copyright 1999-2026 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 - * . - */ - -/* 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 whether 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 deleted file mode 100644 index b8e3411296..0000000000 --- a/servers/slapd/back-perl/bind.c +++ /dev/null @@ -1,80 +0,0 @@ -/* $OpenLDAP$ */ -/* This work is part of OpenLDAP Software . - * - * Copyright 1999-2026 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 - * . - */ - -#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 ); - - /* 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 deleted file mode 100644 index ae680e887c..0000000000 --- a/servers/slapd/back-perl/close.c +++ /dev/null @@ -1,59 +0,0 @@ -/* $OpenLDAP$ */ -/* This work is part of OpenLDAP Software . - * - * Copyright 1999-2026 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 - * . - */ - -#include "perl_back.h" -#include "../slap-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 deleted file mode 100644 index 3ca66519fe..0000000000 --- a/servers/slapd/back-perl/compare.c +++ /dev/null @@ -1,80 +0,0 @@ -/* $OpenLDAP$ */ -/* This work is part of OpenLDAP Software . - * - * Copyright 1999-2026 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 - * . - */ - -#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" ); - - return (0); -} - diff --git a/servers/slapd/back-perl/config.c b/servers/slapd/back-perl/config.c deleted file mode 100644 index 17d40f8365..0000000000 --- a/servers/slapd/back-perl/config.c +++ /dev/null @@ -1,256 +0,0 @@ -/* $OpenLDAP$ */ -/* This work is part of OpenLDAP Software . - * - * Copyright 1999-2026 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 - * . - */ - -#include "perl_back.h" -#include "../slap-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' " - "EQUALITY booleanMatch " - "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; ibe->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 ); - 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 deleted file mode 100644 index d0b82e56ce..0000000000 --- a/servers/slapd/back-perl/delete.c +++ /dev/null @@ -1,59 +0,0 @@ -/* $OpenLDAP$ */ -/* This work is part of OpenLDAP Software . - * - * Copyright 1999-2026 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 - * . - */ - -#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" ); - return( 0 ); -} diff --git a/servers/slapd/back-perl/init.c b/servers/slapd/back-perl/init.c deleted file mode 100644 index 7c795c7398..0000000000 --- a/servers/slapd/back-perl/init.c +++ /dev/null @@ -1,176 +0,0 @@ -/* $OpenLDAP$ */ -/* This work is part of OpenLDAP Software . - * - * Copyright 1999-2026 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 - * . - */ - -#include "perl_back.h" -#include "../slap-config.h" - -#ifdef PERL_SYS_INIT3 -#include /* 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 function reference (bi->bi_open) is not functional */ - Debug( LDAP_DEBUG_TRACE, "perl backend open\n" ); - - if( PERL_INTERPRETER != NULL ) { - Debug( LDAP_DEBUG_ANY, "perl backend open: already opened\n" ); - 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" ); - - 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 deleted file mode 100644 index 5c2e0b877c..0000000000 --- a/servers/slapd/back-perl/modify.c +++ /dev/null @@ -1,97 +0,0 @@ -/* $OpenLDAP$ */ -/* This work is part of OpenLDAP Software . - * - * Copyright 1999-2026 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 - * . - */ - -#include "perl_back.h" -#include - -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" ); - return( 0 ); -} - diff --git a/servers/slapd/back-perl/modrdn.c b/servers/slapd/back-perl/modrdn.c deleted file mode 100644 index 61f09eda69..0000000000 --- a/servers/slapd/back-perl/modrdn.c +++ /dev/null @@ -1,63 +0,0 @@ -/* $OpenLDAP$ */ -/* This work is part of OpenLDAP Software . - * - * Copyright 1999-2026 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 - * . - */ - -#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" ); - return( 0 ); -} diff --git a/servers/slapd/back-perl/perl_back.h b/servers/slapd/back-perl/perl_back.h deleted file mode 100644 index 1672fb363d..0000000000 --- a/servers/slapd/back-perl/perl_back.h +++ /dev/null @@ -1,82 +0,0 @@ -/* $OpenLDAP$ */ -/* This work is part of OpenLDAP Software . - * - * Copyright 1999-2026 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 - * . - */ - -#ifndef PERL_BACK_H -#define PERL_BACK_H 1 - -#include -#include -#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 deleted file mode 100644 index bd57d89110..0000000000 --- a/servers/slapd/back-perl/proto-perl.h +++ /dev/null @@ -1,43 +0,0 @@ -/* $OpenLDAP$ */ -/* This work is part of OpenLDAP Software . - * - * Copyright 1999-2026 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 - * . - */ - -#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 deleted file mode 100644 index cbca56c76d..0000000000 --- a/servers/slapd/back-perl/search.c +++ /dev/null @@ -1,122 +0,0 @@ -/* $OpenLDAP$ */ -/* This work is part of OpenLDAP Software . - * - * Copyright 1999-2026 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 - * . - */ - -#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 ); - - } 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; -} diff --git a/servers/slapd/overlays/slapover.txt b/servers/slapd/overlays/slapover.txt index 2015d8da2a..3284c95f99 100644 --- a/servers/slapd/overlays/slapover.txt +++ b/servers/slapd/overlays/slapover.txt @@ -65,8 +65,8 @@ also the basis of backglue, which allows separate databases to be searched as if they were a single naming context. Very often, one needs to add just a tiny feature onto an otherwise "normal" -database. The usual way to achieve this was to use a programmable backend (like -back-perl) to preprocess various requests and then forward them back into slapd +database. The usual way to achieve this was to use a programmable backend (like back-sock) +to preprocess various requests and then forward them back into slapd to be handled by the real database. While this technique works, it is fairly inefficient because it involves many transitions from network to slapd and back again. The overlay concept introduced in OpenLDAP 2.2 allows code to be