39 |
39 |
40 sub import(@) { |
40 sub import(@) { |
41 $Cf = shift; |
41 $Cf = shift; |
42 |
42 |
43 require constant; |
43 require constant; |
44 import constant OU_ACCOUNTS => $Cf->ldap_ou_accounts; |
44 import constant OU_ACCOUNTS => $Cf->ldap_ou_accounts; |
45 import constant OU_ALIASES => $Cf->ldap_ou_aliases; |
45 import constant OU_ALIASES => $Cf->ldap_ou_aliases; |
46 import constant OC_RECIPIENT => $Cf->ldap_oc_recipient; |
46 import constant OC_RECIPIENT => $Cf->ldap_oc_recipient; |
47 import constant AT_PRIMARYADDRESS => $Cf->ldap_at_primaryaddress; |
47 import constant AT_PRIMARYADDRESS => $Cf->ldap_at_primaryaddress; |
48 import constant AT_ADDRESS => $Cf->ldap_at_address; |
48 import constant AT_ADDRESS => $Cf->ldap_at_address; |
49 import constant AT_GROUP => $Cf->ldap_at_group; |
49 import constant AT_GROUP => $Cf->ldap_at_group; |
50 import constant AT_FORWARDINGADDRESS => $Cf->ldap_at_forwardingaddress; |
50 import constant AT_FORWARDINGADDRESS => $Cf->ldap_at_forwardingaddress; |
51 import constant AT_QUOTA => $Cf->ldap_at_quota; |
51 import constant AT_QUOTA => $Cf->ldap_at_quota; |
52 |
52 |
53 $ubase = OU_ACCOUNTS . "," . $Cf->ldap_base; |
53 $ubase = OU_ACCOUNTS . "," . $Cf->ldap_base; |
54 $abase = OU_ALIASES . "," . $Cf->ldap_base; |
54 $abase = OU_ALIASES . "," . $Cf->ldap_base; |
55 } |
55 } |
56 |
56 |
57 sub run($) { |
57 sub run($) { |
|
58 |
58 # Eigentlich brauchen wir für alles imap und ldap |
59 # Eigentlich brauchen wir für alles imap und ldap |
59 $ldap = new Net::LDAP $Cf->ldap_server or die; |
60 $ldap = new Net::LDAP $Cf->ldap_server or die; |
60 my $r = $ldap->bind($Cf->ldap_bind_dn, |
61 my $r = $ldap->bind( $Cf->ldap_bind_dn, |
61 password => $Cf->ldap_password || $ENV{LDAP_PASS} || password::ask("LDAP (". $Cf->ldap_bind_dn .") password: ")); |
62 password => $Cf->ldap_password |
|
63 || $ENV{LDAP_PASS} |
|
64 || password::ask( "LDAP (" . $Cf->ldap_bind_dn . ") password: " ) ); |
62 die $r->error, "\n" if $r->code; |
65 die $r->error, "\n" if $r->code; |
63 |
66 |
64 $imap = Mail::IMAPTalk->new(Server => $Cf->imap_server, Port => $Cf->imap_port) |
67 $imap = |
65 or die "Can't connect to IMAP Server '", $Cf->imap_server, "', Port '", $Cf->imap_port, "': ", $@; |
68 Mail::IMAPTalk->new( Server => $Cf->imap_server, Port => $Cf->imap_port ) |
66 $imap_password = $Cf->imap_password || $ENV{IMAP_PASS} || password::ask("IMAP (". $Cf->imap_admin .") password: "); |
69 or die "Can't connect to IMAP Server '", $Cf->imap_server, "', Port '", |
67 |
70 $Cf->imap_port, "': ", $@; |
68 if ($Cf->list) { _list() } |
71 $imap_password = |
69 elsif ($Cf->add) { _add() } |
72 $Cf->imap_password |
70 elsif ($Cf->delete) { _delete() } |
73 || $ENV{IMAP_PASS} |
71 elsif ($Cf->modify) { _modify() } |
74 || password::ask( "IMAP (" . $Cf->imap_admin . ") password: " ); |
72 else { die "Need action (--add|--modify|--list|--delete)\n" }; |
75 |
|
76 if ( $Cf->list ) { _list() } |
|
77 elsif ( $Cf->add ) { _add() } |
|
78 elsif ( $Cf->delete ) { _delete() } |
|
79 elsif ( $Cf->modify ) { _modify() } |
|
80 else { die "Need action (--add|--modify|--list|--delete)\n" } |
73 |
81 |
74 } |
82 } |
75 |
83 |
76 sub _add() { |
84 sub _add() { |
77 # Beim Hinzufügen tragen wir nur das unbedingt notwendige |
85 |
78 # ein. Wenn es schon eine mailPrimaryAddress gibt oder eine |
86 # Beim Hinzufügen tragen wir nur das unbedingt notwendige |
79 # mail, machen wir gar nichts. |
87 # ein. Wenn es schon eine mailPrimaryAddress gibt oder eine |
80 # Ansonsten: |
88 # mail, machen wir gar nichts. |
81 # uid wird hinzugefügt |
89 # Ansonsten: |
82 # cn, sn bleiben unangetastet |
90 # uid wird hinzugefügt |
83 # Wenn die mailbox-Option gesetzt ist, wird die |
91 # cn, sn bleiben unangetastet |
84 # IMAP-Mailbox angelegt. |
92 # Wenn die mailbox-Option gesetzt ist, wird die |
85 |
93 # IMAP-Mailbox angelegt. |
86 |
94 |
87 die "Need user name for creation\n" if not @ARGV; |
95 die "Need user name for creation\n" if not @ARGV; |
88 my $user = shift @ARGV; |
96 my $user = shift @ARGV; |
89 my $mailPrimaryAddress = $Cf->primary || $user; # evtl. mit ! |
97 my $mailPrimaryAddress = $Cf->primary || $user; # evtl. mit ! |
90 my $mailAddress = [$user, split /,/, $Cf->other || ""]; # ditto |
98 my $mailAddress = [ $user, split /,/, $Cf->other || "" ]; # ditto |
91 |
99 |
92 $user =~ s/!$//; # jetzt können wir ! nicht mehr brauchn |
100 $user =~ s/!$//; # jetzt können wir ! nicht mehr brauchn |
93 my $cn = $Cf->fullname || $user; |
101 my $cn = $Cf->fullname || $user; |
94 my $sn = (reverse split " ", $cn)[0]; |
102 my $sn = ( reverse split " ", $cn )[0]; |
95 my $mailGroup = [split /,/, $Cf->group || ""]; |
103 my $mailGroup = [ split /,/, $Cf->group || "" ]; |
96 my $mailForwardingAddress = [split /,/, $Cf->forward || ""]; |
104 my $mailForwardingAddress = [ split /,/, $Cf->forward || "" ]; |
97 my $pw = _mkpw($Cf->password || "{pwgen}"); |
105 my $pw = _mkpw( $Cf->password || "{pwgen}" ); |
98 my $mbox = _mbox($user); |
106 my $mbox = _mbox($user); |
99 |
107 |
100 if ($mailPrimaryAddress !~ /@/) { |
108 if ( $mailPrimaryAddress !~ /@/ ) { |
101 $mailPrimaryAddress .= "@" . $Cf->default_domain; |
109 $mailPrimaryAddress .= "@" . $Cf->default_domain; |
102 } |
110 } |
103 |
|
104 |
111 |
105 my $dn = "uid=$user,$ubase"; |
112 my $dn = "uid=$user,$ubase"; |
106 my $r; |
113 my $r; |
107 |
114 |
108 verbose("$user:\n"); |
115 verbose("$user:\n"); |
109 |
116 |
110 verbose("\t$dn..."); |
117 verbose("\t$dn..."); |
111 |
118 |
112 $r = $ldap->search(base => $ubase, filter => "(uid=$user)"); |
119 $r = $ldap->search( base => $ubase, filter => "(uid=$user)" ); |
113 die $r->error if $r->code; |
120 die $r->error if $r->code; |
114 die "Multiple entries not expected" if $r->count > 1; |
121 die "Multiple entries not expected" if $r->count > 1; |
115 |
122 |
116 my $e; |
123 my $e; |
117 if ($r->count) { |
124 if ( $r->count ) { |
118 $e = $r->shift_entry; |
125 $e = $r->shift_entry; |
119 } else { |
126 } else { |
120 $e = new Net::LDAP::Entry; |
127 $e = new Net::LDAP::Entry; |
121 $e->dn($dn); |
128 $e->dn($dn); |
122 } |
129 } |
123 |
130 |
124 if ($e->exists("mail") || $e->exists(AT_PRIMARYADDRESS) || $e->exists("userPassword")) { |
131 if ( $e->exists("mail") |
125 verbose "exists\n"; |
132 || $e->exists(AT_PRIMARYADDRESS) |
|
133 || $e->exists("userPassword") ) |
|
134 { |
|
135 verbose "exists\n"; |
126 } else { |
136 } else { |
127 FORCE: |
137 FORCE: |
128 |
138 |
129 # Bevor wir ans Werk gehen, noch ein paar Tests (mailPrimaryAddress und mail darf |
139 # Bevor wir ans Werk gehen, noch ein paar Tests (mailPrimaryAddress und mail darf |
130 # noch nicht vergeben sein) |
140 # noch nicht vergeben sein) |
131 foreach my $a ($mailPrimaryAddress, @$mailAddress) { |
141 foreach my $a ( $mailPrimaryAddress, @$mailAddress ) { |
132 $a =~ s/!$// and next; # wenn ein ! am Ende steht, dann ist es so gewollt und wird |
142 $a =~ s/!$// |
133 # nicht geprüft |
143 and |
134 $r = $ldap->search(filter => "(mail=$a)", base => $ubase); |
144 next; # wenn ein ! am Ende steht, dann ist es so gewollt und wird |
135 die $r->error if $r->code; |
145 # nicht geprüft |
136 die "$a ist schon vergeben\n" if $r->count; |
146 $r = $ldap->search( filter => "(mail=$a)", base => $ubase ); |
137 } |
147 die $r->error if $r->code; |
138 |
148 die "$a ist schon vergeben\n" if $r->count; |
139 $e->replace(objectClass => [uniq $e->get("objectClass"), qw/uidObject person/, OC_RECIPIENT]); |
149 } |
140 $e->replace(uid => [uniq $e->get("uid"), $user]); |
150 |
141 |
151 $e->replace( |
142 $e->add((AT_ADDRESS) => $mailAddress); |
152 objectClass => [ |
143 $e->add((AT_PRIMARYADDRESS) => $mailPrimaryAddress); |
153 uniq $e->get("objectClass"), |
144 $e->add(userPassword => "{plain}$pw"); |
154 qw/uidObject person/, |
145 $e->add((AT_GROUP) => $mailGroup) if @$mailGroup; |
155 OC_RECIPIENT |
146 $e->add((AT_FORWARDINGADDRESS) => $mailForwardingAddress) if @$mailForwardingAddress; |
156 ] |
147 $e->add((AT_QUOTA) => $Cf->imap_quota); |
157 ); |
148 |
158 $e->replace( uid => [ uniq $e->get("uid"), $user ] ); |
149 # $e->add(iusRestrictedMail => $Cf->internal) if $Cf->internal ne ":"; |
159 |
150 |
160 $e->add( (AT_ADDRESS) => $mailAddress ); |
151 $e->exists("sn") or $e->add(sn => $sn); |
161 $e->add( (AT_PRIMARYADDRESS) => $mailPrimaryAddress ); |
152 $e->exists("cn") or $e->add(cn => $cn); |
162 $e->add( userPassword => "{plain}$pw" ); |
153 |
163 $e->add( (AT_GROUP) => $mailGroup ) if @$mailGroup; |
154 |
164 $e->add( (AT_FORWARDINGADDRESS) => $mailForwardingAddress ) |
155 $r = $e->update($ldap); |
165 if @$mailForwardingAddress; |
156 die $r->error if $r->code; |
166 $e->add( (AT_QUOTA) => $Cf->imap_quota ); |
157 |
167 |
158 verbose('ok'); |
168 # $e->add(iusRestrictedMail => $Cf->internal) if $Cf->internal ne ":"; |
159 verbose(" Password: $pw") if not $Cf->password or $Cf->password eq "{pwgen}"; |
169 |
160 } |
170 $e->exists("sn") or $e->add( sn => $sn ); |
161 |
171 $e->exists("cn") or $e->add( cn => $cn ); |
162 if($Cf->mbox) { |
172 |
163 |
173 $r = $e->update($ldap); |
164 verbose("\n\t$mbox..."); |
174 die $r->error if $r->code; |
165 |
175 |
166 if (-d $mbox) { |
176 verbose('ok'); |
|
177 verbose(" Password: $pw") |
|
178 if not $Cf->password |
|
179 or $Cf->password eq "{pwgen}"; |
|
180 } |
|
181 |
|
182 if ( $Cf->mbox ) { |
|
183 |
|
184 verbose("\n\t$mbox..."); |
|
185 |
|
186 if ( -d $mbox ) { |
167 |
187 |
168 verbose('exists') |
188 verbose('exists') |
169 |
189 |
170 } elsif($imap->capability->{acl}) { |
190 } elsif ( $imap->capability->{acl} ) { |
171 |
191 |
172 $imap->login($user, $pw) or die $@; |
192 $imap->login( $user, $pw ) or die $@; |
|
193 |
173 # wenn wir acl verwenden, |
194 # wenn wir acl verwenden, |
174 # * dann triggert 'list' acl file (und damit maildir) erzeugung |
195 # * dann triggert 'list' acl file (und damit maildir) erzeugung |
175 # bei dovecot |
196 # bei dovecot |
176 # * müssen wir dem master nutzer ausdrücklich rechte gewähren |
197 # * müssen wir dem master nutzer ausdrücklich rechte gewähren |
177 # (lra: sicht-, les- und administrierbar) |
198 # (lra: sicht-, les- und administrierbar) |
178 my $f = $imap->list('', '*') or die $@; |
199 my $f = $imap->list( '', '*' ) or die $@; |
179 $imap->setacl($f->[0]->[2], $Cf->imap_admin, 'lra') or die $@; |
200 $imap->setacl( $f->[0]->[2], $Cf->imap_admin, 'lra' ) or die $@; |
180 verbose('ok'); |
201 verbose('ok'); |
181 |
202 |
182 } else { |
203 } else { |
183 |
204 |
184 verbose('will be created automatically on first email delivery'); |
205 verbose('will be created automatically on first email delivery'); |
185 |
206 |
186 } |
207 } |
187 |
208 |
188 |
|
189 } |
209 } |
190 |
210 |
191 verbose("\n"); |
211 verbose("\n"); |
192 } |
212 } |
193 |
213 |
194 sub _modify() { |
214 sub _modify() { |
195 # Auch hier gehen wir davon aus, daß die dn direkt aus dem User-Namen folgt: |
215 |
196 # dn: uid=USER,... |
216 # Auch hier gehen wir davon aus, daß die dn direkt aus dem User-Namen folgt: |
|
217 # dn: uid=USER,... |
197 my (@users) = @ARGV or die "Need username(s)\n"; |
218 my (@users) = @ARGV or die "Need username(s)\n"; |
198 my @dns; |
219 my @dns; |
199 |
220 |
200 my $r = $ldap->search(base => $ubase, |
221 my $r = $ldap->search( |
201 filter => "(|" . join("", map { "(uid=$_)" } @ARGV) . ")"); |
222 base => $ubase, |
|
223 filter => "(|" . join( "", map { "(uid=$_)" } @ARGV ) . ")" |
|
224 ); |
202 die $r->error if $r->code; |
225 die $r->error if $r->code; |
203 die "No entries found.\n" if $r->count == 0; |
226 die "No entries found.\n" if $r->count == 0; |
204 |
227 |
205 while (my $e = $r->shift_entry) { |
228 while ( my $e = $r->shift_entry ) { |
206 my $r; |
229 my $r; |
207 |
230 |
208 my $user = $e->get_value("uid"); |
231 my $user = $e->get_value("uid"); |
209 my $dn = $e->dn; |
232 my $dn = $e->dn; |
210 |
233 |
211 my $modified = 0; |
234 my $modified = 0; |
212 verbose "$user:"; |
235 verbose "$user:"; |
213 |
236 |
214 verbose "\n\t$dn..."; |
237 verbose "\n\t$dn..."; |
215 |
238 |
216 # Fix: iusMailOptions wurde erst später eingeführt, bei Bedarf also hinzufügen |
239 # Fix: iusMailOptions wurde erst später eingeführt, bei Bedarf also hinzufügen |
217 #if (!grep /^iusMailOptions$/, @{$e->get("objectClass")}) { |
240 #if (!grep /^iusMailOptions$/, @{$e->get("objectClass")}) { |
218 #$e->add(objectClass => "iusMailOptions"); |
241 #$e->add(objectClass => "iusMailOptions"); |
219 #} |
242 #} |
220 |
243 |
221 if (my $cn = $Cf->fullname) { |
244 if ( my $cn = $Cf->fullname ) { |
222 # Aus dem Fullnamen leiten wir cn und sn ab. |
245 |
223 my $sn = (reverse split " ", $cn)[0]; |
246 # Aus dem Fullnamen leiten wir cn und sn ab. |
224 |
247 my $sn = ( reverse split " ", $cn )[0]; |
225 if ($cn =~ s/^\+//) { |
248 |
226 $e->replace( |
249 if ( $cn =~ s/^\+// ) { |
227 cn => [uniq $e->get("cn"), $cn], |
250 $e->replace( |
228 sn => [uniq $e->get("sn"), $sn]); |
251 cn => [ uniq $e->get("cn"), $cn ], |
229 } elsif ($cn =~ s/^-//) { |
252 sn => [ uniq $e->get("sn"), $sn ] |
230 $e->delete(cn => [$cn], sn => [$sn]); |
253 ); |
231 } else { $e->replace(cn => $cn, sn => $sn); } |
254 } elsif ( $cn =~ s/^-// ) { |
232 $modified++; |
255 $e->delete( cn => [$cn], sn => [$sn] ); |
233 } |
256 } else { |
234 |
257 $e->replace( cn => $cn, sn => $sn ); |
235 if (defined $Cf->other) { |
258 } |
236 my @o = split /,/, $Cf->other; |
259 $modified++; |
237 grep { /^[+-]/ } @o or $e->delete(AT_ADDRESS); |
260 } |
238 |
261 |
239 foreach my $a (split /,/, $Cf->other) { |
262 if ( defined $Cf->other ) { |
240 if ($a =~ s/^-//) { |
263 my @o = split /,/, $Cf->other; |
241 $e->delete((AT_ADDRESS) => [$a]) |
264 grep { /^[+-]/ } @o or $e->delete(AT_ADDRESS); |
242 } else { |
265 |
243 $a =~ s/^\+//; |
266 foreach my $a ( split /,/, $Cf->other ) { |
244 |
267 if ( $a =~ s/^-// ) { |
245 # Darf noch nicht woanders sein |
268 $e->delete( (AT_ADDRESS) => [$a] ); |
246 $r = $ldap->search(base => $ubase, filter => "(mail=$a)"); |
269 } else { |
247 die $r->error if $r->code; |
270 $a =~ s/^\+//; |
248 die "$a ist schon vergeben\n" if $r->count; |
271 |
249 |
272 # Darf noch nicht woanders sein |
250 $e->add((AT_ADDRESS) => [$a]) |
273 $r = $ldap->search( base => $ubase, filter => "(mail=$a)" ); |
251 } |
274 die $r->error if $r->code; |
252 } |
275 die "$a ist schon vergeben\n" if $r->count; |
253 $modified++; |
276 |
254 } |
277 $e->add( (AT_ADDRESS) => [$a] ); |
255 |
278 } |
256 if (defined $Cf->group) { |
279 } |
257 my @g = split /,/, $Cf->group; |
280 $modified++; |
258 grep { /^[+-]/ } @g or $e->delete(AT_GROUP) |
281 } |
259 if $e->get_value(AT_GROUP); |
282 |
260 |
283 if ( defined $Cf->group ) { |
261 foreach my $g (@g) { |
284 my @g = split /,/, $Cf->group; |
262 if ($g =~ s/^-//) { |
285 grep { /^[+-]/ } @g |
263 $e->delete((AT_GROUP) => [$g]) |
286 or $e->delete(AT_GROUP) |
264 } else { |
287 if $e->get_value(AT_GROUP); |
265 $g =~ s/^\+//; |
288 |
266 $e->add((AT_GROUP) => [$g]) |
289 foreach my $g (@g) { |
267 } |
290 if ( $g =~ s/^-// ) { |
268 } |
291 $e->delete( (AT_GROUP) => [$g] ); |
269 $modified++; |
292 } else { |
270 } |
293 $g =~ s/^\+//; |
271 |
294 $e->add( (AT_GROUP) => [$g] ); |
272 if (defined $Cf->forward) { |
295 } |
273 my @f = split /,/, $Cf->forward; |
296 } |
274 grep { /^[+-]/ } @f or $e->delete(AT_FORWARDINGADDRESS) |
297 $modified++; |
275 if $e->get_value(AT_FORWARDINGADDRESS); |
298 } |
276 |
299 |
277 foreach my $f (@f) { |
300 if ( defined $Cf->forward ) { |
278 if ($f =~ s/^-//) { |
301 my @f = split /,/, $Cf->forward; |
279 $e->delete((AT_FORWARDINGADDRESS) => [$f]); |
302 grep { /^[+-]/ } @f |
280 } else { |
303 or $e->delete(AT_FORWARDINGADDRESS) |
281 $f =~ s/^\+//; |
304 if $e->get_value(AT_FORWARDINGADDRESS); |
282 $e->add((AT_FORWARDINGADDRESS) => [$f]); |
305 |
283 } |
306 foreach my $f (@f) { |
284 } |
307 if ( $f =~ s/^-// ) { |
285 $modified++; |
308 $e->delete( (AT_FORWARDINGADDRESS) => [$f] ); |
286 } |
309 } else { |
287 |
310 $f =~ s/^\+//; |
288 if (my $a = $Cf->primary) { |
311 $e->add( (AT_FORWARDINGADDRESS) => [$f] ); |
289 $r = $ldap->search(base => $ubase, |
312 } |
290 # filter => "(|(mailPrimaryAddress=$a)(mail=$a))"); |
313 } |
291 filter => "(mail=$a)"); |
314 $modified++; |
292 die $r->error if $r->code; |
315 } |
293 die "$a ist schon vergeben\n" if $r->count; |
316 |
294 |
317 if ( my $a = $Cf->primary ) { |
295 $e->replace((AT_PRIMARYADDRESS) => $Cf->primary); |
318 $r = $ldap->search( |
296 $modified++; |
319 base => $ubase, |
297 } |
320 |
298 |
321 # filter => "(|(mailPrimaryAddress=$a)(mail=$a))"); |
299 if (my $pw = _mkpw($Cf->password)) { |
322 filter => "(mail=$a)" |
300 $e->replace(userPassword => $pw); |
323 ); |
301 $modified++; |
324 die $r->error if $r->code; |
302 } |
325 die "$a ist schon vergeben\n" if $r->count; |
303 |
326 |
304 #if ($Cf->internal ne ":") { |
327 $e->replace( (AT_PRIMARYADDRESS) => $Cf->primary ); |
305 #$e->replace(iusRestrictedMail => $Cf->internal ? "TRUE" : "FALSE"); |
328 $modified++; |
306 #$modified++; |
329 } |
307 #} |
330 |
308 |
331 if ( my $pw = _mkpw( $Cf->password ) ) { |
309 $e->dump if $Cf->debug; |
332 $e->replace( userPassword => $pw ); |
310 |
333 $modified++; |
311 if ($modified) { |
334 } |
312 $r = $e->update($ldap); |
335 |
313 die $r->error.$r->code if $r->code; |
336 #if ($Cf->internal ne ":") { |
314 } |
337 #$e->replace(iusRestrictedMail => $Cf->internal ? "TRUE" : "FALSE"); |
315 |
338 #$modified++; |
316 verbose "ok\n"; |
339 #} |
317 |
340 |
318 print "\n"; |
341 $e->dump if $Cf->debug; |
|
342 |
|
343 if ($modified) { |
|
344 $r = $e->update($ldap); |
|
345 die $r->error . $r->code if $r->code; |
|
346 } |
|
347 |
|
348 verbose "ok\n"; |
|
349 |
|
350 print "\n"; |
319 } |
351 } |
320 } |
352 } |
321 |
353 |
322 sub _delete() { |
354 sub _delete() { |
323 # Wir gehen davon aus, daß es einen dn uid=USER,ou=.... gibt, den wir löschen können. |
355 |
324 # Wir löschen den kompletten Container. Es kann natürlich sein, daß er noch jemand anders gehört. |
356 # Wir gehen davon aus, daß es einen dn uid=USER,ou=.... gibt, den wir löschen können. |
325 # Dann ist das Pech. Um es besser zu haben, müßten wir für alles unsere eigenen |
357 # Wir löschen den kompletten Container. Es kann natürlich sein, daß er noch jemand anders gehört. |
326 # Objektklassen haben... |
358 # Dann ist das Pech. Um es besser zu haben, müßten wir für alles unsere eigenen |
327 |
359 # Objektklassen haben... |
328 if (!@ARGV) { |
360 |
329 print "User: "; |
361 if ( !@ARGV ) { |
330 chomp($_ = <>); |
362 print "User: "; |
331 @ARGV = ($_); |
363 chomp( $_ = <> ); |
332 } |
364 @ARGV = ($_); |
333 |
365 } |
334 |
366 |
335 foreach (@ARGV) { |
367 foreach (@ARGV) { |
336 my $user = $_; |
368 my $user = $_; |
337 my $dn = "uid=$user,$ubase"; |
369 my $dn = "uid=$user,$ubase"; |
338 |
370 |
339 verbose("$user:\n"); |
371 verbose("$user:\n"); |
340 |
372 |
341 # Nachsehen, ob es noch aliase gibt, in denen dieser Nutzer steht: |
373 # Nachsehen, ob es noch aliase gibt, in denen dieser Nutzer steht: |
342 my $r = $ldap->search(base => $abase, |
374 my $r = $ldap->search( |
343 filter => "(".AT_FORWARDINGADDRESS."=$_)", |
375 base => $abase, |
344 attrs => ["mail", AT_FORWARDINGADDRESS]); |
376 filter => "(" . AT_FORWARDINGADDRESS . "=$_)", |
345 while (my $e = $r->shift_entry) { |
377 attrs => [ "mail", AT_FORWARDINGADDRESS ] |
346 verbose("\tdeleting $user from alias ".$e->get_value("mail")."..."); |
378 ); |
347 $e->delete((AT_FORWARDINGADDRESS) => [$user]); |
379 while ( my $e = $r->shift_entry ) { |
348 |
380 verbose("\tdeleting $user from alias " |
349 my $r = $e->update($ldap); |
381 . $e->get_value("mail") |
350 if ($r->code == 0) { verbose("ok\n") } |
382 . "..." ); |
351 else { die $r->error } |
383 $e->delete( (AT_FORWARDINGADDRESS) => [$user] ); |
352 } |
384 |
353 |
385 my $r = $e->update($ldap); |
354 verbose("\tdeleting $dn..."); |
386 if ( $r->code == 0 ) { verbose("ok\n") } |
355 $r = $ldap->delete($dn); |
387 else { die $r->error } |
356 |
388 } |
357 if ($r->code == LDAP_NO_SUCH_OBJECT) { |
389 |
358 verbose("doesn't exist"); |
390 verbose("\tdeleting $dn..."); |
359 } elsif ($r->code == 0) { |
391 $r = $ldap->delete($dn); |
360 verbose("ok"); |
392 |
361 } else { |
393 if ( $r->code == LDAP_NO_SUCH_OBJECT ) { |
362 die $r->error; |
394 verbose("doesn't exist"); |
363 } |
395 } elsif ( $r->code == 0 ) { |
364 verbose("\n"); |
396 verbose("ok"); |
365 |
397 } else { |
366 if ($Cf->mbox) { |
398 die $r->error; |
|
399 } |
|
400 verbose("\n"); |
|
401 |
|
402 if ( $Cf->mbox ) { |
367 my $m = _mbox($user); |
403 my $m = _mbox($user); |
368 if (not (defined $m and $m)) { |
404 if ( not( defined $m and $m ) ) { |
369 verbose("can't determine mbox location - not deleting it"); |
405 verbose("can't determine mbox location - not deleting it"); |
370 } else { |
406 } else { |
371 verbose("\tdeleting $m..."); |
407 verbose("\tdeleting $m..."); |
372 verbose((remove_tree $m) ? 'ok' : " Can't remove '$m': $!"); |
408 verbose( ( remove_tree $m) ? 'ok' : " Can't remove '$m': $!" ); |
373 } |
409 } |
374 } |
410 } |
375 |
411 |
376 verbose("\n"); |
412 verbose("\n"); |
377 |
413 |
378 } |
414 } |
379 } |
415 } |
380 |
416 |
381 sub _list() { |
417 sub _list() { |
382 my $filter; |
418 my $filter; |
383 @ARGV = ("*") unless @ARGV; |
419 @ARGV = ("*") unless @ARGV; |
384 $filter = "(|" . join("", map { "(uid=$_)" } @ARGV) . ")"; |
420 $filter = "(|" . join( "", map { "(uid=$_)" } @ARGV ) . ")"; |
385 |
421 |
386 my $r = $ldap->search( |
422 my $r = $ldap->search( |
387 filter => $filter, |
423 filter => $filter, |
388 base => $ubase, |
424 base => $ubase, |
389 #attrs => [qw/uid cn mail userPassword/, (AT_PRIMARYADDRESS)] |
425 |
|
426 #attrs => [qw/uid cn mail userPassword/, (AT_PRIMARYADDRESS)] |
390 ); |
427 ); |
391 die $r->error if $r->code; |
428 die $r->error if $r->code; |
392 |
429 |
393 #if (-t STDOUT) { open(LESS, "|less -F -X") and select LESS; } |
430 #if (-t STDOUT) { open(LESS, "|less -F -X") and select LESS; } |
394 |
431 |
395 |
432 while ( my $e = $r->shift_entry ) { |
396 while (my $e = $r->shift_entry) { |
433 my $uid = $e->get_value("uid"); |
397 my $uid = $e->get_value("uid"); |
434 my $cn = join( ", ", $e->get_value("cn") ); |
398 my $cn = join(", ", $e->get_value("cn")); |
435 my $mr = $e->get_value(AT_PRIMARYADDRESS) || ""; # ?? |
399 my $mr = $e->get_value(AT_PRIMARYADDRESS) || ""; # ?? |
436 my $ml = join( ", ", $e->get_value(AT_ADDRESS) ) || ""; # ?? |
400 my $ml = join(", ", $e->get_value(AT_ADDRESS)) || ""; # ?? |
437 my $mg = join( ", ", $e->get_value(AT_GROUP) ) || ""; # ?? |
401 my $mg = join(", ", $e->get_value(AT_GROUP)) || ""; # ?? |
438 my $forw = join( ", ", $e->get_value(AT_FORWARDINGADDRESS) ) || ""; |
402 my $forw = join (", ", $e->get_value(AT_FORWARDINGADDRESS)) || ""; |
439 |
403 |
440 print "$uid: $cn <$mr>"; |
404 print "$uid: $cn <$mr>"; |
441 |
405 |
442 #if (($e->get_value("iusRestrictedMail")||"") eq "TRUE") { |
406 #if (($e->get_value("iusRestrictedMail")||"") eq "TRUE") { |
443 #print " INTERNAL"; |
407 #print " INTERNAL"; |
444 #} |
408 #} |
|
409 |
445 |
410 # das imap protokoll sieht keine zustandsänderung von 'authenticated' |
446 # das imap protokoll sieht keine zustandsänderung von 'authenticated' |
411 # zu 'not authenticated' vor - daher müssen wir für jeden nutzer eine |
447 # zu 'not authenticated' vor - daher müssen wir für jeden nutzer eine |
412 # eigene verbindung aufbauen |
448 # eigene verbindung aufbauen |
413 $imap = Mail::IMAPTalk->new(Server => $Cf->imap_server, Port => $Cf->imap_port) |
449 $imap = Mail::IMAPTalk->new( |
414 or die "Can't connect to IMAP Server '", $Cf->imap_server, "', Port '", $Cf->imap_port, "': ", $@; |
450 Server => $Cf->imap_server, |
415 $imap->login("$uid*" . $Cf->imap_admin, $imap_password ) or die $@; |
451 Port => $Cf->imap_port |
416 my $folders = $imap->list('', '*') or die $@; |
452 ) |
|
453 or die "Can't connect to IMAP Server '", $Cf->imap_server, |
|
454 "', Port '", $Cf->imap_port, "': ", $@; |
|
455 $imap->login( "$uid*" . $Cf->imap_admin, $imap_password ) or die $@; |
|
456 my $folders = $imap->list( '', '*' ) or die $@; |
417 my %q; |
457 my %q; |
418 for my $f(@{$folders}) { |
458 for my $f ( @{$folders} ) { |
|
459 |
419 # single folder sieht wie folgt aus: [[flag1, flag2, ...], separator, foldername] |
460 # single folder sieht wie folgt aus: [[flag1, flag2, ...], separator, foldername] |
420 my $q = $imap->getquotaroot($f->[2]) or die $@; |
461 my $q = $imap->getquotaroot( $f->[2] ) or die $@; |
421 delete $q->{quotaroot}; |
462 delete $q->{quotaroot}; |
422 %q = ( %q, %{$q} ); |
463 %q = ( %q, %{$q} ); |
423 } |
464 } |
424 $imap->logout or die $@; |
465 $imap->logout or die $@; |
425 |
466 |
426 # da wir uns anmelden konnten haben wir auch eine 'mbox' |
467 # da wir uns anmelden konnten haben wir auch eine 'mbox' |
427 print ", mbox"; |
468 print ", mbox"; |
428 my $has_quota; |
469 my $has_quota; |
429 for my $qr(keys %q) { |
470 for my $qr ( keys %q ) { |
430 my @q = @{$q{$qr}}; |
471 my @q = @{ $q{$qr} }; |
431 my $elem = ''; |
472 my $elem = ''; |
432 $elem = shift @q while defined $elem and $elem ne 'STORAGE'; |
473 $elem = shift @q while defined $elem and $elem ne 'STORAGE'; |
433 my ($used, $max) = map { int($_ / 1024) } @q[0..1]; |
474 my ( $used, $max ) = map { int( $_ / 1024 ) } @q[ 0 .. 1 ]; |
434 print ", quota '$qr': $used/${max}MB " . int(100 * $used/$max) . "%"; |
475 print ", quota '$qr': $used/${max}MB " |
|
476 . int( 100 * $used / $max ) . "%"; |
435 $has_quota = 1; |
477 $has_quota = 1; |
436 } |
478 } |
437 print ", no quota" unless $has_quota; |
479 print ", no quota" unless $has_quota; |
438 print "\n"; |
480 print "\n"; |
439 |
481 |
440 print "\tPassword: ", $> == 0 ? $e->get_value("userPassword") : "*", "\n"; |
482 print "\tPassword: ", $> == 0 ? $e->get_value("userPassword") : "*", |
441 |
483 "\n"; |
442 print wrap("\t", "\t\t", "Other Adresses: $ml\n") if $ml; |
484 |
443 print wrap("\t", "\t\t", "Mail Groups: $mg\n") if $mg; |
485 print wrap( "\t", "\t\t", "Other Adresses: $ml\n" ) if $ml; |
444 print wrap("\t", "\t\t", "Forwardings: $forw\n") if $forw; |
486 print wrap( "\t", "\t\t", "Mail Groups: $mg\n" ) if $mg; |
|
487 print wrap( "\t", "\t\t", "Forwardings: $forw\n" ) if $forw; |
445 |
488 |
446 } |
489 } |
447 } |
490 } |
448 |
491 |
449 sub verbose(@) { |
492 sub verbose(@) { |