gunnar: server/perl-kolab/lib/Kolab Cyrus.pm, NONE, 1.1 LDAP.pm, NONE, 1.1 Util.pm, NONE, 1.1
cvs at kolab.org
cvs at kolab.org
Wed Aug 1 16:57:44 CEST 2007
Author: gunnar
Update of /kolabrepository/server/perl-kolab/lib/Kolab
In directory doto:/tmp/cvs-serv20643/lib/Kolab
Added Files:
Cyrus.pm LDAP.pm Util.pm
Log Message:
Converted the perl-kolab package into a standard perl library.
--- NEW FILE: Cyrus.pm ---
package Kolab::Cyrus;
## COPYRIGHT
## ---------
##
## See AUTHORS file
##
##
## LICENSE
## -------
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License as
## published by the Free Software Foundation; either version 2, or
## (at your option) any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
## General Public License for more details.
##
## You can view the GNU General Public License, online, at the GNU
## Project's homepage; see <http://www.gnu.org/licenses/gpl.html>.
##
## $Revision: 1.1 $
use 5.008;
use strict;
use warnings;
use Cyrus::IMAP::Admin;
use Kolab::Util;
use Kolab;
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = (
'all' => [ qw(
&create
&createUid
&createMailbox
&deleteMailbox
&setQuota
&setACL
) ]
);
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(
);
our $VERSION = '0.9';
sub create
{
Kolab::log('Y', 'Connecting to local Cyrus admin interface');
my $cyrus = Cyrus::IMAP::Admin->new('localhost');
if (!$cyrus) {
Kolab::log('Y', 'Unable to connect to local Cyrus admin interface', KOLAB_ERROR);
return 0;
}
if (!$cyrus->authenticate(
'User' => $Kolab::config{'cyrus_admin'},
'Password' => $Kolab::config{'cyrus_admin_pw'},
'Mechanism' => 'LOGIN',
)) {
Kolab::log('Y', "Unable to authenticate with Cyrus admin interface, Error = `" . $cyrus->error . "'", KOLAB_ERROR);
return 0;
}
return $cyrus;
}
sub createUid
{
my $user = shift;
my $sf = shift || 0;
my $seperator = '/';
my $uidprefix = 'user';
if ($sf) {
$seperator = '.';
$uidprefix = 'shared';
}
return $uidprefix . $seperator . $user;
# return 'user' . ($sf ? '.' : '/') . $user;
}
sub createMailbox
{
my $cyrus = shift;
my $uid = shift;
my $sf = shift || 0;
my $cyruid = &createUid($uid, $sf);
my $mailbox = ($cyrus->list($cyruid))[0];
if ($uid && ($uid ne $Kolab::config{'cyrus_admin'}) && ($uid ne "freebusy") && ($uid ne "nobody") && !defined($mailbox)) {
Kolab::log('Y', "Creating mailbox `$cyruid'");
if (!$cyrus->create($cyruid)) {
Kolab::log('Y', "Unable to create mailbox `$cyruid', Error = `" . $cyrus->error . "'", KOLAB_WARN);
}
} else {
Kolab::log('Y', "Skipping mailbox creation for $uid (curuid='$cyruid', mailbox='".join(',',@{$mailbox})."'", KOLAB_DEBUG);
}
}
sub setQuota
{
my $cyrus = shift;
my $uid = shift;
my $quota = shift || 0;
my $sf = shift || 0;
my $cyruid = &createUid($uid, $sf);
if( $quota < 0 ) {
return;
}
(my $root, my %quota) = $cyrus->quotaroot($cyruid);
my $setquota = $quota{'STORAGE'}[1];
if (!defined($setquota) || ($setquota != $quota)) {
if( $quota == 0 ) {
Kolab::log('Y', "Removing quota from mailbox `$cyruid'");
if (!$cyrus->setquota($cyruid)) {
Kolab::log('Y', "Unable to remove quota for mailbox `$cyruid', Error = `" . $cyrus->error . "'", KOLAB_WARN);
}
} else {
Kolab::log('Y', "Setting quota of mailbox `$cyruid' to $quota");
if (!$cyrus->setquota($cyruid, 'STORAGE', $quota)) {
Kolab::log('Y', "Unable to set quota for mailbox `$cyruid', Error = `" . $cyrus->error . "'", KOLAB_WARN);
}
}
}
}
sub deleteMailbox
{
my $cyrus = shift;
my $uid = shift;
my $sf = shift || 0;
my $cyruid = &createUid($uid, $sf);
Kolab::log('Y', "Removing mailbox `$cyruid'");
if (!$cyrus->setacl($cyruid, $Kolab::config{'cyrus_admin'}, 'c')) {
Kolab::log('Y', "Unable to reset ACL of mailbox `$cyruid', Error = `" . $cyrus->error . "'", KOLAB_WARN);
}
if (!$cyrus->delete($cyruid)) {
Kolab::log('Y', "Unable to remove mailbox `$cyruid', Error = `" . $cyrus->error . "'", KOLAB_WARN);
}
}
sub setACL
{
my $cyrus = shift;
my $uid = shift;
my $sf = shift || 0;
my $cyruid = &createUid($uid, $sf);
Kolab::log('Y', "Setting up ACL of mailbox `$cyruid'");
my $prefix = $Kolab::config{'prefix'};
my %acls = $cyrus->listacl( $cyruid );
my ($user, $entry, $acl);
Kolab::log('Y', "Removing users from ACL of $cyruid (users are \"".join(', ', keys %acls)."\")", KOLAB_DEBUG);
foreach $user ( keys %acls) {
Kolab::log('Y', "Removing `$user' from the ACL of mailbox `$cyruid'");
if (!$cyrus->deleteacl($cyruid, $user)) {
Kolab::log('Y', "Unable to remove `$user' from the ACL of mailbox `$cyruid', Error = `" . $cyrus->error . "'", KOLAB_WARN);
}
}
Kolab::log('Y', "Add users from ACL of $cyruid", KOLAB_DEBUG);
my $newacl = shift;
foreach $entry (@$newacl) {
Kolab::log('Y', "Setting up ACL `$entry'", KOLAB_DEBUG);
($user, $acl) = split(/ /, $entry , 2);
Kolab::log('Y', "Split `$user' and `$acl'", KOLAB_DEBUG);
$user = trim($user);
$acl = trim($acl);
Kolab::log('Y', "Setting the ACL of user `$user' in mailbox `$cyruid' to $acl");
if (!$cyrus->setacl($cyruid, $user, $acl)) {
Kolab::log('Y', "Unable to set the ACL of user `$user' in mailbox `$cyruid' to $acl, Error = `" . $cyrus->error . "'", KOLAB_WARN);
}
}
Kolab::log('Y', "Finished modifying ACL of $cyruid", KOLAB_DEBUG);
}
sub setFolderType {
my $cyrus = shift;
my $uid = shift;
my $sf = shift || 0;
my $foldertype = shift || 'mail';
my $cyruid = &createUid($uid, $sf);
if (!$cyrus->mboxconfig($cyruid, '/vendor/kolab/folder-type', $foldertype)) {
Kolab::log('Y', "Unable to set the folder type for mailbox `$cyruid' to `$foldertype', Error = `" . $cyrus->error . "'", KOLAB_WARN);
}
}
1;
__END__
# Below is stub documentation for your module. You'd better edit it!
=head1 NAME
Kolab::Cyrus - Perl extension for interfacing with the Kolab Cyrus
admin module.
=head1 ABSTRACT
Kolab::Cyrus contains cyrus-related functions, such as
adding/deleting mailboxes, etc.
=head1 COPYRIGHT AND AUTHORS
Stuart Bingë and others (see AUTHORS file)
=head1 LICENSE
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You can view the GNU General Public License, online, at the GNU
Project's homepage; see <http://www.gnu.org/licenses/gpl.html>.
=cut
--- NEW FILE: LDAP.pm ---
package Kolab::LDAP;
## COPYRIGHT
## ---------
##
## See AUTHORS file
##
##
## LICENSE
## -------
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License as
## published by the Free Software Foundation; either version 2, or
## (at your option) any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
## General Public License for more details.
##
## You can view the GNU General Public License, online, at the GNU
## Project's homepage; see <http://www.gnu.org/licenses/gpl.html>.
##
## $Revision: 1.1 $
use 5.008;
use strict;
use warnings;
use UNIVERSAL;
use Time::Local;
use Net::LDAP qw( LDAP_SUCCESS LDAP_PROTOCOL_ERROR LDAP_REFERRAL );
use Net::LDAPS;
use Net::LDAP::Util;
use DB_File;
use Kolab;
use Kolab::Util;
use Kolab::Cyrus;
use vars qw(%uid_db %gyard_db %newuid_db %gyard_ts_db %quota_db);
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = (
'all' => [ qw(
&startup
&shutdown
&create
&destroy
&ensureAsync
&isObject
&isDeleted
&createObject
&deleteObject
&sync
) ]
);
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(
);
our $VERSION = '0.9';
# Timestamp to keep track of changed objects
our $user_timestamp = "";
our $sf_timestamp = "";
our $group_timestamp = "";
sub startup
{
my $statedir = shift;
Kolab::log('L', 'Starting up');
Kolab::log('L', 'Opening mailbox uid cache DB');
if (!dbmopen(%uid_db, "$statedir/mailbox-uidcache.db", 0666)) {
Kolab::log('L', 'Unable to open mailbox uid cache DB', KOLAB_ERROR);
exit(1);
}
Kolab::log('L', 'Opening graveyard uid/timestamp cache DB');
if (!dbmopen(%gyard_db, "$statedir/graveyard-uidcache.db", 0666)) {
Kolab::log('L', 'Unable to open graveyard uid cache DB', KOLAB_ERROR);
exit(1);
}
if (!dbmopen(%gyard_ts_db, "$statedir/graveyard-tscache.db", 0666)) {
Kolab::log('L', 'Unable to open graveyard timestamp cache DB', KOLAB_ERROR);
exit(1);
}
Kolab::log('L', 'Opening mailbox quota cache DB');
if (!dbmopen(%quota_db, "$statedir/mailbox-quotacache.db", 0666)) {
Kolab::log('L', 'Unable to open mailbox quota cache DB', KOLAB_ERROR);
exit(1);
}
}
sub shutdown
{
Kolab::log('L', 'Shutting down');
dbmclose(%uid_db);
dbmclose(%gyard_db);
dbmclose(%quota_db);
}
sub create
{
my $ip = shift;
my $pt = shift;
my $dn = shift;
my $pw = shift;
my $as = shift || 0;
Kolab::log('L', "Connecting to LDAP server `$ip:$pt'");
my $ldap;
if( $pt == 636 ) {
# Use SSL
$ldap = Net::LDAPS->new(
$ip,
port => $pt,
version => 3,
timeout => 20,
async => $as,
verify => 'none',
onerror => 'undef'
);
} else {
$ldap = Net::LDAP->new(
$ip,
port => $pt,
version => 3,
timeout => 20,
async => $as,
onerror => 'undef'
);
}
if (!$ldap) {
Kolab::log('L', "Unable to connect to LDAP server `$ip:$pt'", KOLAB_ERROR);
if ($as) { return 0; } else { exit(1); }
}
Kolab::log('L', "Binding to `$dn'");
my $ldapmesg = $ldap->bind(
$dn,
password => $pw
);
if ($ldapmesg->code) {
Kolab::log('L', "Unable to bind to `$dn', LDAP Error = `" . $ldapmesg->error . "'", KOLAB_ERROR);
if ($as) { return 0; } else { exit(1); }
}
return $ldap;
}
sub destroy
{
my $ldap = shift;
if (defined($ldap) && ($ldap->isa('Net::LDAP') || $ldap->isa('Net::LDAPS'))) {
$ldap->abandon;
$ldap->unbind;
$ldap->disconnect;
}
}
sub ensureAsync
{
my $ldap = shift || 0;
if ($ldap && !$ldap->async) {
Kolab::log('L', 'LDAP operations are not asynchronous', KOLAB_ERROR);
exit(1);
}
Kolab::log('L', 'LDAP operations are asynchronous', KOLAB_DEBUG);
}
sub isObject
{
my $object = shift;
my $class = shift;
my $classes = $object->get_value('objectClass', asref => 1);
return 0 if !defined($classes);
foreach my $oc (@$classes) {
if ($oc =~ /$class/i) {
return 1;
}
}
return 0;
}
sub isDeleted
{
my $object = shift;
my $p = shift || 'user';
my $del = $object->get_value($Kolab::config{$p . '_field_deleted'}, asref => 1 );
#foreach (@$del) {
# return 1 if lc($_) eq lc($Kolab::config{'fqdnhostname'});
#}
#return 0;
return $#$del > 0;
}
# Map from Kolab ACLs to Cyrus ACLs
sub mapAcls {
my $acls = shift;
my $sf = shift || 0;
my @acls = map {
my ($uid,$perm) = split(/\s+/,$_,2);
Kolab::log('L', "Kolab::LDAP::mapAcls() uid=$uid perm=$perm", KOLAB_DEBUG);
my $post = 0;
if( $perm =~ /(.*)\/post/ ) {
$perm = $1;
$post = 1;
}
Kolab::log('L', "Kolab::LDAP::mapAcls() uid=$uid perm=$perm post=$post", KOLAB_DEBUG);
if( lc $perm eq 'none' ) { $_ = "$uid none"; }
elsif( lc $perm eq 'post' ) { $_ = "$uid p"; }
elsif( lc $perm eq 'read' ) { $_ = "$uid lrs"; }
elsif( lc $perm eq 'read anon' ) { $_ = "$uid lr"; }
elsif( lc $perm eq 'read hidden' ) { $_ = "$uid rs"; }
elsif( lc $perm eq 'append' ) { $_ = "$uid lrsip"; }
elsif( lc $perm eq 'write' ) { if( $sf ) { $_ = "$uid lrsiwdp"; } else { $_ = "$uid lrsiwcdp"; } }
elsif( lc $perm eq 'all' ) { if( $sf ) { $_ = "$uid lrsiwdap"; } else { $_ = "$uid lrsiwcdap"; } }
else { $_ = "$uid $perm"; } # passthrough
if( $post ) { $_ .= 'p'; }
Kolab::log('L', "Kolab::LDAP::mapAcls() acl=$_", KOLAB_DEBUG);
} @$acls;
if( $sf ) {
# Do we need to push admin rights for manager?
}
Kolab::log('L', "Kolab::LDAP::mapAcls() acls=".join(", ", @$acls), KOLAB_DEBUG);
return $acls;
}
sub createObject
{
my $ldap = shift;
my $cyrus = shift;
my $object = shift;
my $sync = shift || 0;
my $p = shift || 'user';
my $doacls = shift || 0;
my $objuidfield = shift || ($p eq 'user' ? 'mail' : ($p eq 'sf' ? 'cn' : ''));
Kolab::log('L', "Kolab::LDAP::createObject() called with obj uid field `$objuidfield' for obj type `$p'", KOLAB_DEBUG);
# No action for groups or external
return if( $objuidfield eq '' );
my $uid = lc(trim($object->get_value($objuidfield))) || 0;
return unless $uid;
return if( $objuidfield eq 'mail' && !$object->get_value('uid') );
my $kolabhomeserver = lc($object->get_value('kolabhomeserver'));
my $islocal = 1;
my $del = $object->get_value($Kolab::config{$p . '_field_deleted'}, asref => 1);
if( ref($del) eq 'ARRAY' && @$del > 0 ) {
Kolab::log('L', "Kolab::LDAP::createObject() skipping object ".lc($object->get_value($objuidfield))
." because it is deleted", KOLAB_DEBUG);
return;
}
if( $kolabhomeserver && $kolabhomeserver ne lc($Kolab::config{'fqdnhostname'}) ) {
if( $p eq 'sf' ) {
# Dont create shared folders on other hosts than it's kolabhomeserver
Kolab::log('L', "Kolab::LDAP::createObject() skipping shared folder for other server $kolabhomeserver", KOLAB_DEBUG);
return;
}
Kolab::log('L', "Kolab::LDAP::createObject() for other server $kolabhomeserver. TODO: Create referral or something, for now we just create ", KOLAB_DEBUG);
$islocal = 0;
}
# Intermediate multidomain support:
# We accept domain encoded in CN...
if( $p eq 'sf' && index( $uid, '@' ) < 0 ) {
# We have to create shared folders
# with names shared.<fldrname>@<domain>
my @dcs = split(/,/,$object->dn());
my @dn;
while( pop( @dcs ) =~ /dc=(.*)/ ) {
push(@dn, $1);
}
if( $#dn > 0 ) { $uid .= '@'.join('.',reverse(@dn)); }
}
if (!$uid) {
Kolab::log('L', "Kolab::LDAP::createObject() called with null id attribute `$objuidfield', returning", KOLAB_DEBUG);
return;
}
Kolab::log('L', "Synchronising object `$uid'", KOLAB_DEBUG);
my $guid = $object->get_value($Kolab::config{$p . '_field_guid'});
Kolab::log('L', "GUID attribute `" . $Kolab::config{$p . '_field_guid'} . "' is `$guid'", KOLAB_DEBUG);
my $olduid = $uid_db{$guid} || '';
if ($olduid) {
# We have records of the object
$newuid_db{$guid} = $olduid if ($sync);
if ($olduid ne $uid) {
# The mailbox changed; bitch
Kolab::log('L', "Object `$uid' already exists as `$olduid'; refusing to create", KOLAB_WARN);
} else {
Kolab::log('L', "Object `$uid' already exists, skipping", KOLAB_DEBUG);
}
# Nothing changed; nothing to do
} else {
# No official records - check the graveyard
my $oldgyarduid = $gyard_db{$guid} || '';
if ($oldgyarduid) {
# The object needs to be resurrected!
if ($oldgyarduid ne $uid) {
Kolab::log('L', "Resurrected object `$uid' already exists as `$oldgyarduid'; refusing to create", KOLAB_WARN);
} else {
Kolab::log('L', "Object `$uid' has been resurrected", KOLAB_DEBUG);
}
# Remove the object from the graveyard
if ($sync) { $newuid_db{$guid} = $oldgyarduid; } else { $uid_db{$guid} = $oldgyarduid; }
delete $gyard_db{$guid};
delete $gyard_ts_db{$guid};
} else {
Kolab::log('L', "Creating user `$uid' corresponding to GUID `$guid'", KOLAB_DEBUG);
# We have a object that we have no previous record of, so create everything
if ($sync) { $newuid_db{$guid} = $uid; } else { $uid_db{$guid} = $uid; }
Kolab::Cyrus::createMailbox($cyrus, $uid, ($p eq 'sf' ? 1 : 0));
if( $p eq 'sf' ){
my $foldertype = lc($object->get_value('kolabfoldertype'));
if ( $foldertype ne '' ){
Kolab::Cyrus::setFolderType($cyrus,$uid,1,$foldertype);
}
}
if( $p ne 'sf' && !$islocal ) {
# Hide user mailboxes on other servers
Kolab::Cyrus::setACL($cyrus,$uid,0, ["$uid rswipcda"]);
} elsif( $p ne 'sf' ) {
# Deal with group and resource accounts
my $edn = Net::LDAP::Util::ldap_explode_dn($object->dn(), casefold=>'lower' );
my $gcn = $edn->[1]->{'cn'};
if( $gcn && ($gcn eq 'groups' || $gcn eq 'resources') ) {
# We need to give the calendar user access to
# the groups/resources folder.
# TODO: Don't hardcode username
Kolab::log('L', "Detected group or resource account, adding ACL for calendar", KOLAB_ERROR );
Kolab::Cyrus::setACL($cyrus,$uid,0, ["$uid all",
'calendar@'.$Kolab::config{'postfix-mydomain'}
.' all']);
}
}
}
}
if ($doacls) {
my $acls = $object->get_value('acl', 'asref' => 1);
Kolab::Cyrus::setACL($cyrus, $uid, ($p eq 'sf' ? 1 : 0), mapAcls( $acls, ($p eq 'sf' ? 1:0)));
}
my $quota = $object->get_value($Kolab::config{$p . '_field_quota'});
defined($quota) or ($quota = 0);
my $oldquota = $quota_db{$guid} || 0;
if( $quota != $oldquota ) {
Kolab::Cyrus::setQuota($cyrus, $uid, $quota*1024, ($p eq 'sf' ? 1 : 0));
if( $quota == 0 ) {
delete $quota_db{$guid};
} else {
$quota_db{$guid} = $quota;
}
}
Kolab::log('L', "createObject() done", KOLAB_DEBUG );
}
sub createMasterLDAP {
my $uri = $Kolab::config{'ldap_master_uri'};
my $masterldap = Net::LDAP->new(
$uri,
version => 3,
timeout => 20,
verify => 'none',
onerror => 'undef' );
if( defined( $masterldap ) ) {
my $mesg = $masterldap->bind(
$Kolab::config{'bind_dn'},
password => $Kolab::config{'bind_pw'});
if ($mesg->code) {
Kolab::log('L', "Unable to bind to `$uri', LDAP Error = `"
.$mesg->error."'", KOLAB_ERROR);
undef( $masterldap );
}
} else {
Kolab::log('L', "Unable to connect to `$uri'"
, KOLAB_ERROR);
}
return $masterldap;
}
sub deleteObject
{
# This should only ever be called if the object is specifically flagged for
# deletion, as we nuke the mailbox
#
# The graveyard code will handle the case of an object `going missing'.
my $ldap = shift;
my $cyrus = shift;
my $object = shift;
my $remfromldap = shift || 0;
my $p = shift || 'user';
if ($remfromldap) {
my $dn = $object->dn;
my $del = $object->get_value($Kolab::config{$p . '_field_deleted'}, asref => 1);
my $masterldap;
if( lc($Kolab::config{'is_master'}) eq 'true' ) {
# We are the master, just go ahead
$masterldap = $ldap;
} else {
$masterldap = createMasterLDAP;
}
if( !defined( $masterldap ) ) {
# Problem here, could not connect to master!
Kolab::log('L', "Unable to remove DN `$dn', master LDAP server not available", KOLAB_WARN);
return 0;
}
if( lc ($Kolab::config{'is_master'}) eq 'true' && ref($del) eq 'ARRAY' && scalar(@$del) == 1 ) {
# Ok we are the last one and the master
if( $Kolab::config{'kolab_remove_objectclass'} ) {
# Remove the kolab-related objectClasses
# Some people find it useful to integrate Kolab
# with an existing LDAP database and when a Kolab
# object is to be deleted, it should just remove
# the Kolab stuff and leave the rest of the object
# in the database.
#
# This is what we do here.
# Warning: All attributes in the kolab-related
# objectclasses will be deleted!
#
# PENDING(steffen): Only remove attributes that _have_ to
# be removed.
Kolab::log('L', "Removing Kolab objectClasses from DN `$dn'");
my $schema = $masterldap->schema( $dn );
# PENDING(steffen): Dont hardcode objectClasses
foreach my $c qw(kolabInetOrgPerson kolabGroupOfNames) {
my @may = map $_->{name}, $schema->may($c);
my @must = map $_->{name}, $schema->must($c);
foreach my $attr (@must, at may,split(' ',$Kolab::config{'kolab_remove_attributes'})) {
# Remove attributes
Kolab::log('L', "Removing attribute $attr", KOLAB_WARN);
my $mesg = $masterldap->modify( $dn,
delete => $attr );
if ($mesg && $mesg->code ) {
Kolab::log('L', "Unable to remove attribute $attr from DN `$dn': ".$mesg->error, KOLAB_WARN);
}
}
# Remove objectClass
my $mesg = $masterldap->modify( $dn,
delete => { 'objectClass' => $c } );
if ($mesg && $mesg->code ) {
Kolab::log('L', "Unable to remove Kolab objectClas $_ from DN `$dn': ".$mesg->error, KOLAB_WARN);
}
}
} else {
# Default behaviour, delete the object
Kolab::log('L', "Removing DN `$dn'");
my $mesg = $masterldap->delete($dn);
if ($mesg && $mesg->code ) {
Kolab::log('L', "Unable to remove DN `$dn': ".$mesg->error, KOLAB_WARN);
}
}
} elsif( lc ($Kolab::config{'is_master'}) eq 'false' ) {
# Just remove us from the kolabdeleteflag
# master does not perform this step as it should
# be the last to delete and remove the object
Kolab::log('L', "Removing ".$Kolab::config{'fqdnhostname'}." from ".
$Kolab::config{$p . '_field_deleted'}." in `$dn'");
my $mesg = $masterldap->modify( $dn, delete =>
{ $Kolab::config{$p . '_field_deleted'} =>
$Kolab::config{'fqdnhostname'} } );
if ($mesg && $mesg->code) {
Kolab::log('L', "Unable to remove ".$Kolab::config{'fqdnhostname'}
." from kolabdeleteflag in `$dn': ".$mesg->error, KOLAB_WARN);
}
}
if( $ldap != $masterldap ) {
# Disconnect from master if we are the slave
$masterldap->disconnect;
}
}
my $guid = $object->get_value($Kolab::config{$p . '_field_guid'});
my $uid = $uid_db{$guid} || 0;
if (!$uid) {
Kolab::log('L', 'Deleted object not found in mboxcache, returning', KOLAB_DEBUG);
return;
}
Kolab::Cyrus::deleteMailbox($cyrus, $uid, ($p eq 'sf' ? 1 : 0));
delete $uid_db{$guid};
delete $quota_db{$guid};
return 1;
}
sub sync
{
Kolab::log('L', 'Synchronising');
my $cyrus = Kolab::Cyrus::create;
if( !$cyrus ) {
# We could not connect, bail out for now
return 0;
}
%newuid_db = ();
$user_timestamp = syncBasic($cyrus, 'user', '', $user_timestamp, 0);
$sf_timestamp = syncBasic($cyrus, 'sf', '', $sf_timestamp, 1);
$group_timestamp = syncBasic($cyrus, 'group', '', $group_timestamp, 0);
# Check that all mailboxes correspond to LDAP objects
Kolab::log('L', 'Synchronising mailboxes');
my @mailboxes = $cyrus->list('*');
my %objects;
my $mailbox;
foreach $mailbox (@mailboxes) {
my $u = ${@{$mailbox}}[0];
$u =~ /user[\/\.]([^\/]*)\/?.*/;
$objects{$1} = 1 if ($1);
}
undef @mailboxes;
my $guid;
foreach $guid (keys %newuid_db) {
delete $objects{$newuid_db{$guid}} if (exists $objects{$newuid_db{$guid}});
}
# Any mailboxes left should be sent to the graveyard; these are mailboxes
# without a corresponding LDAP object, yet we were never informed of their
# deletion, i.e. either we missed the deletion notification or there was
# an error when iterating through the objects (Lost connection, invalid DNs)
foreach $guid (keys %uid_db) {
if (defined $uid_db{$guid} && exists $objects{$uid_db{$guid}}) {
$gyard_db{$guid} = $uid_db{$guid};
$gyard_ts_db{$guid} = time;
}
}
my $now = time;
my $period = $Kolab::config{'gyard_deletion_period'} * 60;
Kolab::log('L', 'Gravekeeping (period = ' . $Kolab::config{'gyard_deletion_period'} . ' minutes)');
foreach $guid (keys %gyard_ts_db) {
if ($now - $gyard_ts_db{$guid} > $period) {
Kolab::log('L', "Clearing graveyard database entry `" . $gyard_db{$guid} . "'");
#Kolab::Cyrus::deleteMailbox($cyrus, $gyard_db{$guid}, 0);
delete $gyard_ts_db{$guid};
delete $gyard_db{$guid};
}
}
%uid_db = %newuid_db;
Kolab::log('L', 'Finished synchronisation');
}
# Date::Parse doesn't understand this format
# so we have to hack it ourselves
sub parse_generalized_time
{
my $ts = shift;
# YYYYMMDDHHMMSSZ
if( $ts =~ /(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)Z/ ) {
my $t = 0;
eval { $t = timegm($6,$5,$4,$3,$2-1,$1); };
return $t;
} else {
return 0;
}
}
# Returns the largest of two string-rep.
# of LDAP generalizedTime
sub max_generalized_time
{
my $ts1 = shift;
my $ts2 = shift;
if( parse_generalized_time($ts1) >
parse_generalized_time($ts2) ) { return $ts1; }
else { return $ts2; }
}
sub syncBasic
{
my $cyrus = shift;
my $p = shift || 'user';
my $add = shift || ($p eq 'user' ? '' : '');
my $ts = shift || "";
my $doacls = shift || 0;
Kolab::log('L', "Synchronising `$p' objects");
my $ldap = &create(
$Kolab::config{$p . '_ldap_ip'},
$Kolab::config{$p . '_ldap_port'},
$Kolab::config{$p . '_bind_dn'},
$Kolab::config{$p . '_bind_pw'}
);
my $ldapmesg;
my $ldapobject;
my @dnlist = split(/;/, $Kolab::config{$p . '_dn_list'});
my $dn;
foreach $dn (@dnlist) {
Kolab::log('L', "Synchronising `$p' DN `$dn'");
# First of all, remove any objects explicitly marked for deletion
$ldapmesg = $ldap->search(
base => $dn,
scope => 'sub',
filter => '(&(objectClass=' . $Kolab::config{$p . '_object_class'} . ")$add(" . $Kolab::config{$p . '_field_deleted'} . '='.$Kolab::config{'fqdnhostname'}.'))',
attrs => [
'objectClass',
$Kolab::config{$p . '_field_guid'},
$Kolab::config{$p . '_field_modified'},
$Kolab::config{$p . '_field_deleted'},
],
);
if ( UNIVERSAL::isa( $ldapmesg, 'Net::LDAP::Search') && $ldapmesg->code() <= 0) {
while( $ldapobject = $ldapmesg->pop_entry ) {
deleteObject($ldap, $cyrus, $ldapobject, 1, $p);
}
} else {
Kolab::log('L', "Unable to locate deleted `$p' objects in DN `$dn'", KOLAB_WARN);
}
# Now check that all objects in LDAP have corresponding mailboxes
# This also resurrects any missing users, if neccessary
my $filter;
if( $ts eq "" ) {
$filter = '(&(objectClass=' . $Kolab::config{$p . '_object_class'} . ")$add)",
} else {
$filter = '(&(objectClass=' . $Kolab::config{$p . '_object_class'} . ")("
.$Kolab::config{$p.'_field_modified'}.">=$ts)$add)";
}
Kolab::log('L', "filter is $filter", KOLAB_DEBUG);
$ldapmesg = $ldap->search(
base => $dn,
scope => 'sub',
filter => $filter,
attrs => [
'*',
$Kolab::config{$p . '_field_guid'},
$Kolab::config{$p . '_field_modified'},
$Kolab::config{$p . '_field_quota'},
$Kolab::config{$p . '_field_deleted'},
],
);
if ( UNIVERSAL::isa( $ldapmesg, 'Net::LDAP::Search') && $ldapmesg->code() <= 0) {
while( $ldapobject = $ldapmesg->pop_entry ) {
createObject($ldap, $cyrus, $ldapobject, 1, $p, $doacls);
$ts = max_generalized_time($ts,$ldapobject->get_value($Kolab::config{$p . '_field_modified'}));
}
} else {
Kolab::log('L', "Unable to locate `$p' objects in DN `$dn'", KOLAB_WARN);
}
Kolab::log('L', "Finished synchronising `$p' DN `$dn'");
}
&destroy($ldap);
Kolab::log('L', "Finished `$p' object synchronisation");
return $ts;
}
1;
__END__
# Below is stub documentation for your module. You'd better edit it!
=head1 NAME
Kolab::LDAP - Perl extension for generic LDAP code
=head1 ABSTRACT
Kolab::LDAP contains functions used to create/delete objects,
as well as synchronise LDAP and Cyrus.
=head1 COPYRIGHT AND AUTHORS
Stuart Bingë and others (see AUTHORS file)
=head1 LICENSE
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You can view the GNU General Public License, online, at the GNU
Project's homepage; see <http://www.gnu.org/licenses/gpl.html>.
=cut
--- NEW FILE: Util.pm ---
package Kolab::Util;
## COPYRIGHT
## ---------
##
## See AUTHORS file
##
##
## LICENSE
## -------
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License as
## published by the Free Software Foundation; either version 2, or
## (at your option) any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
## General Public License for more details.
##
## You can view the GNU General Public License, online, at the GNU
## Project's homepage; see <http://www.gnu.org/licenses/gpl.html>.
##
## $Revision: 1.1 $
use 5.008;
use strict;
use warnings;
use IO::File;
use Sys::Syslog;
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = (
'all' => [ qw(
) ]
);
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(
&trim
&ldapDateToEpoch
&readConfig
&readList
&superLog
);
our $VERSION = '0.9';
sub trim
{
my $string = shift;
if (defined $string) {
$string =~ s/^\s+//g;
$string =~ s/\s+$//g;
chomp $string;
}
return $string;
}
sub ldapDateToEpoch
{
my $ldapdate = shift;
(my $y, my $m, my $d, my $h, my $mi, my $se) = unpack('A4A2A2A2A2A2', $ldapdate);
return timelocal($se, $mi, $h, $d, $m, $y);
}
sub superLog
{
my $text = shift;
#print STDERR "$text\n";
syslog('info', "$text");
}
sub readConfig
{
my $ref = shift;
my (%cfg, $file);
if (ref($ref) eq 'HASH') {
%cfg = %$ref;
$file = shift || 0;
} else {
$file = $ref;
}
if (!$file) { return %cfg; }
my $sep = shift || ':';
$sep = '\s' if ($sep eq ' ' || $sep eq '#');
my $fd;
if (!($fd = IO::File->new($file, 'r'))) {
superLog( "Warning: Could not read $file");
return %cfg;
}
foreach (<$fd>) {
if (/^([^$sep#]+)$sep(.*)/) {
$cfg{trim($1)} = trim($2);
}
}
return %cfg;
}
sub readList
{
my @list;
my $file = shift || 0;
if (!$file) { return @list; }
my $fd;
if (!($fd = IO::File->new($file, 'r'))) { return @list; }
foreach (<$fd>) {
if (/^([^#]+)/) {
my $temp = trim($1);
next if $temp eq '';
push(@list, ($temp));
}
}
return @list;
}
1;
__END__
# Below is stub documentation for your module. You'd better edit it!
=head1 NAME
Kolab::Util - Perl extension for general utility functions
=head1 ABSTRACT
Kolab::Util contains several basic utility functions.
=head1 COPYRIGHT AND AUTHORS
Stuart Bingë and others (see AUTHORS file)
=head1 LICENSE
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License as
published by the Free Software Foundation; either version 2, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You can view the GNU General Public License, online, at the GNU
Project's homepage; see <http://www.gnu.org/licenses/gpl.html>.
=cut
More information about the commits
mailing list