xref: /netbsd-src/external/bsd/openldap/dist/servers/slapd/back-perl/bind.c (revision 549b59ed3ccf0d36d3097190a0db27b770f3a839)
1 /*	$NetBSD: bind.c,v 1.3 2021/08/14 16:15:01 christos Exp $	*/
2 
3 /* $OpenLDAP$ */
4 /* This work is part of OpenLDAP Software <http://www.openldap.org/>.
5  *
6  * Copyright 1999-2021 The OpenLDAP Foundation.
7  * Portions Copyright 1999 John C. Quillan.
8  * Portions Copyright 2002 myinternet Limited.
9  * All rights reserved.
10  *
11  * Redistribution and use in source and binary forms, with or without
12  * modification, are permitted only as authorized by the OpenLDAP
13  * Public License.
14  *
15  * A copy of this license is available in file LICENSE in the
16  * top-level directory of the distribution or, alternatively, at
17  * <http://www.OpenLDAP.org/license.html>.
18  */
19 
20 #include "perl_back.h"
21 
22 
23 /**********************************************************
24  *
25  * Bind
26  *
27  **********************************************************/
28 int
perl_back_bind(Operation * op,SlapReply * rs)29 perl_back_bind(
30 	Operation *op,
31 	SlapReply *rs )
32 {
33 	int count;
34 
35 	PerlBackend *perl_back = (PerlBackend *) op->o_bd->be_private;
36 
37 	/* allow rootdn as a means to auth without the need to actually
38  	 * contact the proxied DSA */
39 	switch ( be_rootdn_bind( op, rs ) ) {
40 	case SLAP_CB_CONTINUE:
41 		break;
42 
43 	default:
44 		return rs->sr_err;
45 	}
46 
47 	PERL_SET_CONTEXT( PERL_INTERPRETER );
48 	ldap_pvt_thread_mutex_lock( &perl_interpreter_mutex );
49 
50 	{
51 		dSP; ENTER; SAVETMPS;
52 
53 		PUSHMARK(SP);
54 		XPUSHs( perl_back->pb_obj_ref );
55 		XPUSHs(sv_2mortal(newSVpv( op->o_req_dn.bv_val , op->o_req_dn.bv_len)));
56 		XPUSHs(sv_2mortal(newSVpv( op->orb_cred.bv_val , op->orb_cred.bv_len)));
57 		PUTBACK;
58 
59 		count = call_method("bind", G_SCALAR);
60 
61 		SPAGAIN;
62 
63 		if (count != 1) {
64 			croak("Big trouble in back_bind\n");
65 		}
66 
67 		rs->sr_err = POPi;
68 
69 
70 		PUTBACK; FREETMPS; LEAVE;
71 	}
72 
73 	ldap_pvt_thread_mutex_unlock( &perl_interpreter_mutex );
74 
75 	Debug( LDAP_DEBUG_ANY, "Perl BIND returned 0x%04x\n", rs->sr_err );
76 
77 	/* frontend will send result on success (0) */
78 	if( rs->sr_err != LDAP_SUCCESS )
79 		send_ldap_result( op, rs );
80 
81 	return ( rs->sr_err );
82 }
83