--- a/shared.pm Fri Nov 25 15:29:45 2011 +0100
+++ b/shared.pm Mon Nov 28 09:49:28 2011 +0100
@@ -1,4 +1,5 @@
package shared;
+
# © Heiko Schlittermann
# $Id$
# $URL$
@@ -6,18 +7,18 @@
use strict;
use warnings;
use Net::LDAP;
-use Net::LDAP::Constant qw(LDAP_ALREADY_EXISTS LDAP_NO_SUCH_OBJECT LDAP_TYPE_OR_VALUE_EXISTS);
+use Net::LDAP::Constant
+ qw(LDAP_ALREADY_EXISTS LDAP_NO_SUCH_OBJECT LDAP_TYPE_OR_VALUE_EXISTS);
use Net::LDAP::Entry;
+
#use Cyrus::IMAP::Admin;
use Text::Wrap;
use password;
-
my $Cf;
-my ($ldap, $ubase, $abase);
+my ( $ldap, $ubase, $abase );
my ($imap);
-END { $imap and $imap = undef; };
-
+END { $imap and $imap = undef; }
sub _add();
sub _list();
@@ -37,12 +38,12 @@
$Cf = shift;
require constant;
- import constant OU_ACCOUNTS => $Cf->ldap_ou_accounts;
- import constant OU_ALIASES => $Cf->ldap_ou_aliases;
- import constant OC_RECIPIENT => $Cf->ldap_oc_recipient;
- import constant AT_PRIMARYADDRESS => $Cf->ldap_at_primaryaddress;
- import constant AT_ADDRESS => $Cf->ldap_at_address;
- import constant AT_GROUP => $Cf->ldap_at_group;
+ import constant OU_ACCOUNTS => $Cf->ldap_ou_accounts;
+ import constant OU_ALIASES => $Cf->ldap_ou_aliases;
+ import constant OC_RECIPIENT => $Cf->ldap_oc_recipient;
+ import constant AT_PRIMARYADDRESS => $Cf->ldap_at_primaryaddress;
+ import constant AT_ADDRESS => $Cf->ldap_at_address;
+ import constant AT_GROUP => $Cf->ldap_at_group;
import constant AT_FORWARDINGADDRESS => $Cf->ldap_at_forwardingaddress;
$ubase = OU_ACCOUNTS . "," . $Cf->ldap_base;
@@ -50,188 +51,205 @@
}
sub run($) {
+
# Eigentlich brauchen wir für alles imap und ldap
$ldap = new Net::LDAP $Cf->ldap_server or die;
- my $r = $ldap->bind($Cf->ldap_bind_dn,
- password => $Cf->ldap_password || $ENV{LDAP_PASS} || password::ask("LDAP (". $Cf->ldap_bind_dn .") password: "));
+ my $r = $ldap->bind( $Cf->ldap_bind_dn,
+ password => $Cf->ldap_password
+ || $ENV{LDAP_PASS}
+ || password::ask( "LDAP (" . $Cf->ldap_bind_dn . ") password: " ) );
die $r->error, "\n" if $r->code;
$imap = new Cyrus::IMAP::Admin or die $@;
- $imap->authenticate(-server => $Cf->imap_server, -user => $Cf->imap_admin,
- -password => $Cf->imap_password || $ENV{IMAP_PASS} || password::ask("IMAP (". $Cf->imap_admin .") password: "))
- or die $@;
-
+ $imap->authenticate(
+ -server => $Cf->imap_server,
+ -user => $Cf->imap_admin,
+ -password => $Cf->imap_password
+ || $ENV{IMAP_PASS}
+ || password::ask( "IMAP (" . $Cf->imap_admin . ") password: " )
+ ) or die $@;
- if ($Cf->list) { _list() }
- elsif ($Cf->add) { _add() }
- elsif ($Cf->delete) { _delete() }
- elsif ($Cf->modify) { _modify() }
- else { die "Need action (--add|--modify|--list|--delete)\n" };
+ if ( $Cf->list ) { _list() }
+ elsif ( $Cf->add ) { _add() }
+ elsif ( $Cf->delete ) { _delete() }
+ elsif ( $Cf->modify ) { _modify() }
+ else { die "Need action (--add|--modify|--list|--delete)\n" }
}
sub _add() {
-# Beim Hinzufügen tragen wir nur das unbedingt notwendige
-# ein.
-# Die IMAP-Mailbox wird angelegt.
+ # Beim Hinzufügen tragen wir nur das unbedingt notwendige
+ # ein.
+ # Die IMAP-Mailbox wird angelegt.
die "Need mailbox name for creation\n" if not @ARGV;
my $mbox = shift @ARGV;
verbose("shared mbox:\n");
- if($Cf->mbox) {
- verbose("\n\t$mbox...");
+ if ( $Cf->mbox ) {
+ verbose("\n\t$mbox...");
- if ($imap->list($mbox)) { verbose("exists") }
- else {
- $imap->create($mbox) and verbose("ok") or die $@;
- $imap->setacl($mbox, $Cf->imap_admin => "lrswipcda") or die $@;
- $imap->setquota($mbox, STORAGE => 1024 * $Cf->imap_quota) or die $@;
- }
+ if ( $imap->list($mbox) ) { verbose("exists") }
+ else {
+ $imap->create($mbox) and verbose("ok") or die $@;
+ $imap->setacl( $mbox, $Cf->imap_admin => "lrswipcda" ) or die $@;
+ $imap->setquota( $mbox, STORAGE => 1024 * $Cf->imap_quota )
+ or die $@;
+ }
}
-
verbose("\n");
}
sub _modify() {
-# Auch hier gehen wir davon aus, daß die dn direkt aus dem User-Namen folgt:
-# dn: uid=USER,...
+
+ # Auch hier gehen wir davon aus, daß die dn direkt aus dem User-Namen folgt:
+ # dn: uid=USER,...
my (@users) = @ARGV or die "Need username(s)\n";
my @dns;
- my $r = $ldap->search(base => $ubase,
- filter => "(|" . join("", map { "(uid=$_)" } @ARGV) . ")");
+ my $r = $ldap->search(
+ base => $ubase,
+ filter => "(|" . join( "", map { "(uid=$_)" } @ARGV ) . ")"
+ );
die $r->error if $r->code;
die "No entries found.\n" if $r->count == 0;
- while (my $e = $r->shift_entry) {
- my $r;
+ while ( my $e = $r->shift_entry ) {
+ my $r;
- my $user = $e->get_value("uid");
- my $dn = $e->dn;
- my $mbox = "user/$user";
+ my $user = $e->get_value("uid");
+ my $dn = $e->dn;
+ my $mbox = "user/$user";
- my $modified = 0;
- verbose "$user:";
+ my $modified = 0;
+ verbose "$user:";
- verbose "\n\t$dn...";
+ verbose "\n\t$dn...";
- # Fix: iusMailOptions wurde erst später eingeführt, bei Bedarf also hinzufügen
- #if (!grep /^iusMailOptions$/, @{$e->get("objectClass")}) {
- #$e->add(objectClass => "iusMailOptions");
- #}
+ # Fix: iusMailOptions wurde erst später eingeführt, bei Bedarf also hinzufügen
+ #if (!grep /^iusMailOptions$/, @{$e->get("objectClass")}) {
+ #$e->add(objectClass => "iusMailOptions");
+ #}
- if (my $cn = $Cf->fullname) {
- # Aus dem Fullnamen leiten wir cn und sn ab.
- my $sn = (reverse split " ", $cn)[0];
+ if ( my $cn = $Cf->fullname ) {
+
+ # Aus dem Fullnamen leiten wir cn und sn ab.
+ my $sn = ( reverse split " ", $cn )[0];
- if ($cn =~ s/^\+//) {
- $e->replace(
- cn => [uniq $e->get("cn"), $cn],
- sn => [uniq $e->get("sn"), $sn]);
- } elsif ($cn =~ s/^-//) {
- $e->delete(cn => [$cn], sn => [$sn]);
- } else { $e->replace(cn => $cn, sn => $sn); }
- $modified++;
- }
+ if ( $cn =~ s/^\+// ) {
+ $e->replace(
+ cn => [ uniq $e->get("cn"), $cn ],
+ sn => [ uniq $e->get("sn"), $sn ]
+ );
+ } elsif ( $cn =~ s/^-// ) {
+ $e->delete( cn => [$cn], sn => [$sn] );
+ } else {
+ $e->replace( cn => $cn, sn => $sn );
+ }
+ $modified++;
+ }
- if (defined $Cf->other) {
- my @o = split /,/, $Cf->other;
- grep { /^[+-]/ } @o or $e->delete(AT_ADDRESS);
+ if ( defined $Cf->other ) {
+ my @o = split /,/, $Cf->other;
+ grep { /^[+-]/ } @o or $e->delete(AT_ADDRESS);
- foreach my $a (split /,/, $Cf->other) {
- if ($a =~ s/^-//) {
- $e->delete((AT_ADDRESS) => [$a])
- } else {
- $a =~ s/^\+//;
+ foreach my $a ( split /,/, $Cf->other ) {
+ if ( $a =~ s/^-// ) {
+ $e->delete( (AT_ADDRESS) => [$a] );
+ } else {
+ $a =~ s/^\+//;
- # Darf noch nicht woanders sein
- $r = $ldap->search(base => $ubase, filter => "(mail=$a)");
- die $r->error if $r->code;
- die "$a ist schon vergeben\n" if $r->count;
+ # Darf noch nicht woanders sein
+ $r = $ldap->search( base => $ubase, filter => "(mail=$a)" );
+ die $r->error if $r->code;
+ die "$a ist schon vergeben\n" if $r->count;
- $e->add((AT_ADDRESS) => [$a])
- }
- }
- $modified++;
- }
+ $e->add( (AT_ADDRESS) => [$a] );
+ }
+ }
+ $modified++;
+ }
- if (defined $Cf->group) {
- my @g = split /,/, $Cf->group;
- grep { /^[+-]/ } @g or $e->delete(AT_GROUP)
- if $e->get_value(AT_GROUP);
+ if ( defined $Cf->group ) {
+ my @g = split /,/, $Cf->group;
+ grep { /^[+-]/ } @g
+ or $e->delete(AT_GROUP)
+ if $e->get_value(AT_GROUP);
- foreach my $g (@g) {
- if ($g =~ s/^-//) {
- $e->delete((AT_GROUP) => [$g])
- } else {
- $g =~ s/^\+//;
- $e->add((AT_GROUP) => [$g])
- }
- }
- $modified++;
- }
+ foreach my $g (@g) {
+ if ( $g =~ s/^-// ) {
+ $e->delete( (AT_GROUP) => [$g] );
+ } else {
+ $g =~ s/^\+//;
+ $e->add( (AT_GROUP) => [$g] );
+ }
+ }
+ $modified++;
+ }
- if (my $a = $Cf->primary) {
- $r = $ldap->search(base => $ubase,
- # filter => "(|(mailPrimaryAddress=$a)(mail=$a))");
- filter => "(mail=$a)");
- die $r->error if $r->code;
- die "$a ist schon vergeben\n" if $r->count;
-
- $e->replace((AT_PRIMARYADDRESS) => $Cf->primary);
- $modified++;
- }
+ if ( my $a = $Cf->primary ) {
+ $r = $ldap->search(
+ base => $ubase,
+
+ # filter => "(|(mailPrimaryAddress=$a)(mail=$a))");
+ filter => "(mail=$a)"
+ );
+ die $r->error if $r->code;
+ die "$a ist schon vergeben\n" if $r->count;
- if (my $pw = _mkpw($Cf->password)) {
- $e->replace(userPassword => $pw);
- $modified++;
- }
+ $e->replace( (AT_PRIMARYADDRESS) => $Cf->primary );
+ $modified++;
+ }
- #if ($Cf->internal ne ":") {
- #$e->replace(iusRestrictedMail => $Cf->internal ? "TRUE" : "FALSE");
- #$modified++;
- #}
+ if ( my $pw = _mkpw( $Cf->password ) ) {
+ $e->replace( userPassword => $pw );
+ $modified++;
+ }
- $e->dump if $Cf->debug;
+ #if ($Cf->internal ne ":") {
+ #$e->replace(iusRestrictedMail => $Cf->internal ? "TRUE" : "FALSE");
+ #$modified++;
+ #}
- if ($modified) {
- $r = $e->update($ldap);
- die $r->error.$r->code if $r->code;
- }
+ $e->dump if $Cf->debug;
+
+ if ($modified) {
+ $r = $e->update($ldap);
+ die $r->error . $r->code if $r->code;
+ }
- # FIXME: Wenn keine Mailbox existiert, gibt es hier ein Problem
- if (defined $Cf->imap_quota) {
- $imap->setquota($mbox, STORAGE => $Cf->imap_quota * 1024)
- or die $@;
- }
+ # FIXME: Wenn keine Mailbox existiert, gibt es hier ein Problem
+ if ( defined $Cf->imap_quota ) {
+ $imap->setquota( $mbox, STORAGE => $Cf->imap_quota * 1024 )
+ or die $@;
+ }
- verbose "ok\n";
+ verbose "ok\n";
- print "\n";
+ print "\n";
}
}
sub _delete() {
- if (!@ARGV) {
- print "Mailbox: ";
- chomp($_ = <>);
- @ARGV = ($_);
+ if ( !@ARGV ) {
+ print "Mailbox: ";
+ chomp( $_ = <> );
+ @ARGV = ($_);
}
foreach my $mbox (@ARGV) {
- if ($Cf->mbox) {
- verbose("\tdeleting mbox $mbox...");
- $imap->delete($mbox) and verbose("ok")
- or verbose($imap->error);
- }
+ if ( $Cf->mbox ) {
+ verbose("\tdeleting mbox $mbox...");
+ $imap->delete($mbox) and verbose("ok")
+ or verbose( $imap->error );
+ }
- verbose("\n");
+ verbose("\n");
}
}
@@ -240,32 +258,33 @@
@ARGV = ("*") unless @ARGV;
foreach (@ARGV) {
- my @mboxes = $imap->list($_);
+ my @mboxes = $imap->list($_);
- foreach (@mboxes) {
- my ($mbox, $attr, $sep) = @$_;
- next if $mbox =~ /^user$sep/;
+ foreach (@mboxes) {
+ my ( $mbox, $attr, $sep ) = @$_;
+ next if $mbox =~ /^user$sep/;
- print "$mbox: shared mailbox";
+ print "$mbox: shared mailbox";
- # Quota
- my %q = $imap->listquota($mbox);
- my ($used, $max) = map { int($_ / 1024) } @{$q{STORAGE}};
+ # Quota
+ my %q = $imap->listquota($mbox);
+ my ( $used, $max ) = map { int( $_ / 1024 ) } @{ $q{STORAGE} };
- if (!$max) {
- print ", no quota";
- } else {
- print ", quota ($used/$max): " . int(100 * $used/$max) . "%";
- }
- print "\n";
+ if ( !$max ) {
+ print ", no quota";
+ } else {
+ print ", quota ($used/$max): "
+ . int( 100 * $used / $max ) . "%";
+ }
+ print "\n";
- # ACL
- my %acl = $imap->listacl($mbox);
- foreach (sort keys %acl) {
- print "\t$_: $acl{$_}\n";
- }
- }
-
+ # ACL
+ my %acl = $imap->listacl($mbox);
+ foreach ( sort keys %acl ) {
+ print "\t$_: $acl{$_}\n";
+ }
+ }
+
}
}
@@ -279,19 +298,23 @@
return keys %x;
}
-{ my @pw;
-sub _mkpw($) {
- my $in = $_[0];
+{
+ my @pw;
- return $in unless $in and $in eq "{pwgen}";
+ sub _mkpw($) {
+ my $in = $_[0];
+
+ return $in unless $in and $in eq "{pwgen}";
- if (!@pw) {
- chomp(@pw = `pwgen 8 10 2>/dev/null|| mkpasswd`);
- die "pwgen/mkpasswd: $!" if $?;
+ if ( !@pw ) {
+ chomp( @pw = `pwgen 8 10 2>/dev/null|| mkpasswd` );
+ die "pwgen/mkpasswd: $!" if $?;
+ }
+ return shift @pw;
+
}
- return shift @pw;
-
-} }
+}
1;
+
# vim:sts=4 sw=4 aw ai sm nohlsearch: