import

1 files changed, 180 insertions, 0 deletions

diff --git a/LDAPShell/Callbacks.pm b/LDAPShell/Callbacks.pm
new file mode 100755
index 0000000..b4e60ba
--- /dev/null
+++ b/LDAPShell/Callbacks.pm
@@ -0,0 +1,180 @@
+package LDAPShell::Callbacks;
+
+use Net::LDAP;
+
+@LDAPShell::Callbacks::ISA = qw(Exporter);
+@LDAPShell::Callbacks::EXPORT = qw(check_global_uid_uniqueness
+				   check_global_group_gid_uniqueness
+				   check_global_group_cn_uniqueness
+				   track_cn_and_displayname
+				   track_mail
+				   add_top_unless_present);
+
+sub new
+  {
+    my $self = shift;
+    my $class = ref $self || $self;
+
+    bless {},$class;
+  }
+
+sub add_callbacks
+  {
+    my $self = shift;
+    my $entry = shift;
+    my $ldap = shift;
+    my @attrs = @{shift} || $entry->attributes;
+
+    foreach my $attr (@attrs)
+      {
+	foreach my $cb (@{$self->{add}->{$attr}})
+	  {
+	    &$cb($ldap,$attr,$entry,\@attrs);
+	  }
+	foreach my $cb (@{$self->{any}->{$attr}})
+	  {
+	    &$cb($ldap,$attr,$entry,\@attrs);
+	  }
+      }
+  }
+
+sub modify_callbacks
+  {
+    my $self = shift;
+    my $entry = shift;
+    my $ldap = shift;
+    my @attrs = @{shift} || $entry->attributes;
+
+    foreach my $attr (@attrs)
+      {
+	foreach my $cb (@{$self->{modify}->{$attr}})
+	  {
+	    &$cb($ldap,$attr,$entry,\@attrs);
+	  }
+	foreach my $cb (@{$self->{any}->{$attr}})
+	  {
+	    &$cb($ldap,$attr,$entry,\@attrs);
+	  }
+      }
+  }
+
+sub callback
+  {
+    my $self = shift;
+    my $attr = shift;
+    my $type = shift;
+    my $code = shift;
+
+    die "Must be a CODE reference\n" unless ref $code eq 'CODE';
+
+    push(@{$self->{lc($type)}->{lc($attr)}},$code);
+  }
+
+sub check_global_uid_uniqueness
+  {
+    my $c = shift;
+    my $attr = shift;
+    my $entry = shift;
+    my $attrs = shift;
+
+    return unless grep /(uid|userid)/is,@{$attrs};
+    my $uid = $entry->get_value('uid');
+    $uid = $entry->get_value('userid') unless $uid;
+    return unless $uid;
+
+    my $res = $c->search(filter=>"uid=$uid",base=>'',attrs=>['uid']);
+    return if $res->code == LDAP_NO_SUCH_OBJECT;
+    $res->code && die "LDAP Error: ".$res->error."\n";
+    my $e = $res->pop_entry;
+    return unless $e;
+    $e->dump();
+    my $dn = $e->dn();
+    die "The username \'$uid\' already exists: \"$dn\"\n";
+  }
+
+sub check_global_group_cn_uniqueness
+  {
+    my $c = shift;
+    my $attr = shift;
+    my $entry = shift;
+    my $attrs = shift;
+
+    return unless $c->isA($entry,'posixGroup');
+    my $cn = $entry->get_value('cn');
+    return unless $cn;
+
+    my $res = $c->search(filter=>"(&(cn=$cn)(posixGroup))",base=>'',scope=>'sub',attrs=>['cn']);
+    return if $res->code == LDAP_NO_SUCH_OBJECT;
+    $res->code && die "LDAP Error: ".$res->error."\n";
+    my $e = $res->pop_entry;
+    return unless $e;
+    my $dn = $e->dn();
+    die "The group \'$cn\' already exists: \"$dn\"\n";
+  }
+
+sub check_global_group_gid_uniqueness
+  {
+    my $c = shift;
+    my $attr = shift;
+    my $entry = shift;
+    my $attrs = shift;
+
+    return unless $c->isA($e,'posixGroup');
+    my $gidNumber = $entry->get_value('gidNumber');
+    return unless $gidNumber;
+
+    my $res = $c->search(filter=>"(&(gidNumber=$gidNumber)(posixGroup))",base=>'',scope=>'sub',attrs=>['cn']);
+    return if $res->code == LDAP_NO_SUCH_OBJECT;
+    $res->code && die "LDAP Error: ".$res->error."\n";
+    my $e = $res->pop_entry;
+    return unless $e;
+    my $dn = $e->dn();
+    die "The group with GID \'$gidNumber\' already exists: \"$dn\"\n";
+  }
+
+sub track_cn_and_displayname
+  {
+    my $c = shift;
+    my $attr = shift;
+    my $entry = shift;
+    my $attrs = shift;
+
+    return unless $c->isA($entry,'inetOrgPerson');
+    return unless grep /sn/is,@{$attrs};
+    return unless grep /givenName/is,@{$attrs};
+
+    my $sn = $entry->get_value('sn');
+    my $givenName = $entry->get_value('givenName');
+    return unless $sn && $givenName;
+
+    my $cn = "$givenName $sn";
+    $entry->replace(cn=>$cn);
+    $entry->replace(displayName=>$cn);
+  }
+
+sub track_mail
+  {
+    my $c = shift;
+    my $attr = shift;
+    my $entry = shift;
+    my $attrs = shift;
+
+    return unless $c->isA($entry,'inetOrgPerson');
+    my $uid = $entry->get_value('uid');
+    my $domain = $c->domainOf($entry);
+    return unless $uid && $domain;
+    $entry->add(mail=>"$uid\@$domain") 
+      unless grep /$uid\@$domain/is,$entry->get_value('mail');
+  }
+
+sub add_top_unless_present
+  {
+    my $c = shift;
+    my $attr = shift;
+    my $entry = shift;
+    my $attrs = shift;
+
+    my @oc = $entry->get_value('objectClass');
+    push(@oc,'top') unless grep /top/is,@oc;
+    $entry->replace(objectClass=>\@oc);
+  }