Authen-SASL-XS
view release on metacpan or search on metacpan
0.12-server
merged some of the changes from Authen::SASL::Cyrus 0.12
changed version named in order to distinguish from the Authen::SASL::Cyrus by Mark Adamson.
0.11
added setpass and checkpass methods
added setpass callback
applied a patch by Graham Barr (found with google) for enabling GSSAPI
authentication (fix a problem in Security.pm)
added a check for undef return values when using sub-callbacks (Thanks
to Quanah Gibson-Mount for discovering this one)
0.10
Added the iplocalport and ipremote port to *_new methods, after filling
in the appropriate string (see doc) ASC is able to manage KERBEROS_V4
on the server side
solved bug in property handling (strlen(NULL) after received NULL
as data from a sasl_getprop)
0.09
Added callback documenation
Perl-Callback types (PVMG, PV, PVIV) handling extended
0.08-desy-internal
Almost complete rewrite of Perlcallbacks from Cyrus.xs.
SASL-Server functionality added, so servers written in Perl can use
SASL as Authentication Layer. Synchronize callbacks between Cyrus SASL
v1 and v2.
Many changes in the internal handling of sasl variables.
Documentation inside the XS-file, do motivate myself to write docs
0.07
Memcpy fix provided by Maurice Massar
0.06
Added SASL V2 support patch provided by Leif Johansson.
The XS framework makes calls into the existing libsasl.so resp. libsasl2
shared library to perform SASL client connection functionality, including
loading existing shared library mechanisms.
=head1 CONSTRUCTOR
The constructor may be called with or without arguments. Passing arguments is
just a short cut to calling the C<mechanism> and C<callback> methods.
You have to use the C<Authen::SASL> new-constructor to create a SASL object.
The C<Authen::SASL> object then holds all necessary variables and callbacks, which
you gave when creating the object.
C<client_new> and C<server_new> will retrieve needed information from this
object.
=pod
=head1 CALLBACKS
Callbacks are very important. It depends on the mechanism which callbacks
have to be set. It is not a failure to set callbacks even they aren't used.
(e.g. password-callback when using GSSAPI or KERBEROS_V4)
The Cyrus-SASL library uses callbacks when the application
needs some information. Common reasons are getting
usernames and passwords.
Authen::SASL::XS allows Cyrus-SASL to use perl-variables and perl-subs
as callback-targets.
Currently Authen::SASL::XS supports the following Callback types:
(for a more detailed description on what the callback type is used for
see the respective man pages)
B<Remark>: All callbacks, which have to return some values (e.g.: **result in
C<sasl_getsimple_t>) do this by returning the value(s). See example below.
=over 4
=item user (client)
=item auth (client)
=item language (client)
This callbacks represent the C<sasl_getsimple_t> from the library.
Input: none
Output: C<username>, C<authname> or C<language>
=item password (client)
=item pass (client)
This callbacks represent the C<sasl_getsecret_t> from the library.
Input: none
Output: C<password>
=item realm <client>
This callback represents the C<sasl_getrealm_t> from the library.
Input: a list of available realms
=item getsecret (server, SASL v1 only)
This callback represents the C<sasl_server_getsecret_t> from the library. Sasl
will check if the passwords are matching.
Input: C<mechanism>, C<username>, C<default_realm>
Output: C<secret_phrase (password)>
B<Remark>: Programmers that are using should specify both callbacks (getsecret and checkpass).
Then, depending on you Cyrus SASL library either the one or the other is called. Cyrus SASL v1
ignores checkpass and Cyrus SASL v2 ignores getsecret.
=item putsecret (SASL v1) and setpass (SASL v2)
are currently not supported (and won't be, unless someone needs it).
=item canonuser (server/client in SASL v2, server only in SASL v1)
This callback name represents the C<sasl_canon_user_t> from the library.
If the value passed is an array reference, the first element in the array
must be a code reference. When the callback is called the code reference
will be called with the value from the array passed after.
=item SCALAR
All other values passed will be returned directly to the SASL library
as the answer to the callback.
=back
=head2 Example of setting callbacks
$sasl = new Authen::SASL (
mechanism => "PLAIN",
callback => {
# Scalar
user => "mannfred",
pass => $password,
language => 1,
# Coderef
The XS framework makes calls into the existing libsasl.so resp. libsasl2
shared library to perform SASL client connection functionality, including
loading existing shared library mechanisms.
=head1 CONSTRUCTOR
The constructor may be called with or without arguments. Passing arguments is
just a short cut to calling the C<mechanism> and C<callback> methods.
You have to use the C<Authen::SASL> new-constructor to create a SASL object.
The C<Authen::SASL> object then holds all necessary variables and callbacks, which
you gave when creating the object.
C<client_new> and C<server_new> will retrieve needed information from this
object.
=cut
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>
#else
#define _DEBUG(x,...)
#define __DEBUG(x)
#endif
#define SASL_IS_SERVER 0
#define SASL_IS_CLIENT 1
struct authensasl {
sasl_conn_t *conn;
sasl_callback_t *callbacks;
int callback_count;
char *server;
char *service;
char *mech;
char *user;
int error_code;
char *additional_errormsg;
struct _perlcontext {
SV *func;
SV *param;
int intparam;
};
/* Define missing DEFINES, to help programmers avoiding conflict
* between SASL v1 and v2 libs.
* Ignore but allow setting callbacks which are lib version depending
*/
#ifdef SASL2
#define SASL_CB_SERVER_GETSECRET (0)
#define SASL_CB_SERVER_PUTSECRET (0)
#else
#define SASL_CB_SERVER_USERDB_CHECKPASS (0)
sasl->additional_errormsg = NULL;
}
_DEBUG("called Error: %s, Code: %d Client: %d",msg,code,sasl->is_client);
_DEBUG("now Error: %s, Code: %d",sasl->additional_errormsg,sasl->error_code);
}
return code;
}
/*
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.
*/
/*
This function executes the perl sub/code and returns the result
and its length.
*/
int PerlCallbackSub (struct _perlcontext *cp, char **result, STRLEN *len, AV *args)
{
}
#endif
=pod
=head1 CALLBACKS
Callbacks are very important. It depends on the mechanism which callbacks
have to be set. It is not a failure to set callbacks even they aren't used.
(e.g. password-callback when using GSSAPI or KERBEROS_V4)
The Cyrus-SASL library uses callbacks when the application
needs some information. Common reasons are getting
usernames and passwords.
Authen::SASL::XS allows Cyrus-SASL to use perl-variables and perl-subs
as callback-targets.
Currently Authen::SASL::XS supports the following Callback types:
(for a more detailed description on what the callback type is used for
see the respective man pages)
B<Remark>: All callbacks, which have to return some values (e.g.: **result in
C<sasl_getsimple_t>) do this by returning the value(s). See example below.
=over 4
=item user (client)
=item auth (client)
=item language (client)
This callbacks represent the C<sasl_getsimple_t> from the library.
Input: none
Output: C<username>, C<authname> or C<language>
=item password (client)
=item pass (client)
This callbacks represent the C<sasl_getsecret_t> from the library.
Input: none
Output: C<password>
=item realm <client>
This callback represents the C<sasl_getrealm_t> from the library.
Input: a list of available realms
=item getsecret (server, SASL v1 only)
This callback represents the C<sasl_server_getsecret_t> from the library. Sasl
will check if the passwords are matching.
Input: C<mechanism>, C<username>, C<default_realm>
Output: C<secret_phrase (password)>
B<Remark>: Programmers that are using should specify both callbacks (getsecret and checkpass).
Then, depending on you Cyrus SASL library either the one or the other is called. Cyrus SASL v1
ignores checkpass and Cyrus SASL v2 ignores getsecret.
=item putsecret (SASL v1) and setpass (SASL v2)
are currently not supported (and won't be, unless someone needs it).
=item canonuser (server/client in SASL v2, server only in SASL v1)
This callback name represents the C<sasl_canon_user_t> from the library.
If the value passed is an array reference, the first element in the array
must be a code reference. When the callback is called the code reference
will be called with the value from the array passed after.
=item SCALAR
All other values passed will be returned directly to the SASL library
as the answer to the callback.
=back
=head2 Example of setting callbacks
$sasl = new Authen::SASL (
mechanism => "PLAIN",
callback => {
# Scalar
user => "mannfred",
pass => $password,
language => 1,
# Coderef
#ifdef SASL2
croak("Unknown callback: '%s'. (user|auth|language|pass|realm|checkpass|canonuser|authorize)\n", name);
#else
croak("Unknown callback: '%s'. (user|auth|language|pass|realm|getsecret|canonuser|authorize)\n", name);
#endif
}
/*
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(SV *action, struct _perlcontext *pcb, sasl_callback_t *cb)
{
__DEBUG("AddCallback");
if (SvROK(action)) { /* user => <ref> */
__DEBUG("SvROK -> Dereferencing");
action = SvRV(action);
__DEBUG("SVt_IV");
break;
default:
_DEBUG("Unknown parameter %d %s",SvTYPE(action),SvPV_nolen(action));
croak("Unknown parameter to %x callback.\n", cb->id);
break;
}
_DEBUG("Callback: %x",cb->id);
/* Write the C SASL callbacks */
switch (cb->id)
{
case SASL_CB_USER:
case SASL_CB_AUTHNAME:
case SASL_CB_LANGUAGE:
cb->proc = PerlCallback;
break;
case SASL_CB_PASS:
cb->proc = PerlCallbackSecret;
break;
#ifdef SASL2
case SASL_CB_SERVER_USERDB_CHECKPASS:
cb->proc = PerlCallbackServerCheckPass;
break;
case SASL_CB_SERVER_USERDB_SETPASS:
cb->proc = PerlCallbackServerSetPass;
break;
#else
// SASL 1 Servercallbacks:
case SASL_CB_SERVER_GETSECRET:
cb->proc = PerlCallbackGetSecret;
break;
case SASL_CB_SERVER_PUTSECRET:
// Not implemented yet maybe TODO, if ever needed
break;
#endif
default:
break;
}
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
* Only valid (non-zero) callbacks are counted.
*/
hv_iterinit(hash);
for (iter=hv_iternext(hash); iter; iter=hv_iternext(hash))
{
key = hv_iterkey(iter,&l);
if ((i=CallbackNumber(key))) {
#ifndef SASL2
// Missing SASL1 canonuser workaround
if (i == SASL_CB_CANON_USER) canon = count;
if (i == SASL_CB_PROXY_POLICY) auth = count;
#endif
count++;
}
}
_DEBUG("Found %d valid callback(s)",count);
/* Allocate space for the callbacks */
if (sasl->callbacks) {
free(sasl->callbacks->context);
free(sasl->callbacks);
}
pcb = (struct _perlcontext *) malloc(count * sizeof(struct _perlcontext));
if (pcb == NULL)
croak("Out of memory\n");
l = (count + 1) * sizeof(sasl_callback_t);
sasl->callbacks = (sasl_callback_t *)malloc(l);
if (sasl->callbacks == NULL)
croak("Out of memory\n");
memset(sasl->callbacks, 0, l);
/* Run through all of parent's callback types, fill in the sasl->callbacks
* Only valid (non-zero) callbacks will be filled in
*/
hv_iterinit(hash);
count = 0;
for (iter=hv_iternext(hash); iter; iter=hv_iternext(hash)) {
key = hv_iterkey(iter,&l);
_DEBUG("Callback %d, %s",count, key);
if ( (i = CallbackNumber(key))) {
_DEBUG("Adding Callback %s %d %x.",key,count,i);
sasl->callbacks[count].id = i;
val = hv_iterval(hash, iter);
AddCallback(val, &pcb[count], &sasl->callbacks[count]);
count++;
}
else
_DEBUG("Ignore Callback %s %d %x.",key,count,i);
}
sasl->callbacks[count].id = SASL_CB_LIST_END;
sasl->callbacks[count].context = pcb;
sasl->callback_count = count;
#ifndef SASL2
// Missing-SASL1-canonuser workaround
// If canon is needed
if (canon != -1)
{
if (auth != -1) // and auth also
sp_canon = sasl->callbacks[canon].context; // Auth has to call canon
else
{
sasl->callbacks[canon].id = SASL_CB_PROXY_POLICY; // call canon when auth is actually needed
sasl->callbacks[canon].proc = PerlCallbackCanonUser1;
}
}
_DEBUG("index for auth: %d, index for canon: %d",auth,canon);
#endif
return;
}
#ifdef SASL2
int rc;
if ((rc = init_sasl(parent,service,host,&sasl,SASL_IS_SERVER)) != SASL_OK)
croak("Saslinit failed. (%x)\n",rc);
_DEBUG("server_new: Service: %s Server: %s, %s %s %s %s",sasl->service,sasl->server,service,host,iplocalport,ipremoteport);
if ((rc = sasl_server_init(NULL,sasl->service)) != SASL_OK)
SetSaslError(sasl,rc,"server_init error.");
#ifdef SASL2
rc = sasl_server_new(sasl->service, sasl->server, NULL, iplocalport, ipremoteport, sasl->callbacks, 1, &sasl->conn);
#else
rc = sasl_server_new(sasl->service, sasl->server, NULL, sasl->callbacks, 1, &sasl->conn);
#endif
if (SetSaslError(sasl,rc,"server_new error.") == SASL_OK)
{
#ifdef SASL2
set_secprop(sasl);
#endif
}
RETVAL = sasl;
}
{
Authen_SASL_XS sasl = NULL;
int rc;
if ((rc = init_sasl(parent,service,host,&sasl,SASL_IS_CLIENT)) != SASL_OK)
croak("Saslinit failed. (%x)\n",rc);
sasl_client_init(NULL);
_DEBUG("service: %s, host: %s, mech: %s",sasl->service,sasl->server,sasl->mech);
#ifdef SASL2
rc = sasl_client_new(sasl->service, sasl->server, iplocalport, ipremoteport, sasl->callbacks, 1, &sasl->conn);
#else
rc = sasl_client_new(sasl->service, sasl->server, sasl->callbacks, 1, &sasl->conn);
#endif
if (SetSaslError(sasl,rc,"client_new error.") == SASL_OK)
{
#ifdef SASL2
set_secprop(sasl);
#endif
}
RETVAL = sasl;
}
int
callback(sasl, ...)
Authen_SASL_XS sasl
CODE:
/*
This function is unnecessary since there is no
chance for changing callbacks in sasl after (server|
client)_new function calls. But without calling one
of these functions (from perl) you do not have an
object of this class. So you cannot call ->callback.
At least I was not able to use this function to fill in
a callback with this function.
-Patrick
*/
croak("Deprecated. Don't use, it isn't working anymore.");
RETVAL = 0;
OUTPUT:
}
}
void
DESTROY(sasl)
Authen_SASL_XS sasl
CODE:
{
__DEBUG("DESTROY");
if (sasl->conn) sasl_dispose(&sasl->conn);
if (sasl->callbacks) {
free(sasl->callbacks[sasl->callback_count].context);
free(sasl->callbacks);
}
if (sasl->service) free(sasl->service);
if (sasl->mech) free(sasl->mech);
if (sasl->additional_errormsg) free(sasl->additional_errormsg);
free(sasl);
sasl_done();
}
( run in 1.856 second using v1.01-cache-2.11-cpan-9b1e4054eb1 )