account.pm
branchfoerste
changeset 42 b90dc89e8c66
parent 41 a0ed03bc2e1d
child 43 231984cb81a7
equal deleted inserted replaced
41:a0ed03bc2e1d 42:b90dc89e8c66
     3 # $Id$
     3 # $Id$
     4 # $URL$
     4 # $URL$
     5 
     5 
     6 use strict;
     6 use strict;
     7 use warnings;
     7 use warnings;
       
     8 use File::Path qw(remove_tree);
     8 use Net::LDAP;
     9 use Net::LDAP;
     9 use Net::LDAP::Constant qw(LDAP_ALREADY_EXISTS LDAP_NO_SUCH_OBJECT LDAP_TYPE_OR_VALUE_EXISTS);
    10 use Net::LDAP::Constant qw(LDAP_ALREADY_EXISTS LDAP_NO_SUCH_OBJECT LDAP_TYPE_OR_VALUE_EXISTS);
    10 use Net::LDAP::Entry;
    11 use Net::LDAP::Entry;
    11 use Mail::IMAPTalk;
    12 use Mail::IMAPTalk;
    12 use Text::Wrap;
    13 use Text::Wrap;
    23 sub _list();
    24 sub _list();
    24 sub _delete();
    25 sub _delete();
    25 sub _mkpw($);
    26 sub _mkpw($);
    26 sub uniq(@);
    27 sub uniq(@);
    27 sub verbose(@);
    28 sub verbose(@);
       
    29 sub _mbox($);
    28 
    30 
    29 sub OU_ACCOUNTS();
    31 sub OU_ACCOUNTS();
    30 sub OU_ALIASES();
    32 sub OU_ALIASES();
    31 sub AT_PRIMARYADDRESS();
    33 sub AT_PRIMARYADDRESS();
    32 sub OC_RECIPIENT();
    34 sub OC_RECIPIENT();
    91     my $cn = $Cf->fullname || $user;
    93     my $cn = $Cf->fullname || $user;
    92     my $sn = (reverse split " ", $cn)[0];
    94     my $sn = (reverse split " ", $cn)[0];
    93     my $mailGroup = [split /,/, $Cf->group || ""];
    95     my $mailGroup = [split /,/, $Cf->group || ""];
    94     my $mailForwardingAddress = [split /,/, $Cf->forward || ""];
    96     my $mailForwardingAddress = [split /,/, $Cf->forward || ""];
    95     my $pw = _mkpw($Cf->password || "{pwgen}");
    97     my $pw = _mkpw($Cf->password || "{pwgen}");
    96     # assuming usernames of the form localpart@domain
    98     my $mbox = _mbox($user);
    97     $user =~ /@(.+)$/;
       
    98     my $escapes;
       
    99     die "Invalid username '$user'" unless $escapes->{'%u'} = $user
       
   100         and $escapes->{'%1'} = substr $user, 0, 1
       
   101         and $escapes->{'%d'} = $1;
       
   102     my $mbox = $Cf->imap_mail_location;
       
   103     $mbox =~ s/$_/$escapes->{$_}/ for keys %{$escapes};
       
   104 
    99 
   105     if ($mailPrimaryAddress !~ /@/) {
   100     if ($mailPrimaryAddress !~ /@/) {
   106 	$mailPrimaryAddress .= "@" . $Cf->default_domain;
   101 	$mailPrimaryAddress .= "@" . $Cf->default_domain;
   107     }
   102     }
   108 
   103 
   159 
   154 
   160 	$r = $e->update($ldap);
   155 	$r = $e->update($ldap);
   161 	die $r->error if $r->code;
   156 	die $r->error if $r->code;
   162 
   157 
   163 	verbose('ok');
   158 	verbose('ok');
   164 	verbose(" Password: $pw") if not $Cf->password or $Cf->password eq "{pwgen}";
   159         verbose(" Password: $pw") if not $Cf->password or $Cf->password eq "{pwgen}";
   165     }
   160     }
   166 
   161 
   167     if($Cf->mbox) {
   162     if($Cf->mbox) {
       
   163 
   168 	verbose("\n\t$mbox...");
   164 	verbose("\n\t$mbox...");
   169 
   165 
   170 	if (-d $mbox) { verbose('exists') }
   166 	if (-d $mbox) {
   171 	else {
   167 
       
   168             verbose('exists')
       
   169 
       
   170         } elsif($imap->capability->{acl}) {
   172 
   171 
   173             $imap->login($user, $pw) or die $@;
   172             $imap->login($user, $pw) or die $@;
   174             # 'list' seems to trigger acl file (and thus the maildir) creation with dovecot
   173             # wenn wir acl verwenden,
   175             $imap->list('', '*') or die $@;
   174             #  * dann triggert 'list' acl file (und damit maildir) erzeugung
       
   175             #    bei dovecot
       
   176             #  * müssen wir dem master nutzer ausdrücklich rechte gewähren
       
   177             #    (lra: sicht-, les- und administrierbar)
       
   178             my $f = $imap->list('', '*') or die $@;
       
   179             $imap->setacl($f->[0]->[2], $Cf->imap_admin, 'lra') or die $@;
   176             verbose('ok');
   180             verbose('ok');
   177 	}
   181 
       
   182         } else {
       
   183 
       
   184             verbose('will be created automatically on first email delivery');
       
   185 
       
   186         }
       
   187 
   178 
   188 
   179     }
   189     }
   180 
   190 
   181     verbose("\n");
   191     verbose("\n");
   182 }
   192 }
   358 	    die $r->error;
   368 	    die $r->error;
   359 	}
   369 	}
   360 	verbose("\n");
   370 	verbose("\n");
   361 	
   371 	
   362 	if ($Cf->mbox) {
   372 	if ($Cf->mbox) {
   363             verbose("\tdeleting mbox for $user...");
   373             my $m = _mbox($user);
   364             my $m = user_dovecot( 'LOGIN' )->{'home'};
   374             if (not (defined $m and $m)) {
   365             if (not (defined $m and $m)) { verbose("can't determine mbox location - not deleting it"); }
   375                 verbose("can't determine mbox location - not deleting it");
   366             elsif (not unlink $m) { verbose("Can't unlink $m: $!"); }
   376             } else {
   367             else { verbose('ok'); }
   377                 verbose("\tdeleting $m...");
   368 	}
   378                 verbose((remove_tree $m) ? 'ok' : " Can't remove '$m': $!");
       
   379             }
       
   380         }
   369 
   381 
   370 	verbose("\n");
   382 	verbose("\n");
   371 
   383 
   372     }
   384     }
   373 }
   385 }
   400 	#if (($e->get_value("iusRestrictedMail")||"") eq "TRUE") {
   412 	#if (($e->get_value("iusRestrictedMail")||"") eq "TRUE") {
   401 	    #print " INTERNAL";
   413 	    #print " INTERNAL";
   402 	#}
   414 	#}
   403 
   415 
   404         $imap->login("$uid*" . $Cf->imap_admin, $imap_password ) or die $@;
   416         $imap->login("$uid*" . $Cf->imap_admin, $imap_password ) or die $@;
       
   417         my $m = $imap->list('', '*') or die $@;
       
   418         use Data::Dumper;
       
   419 verbose Dumper $m;
       
   420         my $q = $imap->getquotaroot($m->[0]->[2]) or die $@;
       
   421 verbose Dumper $q;
       
   422         $q = $imap->getquota($m->[0]->[2]) or die $@;
       
   423 verbose Dumper $q;
   405 
   424 
   406 	MBOX: {
   425 	MBOX: {
   407 	    if (!$imap->list()) {
   426 	    if (!$imap->list()) {
   408 		print ", no mbox";
   427 		print ", no mbox";
   409 		last MBOX;
   428 		last MBOX;
   451     }
   470     }
   452     return shift @pw;
   471     return shift @pw;
   453     
   472     
   454 } }
   473 } }
   455 
   474 
       
   475 sub _mbox($) {
       
   476 
       
   477     my ($user) = @_;
       
   478 
       
   479     my ($localpart, $domain, $escapes);
       
   480 
       
   481     # assuming usernames of the form localpart@domain
       
   482     $user =~ /(.+)@(.+)$/;
       
   483     ($localpart, $domain) = ($1, $2);
       
   484 
       
   485     die "Invalid username '$user'" unless $escapes->{'%u'} = $localpart
       
   486         and $escapes->{'%1'} = substr $localpart, 0, 1
       
   487         and $escapes->{'%d'} = $domain;
       
   488     my $mbox = $Cf->imap_mail_location;
       
   489     $mbox =~ s/$_/$escapes->{$_}/ for keys %{$escapes};
       
   490 
       
   491     return $mbox;
       
   492 
       
   493 }
       
   494 
   456 1;
   495 1;
   457 # vim:sts=4 sw=4 aw ai sm nohlsearch:
   496 # vim:sts=4 sw=4 aw ai sm nohlsearch: