Skip Menu |
 

This queue is for tickets about the Authen-Krb5-Admin CPAN distribution.

Report information
The Basics
Id: 80205
Status: open
Priority: 0/
Queue: Authen-Krb5-Admin

People
Owner: Nobody in particular
Requestors: dorian [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Wishlist
Broken in: 0.13
Fixed in: 0.13



Subject: Adding a db_args method to Authen::Krb5::Admin::Principal
Download (untitled) / with headers
text/plain 531b
I needed to be able to pass in db_args to add principals to existing LDAP entries (e.g. addprinc -x dn=cn=foo,dc=bar,dc=com in kadmin). Here is a patch that adds a db_args method. Called with no arguments, db_args will return the list of existing args. Otherwise all subsequent arguments will replace the existing set while returning it. I'm not married to this behaviour but it seemed sane enough to do at the time. Alternatively, if you have this module in GitHub or BitBucket I'm happy to clone it and do a pull request there.
Subject: 2012-10-15-djt-db-args.diff
diff -r d74e15a27d7a Admin.pm --- a/Admin.pm Mon Oct 15 21:08:05 2012 -0700 +++ b/Admin.pm Mon Oct 15 23:10:16 2012 -0700 @@ -193,7 +193,7 @@ KRB5_KDB_ACCESS_ERROR ); %EXPORT_TAGS = (constants => \@EXPORT_OK); -$VERSION = '0.13'; +$VERSION = '0.14'; # Preloaded methods go here. @@ -513,6 +513,17 @@ Expire time (in seconds since the Epoch) of the principal's password +=item * db_args [@ARGS] + +When called without any C<@ARGS>, returns the list of arguments that +will be passed into the underlying database, as with C<addprinc -x> in +C<kadmin>. If C<@ARGS> is non-empty, it will replace any database +arguments, which will then be returned, like this: + + my @old = $principal->db_args; + # or + my @old = $principal->db_args(@new); + =back =head2 Operations diff -r d74e15a27d7a Admin.xs --- a/Admin.xs Mon Oct 15 21:08:05 2012 -0700 +++ b/Admin.xs Mon Oct 15 23:10:16 2012 -0700 @@ -30,6 +30,7 @@ #include "perl.h" #include "XSUB.h" #include <krb5.h> +#include <kdb.h> #include <com_err.h> #ifdef USE_LOCAL_ADMINH #include "admin.h" @@ -2018,6 +2019,92 @@ RETVAL void +db_args(princ, ...) + Authen::Krb5::Admin::Principal princ + PREINIT: + krb5_tl_data *tl, *last_tl; + krb5_octet **db_args; + int i; + + PPCODE: + /* arglist will be items - 1, but the last item should be a NULL. */ + Newxz(db_args, items, krb5_octet *); + + /* pull db args off the stack */ + /* grab the arg stack */ + for (i = 1; i < items; i++) { + db_args[i - 1] = (krb5_octet *)SvPV_nolen(ST(i)); + } + + last_tl = NULL; + tl = princ->kadm5_princ.tl_data; + while (tl != NULL) { + krb5_tl_data *next_tl = tl->tl_data_next; + + /* bail out early for anything but db_args */ + if (tl->tl_data_type != KRB5_TL_DB_ARGS) { + last_tl = tl; + tl = next_tl; + continue; + } + + /* otherwise: */ + + /* pinched from kdb5.c */ + if (((char *) tl->tl_data_contents)[tl->tl_data_length - 1] != '\0') { + /* croak */ + Perl_croak(aTHX_ "Unsafe string in principal tail data"); + } + else { + /* extend and push the stack with a new mortal SvPV */ + mXPUSHp((char *) tl->tl_data_contents, tl->tl_data_length - 1); + /* only two hard things in computer science: cache + expiration, naming things, and off-by-one errors. */ + + /* PS that copies the string, right? because i'm about to + nuke it. */ + + /* we're only doing surgery if there is something to + replace these with */ + if (items > 1) { + /* stitch next record to last record if it exists */ + if (last_tl != NULL) last_tl->tl_data_next = next_tl; + /* stitch the next one onto if this is the first */ + else if (tl == princ->kadm5_princ.tl_data) + princ->kadm5_princ.tl_data = next_tl; + + /* poof */ + free(tl->tl_data_contents); + free(tl); + + } + + /* set this either way */ + tl = next_tl; + } + } + + /* add new db args to tl_data */ + if (items > 1) { + for (i = 0; i < items - 1; i++) { + krb5_tl_data *new_tl; + + new_tl = calloc(1, sizeof(*new_tl)); + new_tl->tl_data_type = KRB5_TL_DB_ARGS; + new_tl->tl_data_length = strlen(db_args[i]) + 1; + new_tl->tl_data_contents = db_args[i]; + new_tl->tl_data_next = NULL; + + /* append to list */ + if (last_tl != NULL) last_tl->tl_data_next = new_tl; + else princ->kadm5_princ.tl_data = new_tl; + + /* either way, it becomes the new tail */ + last_tl = new_tl; + } + } + +void DESTROY(princ) Authen::Krb5::Admin::Principal princ PREINIT: diff -r d74e15a27d7a MANIFEST.SKIP --- a/MANIFEST.SKIP Mon Oct 15 21:08:05 2012 -0700 +++ b/MANIFEST.SKIP Mon Oct 15 23:10:16 2012 -0700 @@ -1,3 +1,4 @@ +^\.hg ^Admin\.bs$ ^Admin\.[co]$ ^CVS/ diff -r d74e15a27d7a Makefile.PL --- a/Makefile.PL Mon Oct 15 21:08:05 2012 -0700 +++ b/Makefile.PL Mon Oct 15 23:10:16 2012 -0700 @@ -145,7 +145,7 @@ $commands =~ s/PERL_DL_NONLAZY=1 /$new_vars /; return exists $ENV{PERL_KADM5_TEST_CACHE} ? $commands - : "\t$KRB5_BINDIR/kinit -S kadmin/admin -c $test_cache -l 5m " + : "\t$KRB5_BINDIR/kinit -S kadmin/admin -c $test_cache -l 50m " . "$KADM5_PRINCIPAL\n$commands" ; } diff -r d74e15a27d7a t/30-addprinc.t --- a/t/30-addprinc.t Mon Oct 15 21:08:05 2012 -0700 +++ b/t/30-addprinc.t Mon Oct 15 23:10:16 2012 -0700 @@ -31,7 +31,7 @@ use strict; use Test; -BEGIN { plan test => 20 } +BEGIN { plan test => 22 } use Authen::Krb5; use Authen::Krb5::Admin qw(:constants); @@ -50,6 +50,14 @@ my $ap = Authen::Krb5::Admin::Principal->new; ok $ap; +my @args = $ap->db_args('derp'); +ok !@args; + +@args = $ap->db_args; +#warn $_ for unpack 'C*', $args[0]; +#warn $args[0]; +ok $args[0] eq "derp"; + $ap->attributes(KRB5_KDB_DISALLOW_ALL_TIX | KRB5_KDB_DISALLOW_TGT_BASED); ok $ap->attributes, KRB5_KDB_DISALLOW_ALL_TIX | KRB5_KDB_DISALLOW_TGT_BASED; ok $ap->mask & KADM5_ATTRIBUTES; @@ -82,5 +90,6 @@ ok $ap->pw_expiration, 1021908826; ok $ap->mask & KADM5_PW_EXPIRATION; -ok $handle->create_principal($ap, join '', map { chr rand(255) + 1 } 1..256) +# utf8 gets ya +ok $handle->create_principal($ap, join '', map { chr(rand(127) + 1) } 1..256) or warn Authen::Krb5::Admin::error;
Download (untitled) / with headers
text/plain 801b
Thanks for the patch, it is much appreciated. The code looks good, I will hopefully get a chance to push out a new release next week, I have a few other changes backed up ready to go as well. Stephen On Tue Oct 16 02:16:48 2012, DORIAN wrote: Show quoted text
> I needed to be able to pass in db_args to add principals to existing > LDAP entries (e.g. addprinc -x dn=cn=foo,dc=bar,dc=com in kadmin). Here > is a patch that adds a db_args method. > > Called with no arguments, db_args will return the list of existing args. > Otherwise all subsequent arguments will replace the existing set while > returning it. I'm not married to this behaviour but it seemed sane > enough to do at the time. > > Alternatively, if you have this module in GitHub or BitBucket I'm happy > to clone it and do a pull request there.
Download (untitled) / with headers
text/plain 480b
On Thu Oct 18 05:32:18 2012, SJQUINNEY wrote: Show quoted text
> Thanks for the patch, it is much appreciated. The code looks good, I > will hopefully get a chance to push out a new release next week, I have > a few other changes backed up ready to go as well.
Great! Thanks. Hold on a moment though, as I've added an important doc patch about setting flags that will frustrate people if it isn't there. It's concerned with setting the KADM5_TL_DATA flag, otherwise the RPC will ignore that data.
Subject: 2012-10-18-djt-db-args.diff
diff -r d74e15a27d7a Admin.pm --- a/Admin.pm Mon Oct 15 21:08:05 2012 -0700 +++ b/Admin.pm Thu Oct 18 08:12:40 2012 -0700 @@ -193,7 +193,7 @@ KRB5_KDB_ACCESS_ERROR ); %EXPORT_TAGS = (constants => \@EXPORT_OK); -$VERSION = '0.13'; +$VERSION = '0.14'; # Preloaded methods go here. @@ -513,6 +513,21 @@ Expire time (in seconds since the Epoch) of the principal's password +=item * db_args [@ARGS] + +When called without any C<@ARGS>, returns the list of arguments that +will be passed into the underlying database, as with C<addprinc -x> in +C<kadmin>. If C<@ARGS> is non-empty, it will replace any database +arguments, which will then be returned, like this: + + my @old = $principal->db_args; + # -or- + my @old = $principal->db_args(@new); + + # The RPC call will ignore the tail data unless + # you set this flag: + $principal->mask($principal->mask | KADM5_TL_DATA); + =back =head2 Operations diff -r d74e15a27d7a Admin.xs --- a/Admin.xs Mon Oct 15 21:08:05 2012 -0700 +++ b/Admin.xs Thu Oct 18 08:12:40 2012 -0700 @@ -30,6 +30,7 @@ #include "perl.h" #include "XSUB.h" #include <krb5.h> +#include <kdb.h> #include <com_err.h> #ifdef USE_LOCAL_ADMINH #include "admin.h" @@ -2018,6 +2019,93 @@ RETVAL void +db_args(princ, ...) + Authen::Krb5::Admin::Principal princ + PROTOTYPE: $;@ + PREINIT: + krb5_tl_data *tl, *last_tl; + krb5_octet **db_args; + int i; + + PPCODE: + /* arglist will be items - 1, but the last item should be a NULL. */ + Newxz(db_args, items, krb5_octet *); + + /* pull db args off the stack */ + /* grab the arg stack */ + for (i = 1; i < items; i++) { + db_args[i - 1] = (krb5_octet *)SvPV_nolen(ST(i)); + } + + last_tl = NULL; + tl = princ->kadm5_princ.tl_data; + while (tl != NULL) { + krb5_tl_data *next_tl = tl->tl_data_next; + + /* bail out early for anything but db_args */ + if (tl->tl_data_type != KRB5_TL_DB_ARGS) { + last_tl = tl; + tl = next_tl; + continue; + } + + /* otherwise: */ + + /* pinched from kdb5.c */ + if (((char *) tl->tl_data_contents)[tl->tl_data_length - 1] != '\0') { + /* croak */ + Perl_croak(aTHX_ "Unsafe string in principal tail data"); + } + else { + /* extend and push the stack with a new mortal SvPV */ + mXPUSHp((char *) tl->tl_data_contents, tl->tl_data_length - 1); + /* only two hard things in computer science: cache + expiration, naming things, and off-by-one errors. */ + + /* PS that copies the string, right? because i'm about to + nuke it. */ + + /* we're only doing surgery if there is something to + replace these with */ + if (items > 1) { + /* stitch next record to last record if it exists */ + if (last_tl != NULL) last_tl->tl_data_next = next_tl; + /* stitch the next one onto if this is the first */ + else if (tl == princ->kadm5_princ.tl_data) + princ->kadm5_princ.tl_data = next_tl; + + /* poof */ + free(tl->tl_data_contents); + free(tl); + + } + + /* set this either way */ + tl = next_tl; + } + } + + /* add new db args to tl_data */ + if (items > 1) { + for (i = 0; i < items - 1; i++) { + krb5_tl_data *new_tl; + + new_tl = calloc(1, sizeof(*new_tl)); + new_tl->tl_data_type = KRB5_TL_DB_ARGS; + new_tl->tl_data_length = strlen(db_args[i]) + 1; + new_tl->tl_data_contents = db_args[i]; + new_tl->tl_data_next = NULL; + + /* append to list */ + if (last_tl != NULL) last_tl->tl_data_next = new_tl; + else princ->kadm5_princ.tl_data = new_tl; + + /* either way, it becomes the new tail */ + last_tl = new_tl; + } + } + +void DESTROY(princ) Authen::Krb5::Admin::Principal princ PREINIT: diff -r d74e15a27d7a MANIFEST.SKIP --- a/MANIFEST.SKIP Mon Oct 15 21:08:05 2012 -0700 +++ b/MANIFEST.SKIP Thu Oct 18 08:12:40 2012 -0700 @@ -1,3 +1,4 @@ +^\.hg ^Admin\.bs$ ^Admin\.[co]$ ^CVS/ diff -r d74e15a27d7a Makefile.PL --- a/Makefile.PL Mon Oct 15 21:08:05 2012 -0700 +++ b/Makefile.PL Thu Oct 18 08:12:40 2012 -0700 @@ -145,7 +145,7 @@ $commands =~ s/PERL_DL_NONLAZY=1 /$new_vars /; return exists $ENV{PERL_KADM5_TEST_CACHE} ? $commands - : "\t$KRB5_BINDIR/kinit -S kadmin/admin -c $test_cache -l 5m " + : "\t$KRB5_BINDIR/kinit -S kadmin/admin -c $test_cache -l 50m " . "$KADM5_PRINCIPAL\n$commands" ; } diff -r d74e15a27d7a t/30-addprinc.t --- a/t/30-addprinc.t Mon Oct 15 21:08:05 2012 -0700 +++ b/t/30-addprinc.t Thu Oct 18 08:12:40 2012 -0700 @@ -31,7 +31,7 @@ use strict; use Test; -BEGIN { plan test => 20 } +BEGIN { plan test => 22 } use Authen::Krb5; use Authen::Krb5::Admin qw(:constants); @@ -50,6 +50,14 @@ my $ap = Authen::Krb5::Admin::Principal->new; ok $ap; +my @args = $ap->db_args('derp'); +ok !@args; + +@args = $ap->db_args; +#warn $_ for unpack 'C*', $args[0]; +#warn $args[0]; +ok $args[0] eq "derp"; + $ap->attributes(KRB5_KDB_DISALLOW_ALL_TIX | KRB5_KDB_DISALLOW_TGT_BASED); ok $ap->attributes, KRB5_KDB_DISALLOW_ALL_TIX | KRB5_KDB_DISALLOW_TGT_BASED; ok $ap->mask & KADM5_ATTRIBUTES; @@ -82,5 +90,6 @@ ok $ap->pw_expiration, 1021908826; ok $ap->mask & KADM5_PW_EXPIRATION; -ok $handle->create_principal($ap, join '', map { chr rand(255) + 1 } 1..256) +# utf8 gets ya +ok $handle->create_principal($ap, join '', map { chr(rand(127) + 1) } 1..256) or warn Authen::Krb5::Admin::error;
Download (untitled) / with headers
text/plain 1.1k
I've just looked at applying your patch but I find that it doesn't compile on my system (RHEL6) which has MIT Kerberos version 1.9. To get it building I had to #define the SECURID cpp macro before the inclusion of the kdb.h header in Admin.xs (it seems this is actually a bug in that header). I also noticed that I don't have kdb.h available on my RHEL5 machine which has version 1.6, the header is in the source but doesn't get installed by the looks of things. I think the header is installed with 1.7 onwards, probably the easiest solution here is to only have the new function compiled into the code when the header is available. Stephen On Thu Oct 18 11:18:04 2012, DORIAN wrote: Show quoted text
> On Thu Oct 18 05:32:18 2012, SJQUINNEY wrote:
> > Thanks for the patch, it is much appreciated. The code looks good, I > > will hopefully get a chance to push out a new release next week, I have > > a few other changes backed up ready to go as well.
> > Great! Thanks. Hold on a moment though, as I've added an important doc > patch about setting flags that will frustrate people if it isn't there. > It's concerned with setting the KADM5_TL_DATA flag, otherwise the RPC > will ignore that data.
On Thu Nov 01 05:38:48 2012, SJQUINNEY wrote: Show quoted text
> I've just looked at applying your patch but I find that it doesn't > compile on my system (RHEL6) which has MIT Kerberos version 1.9. To get > it building I had to #define the SECURID cpp macro before the inclusion > of the kdb.h header in Admin.xs (it seems this is actually a bug in that > header).
Show quoted text
> I also noticed that I don't have kdb.h available on my RHEL5 machine > which has version 1.6, the header is in the source but doesn't get > installed by the looks of things. I think the header is installed with > 1.7 onwards, probably the easiest solution here is to only have the new > function compiled into the code when the header is available.
kdb.h is also missing on OSX. There is only the KADM5_TL_DATA define from there. It might just make sense to define it statically, even though that imports its own potential set of problems. I was using my changes last week and found a double free (actually two, one in Authen::Krb5 also). So I should probably fix that as well.
Download (untitled) / with headers
text/plain 1.2k
Hi there, A while back you mentioned that you had found a double-free in your code, do you now have an improved patch which fixes that issue? Cheers, Stephen Quinney On Thu Nov 01 12:02:59 2012, DORIAN wrote: Show quoted text
> On Thu Nov 01 05:38:48 2012, SJQUINNEY wrote:
> > I've just looked at applying your patch but I find that it doesn't > > compile on my system (RHEL6) which has MIT Kerberos version 1.9. To get > > it building I had to #define the SECURID cpp macro before the inclusion > > of the kdb.h header in Admin.xs (it seems this is actually a bug in that > > header).
>
> > I also noticed that I don't have kdb.h available on my RHEL5 machine > > which has version 1.6, the header is in the source but doesn't get > > installed by the looks of things. I think the header is installed with > > 1.7 onwards, probably the easiest solution here is to only have the new > > function compiled into the code when the header is available.
> > kdb.h is also missing on OSX. There is only the KADM5_TL_DATA define > from there. It might just make sense to define it statically, even > though that imports its own potential set of problems. > > I was using my changes last week and found a double free (actually two, > one in Authen::Krb5 also). So I should probably fix that as well.
Download (untitled) / with headers
text/plain 572b
On Thu Dec 13 05:33:01 2012, SJQUINNEY wrote: Show quoted text
> Hi there, > > A while back you mentioned that you had found a double-free in your > code, do you now have an improved patch which fixes that issue? > > Cheers, > > Stephen Quinney
Two, in fact. One in my code and another in Authen::Krb5 (according to valgrind). I've been working on other stuff in the interim, but I'm going to need that to work at some point in the next few weeks. So I'll be setting a day aside (as I'm not an especially good C programmer) to fix them both soon. Stay tuned and have a happy new year!
Download (untitled) / with headers
text/plain 455b
I found something; looks like it was an an off-by-one. I got Test::Valgrind to stop complaining about it. The script I originally wrote (also attached) to add principals doesn't crash anymore on my system but I still need to try it elsewhere. I should also note that there were other complaints from valgrind around the GC of the context object that must have always been there. Fixing that is a little more involved (and should probably be its own bug).
Subject: 2013-01-27-db-args.diff
diff -r d74e15a27d7a Admin.pm --- a/Admin.pm Mon Oct 15 21:08:05 2012 -0700 +++ b/Admin.pm Mon Jan 28 09:30:55 2013 -0800 @@ -193,7 +193,7 @@ KRB5_KDB_ACCESS_ERROR ); %EXPORT_TAGS = (constants => \@EXPORT_OK); -$VERSION = '0.13'; +$VERSION = '0.14'; # Preloaded methods go here. @@ -513,6 +513,21 @@ Expire time (in seconds since the Epoch) of the principal's password +=item * db_args [@ARGS] + +When called without any C<@ARGS>, returns the list of arguments that +will be passed into the underlying database, as with C<addprinc -x> in +C<kadmin>. If C<@ARGS> is non-empty, it will replace any database +arguments, which will then be returned, like this: + + my @old = $principal->db_args; + # -or- + my @old = $principal->db_args(@new); + + # The RPC call will ignore the tail data unless + # you set this flag: + $principal->mask($principal->mask | KADM5_TL_DATA); + =back =head2 Operations diff -r d74e15a27d7a Admin.xs --- a/Admin.xs Mon Oct 15 21:08:05 2012 -0700 +++ b/Admin.xs Mon Jan 28 09:30:55 2013 -0800 @@ -30,6 +30,7 @@ #include "perl.h" #include "XSUB.h" #include <krb5.h> +#include <kdb.h> #include <com_err.h> #ifdef USE_LOCAL_ADMINH #include "admin.h" @@ -2018,6 +2019,107 @@ RETVAL void +db_args(princ, ...) + Authen::Krb5::Admin::Principal princ + PROTOTYPE: $;@ + PREINIT: + krb5_tl_data *tl, *last_tl; + krb5_octet **db_args; + int i; + + PPCODE: + /* arglist will be items - 1, but the last item should be a NULL. */ + Newxz(db_args, items, krb5_octet *); + + /* pull db args off the stack */ + /* grab the arg stack */ + for (i = 1; i < items; i++) { + krb5_octet *this_arg; + STRLEN length = sv_len(ST(i)) + 1; + /* Perl_croak(aTHX_ "%d", length);*/ + Newxz(this_arg, length, krb5_octet); + Copy((krb5_octet *)SvPV(ST(i), length), this_arg, length, krb5_octet); + /* db_args[i - 1] = (krb5_octet *)SvPV_nolen(ST(i)); */ + db_args[i - 1] = this_arg; + } + + last_tl = NULL; + tl = princ->kadm5_princ.tl_data; + while (tl != NULL) { + krb5_tl_data *next_tl = tl->tl_data_next; + + /* bail out early for anything but db_args */ + if (tl->tl_data_type != KRB5_TL_DB_ARGS) { + last_tl = tl; + tl = next_tl; + continue; + } + + /* otherwise: */ + + /* pinched from kdb5.c */ + if (((char *) tl->tl_data_contents)[tl->tl_data_length - 1] != '\0') { + /* croak */ + Perl_croak(aTHX_ "Unsafe string in principal tail data"); + } + else { + SV * tl_out; + + tl_out = newSVpv((const char *) tl->tl_data_contents, 0); + XPUSHs(tl_out); + + /* extend and push the stack with a new mortal SvPV */ + /* mXPUSHp((char *) tl->tl_data_contents, tl->tl_data_length - 1); */ + /* only two hard things in computer science: cache + expiration, naming things, and off-by-one errors. */ + + /* PS that copies the string, right? because i'm about to + nuke it. */ + + /* we're only doing surgery if there is something to + replace these with */ + if (items > 1) { + /* stitch next record to last record if it exists */ + if (last_tl != NULL) last_tl->tl_data_next = next_tl; + /* stitch the next one onto if this is the first */ + else if (tl == princ->kadm5_princ.tl_data) + princ->kadm5_princ.tl_data = next_tl; + + /* poof */ + free(tl->tl_data_contents); + free(tl); + + } + + /* set this either way */ + tl = next_tl; + } + } + + /* add new db args to tl_data */ + if (items > 1) { + for (i = 0; i < items - 1; i++) { + krb5_tl_data *new_tl; + + new_tl = calloc(1, sizeof(*new_tl)); + new_tl->tl_data_type = KRB5_TL_DB_ARGS; + new_tl->tl_data_length = strlen(db_args[i]) + 1; + new_tl->tl_data_contents = db_args[i]; + new_tl->tl_data_next = NULL; + + /* append to list */ + if (last_tl != NULL) last_tl->tl_data_next = new_tl; + else princ->kadm5_princ.tl_data = new_tl; + + /* either way, it becomes the new tail */ + last_tl = new_tl; + } + } + + /* explictly get rid of db_args */ + Safefree(db_args); + +void DESTROY(princ) Authen::Krb5::Admin::Principal princ PREINIT: diff -r d74e15a27d7a MANIFEST.SKIP --- a/MANIFEST.SKIP Mon Oct 15 21:08:05 2012 -0700 +++ b/MANIFEST.SKIP Mon Jan 28 09:30:55 2013 -0800 @@ -1,3 +1,4 @@ +^\.hg ^Admin\.bs$ ^Admin\.[co]$ ^CVS/ diff -r d74e15a27d7a Makefile.PL --- a/Makefile.PL Mon Oct 15 21:08:05 2012 -0700 +++ b/Makefile.PL Mon Jan 28 09:30:55 2013 -0800 @@ -145,7 +145,7 @@ $commands =~ s/PERL_DL_NONLAZY=1 /$new_vars /; return exists $ENV{PERL_KADM5_TEST_CACHE} ? $commands - : "\t$KRB5_BINDIR/kinit -S kadmin/admin -c $test_cache -l 5m " + : "\t$KRB5_BINDIR/kinit -S kadmin/admin -c $test_cache -l 50m " . "$KADM5_PRINCIPAL\n$commands" ; } diff -r d74e15a27d7a t/30-addprinc.t --- a/t/30-addprinc.t Mon Oct 15 21:08:05 2012 -0700 +++ b/t/30-addprinc.t Mon Jan 28 09:30:55 2013 -0800 @@ -31,7 +31,7 @@ use strict; use Test; -BEGIN { plan test => 20 } +BEGIN { plan test => 22 } use Authen::Krb5; use Authen::Krb5::Admin qw(:constants); @@ -50,6 +50,14 @@ my $ap = Authen::Krb5::Admin::Principal->new; ok $ap; +my @args = $ap->db_args('derp'); +ok !@args; + +@args = $ap->db_args; +#warn $_ for unpack 'C*', $args[0]; +#warn $args[0]; +ok $args[0] eq "derp"; + $ap->attributes(KRB5_KDB_DISALLOW_ALL_TIX | KRB5_KDB_DISALLOW_TGT_BASED); ok $ap->attributes, KRB5_KDB_DISALLOW_ALL_TIX | KRB5_KDB_DISALLOW_TGT_BASED; ok $ap->mask & KADM5_ATTRIBUTES; @@ -82,5 +90,6 @@ ok $ap->pw_expiration, 1021908826; ok $ap->mask & KADM5_PW_EXPIRATION; -ok $handle->create_principal($ap, join '', map { chr rand(255) + 1 } 1..256) +# utf8 gets ya +ok $handle->create_principal($ap, join '', map { chr(rand(127) + 1) } 1..256) or warn Authen::Krb5::Admin::error;
Subject: read-creds.pl
Download read-creds.pl
text/x-perl 9.8k
#!/usr/bin/perl use strict; use warnings FATAL => 'all'; package K5LDAP::Admin; use Moose; #use MooseX::Attribute::Dependent; use Moose::Util::TypeConstraints; use namespace::autoclean; use DateTime; use Authen::Krb5; use Authen::Krb5::Admin qw(KADM5_TL_DATA); use Authen::SASL; use Net::LDAP; use Unicode::Transliterate; has _context => ( is => 'ro', isa => 'Authen::Krb5::Context', default => sub { # lol i just checked the code and this just initializes a # global. hope you don't have to run this in threads! my $x = eval { Authen::Krb5::init_context }; # XXX cargo cult: this is almost certainly a no-op and i'm # merely assuming that it has to be run after init_context. Authen::Krb5::init_ets; # now return it, but not sure why. now that i look at the xs # code, it doesn't give you an object or anything. $x; }, ); # XXX maybe it makes more sense for the constructor to provide an # explicit principal and then build off that, rather than start with # the credential cache from the environment? has cc => ( is => 'ro', isa => 'Authen::Krb5::Ccache', # lazy => 0, default => sub { Authen::Krb5::cc_default }, ); has admin => ( is => 'ro', isa => 'Authen::Krb5::Admin', # dependency => All['cc'], lazy => 1, default => sub { my $self = shift; # $self->_get_kadmin_ticket; my $p = $self->cc->get_principal; my $ps = sprintf '%s@%s', join('/', $p->data), $p->realm; my $a = Authen::Krb5::Admin->init_with_creds($ps, $self->cc) or die Authen::Krb5::Admin::error; $a; }, ); # this is a little confusing because the GSSAPI LDAP connection has # nothing to do with the kerberos munging i'm doing in here. has sasl => ( is => 'ro', isa => 'Authen::SASL', default => sub { Authen::SASL->new(mechanism => 'GSSAPI') }, ); class_type 'LDAPConnection', { class => 'Net::LDAP' }; coerce 'LDAPConnection', from 'Str', via { Net::LDAP->new(shift) }; has ldap => ( is => 'ro', isa => 'LDAPConnection', required => 1, coerce => 1, ); sub _get_kadmin_ticket { my $self = shift; my $cc = $self->cc; my $me = $cc->get_principal; my $now = DateTime->now; my $cursor = $cc->start_seq_get; my $refresh = 1; while (my $cred = $cc->next_cred($cursor)) { # only helps if the ticket isn't expired my $end = DateTime->from_epoch(epoch => $cred->endtime); next unless $end > $now; my $s = Authen::Krb5::parse_name($cred->server); next unless defined $s->realm and $s->realm eq $me->realm; # yoda condition! $refresh = 0 if 'kadmin/admin' eq join '/', $s->data; } $cc->end_seq_get($cursor); # note that this only works if you clear the DISALLOW_TGT_BASED # flag on the kadmin/admin principal. if ($refresh) { warn 'refreshing'; my $ac = Authen::Krb5::AuthContext->new; Authen::Krb5::mk_req($ac, Authen::Krb5::AP_OPTS_MUTUAL_REQUIRED, 'kadmin', 'admin', '', $cc) or die Authen::Krb5::error; } } sub _prune_busted_kadmin { my $self = shift; my $cc = $self->cc; if (my $cursor = $cc->start_seq_get) { while (my $cred = $cc->next_cred($cursor)) { my $s = Authen::Krb5::parse_name($cred->server); # next unless defined $s->realm and $s->realm eq $me->realm; } $cc->end_seq_get($cursor); } } sub _new_ctx { my $self = shift; my $cc = Authen::Krb5::cc_default; my $p = $cc->get_principal; my $ps = sprintf '%s@%s', join('/', $p->data), $p->realm; my $a = Authen::Krb5::Admin->init_with_creds($ps, $self->cc) or die Authen::Krb5::Admin::error; $a; } sub add_principal { my ($self, $name, $pass, $dn) = @_; my $p = Authen::Krb5::parse_name($name); my $ap = Authen::Krb5::Admin::Principal->new; $ap->principal($p); if ($dn) { $ap->db_args(qq{dn=$dn}); warn $dn; # tail data will be ignored otherwise $ap->mask($ap->mask | KADM5_TL_DATA); } my $admin = $self->_new_ctx; unless ($admin->get_principal($p)) { $admin->create_principal($ap, $pass) or die Authen::Krb5::Admin::error; #$self->admin->create_principal($ap, $pass) # or die Authen::Krb5::Admin::error; } } sub BUILD { my $self = shift; $self->_get_kadmin_ticket; # now connect to the ldap database $self->ldap->bind(sasl => $self->sasl); } sub DEMOLISH { # same deal eval { Authen::Krb5::free_context }; } __PACKAGE__->meta->make_immutable; no Moose; 1; # theoretically we can cut this up package K5LDAP::Admin::Loader; use Moose; use namespace::autoclean; use Moose::Util::TypeConstraints; extends 'K5LDAP::Admin'; use Net::LDAP::Entry; use Text::CSV; has base => ( is => 'ro', isa => 'Str', required => 1, ); has rdn => ( is => 'ro', isa => 'Str', required => 1, ); has map => ( is => 'ro', isa => 'HashRef', required => 1, ); has delimiter => ( is => 'ro', isa => 'RegexpRef', required => 1, ); has member_types => ( is => 'ro', isa => 'HashRef', lazy => 1, default => sub { {} }, ); has employers => ( is => 'ro', isa => 'HashRef', lazy => 1, default => sub { {} }, ); has affiliations => ( is => 'ro', isa => 'HashRef', lazy => 1, default => sub { {} }, ); class_type 'CSVReader', { class => 'Text::CSV' }; coerce 'CSVReader', from 'HashRef', via { Text::CSV->new(shift) }; has csv => ( is => 'ro', isa => 'CSVReader', coerce => 1, default => sub { Text::CSV->new({ binary => 1 }); }, ); subtype 'PrimaryKey', as 'ArrayRef[Str]'; coerce 'PrimaryKey', from 'Str', via { [shift] }; has pk => ( is => 'ro', isa => 'PrimaryKey', coerce => 1, required => 1, ); has translit => ( is => 'ro', isa => 'Unicode::Transliterate', lazy => 1, default => sub { Unicode::Transliterate->new(from => 'Latin', to => 'ASCII') }, ); sub _nonempty ($) { my $x = shift; defined $x and $x !~ /^\s*$/; } sub run { my ($self, @files) = @_; for my $fn (@files) { open my $fh, '<:utf8', $fn or die $!; my $cols = $self->csv->getline($fh); $self->csv->column_names(@$cols); my %record; while (my $row = $self->csv->getline_hr($fh)) { next unless keys %$row; if (@{$self->pk} == grep { _nonempty $_ } @{$row}{@{$self->pk}}) { # this will contain stuff if we're more than one # record in. $self->add_user(\%record) if keys %record; # only add nonempty values %record = map { $_ => $row->{$_} } grep { _nonempty $row->{$_} } keys %$row; } else { #warn Data::Dumper::Dumper($row); # turn into arrayref for my $k (grep { _nonempty $row->{$_} } keys %$row) { if (defined $record{$k}) { $record{$k} = [$record{$k}] unless ref $record{$k} eq 'ARRAY'; } else { $record{$k} = []; } push @{$record{$k}}, $row->{$k}; } } } # add final one $self->add_user(\%record); } } sub add_user { my ($self, $rec) = @_; my $rdnf = $self->map->{$self->rdn}; $rec->{$rdnf} = $self->translit->process($rec->{$rdnf}); $rec->{$rdnf} =~ s/[^0-9A-Za-z.-]//g; eval { printf "%s %s\n", $rec->{UID}, $rec->{$rdnf} }; if ($@) { require Data::Dumper; warn Data::Dumper::Dumper($rec); } # create a DN my $dn = sprintf '%s=%s,%s', $self->rdn, $rec->{$rdnf}, $self->base; #warn $dn; my %map = reverse %{$self->map}; my %attrs = map { $map{$_} => $rec->{$_} } grep { defined $rec->{$_} } keys %map; # optionally create predicate groups # optionally create # create an LDAP object my $entry = Net::LDAP::Entry->new ($dn, objectClass => [qw(top OpenLDAPperson posixAccount)], homeDirectory => '/dev/null', gidNumber => 100, %attrs); #$entry->dump(\*STDERR); # shove the ldap object in the servarr my $result = $entry->update($self->ldap); $result->code && warn "failed to add entry: ", $result->error ; $self->add_principal($rec->{$rdnf}, $rec->{Password}, $dn); } __PACKAGE__->meta->make_immutable; no Moose; 1; # --------8<------ package main; # remember the service ticket maps the host to the realm, so you can't # connect to localhost. my $loader = K5LDAP::Admin::Loader->new( ldap => 'deuce', base => 'ou=IAI,dc=privatealpha,dc=com', rdn => 'uid', delimiter => qr/\s*;\s*/, pk => 'UID', map => { # uid => sub { sprintf('member-%05d', shift->{UID}) }, uid => 'Generated Username', uidNumber => 'UID', cn => 'Contact Name', sn => 'Last Name', gn => 'First Name', o => 'Organization 1', title => 'Title', mail => 'Email', street => 'Street Address', l => 'City', st => 'State (US, Canada & Australia)', postalCode => 'Zip', }, ); $loader->run(@ARGV); # predicate groups: # list me in directory # active volunteer # list me in geolocate # subscribe to member list # subscribe to newsletter # groups: # "Member Group" # "IAI Initiative Activity" # "IAI Volunteer Roles"


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.