1 package account; |
1 package account; |
|
2 |
2 # © Heiko Schlittermann |
3 # © Heiko Schlittermann |
3 # $Id$ |
4 # $Id$ |
4 # $URL$ |
5 # $URL$ |
5 |
6 |
6 use strict; |
7 use strict; |
7 use warnings; |
8 use warnings; |
|
9 use File::Path qw(remove_tree); |
8 use Net::LDAP; |
10 use Net::LDAP; |
9 use Net::LDAP::Constant qw(LDAP_ALREADY_EXISTS LDAP_NO_SUCH_OBJECT LDAP_TYPE_OR_VALUE_EXISTS); |
11 use Net::LDAP::Constant |
|
12 qw(LDAP_ALREADY_EXISTS LDAP_NO_SUCH_OBJECT LDAP_TYPE_OR_VALUE_EXISTS); |
10 use Net::LDAP::Entry; |
13 use Net::LDAP::Entry; |
11 use Cyrus::IMAP::Admin; |
14 use Mail::IMAPTalk; |
12 use Text::Wrap; |
15 use Text::Wrap; |
13 use password; |
16 use password; |
14 |
17 |
15 |
|
16 my $Cf; |
18 my $Cf; |
17 my ($ldap, $ubase, $abase); |
19 my ( $ldap, $ubase, $abase ); |
18 my ($imap); |
20 my ( $imap, $imap_password ); |
19 END { $imap and $imap = undef; }; |
21 END { $imap and $imap = undef; } |
20 |
|
21 |
22 |
22 sub _add(); |
23 sub _add(); |
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(); |
33 sub AT_ADDRESS(); |
35 sub AT_ADDRESS(); |
34 sub AT_GROUP(); |
36 sub AT_GROUP(); |
35 sub AT_FORWARDINGADDRESS(); |
37 sub AT_FORWARDINGADDRESS(); |
|
38 sub AT_QUOTA(); |
|
39 sub AT_ACLGROUPS(); |
36 |
40 |
37 sub import(@) { |
41 sub import(@) { |
38 $Cf = shift; |
42 $Cf = shift; |
39 |
43 |
40 require constant; |
44 require constant; |
41 import constant OU_ACCOUNTS => $Cf->ldap_ou_accounts; |
45 import constant OU_ACCOUNTS => $Cf->ldap_ou_accounts; |
42 import constant OU_ALIASES => $Cf->ldap_ou_aliases; |
46 import constant OU_ALIASES => $Cf->ldap_ou_aliases; |
43 import constant OC_RECIPIENT => $Cf->ldap_oc_recipient; |
47 import constant OC_RECIPIENT => $Cf->ldap_oc_recipient; |
44 import constant AT_PRIMARYADDRESS => $Cf->ldap_at_primaryaddress; |
48 import constant AT_PRIMARYADDRESS => $Cf->ldap_at_primaryaddress; |
45 import constant AT_ADDRESS => $Cf->ldap_at_address; |
49 import constant AT_ADDRESS => $Cf->ldap_at_address; |
46 import constant AT_GROUP => $Cf->ldap_at_group; |
50 import constant AT_GROUP => $Cf->ldap_at_group; |
47 import constant AT_FORWARDINGADDRESS => $Cf->ldap_at_forwardingaddress; |
51 import constant AT_FORWARDINGADDRESS => $Cf->ldap_at_forwardingaddress; |
|
52 import constant AT_QUOTA => $Cf->ldap_at_quota; |
|
53 import constant AT_ACLGROUPS => $Cf->ldap_at_aclgroups; |
48 |
54 |
49 $ubase = OU_ACCOUNTS . "," . $Cf->ldap_base; |
55 $ubase = OU_ACCOUNTS . "," . $Cf->ldap_base; |
50 $abase = OU_ALIASES . "," . $Cf->ldap_base; |
56 $abase = OU_ALIASES . "," . $Cf->ldap_base; |
51 } |
57 } |
52 |
58 |
53 sub run($) { |
59 sub run($) { |
|
60 |
54 # Eigentlich brauchen wir für alles imap und ldap |
61 # Eigentlich brauchen wir für alles imap und ldap |
55 $ldap = new Net::LDAP $Cf->ldap_server or die; |
62 $ldap = new Net::LDAP $Cf->ldap_server or die; |
56 my $r = $ldap->bind($Cf->ldap_bind_dn, |
63 my $r = $ldap->bind( $Cf->ldap_bind_dn, |
57 password => $Cf->ldap_password || $ENV{LDAP_PASS} || password::ask("LDAP (". $Cf->ldap_bind_dn .") password: ")); |
64 password => $Cf->ldap_password |
|
65 || $ENV{LDAP_PASS} |
|
66 || password::ask( "LDAP (" . $Cf->ldap_bind_dn . ") password: " ) ); |
58 die $r->error, "\n" if $r->code; |
67 die $r->error, "\n" if $r->code; |
59 |
68 |
60 $imap = new Cyrus::IMAP::Admin or die $@; |
69 $imap = |
61 $imap->authenticate(-server => $Cf->imap_server, -user => $Cf->imap_admin, |
70 Mail::IMAPTalk->new( Server => $Cf->imap_server, Port => $Cf->imap_port ) |
62 -password => $Cf->imap_password || $ENV{IMAP_PASS} || password::ask("IMAP (". $Cf->imap_admin .") password: ")) |
71 or die "Can't connect to IMAP Server '", $Cf->imap_server, "', Port '", |
63 or die $@; |
72 $Cf->imap_port, "': ", $@; |
64 |
73 $imap_password = |
65 |
74 $Cf->imap_password |
66 if ($Cf->list) { _list() } |
75 || $ENV{IMAP_PASS} |
67 elsif ($Cf->add) { _add() } |
76 || password::ask( "IMAP (" . $Cf->imap_admin . ") password: " ); |
68 elsif ($Cf->delete) { _delete() } |
77 |
69 elsif ($Cf->modify) { _modify() } |
78 if ( $Cf->list ) { _list() } |
70 else { die "Need action (--add|--modify|--list|--delete)\n" }; |
79 elsif ( $Cf->add ) { _add() } |
|
80 elsif ( $Cf->delete ) { _delete() } |
|
81 elsif ( $Cf->modify ) { _modify() } |
|
82 else { die "Need action (--add|--modify|--list|--delete)\n" } |
71 |
83 |
72 } |
84 } |
73 |
85 |
74 sub _add() { |
86 sub _add() { |
75 # Beim Hinzufügen tragen wir nur das unbedingt notwendige |
87 |
76 # ein. Wenn es schon eine mailPrimaryAddress gibt oder eine |
88 # Beim Hinzufügen tragen wir nur das unbedingt notwendige |
77 # mail, machen wir gar nichts. |
89 # ein. Wenn es schon eine mailPrimaryAddress gibt oder eine |
78 # Ansonsten: |
90 # mail, machen wir gar nichts. |
79 # uid wird hinzugefügt |
91 # Ansonsten: |
80 # cn, sn bleiben unangetastet |
92 # uid wird hinzugefügt |
81 # Wenn die mailbox-Option gesetzt ist, wird die |
93 # cn, sn bleiben unangetastet |
82 # IMAP-Mailbox angelegt. |
94 # Wenn die mailbox-Option gesetzt ist, wird die |
83 |
95 # IMAP-Mailbox angelegt. |
84 |
96 |
85 die "Need user name for creation\n" if not @ARGV; |
97 die "Need user name for creation\n" if not @ARGV; |
86 my $user = shift @ARGV; |
98 my $user = shift @ARGV; |
87 my $mailPrimaryAddress = $Cf->primary || $user; # evtl. mit ! |
99 my $mailPrimaryAddress = $Cf->primary || $user; # evtl. mit ! |
88 my $mailAddress = [$user, split /,/, $Cf->other || ""]; # ditto |
100 my $mailAddress = [ $user, split /,/, $Cf->other || "" ]; # ditto |
89 |
101 |
90 $user =~ s/!$//; # jetzt können wir ! nicht mehr brauchn |
102 $user =~ s/!$//; # jetzt können wir ! nicht mehr brauchn |
91 my $mbox = "user/$user"; |
|
92 my $cn = $Cf->fullname || $user; |
103 my $cn = $Cf->fullname || $user; |
93 my $sn = (reverse split " ", $cn)[0]; |
104 my $sn = ( reverse split " ", $cn )[0]; |
94 my $mailGroup = [split /,/, $Cf->group || ""]; |
105 my $mailGroup = [ split /,/, $Cf->group || "" ]; |
95 my $mailForwardingAddress = [split /,/, $Cf->forward || ""]; |
106 my $mailForwardingAddress = [ split /,/, $Cf->forward || "" ]; |
96 my $pw = _mkpw($Cf->password || "{pwgen}"); |
107 my $pw = _mkpw( $Cf->password || "{pwgen}" ); |
97 |
108 my $mbox = _mbox($user); |
98 if ($mailPrimaryAddress !~ /@/) { |
109 |
99 $mailPrimaryAddress .= "@" . $Cf->default_domain; |
110 if ( $mailPrimaryAddress !~ /@/ ) { |
100 } |
111 $mailPrimaryAddress .= "@" . $Cf->default_domain; |
101 |
112 } |
102 |
113 |
103 my $dn = "uid=$user,$ubase"; |
114 my $dn = "uid=$user,$ubase"; |
104 my $r; |
115 my $r; |
105 |
116 |
106 verbose("$user:\n"); |
117 verbose("$user:\n"); |
363 } |
374 } |
364 |
375 |
365 sub _list() { |
376 sub _list() { |
366 my $filter; |
377 my $filter; |
367 @ARGV = ("*") unless @ARGV; |
378 @ARGV = ("*") unless @ARGV; |
368 $filter = "(|" . join("", map { "(uid=$_)" } @ARGV) . ")"; |
379 $filter = "(|" . join( "", map { "(uid=$_)" } @ARGV ) . ")"; |
369 |
380 |
370 my $r = $ldap->search( |
381 my $r = $ldap->search( |
371 filter => $filter, |
382 filter => $filter, |
372 base => $ubase, |
383 base => $ubase, |
373 #attrs => [qw/uid cn mail userPassword/, (AT_PRIMARYADDRESS)] |
384 |
|
385 #attrs => [qw/uid cn mail userPassword/, (AT_PRIMARYADDRESS)] |
374 ); |
386 ); |
375 die $r->error if $r->code; |
387 die $r->error if $r->code; |
376 |
388 |
377 #if (-t STDOUT) { open(LESS, "|less -F -X") and select LESS; } |
389 #if (-t STDOUT) { open(LESS, "|less -F -X") and select LESS; } |
378 |
390 |
379 |
391 while ( my $e = $r->shift_entry ) { |
380 while (my $e = $r->shift_entry) { |
392 my $uid = $e->get_value("uid"); |
381 my $uid = $e->get_value("uid"); |
393 my $cn = join( ", ", $e->get_value("cn") ); |
382 my $cn = join(", ", $e->get_value("cn")); |
394 my $mr = $e->get_value(AT_PRIMARYADDRESS) || ""; # ?? |
383 my $mr = $e->get_value(AT_PRIMARYADDRESS) || ""; # ?? |
395 my $ml = join( ", ", $e->get_value(AT_ADDRESS) ) || ""; # ?? |
384 my $ml = join(", ", $e->get_value(AT_ADDRESS)) || ""; # ?? |
396 my $mg = join( ", ", $e->get_value(AT_GROUP) ) || ""; # ?? |
385 my $mg = join(", ", $e->get_value(AT_GROUP)) || ""; # ?? |
397 my $forw = join( ", ", $e->get_value(AT_FORWARDINGADDRESS) ) || ""; |
386 my $forw = join (", ", $e->get_value(AT_FORWARDINGADDRESS)) || ""; |
398 my $ag = $e->get_value(AT_ACLGROUPS); |
387 my $mbox = "user/$uid"; |
399 $ag = '$' . join ',$', split /,/, $ag if $ag; |
388 |
400 |
389 print "$uid: $cn <$mr>"; |
401 print "$uid: $cn <$mr>"; |
390 |
402 |
391 #if (($e->get_value("iusRestrictedMail")||"") eq "TRUE") { |
403 #if (($e->get_value("iusRestrictedMail")||"") eq "TRUE") { |
392 #print " INTERNAL"; |
404 #print " INTERNAL"; |
393 #} |
405 #} |
394 |
406 |
395 MBOX: { |
407 # das imap protokoll sieht keine zustandsänderung von 'authenticated' |
396 if (!$imap->list($mbox)) { |
408 # zu 'not authenticated' vor - daher müssen wir für jeden nutzer eine |
397 print ", no mbox"; |
409 # eigene verbindung aufbauen |
398 last MBOX; |
410 $imap = Mail::IMAPTalk->new( |
399 } |
411 Server => $Cf->imap_server, |
400 print ", mbox"; |
412 Port => $Cf->imap_port |
401 my %q = $imap->listquota($mbox); |
413 ) |
402 my ($used, $max) = map { int($_ / 1024) } @{$q{STORAGE}}; |
414 or die "Can't connect to IMAP Server '", $Cf->imap_server, |
403 |
415 "', Port '", $Cf->imap_port, "': ", $@; |
404 if (!$max) { |
416 $imap->login( "$uid*" . $Cf->imap_admin, $imap_password ) or die $@; |
405 print ", no quota"; |
417 |
406 last MBOX; |
418 my %q; |
407 } |
419 if ( $imap->capability->{quota} ) { |
408 print ", quota ($used/$max): " . int(100 * $used/$max) . "%"; |
420 |
409 } |
421 # prepare patterns for shared folders - we want to ignore them in |
410 print "\n"; |
422 # quota calculations (TODO: what happens if a user has/attempts to |
411 |
423 # create a folder with the name of a namespace? he could avoid |
412 print "\tPassword: ", $> == 0 ? $e->get_value("userPassword") : "*", "\n"; |
424 # quota limits that way?) |
413 |
425 my $ns = $imap->namespace() or die $@; |
414 print wrap("\t", "\t\t", "Other Adresses: $ml\n") if $ml; |
426 my @p = map qr{^\Q$_->[0]\E}, ( @{ $ns->[1] }, @{ $ns->[2] } ); |
415 print wrap("\t", "\t\t", "Mail Groups: $mg\n") if $mg; |
427 |
416 print wrap("\t", "\t\t", "Forwardings: $forw\n") if $forw; |
428 my $folders = $imap->list( '', '*' ) or die $@; |
|
429 |
|
430 for my $f ( @{$folders} ) { |
|
431 |
|
432 # single folder sieht wie folgt aus: [[flag1, flag2, ...], separator, foldername] |
|
433 #next if '\\Noselect' ~~ $f->[0]; |
|
434 # ignore shared folders |
|
435 map { next if ( $f->[2] . $f->[1] ) =~ $_ } @p; |
|
436 my $q = $imap->getquotaroot( $f->[2] ) |
|
437 or $@ eq |
|
438 q{IMAP Command : 'getquotaroot' failed. Response was : no - Not showing other users' quota.} |
|
439 or die $@; |
|
440 delete $q->{quotaroot}; |
|
441 %q = ( %q, %{$q} ); |
|
442 |
|
443 } |
|
444 |
|
445 } |
|
446 |
|
447 $imap->logout or die $@; |
|
448 |
|
449 # da wir uns anmelden konnten haben wir auch eine 'mbox' |
|
450 print ", mbox"; |
|
451 my $has_quota; |
|
452 for my $qr ( keys %q ) { |
|
453 my @q = @{ $q{$qr} }; |
|
454 my $elem = ''; |
|
455 $elem = shift @q while defined $elem and $elem ne 'STORAGE'; |
|
456 my ( $used, $max ) = map { int( $_ / 1024 ) } @q[ 0 .. 1 ]; |
|
457 $max ||= 1; |
|
458 print ", quota '$qr': $used/${max}MB " |
|
459 . int( 100 * $used / $max ) . "%"; |
|
460 $has_quota = 1; |
|
461 } |
|
462 print ", no quota" unless $has_quota; |
|
463 print "\n"; |
|
464 |
|
465 print "\tPassword: ", $> == 0 ? $e->get_value("userPassword") : "*", |
|
466 "\n"; |
|
467 |
|
468 print wrap( "\t", "\t\t", "Other Adresses: $ml\n" ) if $ml; |
|
469 print wrap( "\t", "\t\t", "Mail Groups: $mg\n" ) if $mg; |
|
470 print wrap( "\t", "\t\t", "Forwardings: $forw\n" ) if $forw; |
|
471 print wrap( "\t", "\t\t", "ACL Groups: $ag\n" ) if $ag; |
417 |
472 |
418 } |
473 } |
419 } |
474 } |
420 |
475 |
421 sub verbose(@) { |
476 sub verbose(@) { |