Authen-SASL-Cyrus
view release on metacpan or search on metacpan
name of the server being contacted, which may also be used by the underlying
mechanism.
=head2 Authen::SASL::Cyrus METHODS
=over 4
=item callback ( NAME )
Tells if the named callback has a handler installed. The list of implemented
callbacks is "user", "auth", and "language". Others may be implemented in
future releases.
=item callback( NAME => VALUE, NAME => VALUE, ... )
Sets the given callback(s) to the given value(s). See the C<Callbacks> section
for a description of callback VALUEs. See above for a list of implemented
callback NAMEs.
=item client_start
/*
# Copyright (c) 2002 Carnegie Mellon University
# Written by Mark Adamson
# with SASL2 support by Leif Johansson
# with better mem management and callbacks by Ulrich Pfeifer
#
# C code to glue Perl SASL to Cyrus libsasl.so
#
*/
#define PERL_NO_GET_CONTEXT
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>
#include <netinet/in.h>
EXTEND(sp,1); \
PUSHs(sv_2mortal(newSVpvn((char *)(A),(STRLEN)(B))));
#endif
#ifndef SvPV_nolen
#define SvPV_nolen(A) SvPV(A,PL_na)
#endif
struct authensasl {
sasl_conn_t *conn;
sasl_callback_t *callbacks;
char *server;
char *service;
char *mech;
char *user;
char *initstring;
int initstringlen;
SASLCONST char *errormsg;
int code;
};
/* A unique looking number to help PerlCallback() determine which parameter is
the context. Apparently not all callbacks get the context as the first */
#define PERLCONTEXT_MAGIC 0x0001ABCD
struct _perlcontext {
unsigned long magic;
int id;
SV *func;
SV *param;
int intparam;
};
void free_callbacks(struct authensasl *sasl)
{
if (sasl->callbacks) {
Safefree(sasl->callbacks);
Safefree(sasl->callbacks->context);
sasl->callbacks = NULL;
}
}
struct _perlcontext *
alloc_callbacks(struct authensasl *sasl, int count)
{
dTHX;
struct _perlcontext *pcb;
int i;
Newz(23, pcb, count, struct _perlcontext);
if (pcb == NULL) {croak("Out of memory\n");}
for (i=0; i<count; i++) {
pcb[i].magic = PERLCONTEXT_MAGIC;
}
Newz(23, sasl->callbacks, count+1, sasl_callback_t);
if (sasl->callbacks == NULL) {croak("Out of memory\n");}
return(pcb);
}
/*
This is the wrapper function that calls Perl callback functions. The SASL
library needs a C function to handle callbacks, and this function forms the
glue to get from the C library back into Perl. The perlcontext is a wrapper
around the context given to the "callbacks" method. It tells which Perl
function should be called and what parameter to pass it.
Different types of callbacks have different "output" parameters to give data
back to the C library. This function needs to know how to take information
returned from the Perl callback subroutine and load it back into the output
parameters for the C library to read.
Note that if the callback given to the "callbacks" Perl method is really just
a string or integer, there is no need to jump into a Perl subroutine.
The value is loaded directly into the output parameters.
*/
int PerlCallback(void *perlcontext, char *arg0, char *arg1, char *arg2)
{
dTHX;
char *c;
int i, intparam, count, rc=0;
}
/*
Fill the passed callback action into the passed Perl/SASL callback. This
is called either from ExtractParentCallbacks() when the "new" method is
called, or from callbacks() when that method is called directly.
*/
static
void AddCallback(
char *name,
SV *action,
struct _perlcontext *pcb,
sasl_callback_t *cb
)
{
HV *hash=NULL;
HE *iter;
/* Make sure parent is a ref to a hash (with keys like "mechanism"
and "callback") */
if (!parent) return;
if (!SvROK(parent)) return;
if (SvTYPE(SvRV(parent)) != SVt_PVHV) return;
hash = (HV *)SvRV(parent);
/* Get the parent's callbacks */
hashval = hv_fetch(hash, "callback", 8, 0);
if (!hashval || !*hashval) return;
val = *hashval;
/* Parent's callbacks are another hash (with keys like "user" and "auth") */
if (!SvROK(val)) return;
if (SvTYPE(SvRV(val)) != SVt_PVHV) return;
hash = (HV *)SvRV(val);
/* Run through all of parent's callback types, counting them */
hv_iterinit(hash);
for (iter=hv_iternext(hash); iter; iter=hv_iternext(hash)) count++;
/* Allocate space for the callbacks */
free_callbacks(sasl);
pcb = alloc_callbacks(sasl, count);
/* Run through all of parent's callback types, fill in the sasl->callbacks */
hv_iterinit(hash);
for (count=0,iter=hv_iternext(hash); iter; iter=hv_iternext(hash),count++){
key = hv_iterkey(iter, &l);
val = hv_iterval(hash, iter);
AddCallback(key, val, &pcb[count], &sasl->callbacks[count]);
}
sasl->callbacks[count].id = SASL_CB_LIST_END;
sasl->callbacks[count].context = NULL;
return;
}
MODULE=Authen::SASL::Cyrus PACKAGE=Authen::SASL::Cyrus
hash = (HV *)SvRV(parent);
hashval = hv_fetch(hash, "mechanism", 9, 0);
if (hashval && *hashval && SvTYPE(*hashval) == SVt_PV) {
if (sasl->mech) Safefree(sasl->mech);
sasl->mech = savepv(SvPV_nolen(*hashval));
}
}
sasl_client_init(NULL);
#ifdef SASL2
sasl->code = sasl_client_new(sasl->service, sasl->server, 0, 0, sasl->callbacks, 1, &sasl->conn);
#else
sasl->code = sasl_client_new(sasl->service, sasl->server, sasl->callbacks, 1, &sasl->conn);
#endif
if (sasl->code != SASL_OK) {
if (!sasl->errormsg) sasl->errormsg = SASL_ERR("sasl_client_new failed");
}
else {
#ifdef SASL2
sasl->code = sasl_client_start(sasl->conn, sasl->mech, NULL, &init, &initlen, &mech);
#else
sasl->code = sasl_client_start(sasl->conn, sasl->mech, NULL, NULL, &init, &initlen, &mech);
#endif
if (sasl->code == SASL_NOMECH) {
if (!sasl->errormsg)
sasl->errormsg = "No mechanisms available (did you set all needed callbacks?)";
}
else if ((sasl->code != SASL_OK) && (sasl->code != SASL_CONTINUE)) {
if (!sasl->errormsg) sasl->errormsg = SASL_ERR("sasl_client_start failed");
}
else {
#ifdef SASL2
memset(&ssp, 0, sizeof(ssp));
ssp.maxbufsize = 0xFFFF;
ssp.max_ssf = 0xFF;
sasl_setprop(sasl->conn, SASL_SEC_PROPS, &ssp);
{
SV *action;
char *name;
int x, count;
struct _perlcontext *pcb;
/* Asking if a given callback exists */
if (items == 2) {
RETVAL = 0;
if (sasl->callbacks) {
name = SvPV_nolen(ST(1));
x = CallbackNumber(name);
/* Check the installed callbacks for the requested ID */
for (count=0; sasl->callbacks[count].id != SASL_CB_LIST_END; count++) {
if (sasl->callbacks[count].id == x) {
RETVAL = 1;
break;
}
}
}
}
else {
/* Prepare space for the callback list */
free_callbacks(sasl);
count = (items - 1) / 2;
pcb = alloc_callbacks(sasl, count);
/* Fill in the callbacks */
for(x=0; x<count; x++) {
/* Convert the callback name into a SASL ID number */
if (SvTYPE(ST(1+x*2)) != SVt_PV) {
croak("callbacks: Unknown key given in position %d\n", x);
}
name = SvPV_nolen(ST(1+x*2));
action = ST(2+x*2);
AddCallback(name, action, &pcb[x], &sasl->callbacks[x]);
}
sasl->callbacks[count].id = SASL_CB_LIST_END;
sasl->callbacks[count].context = NULL;
RETVAL = count;
}
}
OUTPUT:
RETVAL
void
DESTROY(sasl)
struct authensasl *sasl
CODE:
if (sasl->conn) sasl_dispose(&sasl->conn);
free_callbacks(sasl);
if (sasl->service) Safefree(sasl->service);
if (sasl->mech) Safefree(sasl->mech);
#ifndef SASL2
if (sasl->errormsg) Safefree(sasl->errormsg);
#endif
if (sasl->initstring)Safefree(sasl->initstring);
Safefree(sasl);
( run in 0.990 second using v1.01-cache-2.11-cpan-9b1e4054eb1 )