[Bps-public-commit] RT-Extension-LDAPImport branch, master, updated. 0.20_01-18-g63b87c5
Kevin Falcone
falcone at bestpractical.com
Wed Jul 28 14:07:11 EDT 2010
The branch, master has been updated
via 63b87c54fbf1a4b13f954edac21e1d4ffdec53da (commit)
via e2f5d66bde52e72b1658e4975cf3891d1946702a (commit)
via 66d2e5f85ceb1b3ea14ace89b3c4a2af08b1e138 (commit)
via 04d176f5b751985391635264310a41983a22a0c5 (commit)
via 9449b6437e34d6dcbd472b9ec1aa221291351b9c (commit)
via 67b0dadea0d83e2ba8cd4a9509f8f23a8a3d3cb1 (commit)
via d713ea64ee78835a9bd3a9e1084825fbc88673a4 (commit)
via 606d3b07486ea017446456b5d11226b655ce7a91 (commit)
via 7a5f19e44d6d243f564667ea16280e6db2f1464e (commit)
via 577f56c133cf5ebb9eb7bd47ace91fe201d3d5ea (commit)
via e10218935f3ac0157ccd826c9e800a0f85686c85 (commit)
via 89cd948f5e80382ab3c78e267f9d4ddf7ef2b771 (commit)
via 942a30d5322e2c28c08d6a8650de49004934d838 (commit)
via be656f54434f8c6acb5d2a825e917c619bed1f12 (commit)
via 8922f0527158010760ea0c965ac0dc7d1fb6dd8b (commit)
via 757989de984742cc797ef319dd99fb2d6b41467a (commit)
via 93e9f9cc112c2052a5499c211af545c94e616112 (commit)
via b84ae788eeeb8d894ca16c4fc62ba3e329c85ce9 (commit)
from ce9afc8ebce993d0718ceebe03192351e2285973 (commit)
Summary of changes:
.gitignore | 2 +
META.yml | 3 +
Makefile.PL | 15 +
bin/rtldapimport.in | 4 +
inc/Module/AutoInstall.pm | 820 ++++++++++++++++++++++++++++++
inc/Module/Install/AutoInstall.pm | 82 +++
inc/Module/Install/Include.pm | 34 ++
lib/RT/Extension/LDAPImport.pm | 284 ++++++++++-
t/group-import.t | 110 ++++
t/lib/RT/Extension/LDAPImport/Test.pm.in | 38 ++
t/user-import.t | 67 +++
11 files changed, 1439 insertions(+), 20 deletions(-)
create mode 100644 inc/Module/AutoInstall.pm
create mode 100644 inc/Module/Install/AutoInstall.pm
create mode 100644 inc/Module/Install/Include.pm
create mode 100644 t/group-import.t
create mode 100644 t/lib/RT/Extension/LDAPImport/Test.pm.in
create mode 100644 t/user-import.t
- Log -----------------------------------------------------------------
commit b84ae788eeeb8d894ca16c4fc62ba3e329c85ce9
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Sat Jul 24 11:10:02 2010 -0700
use autoinstall
diff --git a/inc/Module/AutoInstall.pm b/inc/Module/AutoInstall.pm
new file mode 100644
index 0000000..60b90ea
--- /dev/null
+++ b/inc/Module/AutoInstall.pm
@@ -0,0 +1,820 @@
+#line 1
+package Module::AutoInstall;
+
+use strict;
+use Cwd ();
+use ExtUtils::MakeMaker ();
+
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '1.03';
+}
+
+# special map on pre-defined feature sets
+my %FeatureMap = (
+ '' => 'Core Features', # XXX: deprecated
+ '-core' => 'Core Features',
+);
+
+# various lexical flags
+my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS );
+my (
+ $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps
+);
+my ( $PostambleActions, $PostambleUsed );
+
+# See if it's a testing or non-interactive session
+_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN );
+_init();
+
+sub _accept_default {
+ $AcceptDefault = shift;
+}
+
+sub missing_modules {
+ return @Missing;
+}
+
+sub do_install {
+ __PACKAGE__->install(
+ [
+ $Config
+ ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+ : ()
+ ],
+ @Missing,
+ );
+}
+
+# initialize various flags, and/or perform install
+sub _init {
+ foreach my $arg (
+ @ARGV,
+ split(
+ /[\s\t]+/,
+ $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || ''
+ )
+ )
+ {
+ if ( $arg =~ /^--config=(.*)$/ ) {
+ $Config = [ split( ',', $1 ) ];
+ }
+ elsif ( $arg =~ /^--installdeps=(.*)$/ ) {
+ __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
+ exit 0;
+ }
+ elsif ( $arg =~ /^--default(?:deps)?$/ ) {
+ $AcceptDefault = 1;
+ }
+ elsif ( $arg =~ /^--check(?:deps)?$/ ) {
+ $CheckOnly = 1;
+ }
+ elsif ( $arg =~ /^--skip(?:deps)?$/ ) {
+ $SkipInstall = 1;
+ }
+ elsif ( $arg =~ /^--test(?:only)?$/ ) {
+ $TestOnly = 1;
+ }
+ elsif ( $arg =~ /^--all(?:deps)?$/ ) {
+ $AllDeps = 1;
+ }
+ }
+}
+
+# overrides MakeMaker's prompt() to automatically accept the default choice
+sub _prompt {
+ goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;
+
+ my ( $prompt, $default ) = @_;
+ my $y = ( $default =~ /^[Yy]/ );
+
+ print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] ';
+ print "$default\n";
+ return $default;
+}
+
+# the workhorse
+sub import {
+ my $class = shift;
+ my @args = @_ or return;
+ my $core_all;
+
+ print "*** $class version " . $class->VERSION . "\n";
+ print "*** Checking for Perl dependencies...\n";
+
+ my $cwd = Cwd::cwd();
+
+ $Config = [];
+
+ my $maxlen = length(
+ (
+ sort { length($b) <=> length($a) }
+ grep { /^[^\-]/ }
+ map {
+ ref($_)
+ ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
+ : ''
+ }
+ map { +{@args}->{$_} }
+ grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
+ )[0]
+ );
+
+ # We want to know if we're under CPAN early to avoid prompting, but
+ # if we aren't going to try and install anything anyway then skip the
+ # check entirely since we don't want to have to load (and configure)
+ # an old CPAN just for a cosmetic message
+
+ $UnderCPAN = _check_lock(1) unless $SkipInstall;
+
+ while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
+ my ( @required, @tests, @skiptests );
+ my $default = 1;
+ my $conflict = 0;
+
+ if ( $feature =~ m/^-(\w+)$/ ) {
+ my $option = lc($1);
+
+ # check for a newer version of myself
+ _update_to( $modules, @_ ) and return if $option eq 'version';
+
+ # sets CPAN configuration options
+ $Config = $modules if $option eq 'config';
+
+ # promote every features to core status
+ $core_all = ( $modules =~ /^all$/i ) and next
+ if $option eq 'core';
+
+ next unless $option eq 'core';
+ }
+
+ print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n";
+
+ $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
+
+ unshift @$modules, -default => &{ shift(@$modules) }
+ if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability
+
+ while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
+ if ( $mod =~ m/^-(\w+)$/ ) {
+ my $option = lc($1);
+
+ $default = $arg if ( $option eq 'default' );
+ $conflict = $arg if ( $option eq 'conflict' );
+ @tests = @{$arg} if ( $option eq 'tests' );
+ @skiptests = @{$arg} if ( $option eq 'skiptests' );
+
+ next;
+ }
+
+ printf( "- %-${maxlen}s ...", $mod );
+
+ if ( $arg and $arg =~ /^\D/ ) {
+ unshift @$modules, $arg;
+ $arg = 0;
+ }
+
+ # XXX: check for conflicts and uninstalls(!) them.
+ my $cur = _load($mod);
+ if (_version_cmp ($cur, $arg) >= 0)
+ {
+ print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
+ push @Existing, $mod => $arg;
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+ else {
+ if (not defined $cur) # indeed missing
+ {
+ print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
+ }
+ else
+ {
+ # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above
+ print "too old. ($cur < $arg)\n";
+ }
+
+ push @required, $mod => $arg;
+ }
+ }
+
+ next unless @required;
+
+ my $mandatory = ( $feature eq '-core' or $core_all );
+
+ if (
+ !$SkipInstall
+ and (
+ $CheckOnly
+ or ($mandatory and $UnderCPAN)
+ or $AllDeps
+ or _prompt(
+ qq{==> Auto-install the }
+ . ( @required / 2 )
+ . ( $mandatory ? ' mandatory' : ' optional' )
+ . qq{ module(s) from CPAN?},
+ $default ? 'y' : 'n',
+ ) =~ /^[Yy]/
+ )
+ )
+ {
+ push( @Missing, @required );
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+
+ elsif ( !$SkipInstall
+ and $default
+ and $mandatory
+ and
+ _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
+ =~ /^[Nn]/ )
+ {
+ push( @Missing, @required );
+ $DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
+ }
+
+ else {
+ $DisabledTests{$_} = 1 for map { glob($_) } @tests;
+ }
+ }
+
+ if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) {
+ require Config;
+ print
+"*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n";
+
+ # make an educated guess of whether we'll need root permission.
+ print " (You may need to do that as the 'root' user.)\n"
+ if eval '$>';
+ }
+ print "*** $class configuration finished.\n";
+
+ chdir $cwd;
+
+ # import to main::
+ no strict 'refs';
+ *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
+
+ return (@Existing, @Missing);
+}
+
+sub _running_under {
+ my $thing = shift;
+ print <<"END_MESSAGE";
+*** Since we're running under ${thing}, I'll just let it take care
+ of the dependency's installation later.
+END_MESSAGE
+ return 1;
+}
+
+# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
+# if we are, then we simply let it taking care of our dependencies
+sub _check_lock {
+ return unless @Missing or @_;
+
+ my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
+
+ if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
+ return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS');
+ }
+
+ require CPAN;
+
+ if ($CPAN::VERSION > '1.89') {
+ if ($cpan_env) {
+ return _running_under('CPAN');
+ }
+ return; # CPAN.pm new enough, don't need to check further
+ }
+
+ # last ditch attempt, this -will- configure CPAN, very sorry
+
+ _load_cpan(1); # force initialize even though it's already loaded
+
+ # Find the CPAN lock-file
+ my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" );
+ return unless -f $lock;
+
+ # Check the lock
+ local *LOCK;
+ return unless open(LOCK, $lock);
+
+ if (
+ ( $^O eq 'MSWin32' ? _under_cpan() : <LOCK> == getppid() )
+ and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore'
+ ) {
+ print <<'END_MESSAGE';
+
+*** Since we're running under CPAN, I'll just let it take care
+ of the dependency's installation later.
+END_MESSAGE
+ return 1;
+ }
+
+ close LOCK;
+ return;
+}
+
+sub install {
+ my $class = shift;
+
+ my $i; # used below to strip leading '-' from config keys
+ my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
+
+ my ( @modules, @installed );
+ while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
+
+ # grep out those already installed
+ if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
+ push @installed, $pkg;
+ }
+ else {
+ push @modules, $pkg, $ver;
+ }
+ }
+
+ return @installed unless @modules; # nothing to do
+ return @installed if _check_lock(); # defer to the CPAN shell
+
+ print "*** Installing dependencies...\n";
+
+ return unless _connected_to('cpan.org');
+
+ my %args = @config;
+ my %failed;
+ local *FAILED;
+ if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) {
+ while (<FAILED>) { chomp; $failed{$_}++ }
+ close FAILED;
+
+ my @newmod;
+ while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) {
+ push @newmod, ( $k => $v ) unless $failed{$k};
+ }
+ @modules = @newmod;
+ }
+
+ if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) {
+ _install_cpanplus( \@modules, \@config );
+ } else {
+ _install_cpan( \@modules, \@config );
+ }
+
+ print "*** $class installation finished.\n";
+
+ # see if we have successfully installed them
+ while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+ if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
+ push @installed, $pkg;
+ }
+ elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
+ print FAILED "$pkg\n";
+ }
+ }
+
+ close FAILED if $args{do_once};
+
+ return @installed;
+}
+
+sub _install_cpanplus {
+ my @modules = @{ +shift };
+ my @config = _cpanplus_config( @{ +shift } );
+ my $installed = 0;
+
+ require CPANPLUS::Backend;
+ my $cp = CPANPLUS::Backend->new;
+ my $conf = $cp->configure_object;
+
+ return unless $conf->can('conf') # 0.05x+ with "sudo" support
+ or _can_write($conf->_get_build('base')); # 0.04x
+
+ # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
+ my $makeflags = $conf->get_conf('makeflags') || '';
+ if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) {
+ # 0.03+ uses a hashref here
+ $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST};
+
+ } else {
+ # 0.02 and below uses a scalar
+ $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
+ if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
+
+ }
+ $conf->set_conf( makeflags => $makeflags );
+ $conf->set_conf( prereqs => 1 );
+
+
+
+ while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) {
+ $conf->set_conf( $key, $val );
+ }
+
+ my $modtree = $cp->module_tree;
+ while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+ print "*** Installing $pkg...\n";
+
+ MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
+
+ my $success;
+ my $obj = $modtree->{$pkg};
+
+ if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) {
+ my $pathname = $pkg;
+ $pathname =~ s/::/\\W/;
+
+ foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
+ delete $INC{$inc};
+ }
+
+ my $rv = $cp->install( modules => [ $obj->{module} ] );
+
+ if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) {
+ print "*** $pkg successfully installed.\n";
+ $success = 1;
+ } else {
+ print "*** $pkg installation cancelled.\n";
+ $success = 0;
+ }
+
+ $installed += $success;
+ } else {
+ print << ".";
+*** Could not find a version $ver or above for $pkg; skipping.
+.
+ }
+
+ MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
+ }
+
+ return $installed;
+}
+
+sub _cpanplus_config {
+ my @config = ();
+ while ( @_ ) {
+ my ($key, $value) = (shift(), shift());
+ if ( $key eq 'prerequisites_policy' ) {
+ if ( $value eq 'follow' ) {
+ $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL();
+ } elsif ( $value eq 'ask' ) {
+ $value = CPANPLUS::Internals::Constants::PREREQ_ASK();
+ } elsif ( $value eq 'ignore' ) {
+ $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE();
+ } else {
+ die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n";
+ }
+ } else {
+ die "*** Cannot convert option $key to CPANPLUS version.\n";
+ }
+ }
+ return @config;
+}
+
+sub _install_cpan {
+ my @modules = @{ +shift };
+ my @config = @{ +shift };
+ my $installed = 0;
+ my %args;
+
+ _load_cpan();
+ require Config;
+
+ if (CPAN->VERSION < 1.80) {
+ # no "sudo" support, probe for writableness
+ return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) )
+ and _can_write( $Config::Config{sitelib} );
+ }
+
+ # if we're root, set UNINST=1 to avoid trouble unless user asked for it.
+ my $makeflags = $CPAN::Config->{make_install_arg} || '';
+ $CPAN::Config->{make_install_arg} =
+ join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
+ if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
+
+ # don't show start-up info
+ $CPAN::Config->{inhibit_startup_message} = 1;
+
+ # set additional options
+ while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
+ ( $args{$opt} = $arg, next )
+ if $opt =~ /^force$/; # pseudo-option
+ $CPAN::Config->{$opt} = $arg;
+ }
+
+ local $CPAN::Config->{prerequisites_policy} = 'follow';
+
+ while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
+ MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
+
+ print "*** Installing $pkg...\n";
+
+ my $obj = CPAN::Shell->expand( Module => $pkg );
+ my $success = 0;
+
+ if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) {
+ my $pathname = $pkg;
+ $pathname =~ s/::/\\W/;
+
+ foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
+ delete $INC{$inc};
+ }
+
+ my $rv = $args{force} ? CPAN::Shell->force( install => $pkg )
+ : CPAN::Shell->install($pkg);
+ $rv ||= eval {
+ $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, )
+ ->{install}
+ if $CPAN::META;
+ };
+
+ if ( $rv eq 'YES' ) {
+ print "*** $pkg successfully installed.\n";
+ $success = 1;
+ }
+ else {
+ print "*** $pkg installation failed.\n";
+ $success = 0;
+ }
+
+ $installed += $success;
+ }
+ else {
+ print << ".";
+*** Could not find a version $ver or above for $pkg; skipping.
+.
+ }
+
+ MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
+ }
+
+ return $installed;
+}
+
+sub _has_cpanplus {
+ return (
+ $HasCPANPLUS = (
+ $INC{'CPANPLUS/Config.pm'}
+ or _load('CPANPLUS::Shell::Default')
+ )
+ );
+}
+
+# make guesses on whether we're under the CPAN installation directory
+sub _under_cpan {
+ require Cwd;
+ require File::Spec;
+
+ my $cwd = File::Spec->canonpath( Cwd::cwd() );
+ my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
+
+ return ( index( $cwd, $cpan ) > -1 );
+}
+
+sub _update_to {
+ my $class = __PACKAGE__;
+ my $ver = shift;
+
+ return
+ if _version_cmp( _load($class), $ver ) >= 0; # no need to upgrade
+
+ if (
+ _prompt( "==> A newer version of $class ($ver) is required. Install?",
+ 'y' ) =~ /^[Nn]/
+ )
+ {
+ die "*** Please install $class $ver manually.\n";
+ }
+
+ print << ".";
+*** Trying to fetch it from CPAN...
+.
+
+ # install ourselves
+ _load($class) and return $class->import(@_)
+ if $class->install( [], $class, $ver );
+
+ print << '.'; exit 1;
+
+*** Cannot bootstrap myself. :-( Installation terminated.
+.
+}
+
+# check if we're connected to some host, using inet_aton
+sub _connected_to {
+ my $site = shift;
+
+ return (
+ ( _load('Socket') and Socket::inet_aton($site) ) or _prompt(
+ qq(
+*** Your host cannot resolve the domain name '$site', which
+ probably means the Internet connections are unavailable.
+==> Should we try to install the required module(s) anyway?), 'n'
+ ) =~ /^[Yy]/
+ );
+}
+
+# check if a directory is writable; may create it on demand
+sub _can_write {
+ my $path = shift;
+ mkdir( $path, 0755 ) unless -e $path;
+
+ return 1 if -w $path;
+
+ print << ".";
+*** You are not allowed to write to the directory '$path';
+ the installation may fail due to insufficient permissions.
+.
+
+ if (
+ eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(
+ qq(
+==> Should we try to re-execute the autoinstall process with 'sudo'?),
+ ((-t STDIN) ? 'y' : 'n')
+ ) =~ /^[Yy]/
+ )
+ {
+
+ # try to bootstrap ourselves from sudo
+ print << ".";
+*** Trying to re-execute the autoinstall process with 'sudo'...
+.
+ my $missing = join( ',', @Missing );
+ my $config = join( ',',
+ UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+ if $Config;
+
+ return
+ unless system( 'sudo', $^X, $0, "--config=$config",
+ "--installdeps=$missing" );
+
+ print << ".";
+*** The 'sudo' command exited with error! Resuming...
+.
+ }
+
+ return _prompt(
+ qq(
+==> Should we try to install the required module(s) anyway?), 'n'
+ ) =~ /^[Yy]/;
+}
+
+# load a module and return the version it reports
+sub _load {
+ my $mod = pop; # class/instance doesn't matter
+ my $file = $mod;
+
+ $file =~ s|::|/|g;
+ $file .= '.pm';
+
+ local $@;
+ return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
+}
+
+# Load CPAN.pm and it's configuration
+sub _load_cpan {
+ return if $CPAN::VERSION and $CPAN::Config and not @_;
+ require CPAN;
+
+ # CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to
+ # CPAN::HandleConfig->load. CPAN reports that the redirection
+ # is deprecated in a warning printed at the user.
+
+ # CPAN-1.81 expects CPAN::HandleConfig->load, does not have
+ # $CPAN::HandleConfig::VERSION but cannot handle
+ # CPAN::Config->load
+
+ # Which "versions expect CPAN::Config->load?
+
+ if ( $CPAN::HandleConfig::VERSION
+ || CPAN::HandleConfig->can('load')
+ ) {
+ # Newer versions of CPAN have a HandleConfig module
+ CPAN::HandleConfig->load;
+ } else {
+ # Older versions had the load method in Config directly
+ CPAN::Config->load;
+ }
+}
+
+# compare two versions, either use Sort::Versions or plain comparison
+# return values same as <=>
+sub _version_cmp {
+ my ( $cur, $min ) = @_;
+ return -1 unless defined $cur; # if 0 keep comparing
+ return 1 unless $min;
+
+ $cur =~ s/\s+$//;
+
+ # check for version numbers that are not in decimal format
+ if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) {
+ if ( ( $version::VERSION or defined( _load('version') )) and
+ version->can('new')
+ ) {
+
+ # use version.pm if it is installed.
+ return version->new($cur) <=> version->new($min);
+ }
+ elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
+ {
+
+ # use Sort::Versions as the sorting algorithm for a.b.c versions
+ return Sort::Versions::versioncmp( $cur, $min );
+ }
+
+ warn "Cannot reliably compare non-decimal formatted versions.\n"
+ . "Please install version.pm or Sort::Versions.\n";
+ }
+
+ # plain comparison
+ local $^W = 0; # shuts off 'not numeric' bugs
+ return $cur <=> $min;
+}
+
+# nothing; this usage is deprecated.
+sub main::PREREQ_PM { return {}; }
+
+sub _make_args {
+ my %args = @_;
+
+ $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing }
+ if $UnderCPAN or $TestOnly;
+
+ if ( $args{EXE_FILES} and -e 'MANIFEST' ) {
+ require ExtUtils::Manifest;
+ my $manifest = ExtUtils::Manifest::maniread('MANIFEST');
+
+ $args{EXE_FILES} =
+ [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ];
+ }
+
+ $args{test}{TESTS} ||= 't/*.t';
+ $args{test}{TESTS} = join( ' ',
+ grep { !exists( $DisabledTests{$_} ) }
+ map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
+
+ my $missing = join( ',', @Missing );
+ my $config =
+ join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
+ if $Config;
+
+ $PostambleActions = (
+ ($missing and not $UnderCPAN)
+ ? "\$(PERL) $0 --config=$config --installdeps=$missing"
+ : "\$(NOECHO) \$(NOOP)"
+ );
+
+ return %args;
+}
+
+# a wrapper to ExtUtils::MakeMaker::WriteMakefile
+sub Write {
+ require Carp;
+ Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
+
+ if ($CheckOnly) {
+ print << ".";
+*** Makefile not written in check-only mode.
+.
+ return;
+ }
+
+ my %args = _make_args(@_);
+
+ no strict 'refs';
+
+ $PostambleUsed = 0;
+ local *MY::postamble = \&postamble unless defined &MY::postamble;
+ ExtUtils::MakeMaker::WriteMakefile(%args);
+
+ print << "." unless $PostambleUsed;
+*** WARNING: Makefile written with customized MY::postamble() without
+ including contents from Module::AutoInstall::postamble() --
+ auto installation features disabled. Please contact the author.
+.
+
+ return 1;
+}
+
+sub postamble {
+ $PostambleUsed = 1;
+
+ return <<"END_MAKE";
+
+config :: installdeps
+\t\$(NOECHO) \$(NOOP)
+
+checkdeps ::
+\t\$(PERL) $0 --checkdeps
+
+installdeps ::
+\t$PostambleActions
+
+END_MAKE
+
+}
+
+1;
+
+__END__
+
+#line 1071
diff --git a/inc/Module/Install/AutoInstall.pm b/inc/Module/Install/AutoInstall.pm
new file mode 100644
index 0000000..f1f5356
--- /dev/null
+++ b/inc/Module/Install/AutoInstall.pm
@@ -0,0 +1,82 @@
+#line 1
+package Module::Install::AutoInstall;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.00';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub AutoInstall { $_[0] }
+
+sub run {
+ my $self = shift;
+ $self->auto_install_now(@_);
+}
+
+sub write {
+ my $self = shift;
+ $self->auto_install(@_);
+}
+
+sub auto_install {
+ my $self = shift;
+ return if $self->{done}++;
+
+ # Flatten array of arrays into a single array
+ my @core = map @$_, map @$_, grep ref,
+ $self->build_requires, $self->requires;
+
+ my @config = @_;
+
+ # We'll need Module::AutoInstall
+ $self->include('Module::AutoInstall');
+ require Module::AutoInstall;
+
+ my @features_require = Module::AutoInstall->import(
+ (@config ? (-config => \@config) : ()),
+ (@core ? (-core => \@core) : ()),
+ $self->features,
+ );
+
+ my %seen;
+ my @requires = map @$_, map @$_, grep ref, $self->requires;
+ while (my ($mod, $ver) = splice(@requires, 0, 2)) {
+ $seen{$mod}{$ver}++;
+ }
+ my @build_requires = map @$_, map @$_, grep ref, $self->build_requires;
+ while (my ($mod, $ver) = splice(@build_requires, 0, 2)) {
+ $seen{$mod}{$ver}++;
+ }
+ my @configure_requires = map @$_, map @$_, grep ref, $self->configure_requires;
+ while (my ($mod, $ver) = splice(@configure_requires, 0, 2)) {
+ $seen{$mod}{$ver}++;
+ }
+
+ my @deduped;
+ while (my ($mod, $ver) = splice(@features_require, 0, 2)) {
+ push @deduped, $mod => $ver unless $seen{$mod}{$ver}++;
+ }
+
+ $self->requires(@deduped);
+
+ $self->makemaker_args( Module::AutoInstall::_make_args() );
+
+ my $class = ref($self);
+ $self->postamble(
+ "# --- $class section:\n" .
+ Module::AutoInstall::postamble()
+ );
+}
+
+sub auto_install_now {
+ my $self = shift;
+ $self->auto_install(@_);
+ Module::AutoInstall::do_install();
+}
+
+1;
diff --git a/inc/Module/Install/Include.pm b/inc/Module/Install/Include.pm
new file mode 100644
index 0000000..a28cd4c
--- /dev/null
+++ b/inc/Module/Install/Include.pm
@@ -0,0 +1,34 @@
+#line 1
+package Module::Install::Include;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.00';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub include {
+ shift()->admin->include(@_);
+}
+
+sub include_deps {
+ shift()->admin->include_deps(@_);
+}
+
+sub auto_include {
+ shift()->admin->auto_include(@_);
+}
+
+sub auto_include_deps {
+ shift()->admin->auto_include_deps(@_);
+}
+
+sub auto_include_dependent_dists {
+ shift()->admin->auto_include_dependent_dists(@_);
+}
+
+1;
commit 93e9f9cc112c2052a5499c211af545c94e616112
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Sat Jul 24 11:13:54 2010 -0700
Refactoring for upcoming groups work
diff --git a/lib/RT/Extension/LDAPImport.pm b/lib/RT/Extension/LDAPImport.pm
index b31f6e1..082c8a8 100644
--- a/lib/RT/Extension/LDAPImport.pm
+++ b/lib/RT/Extension/LDAPImport.pm
@@ -67,31 +67,43 @@ sub connect_ldap {
}
-=head2 run_search
+=head2 run_user_search
-Executes a search using the RT::LDAPFilter and RT::LDAPBase
-options.
+Set up the appropriate arguments for a listing of users
-LDAPBase is the DN to look under
-LDAPFilter is how you want to restrict the users coming back
+=cut
+
+sub run_user_search {
+ my $self = shift;
+ $self->_run_search(
+ base => $RT::LDAPBase,
+ filter => $RT::LDAPFilter
+ );
+
+}
+
+=head2 _run_search
+
+Executes a search using the provided base and filter
Will connect to LDAP server using connect_ldap
=cut
-sub run_search {
+sub _run_search {
my $self = shift;
my $ldap = $self->_ldap||$self->connect_ldap;
+ my %args = @_;
unless ($ldap) {
$self->_error("fetching an LDAP connection failed");
return;
}
- $self->_debug("searching with base => '$RT::LDAPBase' filter => '$RT::LDAPFilter'");
+ $self->_debug("searching with base => '$args{base}' filter => '$args{filter}'");
- my $result = $ldap->search( base => $RT::LDAPBase,
- filter => $RT::LDAPFilter );
+ my $result = $ldap->search( base => $args{base},
+ filter => $args{filter} );
if ($result->code) {
$self->_error("LDAP search failed " . $result->error);
@@ -139,7 +151,7 @@ sub import_users {
my $self = shift;
my %args = @_;
- my $results = $self->run_search;
+ my $results = $self->run_user_search;
unless ( $results && $results->count ) {
$self->_debug("No results found, no import");
$self->disconnect_ldap;
commit 757989de984742cc797ef319dd99fb2d6b41467a
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Sat Jul 24 11:15:09 2010 -0700
more documentation of skipping the group adding
diff --git a/lib/RT/Extension/LDAPImport.pm b/lib/RT/Extension/LDAPImport.pm
index 082c8a8..1ed7a7e 100644
--- a/lib/RT/Extension/LDAPImport.pm
+++ b/lib/RT/Extension/LDAPImport.pm
@@ -413,6 +413,7 @@ sub _load_rt_user {
Adds new users to the group specified in the $LDAPGroupName
variable (defaults to 'Imported from LDAP')
+You can avoid this if you set $LDAPSkipAutogeneratedGroup
=cut
commit 8922f0527158010760ea0c965ac0dc7d1fb6dd8b
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Sat Jul 24 11:38:58 2010 -0700
fix pod test
diff --git a/lib/RT/Extension/LDAPImport.pm b/lib/RT/Extension/LDAPImport.pm
index 1ed7a7e..6537273 100644
--- a/lib/RT/Extension/LDAPImport.pm
+++ b/lib/RT/Extension/LDAPImport.pm
@@ -527,6 +527,7 @@ sub add_custom_field_value {
return;
}
+
=head3 disconnect_ldap
Disconnects from the LDAP server
commit be656f54434f8c6acb5d2a825e917c619bed1f12
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Sat Jul 24 11:07:54 2010 -0700
Consider writing tests against a mock LDAP server
diff --git a/META.yml b/META.yml
index 807c999..b22d22f 100644
--- a/META.yml
+++ b/META.yml
@@ -18,9 +18,12 @@ no_index:
directory:
- inc
- t
+recommends:
+ Net::LDAP::Server::Test: 0
requires:
Class::Accessor: 0
Net::LDAP: 0
+ Net::LDAP::Server::Test: 0
RT: 3.6.3
Test::More: 0
resources:
diff --git a/Makefile.PL b/Makefile.PL
index 6bb2942..3dbe422 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -11,6 +11,11 @@ requires('Net::LDAP');
requires('RT' => '3.6.3');
requires('Class::Accessor');
+feature "Proper Testing" =>
+ -default => 0,
+ recommends('Net::LDAP::Server::Test')
+ ;
+
my ($lp) = ($INC{'RT.pm'} =~ /^(.*)[\\\/]/);
my $lib_path = join( ' ', "$RT::LocalPath/lib", $lp );
substitute(
@@ -23,4 +28,5 @@ substitute(
qw(bin/rtldapimport),
);
+&auto_install();
&WriteAll;
diff --git a/t/server.t b/t/server.t
new file mode 100644
index 0000000..ada44d3
--- /dev/null
+++ b/t/server.t
@@ -0,0 +1,5 @@
+use Test::More;
+eval { require Net::LDAP::Server::Test; 1; } or do {
+ plan skip_all => 'Unable to test without Net::Server::LDAP::Test';
+};
+plan tests => 1;
commit 942a30d5322e2c28c08d6a8650de49004934d838
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Sat Jul 24 11:48:35 2010 -0700
Handle the magic of loading us and the RT::Test framework
diff --git a/t/lib/RT/Extension/LDAPImport/Test.pm b/t/lib/RT/Extension/LDAPImport/Test.pm
new file mode 100644
index 0000000..754d48a
--- /dev/null
+++ b/t/lib/RT/Extension/LDAPImport/Test.pm
@@ -0,0 +1,38 @@
+use strict;
+use warnings;
+
+### after: use lib qw(@RT_LIB_PATH@);
+use lib qw(/opt/rt3/local/lib /opt/rt3/lib);
+
+package RT::Extension::LDAPImport::Test;
+
+our @ISA;
+BEGIN {
+ local $@;
+ eval { require RT::Test; 1 } or do {
+ require Test::More;
+ Test::More::BAIL_OUT(
+ "requires 3.8 to run tests. Error:\n$@\n"
+ ."You may need to set PERL5LIB=/path/to/rt/lib"
+ );
+ };
+ push @ISA, 'RT::Test';
+}
+
+sub import {
+ my $class = shift;
+ my %args = @_;
+
+ $args{'requires'} ||= [];
+ if ( $args{'testing'} ) {
+ unshift @{ $args{'requires'} }, 'RT::Extension::LDAPImport';
+ } else {
+ $args{'testing'} = 'RT::Extension::LDAPImport';
+ }
+
+ $class->SUPER::import( %args );
+ require RT::Extension::LDAPImport;
+}
+
+1;
+
commit 89cd948f5e80382ab3c78e267f9d4ddf7ef2b771
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Tue Jul 27 11:52:34 2010 -0400
return success so we can test for it
diff --git a/lib/RT/Extension/LDAPImport.pm b/lib/RT/Extension/LDAPImport.pm
index 6537273..ec52be1 100644
--- a/lib/RT/Extension/LDAPImport.pm
+++ b/lib/RT/Extension/LDAPImport.pm
@@ -173,6 +173,7 @@ sub import_users {
$self->_show_user( user => $user );
}
}
+ return 1;
}
=head2 _import_user
commit e10218935f3ac0157ccd826c9e800a0f85686c85
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Tue Jul 27 11:55:13 2010 -0400
Rename the file and substitute current paths
This avoids needing to install RT::Extension::LDAPImport before
running tests, and makes it easier to have git ignore the file that
contains changes paths
diff --git a/.gitignore b/.gitignore
index 2e169e9..b705beb 100644
--- a/.gitignore
+++ b/.gitignore
@@ -14,3 +14,5 @@ META.yml
*.swp
rtldapimport
*.bak
+t/tmp/
+t/lib/RT/Extension/LDAPImport/Test.pm
diff --git a/Makefile.PL b/Makefile.PL
index 3dbe422..109a6e3 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -27,6 +27,15 @@ substitute(
},
qw(bin/rtldapimport),
);
+substitute(
+ {
+ RT_LIB_PATH => $lib_path,
+ },
+ {
+ sufix => '.in'
+ },
+ q(t/lib/RT/Extension/LDAPImport/Test.pm),
+);
&auto_install();
&WriteAll;
diff --git a/t/lib/RT/Extension/LDAPImport/Test.pm b/t/lib/RT/Extension/LDAPImport/Test.pm.in
similarity index 100%
rename from t/lib/RT/Extension/LDAPImport/Test.pm
rename to t/lib/RT/Extension/LDAPImport/Test.pm.in
commit 577f56c133cf5ebb9eb7bd47ace91fe201d3d5ea
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Tue Jul 27 11:55:56 2010 -0400
Simple round-trip testing
diff --git a/t/server.t b/t/server.t
index ada44d3..4864f4f 100644
--- a/t/server.t
+++ b/t/server.t
@@ -1,5 +1,64 @@
-use Test::More;
+use strict;
+use warnings;
+use lib 't/lib';
+use RT::Extension::LDAPImport::Test tests => 22;
eval { require Net::LDAP::Server::Test; 1; } or do {
plan skip_all => 'Unable to test without Net::Server::LDAP::Test';
};
-plan tests => 1;
+
+use Net::LDAP::Entry;
+use RT::User;
+
+my ($url, $m) = RT::Test->started_ok;
+
+my $importer = RT::Extension::LDAPImport->new;
+isa_ok($importer,'RT::Extension::LDAPImport');
+
+my @ldap_entries;
+for ( 1 .. 13 ) {
+ my $entry = Net::LDAP::Entry->new();
+ my $username = "testuser$_";
+ $entry->dn("uid=$username,ou=foo,dc=bestpractical,dc=com");
+ $entry->add(
+ dn => "uid=$username,ou=foo,dc=bestpractical,dc=com",
+ cn => "Test User $_ ".int rand(200),
+ mail => "$username\@invalid.tld",
+ uid => $username,
+ );
+ push @ldap_entries, $entry;
+}
+
+my $ldap_port = 1024 + int rand(10000) + $$ % 1024;
+ok( my $server = Net::LDAP::Server::Test->new( $ldap_port, data => \@ldap_entries ),
+ "spawned test LDAP server on port $ldap_port");
+
+RT->Config->Set('LDAPHost',"ldap://localhost:$ldap_port");
+RT->Config->Set('LDAPMapping',
+ {Name => 'uid',
+ EmailAddress => 'mail',
+ RealName => 'cn'});
+RT->Config->Set('LDAPBase','ou=foo,dc=bestpractical,dc=com');
+RT->Config->Set('LDAPFilter','(objectClass=User)');
+
+$importer->screendebug(1) if ($ENV{TEST_VERBOSE});
+
+# check that we don't import
+ok($importer->import_users());
+{
+ my $users = RT::Users->new($RT::SystemUser);
+ for my $username (qw/RT_SYSTEM root Nobody/) {
+ $users->Limit( FIELD => 'Name', OPERATOR => '!=', VALUE => $username, ENTRYAGGREGATOR => 'AND' );
+ }
+ diag($users->BuildSelectQuery);
+ is($users->Count,0);
+}
+
+# check that we do import
+ok($importer->import_users( import => 1 ));
+for my $entry (@ldap_entries) {
+ my $user = RT::User->new($RT::SystemUser);
+ $user->LoadByCols( EmailAddress => $entry->get_value('mail'),
+ Realname => $entry->get_value('cn'),
+ Name => $entry->get_value('uid') );
+ ok($user->Id, "Found ".$entry->get_value('cn')." as ".$user->Id);
+}
commit 7a5f19e44d6d243f564667ea16280e6db2f1464e
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Tue Jul 27 15:07:24 2010 -0400
We actually have multiple server tests, give this a better name
diff --git a/t/server.t b/t/user-import.t
similarity index 93%
rename from t/server.t
rename to t/user-import.t
index 4864f4f..35955cb 100644
--- a/t/server.t
+++ b/t/user-import.t
@@ -18,9 +18,10 @@ my @ldap_entries;
for ( 1 .. 13 ) {
my $entry = Net::LDAP::Entry->new();
my $username = "testuser$_";
- $entry->dn("uid=$username,ou=foo,dc=bestpractical,dc=com");
+ my $dn = "uid=$username,ou=foo,dc=bestpractical,dc=com";
+ $entry->dn($dn);
$entry->add(
- dn => "uid=$username,ou=foo,dc=bestpractical,dc=com",
+ dn => $dn,
cn => "Test User $_ ".int rand(200),
mail => "$username\@invalid.tld",
uid => $username,
commit 606d3b07486ea017446456b5d11226b655ce7a91
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Sat Jul 24 11:29:37 2010 -0700
snapshot onto a branch
diff --git a/bin/rtldapimport.in b/bin/rtldapimport.in
index ef62dd6..36519af 100755
--- a/bin/rtldapimport.in
+++ b/bin/rtldapimport.in
@@ -32,6 +32,8 @@ $importer->screendebug(1) if $debug;
if ($import) {
print "Starting import\n";
$importer->import_users(import => 1);
+ print "Starting group import\n";
+ $import->import_groups(import => 1);
print "Finished import\n";
} else {
print <<TESTING;
@@ -40,5 +42,7 @@ Rerun command with --import to perform the import
Rerun command with --debug for more information
TESTING
$importer->import_users;
+ print "Testing group import\n";
+ $import->import_groups();
print "Finished test\n";
}
diff --git a/lib/RT/Extension/LDAPImport.pm b/lib/RT/Extension/LDAPImport.pm
index ec52be1..87d6d61 100644
--- a/lib/RT/Extension/LDAPImport.pm
+++ b/lib/RT/Extension/LDAPImport.pm
@@ -529,6 +529,70 @@ sub add_custom_field_value {
}
+=head2 import_groups import => 1|0
+
+Takes the results of the search from run_group_search
+and maps attributes from LDAP into RT::Group attributes
+using $RT::LDAPGroupMapping.
+
+Creates groups if they don't exist
+
+Removes users from groups if they have been removed from the group on LDAP
+
+With no arguments, only prints debugging information.
+Pass import => 1 to actually change data.
+
+=cut
+
+sub import_groups {
+ my $self = shift;
+ my %args = @_;
+
+ my $results = $self->run_group_search;
+ unless ( $results && $results->count ) {
+ $self->_debug("No results found, no group import");
+ $self->disconnect_ldap;
+ return;
+ }
+
+ return unless $self->_check_ldap_mapping;
+
+ while (my $entry = $results->shift_entry) {
+ my $user = $self->_build_user( ldap_entry => $entry );
+ $user->{Name} ||= $user->{EmailAddress};
+ unless ( $user->{Name} ) {
+ $self->_warn("No Name or Emailaddress for user, skipping ".Dumper $user);
+ next;
+ }
+ if ($args{import}) {
+ $self->_import_user( user => $user, ldap_entry => $entry );
+ } else {
+ $self->_show_user( user => $user );
+ }
+ }
+}
+
+=head3 run_group_search
+
+Set up the approviate arguments for a listing of users
+
+=cut
+
+sub run_group_search {
+ my $self = shift;
+
+ unless ($RT::LDAPGroupBase && $RT::LDAPGroupFilter) {
+ $self->_warn("Not running a group import, configuration not set");
+ return;
+ }
+ $self->_run_search(
+ base => $RT::LDAPGroupBase,
+ filter => $RT::LDAPGroupFilter
+ );
+
+}
+
+
=head3 disconnect_ldap
Disconnects from the LDAP server
commit d713ea64ee78835a9bd3a9e1084825fbc88673a4
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Wed Jul 28 12:14:55 2010 -0400
Convert to the test method that actually runs search
Rather than just returning all the data in @data
diff --git a/t/user-import.t b/t/user-import.t
index 35955cb..ba604a1 100644
--- a/t/user-import.t
+++ b/t/user-import.t
@@ -14,24 +14,26 @@ my ($url, $m) = RT::Test->started_ok;
my $importer = RT::Extension::LDAPImport->new;
isa_ok($importer,'RT::Extension::LDAPImport');
+my $ldap_port = 1024 + int rand(10000) + $$ % 1024;
+ok( my $server = Net::LDAP::Server::Test->new( $ldap_port, auto_schema => 1 ),
+ "spawned test LDAP server on port $ldap_port");
+
+my $ldap = Net::LDAP->new("localhost:$ldap_port");
+$ldap->bind();
my @ldap_entries;
for ( 1 .. 13 ) {
- my $entry = Net::LDAP::Entry->new();
my $username = "testuser$_";
my $dn = "uid=$username,ou=foo,dc=bestpractical,dc=com";
- $entry->dn($dn);
- $entry->add(
- dn => $dn,
- cn => "Test User $_ ".int rand(200),
- mail => "$username\@invalid.tld",
- uid => $username,
- );
+ my $entry = {
+ cn => "Test User $_ ".int rand(200),
+ mail => "$username\@invalid.tld",
+ uid => $username,
+ objectClass => 'User',
+ };
push @ldap_entries, $entry;
+ $ldap->add( $dn, attr => [%$entry] );
}
-my $ldap_port = 1024 + int rand(10000) + $$ % 1024;
-ok( my $server = Net::LDAP::Server::Test->new( $ldap_port, data => \@ldap_entries ),
- "spawned test LDAP server on port $ldap_port");
RT->Config->Set('LDAPHost',"ldap://localhost:$ldap_port");
RT->Config->Set('LDAPMapping',
@@ -50,7 +52,6 @@ ok($importer->import_users());
for my $username (qw/RT_SYSTEM root Nobody/) {
$users->Limit( FIELD => 'Name', OPERATOR => '!=', VALUE => $username, ENTRYAGGREGATOR => 'AND' );
}
- diag($users->BuildSelectQuery);
is($users->Count,0);
}
@@ -58,8 +59,11 @@ ok($importer->import_users());
ok($importer->import_users( import => 1 ));
for my $entry (@ldap_entries) {
my $user = RT::User->new($RT::SystemUser);
- $user->LoadByCols( EmailAddress => $entry->get_value('mail'),
- Realname => $entry->get_value('cn'),
- Name => $entry->get_value('uid') );
- ok($user->Id, "Found ".$entry->get_value('cn')." as ".$user->Id);
+ $user->LoadByCols( EmailAddress => $entry->{mail},
+ Realname => $entry->{cn},
+ Name => $entry->{uid} );
+ ok($user->Id, "Found $entry->{cn} as ".$user->Id);
}
+
+# can't unbind earlier or the server will die
+$ldap->unbind;
commit 67b0dadea0d83e2ba8cd4a9509f8f23a8a3d3cb1
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Wed Jul 28 12:22:35 2010 -0400
pass in a mapping, rather than always using the one for Users
diff --git a/lib/RT/Extension/LDAPImport.pm b/lib/RT/Extension/LDAPImport.pm
index 87d6d61..d168c84 100644
--- a/lib/RT/Extension/LDAPImport.pm
+++ b/lib/RT/Extension/LDAPImport.pm
@@ -158,10 +158,11 @@ sub import_users {
return;
}
- return unless $self->_check_ldap_mapping;
+ my $mapping = $RT::LDAPMapping;
+ return unless $self->_check_ldap_mapping( mapping => $mapping );
while (my $entry = $results->shift_entry) {
- my $user = $self->_build_user( ldap_entry => $entry );
+ my $user = $self->_build_object( ldap_entry => $entry, skip => qr/(?i)^CF\./, mapping => $mapping );
$user->{Name} ||= $user->{EmailAddress};
unless ( $user->{Name} ) {
$self->_warn("No Name or Emailaddress for user, skipping ".Dumper $user);
@@ -260,10 +261,12 @@ ldap if there is no mapping.
sub _check_ldap_mapping {
my $self = shift;
+ my %args = @_;
+ my $mapping = $args{mapping};
- my @rtfields = keys %{$RT::LDAPMapping||{}};
+ my @rtfields = keys %{$mapping};
unless ( @rtfields ) {
- $self->_error("No mapping found in RT::LDAPMapping, can't import");
+ $self->_error("No mapping found, can't import");
$self->disconnect_ldap;
return;
}
@@ -271,21 +274,22 @@ sub _check_ldap_mapping {
return 1;
}
-=head2 _build_user
+=head2 _build_object
-Builds up user data from LDAP for importing
+Builds up data from LDAP for importing
Returns a hash of user data ready for RT::User::Create
=cut
-sub _build_user {
+sub _build_object {
my $self = shift;
my %args = @_;
+ my $mapping = $args{mapping};
my $user = {};
- foreach my $rtfield ( keys %{$RT::LDAPMapping} ) {
- next if $rtfield =~ /^CF\./i;
- my $ldap_attribute = $RT::LDAPMapping->{$rtfield};
+ foreach my $rtfield ( keys %{$mapping} ) {
+ next if $rtfield =~ $args{skip};
+ my $ldap_attribute = $mapping->{$rtfield};
my @attributes = $self->_parse_ldap_mapping($ldap_attribute);
unless (@attributes) {
commit 9449b6437e34d6dcbd472b9ec1aa221291351b9c
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Wed Jul 28 12:28:57 2010 -0400
Group creation
diff --git a/lib/RT/Extension/LDAPImport.pm b/lib/RT/Extension/LDAPImport.pm
index d168c84..34a7518 100644
--- a/lib/RT/Extension/LDAPImport.pm
+++ b/lib/RT/Extension/LDAPImport.pm
@@ -559,21 +559,23 @@ sub import_groups {
return;
}
- return unless $self->_check_ldap_mapping;
+ my $mapping = $RT::LDAPGroupMapping;
+ return unless $self->_check_ldap_mapping( mapping => $mapping );
while (my $entry = $results->shift_entry) {
- my $user = $self->_build_user( ldap_entry => $entry );
- $user->{Name} ||= $user->{EmailAddress};
- unless ( $user->{Name} ) {
- $self->_warn("No Name or Emailaddress for user, skipping ".Dumper $user);
+ my $group = $self->_build_object( ldap_entry => $entry, skip => qr/(i)^Member_Attr/, mapping => $mapping );
+ $group->{Description} ||= 'Imported from LDAP';
+ unless ( $group->{Name} ) {
+ $self->_warn("No Name for group, skipping ".Dumper $group);
next;
}
if ($args{import}) {
- $self->_import_user( user => $user, ldap_entry => $entry );
+ $self->_import_group( group => $group, ldap_entry => $entry );
} else {
- $self->_show_user( user => $user );
+ $self->_show_group( group => $group );
}
}
+ return 1;
}
=head3 run_group_search
@@ -597,6 +599,83 @@ sub run_group_search {
}
+=head2 _import_group
+
+The user has run us with --import, so bring data in
+
+=cut
+
+sub _import_group {
+ my $self = shift;
+ my %args = @_;
+ my $group = $args{group};
+ my $ldap_entry = $args{ldap_entry};
+
+ $self->_debug("Processing group $group->{Name}");
+ my $group_obj = $self->create_rt_group( group => $group );
+ return unless $group_obj;
+ $self->add_group_members( group => $group_obj, ldap_entry => $ldap_entry );
+ #$self->add_custom_field_value( group => $group_obj, ldap_entry => $ldap_entry );
+ return;
+}
+
+=head2 create_rt_group
+
+Takes a hashref of args to pass to RT::User::Create
+Will try loading the group and will only create a new
+group if it can't find an existing group with the Name
+or EmailAddress arg passed in.
+
+If the $LDAPUpdateUsers variable is true, data in RT
+will be clobbered with data in LDAP. Otherwise we
+will skip to the next group.
+
+If $LDAPUpdateOnly is true, we will not create new groups
+but we will update existing ones.
+
+=cut
+
+sub create_rt_group {
+ my $self = shift;
+ my %args = @_;
+ my $group = $args{group};
+
+ my $group_obj = RT::Group->new($RT::SystemUser);
+ $group_obj->LoadUserDefinedGroup( $group->{Name} );
+
+ if ($group_obj->Id) {
+ $self->_debug("Group $group->{Name} already exists as ".$group_obj->Id." updating their data");
+ my @results = $group_obj->Update( ARGSRef => $group, AttributesRef => [keys %$group] );
+ $self->_debug(join("\n", at results)||'no change');
+ }
+
+ if ( !$group_obj->Id ) {
+ my ($val, $msg) = $group_obj->CreateUserDefinedGroup( %$group );
+
+ unless ($val) {
+ $self->_error("couldn't create group_obj for $group->{Name}: $msg");
+ return;
+ }
+ $self->_debug("Created group for $group->{Name} with id ".$group_obj->Id);
+ }
+
+ unless ($group_obj->Id) {
+ $self->_error("We couldn't find or create $group->{Name}. This should never happen");
+ }
+ return $group_obj;
+
+}
+
+sub add_group_members {
+ my $self = shift;
+ my %args = @_;
+ my $group = $args{group};
+ my $ldap_entry = $args{ldap_entry};
+
+
+
+}
+
=head3 disconnect_ldap
Disconnects from the LDAP server
diff --git a/t/group-import.t b/t/group-import.t
new file mode 100644
index 0000000..78a1b00
--- /dev/null
+++ b/t/group-import.t
@@ -0,0 +1,83 @@
+use strict;
+use warnings;
+use lib 't/lib';
+use RT::Extension::LDAPImport::Test tests => 24;
+eval { require Net::LDAP::Server::Test; 1; } or do {
+ plan skip_all => 'Unable to test without Net::Server::LDAP::Test';
+};
+
+use Net::LDAP::Entry;
+use RT::User;
+
+my ($url, $m) = RT::Test->started_ok;
+
+my $importer = RT::Extension::LDAPImport->new;
+isa_ok($importer,'RT::Extension::LDAPImport');
+
+my $ldap_port = 1024 + int rand(10000) + $$ % 1024;
+ok( my $server = Net::LDAP::Server::Test->new( $ldap_port, auto_schema => 1 ),
+ "spawned test LDAP server on port $ldap_port");
+my $ldap = Net::LDAP->new("localhost:$ldap_port");
+$ldap->bind();
+
+my @ldap_user_entries;
+for ( 1 .. 12 ) {
+ my $username = "testuser$_";
+ my $dn = "uid=$username,ou=foo,dc=bestpractical,dc=com";
+ my $entry = {
+ dn => $dn,
+ cn => "Test User $_ ".int rand(200),
+ mail => "$username\@invalid.tld",
+ uid => $username,
+ objectClass => 'User',
+ };
+ push @ldap_user_entries, $entry;
+ $ldap->add( $dn, attr => [%$entry] );
+}
+
+my @ldap_group_entries;
+for ( 1 .. 4 ) {
+ my $groupname = "Test Group $_";
+ my $dn = "cn=$groupname,ou=groups,dc=bestpractical,dc=com";
+ my $entry = {
+ cn => $groupname,
+ member => [ map { $_->{dn} } @ldap_user_entries[($_-1),($_+3),($_+7)] ],
+ objectClass => 'Group',
+ };
+ $ldap->add( $dn, attr => [%$entry] );
+ push @ldap_group_entries, $entry;
+}
+
+RT->Config->Set('LDAPHost',"ldap://localhost:$ldap_port");
+RT->Config->Set('LDAPMapping',
+ {Name => 'uid',
+ EmailAddress => 'mail',
+ RealName => 'cn'});
+RT->Config->Set('LDAPBase','dc=bestpractical,dc=com');
+RT->Config->Set('LDAPFilter','(objectClass=User)');
+
+$importer->screendebug(1) if ($ENV{TEST_VERBOSE});
+
+ok($importer->import_users( import => 1 ));
+for my $entry (@ldap_user_entries) {
+ my $user = RT::User->new($RT::SystemUser);
+ $user->LoadByCols( EmailAddress => $entry->{mail},
+ Realname => $entry->{cn},
+ Name => $entry->{uid} );
+ ok($user->Id, "Found $entry->{cn} as ".$user->Id);
+}
+
+RT->Config->Set('LDAPGroupBase','dc=bestpractical,dc=com');
+RT->Config->Set('LDAPGroupFilter','(objectClass=Group)');
+RT->Config->Set('LDAPGroupMapping',
+ {Name => 'cn',
+ Member_Attr => 'mail',
+ });
+# XXX come back and test skipping the import
+ok( $importer->import_groups( import => 1 ) );
+
+for my $entry (@ldap_group_entries) {
+ my $group = RT::Group->new($RT::SystemUser);
+ $group->LoadUserDefinedGroup( $entry->{cn} );
+ ok($group->Id, "Found $entry->{cn} as ".$group->Id);
+}
commit 04d176f5b751985391635264310a41983a22a0c5
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Wed Jul 28 12:40:00 2010 -0400
Don't start an RT server
We're going to the DB and not driving the UI
kills warnings about setting Config after starting the server
and lets us keep config changing in sensible parts of the test
diff --git a/t/user-import.t b/t/user-import.t
index ba604a1..ec7ca09 100644
--- a/t/user-import.t
+++ b/t/user-import.t
@@ -1,7 +1,7 @@
use strict;
use warnings;
use lib 't/lib';
-use RT::Extension::LDAPImport::Test tests => 22;
+use RT::Extension::LDAPImport::Test tests => 21;
eval { require Net::LDAP::Server::Test; 1; } or do {
plan skip_all => 'Unable to test without Net::Server::LDAP::Test';
};
@@ -9,8 +9,6 @@ eval { require Net::LDAP::Server::Test; 1; } or do {
use Net::LDAP::Entry;
use RT::User;
-my ($url, $m) = RT::Test->started_ok;
-
my $importer = RT::Extension::LDAPImport->new;
isa_ok($importer,'RT::Extension::LDAPImport');
commit 66d2e5f85ceb1b3ea14ace89b3c4a2af08b1e138
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Wed Jul 28 12:52:30 2010 -0400
Add show for groups
don't start an RT server, and test that show correctly fails to import
diff --git a/lib/RT/Extension/LDAPImport.pm b/lib/RT/Extension/LDAPImport.pm
index 34a7518..2bd03bf 100644
--- a/lib/RT/Extension/LDAPImport.pm
+++ b/lib/RT/Extension/LDAPImport.pm
@@ -672,10 +672,56 @@ sub add_group_members {
my $group = $args{group};
my $ldap_entry = $args{ldap_entry};
-
+}
+
+=head2 _show_group
+
+Show debugging information about the group record we're going to import
+when the groups reruns us with --import
+
+=cut
+
+sub _show_group {
+ my $self = shift;
+ my %args = @_;
+ my $group = $args{group};
+
+ my $rt_group = RT::Group->new($RT::SystemUser);
+ $rt_group->LoadUserDefinedGroup( $group->{Name} );
+
+ if ( $rt_group->Id ) {
+ print "Found existing group $group->{Name} to update\n";
+ $self->_show_group_info( %args, rt_group => $rt_group );
+ } else {
+ print "Found new group $group->{Name} to create in RT\n";
+ $self->_show_group_info( %args );
+ }
+}
+sub _show_group_info {
+ my $self = shift;
+ my %args = @_;
+ my $group = $args{group};
+ my $rt_group = $args{rt_group};
+
+ return unless $self->screendebug;
+
+ print "\tRT Field\tRT Value -> LDAP Value\n";
+ foreach my $key (sort keys %$group) {
+ my $old_value;
+ if ($rt_group) {
+ eval { $old_value = $rt_group->$key() };
+ if ($group->{$key} && $old_value eq $group->{$key}) {
+ $old_value = 'unchanged';
+ }
+ }
+ $old_value ||= 'unset';
+ print "\t$key\t$old_value => $group->{$key}\n";
+ }
+ #$self->_debug(Dumper($group));
}
+
=head3 disconnect_ldap
Disconnects from the LDAP server
diff --git a/t/group-import.t b/t/group-import.t
index 78a1b00..653b4d4 100644
--- a/t/group-import.t
+++ b/t/group-import.t
@@ -1,7 +1,7 @@
use strict;
use warnings;
use lib 't/lib';
-use RT::Extension::LDAPImport::Test tests => 24;
+use RT::Extension::LDAPImport::Test tests => 25;
eval { require Net::LDAP::Server::Test; 1; } or do {
plan skip_all => 'Unable to test without Net::Server::LDAP::Test';
};
@@ -9,8 +9,6 @@ eval { require Net::LDAP::Server::Test; 1; } or do {
use Net::LDAP::Entry;
use RT::User;
-my ($url, $m) = RT::Test->started_ok;
-
my $importer = RT::Extension::LDAPImport->new;
isa_ok($importer,'RT::Extension::LDAPImport');
@@ -55,6 +53,7 @@ RT->Config->Set('LDAPMapping',
RealName => 'cn'});
RT->Config->Set('LDAPBase','dc=bestpractical,dc=com');
RT->Config->Set('LDAPFilter','(objectClass=User)');
+RT->Config->Set('LDAPSkipAutogeneratedGroup',1);
$importer->screendebug(1) if ($ENV{TEST_VERBOSE});
@@ -73,9 +72,16 @@ RT->Config->Set('LDAPGroupMapping',
{Name => 'cn',
Member_Attr => 'mail',
});
-# XXX come back and test skipping the import
-ok( $importer->import_groups( import => 1 ) );
+# confirm that we skip the import
+ok( $importer->import_groups() );
+{
+ my $groups = RT::Groups->new($RT::SystemUser);
+ $groups->LimitToUserDefinedGroups;
+ is($groups->Count,0);
+}
+
+ok( $importer->import_groups( import => 1 ) );
for my $entry (@ldap_group_entries) {
my $group = RT::Group->new($RT::SystemUser);
$group->LoadUserDefinedGroup( $entry->{cn} );
commit e2f5d66bde52e72b1658e4975cf3891d1946702a
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Wed Jul 28 13:45:06 2010 -0400
Correctly add users to groups
diff --git a/lib/RT/Extension/LDAPImport.pm b/lib/RT/Extension/LDAPImport.pm
index 2bd03bf..295add2 100644
--- a/lib/RT/Extension/LDAPImport.pm
+++ b/lib/RT/Extension/LDAPImport.pm
@@ -615,7 +615,6 @@ sub _import_group {
my $group_obj = $self->create_rt_group( group => $group );
return unless $group_obj;
$self->add_group_members( group => $group_obj, ldap_entry => $ldap_entry );
- #$self->add_custom_field_value( group => $group_obj, ldap_entry => $ldap_entry );
return;
}
@@ -672,6 +671,38 @@ sub add_group_members {
my $group = $args{group};
my $ldap_entry = $args{ldap_entry};
+ my $mapping = $RT::LDAPGroupMapping;
+
+ my $members = $ldap_entry->get_value($mapping->{Member_Attr}, asref => 1);
+
+ unless (defined $members) {
+ $self->_warn("No members found for $group->{Name} in Member_Attr");
+ return;
+ }
+
+ foreach my $member (@$members) {
+ my $ldap_users = $self->_run_search(
+ base => $RT::LDAPBase,
+ filter => "(dn=$member)"
+ );
+ unless ( $ldap_users && $ldap_users->count ) {
+ $self->_warn("No user found for $member who should be a member of ");
+ }
+ my $ldap_user = $ldap_users->shift_entry;
+ my $username = $ldap_user->get_value($RT::LDAPMapping->{Name});
+ my $rt_user = RT::User->new($RT::SystemUser);
+ my ($res,$msg) = $rt_user->Load( $username );
+ unless ($res) {
+ $self->_warn("Unable to load $username: $msg");
+ next;
+ }
+ ($res,$msg) = $group->AddMember($rt_user->PrincipalObj->Id);
+ unless ($res) {
+ $self->_warn("Failed to add $username to $group->{Name}: $msg");
+ }
+
+ }
+
}
=head2 _show_group
diff --git a/t/group-import.t b/t/group-import.t
index 653b4d4..84f0750 100644
--- a/t/group-import.t
+++ b/t/group-import.t
@@ -1,7 +1,7 @@
use strict;
use warnings;
use lib 't/lib';
-use RT::Extension::LDAPImport::Test tests => 25;
+use RT::Extension::LDAPImport::Test tests => 41;
eval { require Net::LDAP::Server::Test; 1; } or do {
plan skip_all => 'Unable to test without Net::Server::LDAP::Test';
};
@@ -39,7 +39,7 @@ for ( 1 .. 4 ) {
my $dn = "cn=$groupname,ou=groups,dc=bestpractical,dc=com";
my $entry = {
cn => $groupname,
- member => [ map { $_->{dn} } @ldap_user_entries[($_-1),($_+3),($_+7)] ],
+ members => [ map { $_->{dn} } @ldap_user_entries[($_-1),($_+3),($_+7)] ],
objectClass => 'Group',
};
$ldap->add( $dn, attr => [%$entry] );
@@ -70,7 +70,7 @@ RT->Config->Set('LDAPGroupBase','dc=bestpractical,dc=com');
RT->Config->Set('LDAPGroupFilter','(objectClass=Group)');
RT->Config->Set('LDAPGroupMapping',
{Name => 'cn',
- Member_Attr => 'mail',
+ Member_Attr => 'members',
});
# confirm that we skip the import
@@ -86,4 +86,25 @@ for my $entry (@ldap_group_entries) {
my $group = RT::Group->new($RT::SystemUser);
$group->LoadUserDefinedGroup( $entry->{cn} );
ok($group->Id, "Found $entry->{cn} as ".$group->Id);
+
+ my $idlist;
+ my $members = $group->MembersObj;
+ while (my $group_member = $members->Next) {
+ my $member = $group_member->MemberObj;
+ next unless $member->IsUser();
+ $idlist->{$member->Object->Id}++;
+ }
+
+ foreach my $dn ( @{$entry->{members}} ) {
+ my ($user) = grep { $_->{dn} eq $dn } @ldap_user_entries;
+ my $rt_user = RT::User->new($RT::SystemUser);
+ my ($res,$msg) = $rt_user->Load($user->{uid});
+ unless ($res) {
+ diag("Couldn't load user $user->{uid}: $msg");
+ next;
+ }
+ ok($group->HasMember($rt_user->PrincipalObj->Id),"Correctly assigned $user->{uid} to $entry->{cn}");
+ delete $idlist->{$rt_user->Id};
+ }
+ is(keys %$idlist,0,"No dangling users");
}
commit 63b87c54fbf1a4b13f954edac21e1d4ffdec53da
Author: Kevin Falcone <falcone at bestpractical.com>
Date: Wed Jul 28 14:08:46 2010 -0400
Respect LDAPUpdateOnly for groups
diff --git a/lib/RT/Extension/LDAPImport.pm b/lib/RT/Extension/LDAPImport.pm
index 295add2..c924950 100644
--- a/lib/RT/Extension/LDAPImport.pm
+++ b/lib/RT/Extension/LDAPImport.pm
@@ -620,15 +620,11 @@ sub _import_group {
=head2 create_rt_group
-Takes a hashref of args to pass to RT::User::Create
+Takes a hashref of args to pass to RT::Group::Create
Will try loading the group and will only create a new
group if it can't find an existing group with the Name
or EmailAddress arg passed in.
-If the $LDAPUpdateUsers variable is true, data in RT
-will be clobbered with data in LDAP. Otherwise we
-will skip to the next group.
-
If $LDAPUpdateOnly is true, we will not create new groups
but we will update existing ones.
@@ -643,12 +639,21 @@ sub create_rt_group {
$group_obj->LoadUserDefinedGroup( $group->{Name} );
if ($group_obj->Id) {
- $self->_debug("Group $group->{Name} already exists as ".$group_obj->Id." updating their data");
- my @results = $group_obj->Update( ARGSRef => $group, AttributesRef => [keys %$group] );
- $self->_debug(join("\n", at results)||'no change');
+ my $message = "Group $group->{Name} already exists as ".$group_obj->Id;
+ if ($RT::LDAPUpdateOnly) {
+ $self->_debug("$message, updating their data");
+ my @results = $group_obj->Update( ARGSRef => $group, AttributesRef => [keys %$group] );
+ $self->_debug(join("\n", at results)||'no change');
+ } else {
+ $self->_debug("$message, skipping");
+ }
}
if ( !$group_obj->Id ) {
+ if ( $RT::LDAPUpdateOnly ) {
+ $self->_debug("Group $group->{Name} doesn't exist in RT, skipping");
+ return;
+ }
my ($val, $msg) = $group_obj->CreateUserDefinedGroup( %$group );
unless ($val) {
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list