|
1 package account; |
|
2 # © Heiko Schlittermann |
|
3 # $Id$ |
|
4 # $URL$ |
|
5 |
|
6 use strict; |
|
7 use warnings; |
|
8 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::Entry; |
|
11 use Cyrus::IMAP::Admin; |
|
12 use Text::Wrap; |
|
13 use password; |
|
14 |
|
15 |
|
16 my $Cf; |
|
17 my ($ldap, $ubase, $abase); |
|
18 my ($imap); |
|
19 END { $imap and $imap = undef; }; |
|
20 |
|
21 |
|
22 sub _add(); |
|
23 sub _list(); |
|
24 sub _delete(); |
|
25 sub _mkpw($); |
|
26 sub uniq(@); |
|
27 sub verbose(@); |
|
28 |
|
29 sub OU_ACCOUNTS(); |
|
30 sub OU_ALIASES(); |
|
31 sub AT_PRIMARYADDRESS(); |
|
32 sub OC_RECIPIENT(); |
|
33 sub AT_ADDRESS(); |
|
34 sub AT_GROUP(); |
|
35 sub AT_FORWARDINGADDRESS(); |
|
36 |
|
37 sub import(@) { |
|
38 $Cf = shift; |
|
39 |
|
40 require constant; |
|
41 import constant OU_ACCOUNTS => $Cf->ldap_ou_accounts; |
|
42 import constant OU_ALIASES => $Cf->ldap_ou_aliases; |
|
43 import constant OC_RECIPIENT => $Cf->ldap_oc_recipient; |
|
44 import constant AT_PRIMARYADDRESS => $Cf->ldap_at_primaryaddress; |
|
45 import constant AT_ADDRESS => $Cf->ldap_at_address; |
|
46 import constant AT_GROUP => $Cf->ldap_at_group; |
|
47 import constant AT_FORWARDINGADDRESS => $Cf->ldap_at_forwardingaddress; |
|
48 |
|
49 $ubase = OU_ACCOUNTS . "," . $Cf->ldap_base; |
|
50 $abase = OU_ALIASES . "," . $Cf->ldap_base; |
|
51 } |
|
52 |
|
53 sub run($) { |
|
54 # Eigentlich brauchen wir für alles imap und ldap |
|
55 $ldap = new Net::LDAP $Cf->ldap_server or die; |
|
56 my $r = $ldap->bind($Cf->ldap_bind_dn, |
|
57 password => $Cf->ldap_password || $ENV{LDAP_PASS} || password::ask("LDAP (". $Cf->ldap_bind_dn .") password: ")); |
|
58 die $r->error, "\n" if $r->code; |
|
59 |
|
60 $imap = new Cyrus::IMAP::Admin or die $@; |
|
61 $imap->authenticate(-server => $Cf->imap_server, -user => $Cf->imap_admin, |
|
62 -password => $Cf->imap_password || $ENV{IMAP_PASS} || password::ask("IMAP (". $Cf->imap_admin .") password: ")) |
|
63 or die $@; |
|
64 |
|
65 |
|
66 if ($Cf->list) { _list() } |
|
67 elsif ($Cf->add) { _add() } |
|
68 elsif ($Cf->delete) { _delete() } |
|
69 elsif ($Cf->modify) { _modify() } |
|
70 else { die "Need action (--add|--modify|--list|--delete)\n" }; |
|
71 |
|
72 } |
|
73 |
|
74 sub _add() { |
|
75 # Beim Hinzufügen tragen wir nur das unbedingt notwendige |
|
76 # ein. Wenn es schon eine mailPrimaryAddress gibt oder eine |
|
77 # mail, machen wir gar nichts. |
|
78 # Ansonsten: |
|
79 # uid wird hinzugefügt |
|
80 # cn, sn bleiben unangetastet |
|
81 # Wenn die mailbox-Option gesetzt ist, wird die |
|
82 # IMAP-Mailbox angelegt. |
|
83 |
|
84 |
|
85 die "Need user name for creation\n" if not @ARGV; |
|
86 my $user = shift @ARGV; |
|
87 my $mbox = "user/$user"; |
|
88 my $cn = $Cf->fullname || $user; |
|
89 my $sn = (reverse split " ", $cn)[0]; |
|
90 my $mailPrimaryAddress = $Cf->primary || $user; |
|
91 my $mailAddress = [$user, split /,/, $Cf->other || ""]; |
|
92 my $mailGroup = [split /,/, $Cf->group || ""]; |
|
93 my $pw = _mkpw($Cf->password || "{pwgen}"); |
|
94 |
|
95 |
|
96 my $dn = "uid=$user,$ubase"; |
|
97 my $r; |
|
98 |
|
99 verbose("$user:\n"); |
|
100 |
|
101 verbose("\t$dn..."); |
|
102 |
|
103 $r = $ldap->search(base => $ubase, filter => "(uid=$user)"); |
|
104 die $r->error if $r->code; |
|
105 die "Multiple entries not expected" if $r->count > 1; |
|
106 |
|
107 my $e; |
|
108 if ($r->count) { |
|
109 $e = $r->shift_entry; |
|
110 } else { |
|
111 $e = new Net::LDAP::Entry; |
|
112 $e->dn($dn); |
|
113 } |
|
114 |
|
115 if ($e->exists("mail") || $e->exists(AT_PRIMARYADDRESS) || $e->exists("userPassword")) { |
|
116 verbose "exists\n"; |
|
117 } else { |
|
118 |
|
119 # Bevor wir ans Werk gehen, noch ein paar Tests (mailPrimaryAddress und mail darf |
|
120 # darf noch nicht vergeben sein) |
|
121 foreach my $a ($mailPrimaryAddress, @$mailAddress) { |
|
122 $a =~ s/!$// and next; # wenn ein ! am Ende steht, dann ist es so gewollt und wird |
|
123 # nicht geprüft |
|
124 $r = $ldap->search(filter => "(mail=$a)", base => $ubase); |
|
125 die $r->error if $r->code; |
|
126 die "$a ist schon vergeben\n" if $r->count; |
|
127 } |
|
128 |
|
129 $e->replace(objectClass => [uniq $e->get("objectClass"), qw/uidObject person/, OC_RECIPIENT]); |
|
130 $e->replace(uid => [uniq $e->get("uid"), $user]); |
|
131 |
|
132 $e->add((AT_ADDRESS) => $mailAddress); |
|
133 $e->add((AT_PRIMARYADDRESS) => $mailPrimaryAddress); |
|
134 $e->add(userPassword => $pw); |
|
135 $e->add((AT_GROUP) => $mailGroup) if @$mailGroup; |
|
136 # $e->add(iusRestrictedMail => $Cf->internal) if $Cf->internal ne ":"; |
|
137 |
|
138 $e->exists("sn") or $e->add(sn => $sn); |
|
139 $e->exists("cn") or $e->add(cn => $cn); |
|
140 |
|
141 |
|
142 $r = $e->update($ldap); |
|
143 die $r->error if $r->code; |
|
144 |
|
145 verbose("ok"); |
|
146 verbose(" Password: $pw") if not $Cf->password or $Cf->password eq "{pwgen}"; |
|
147 } |
|
148 |
|
149 if($Cf->mbox) { |
|
150 verbose("\n\t$mbox..."); |
|
151 |
|
152 if ($imap->list($mbox)) { verbose("exists") } |
|
153 else { |
|
154 $imap->create($mbox) and verbose("ok") or die $@; |
|
155 $imap->setacl($mbox, $Cf->imap_admin => "lrswipcda") or die $@; |
|
156 $imap->setquota($mbox, STORAGE => 1024 * $Cf->imap_quota) or die $@; |
|
157 } |
|
158 } |
|
159 |
|
160 |
|
161 verbose("\n"); |
|
162 } |
|
163 |
|
164 sub _modify() { |
|
165 # Auch hier gehen wir davon aus, daß die dn direkt aus dem User-Namen folgt: |
|
166 # dn: uid=USER,... |
|
167 my (@users) = @ARGV or die "Need username(s)\n"; |
|
168 my @dns; |
|
169 |
|
170 my $r = $ldap->search(base => $ubase, |
|
171 filter => "(|" . join("", map { "(uid=$_)" } @ARGV) . ")"); |
|
172 die $r->error if $r->code; |
|
173 die "No entries found.\n" if $r->count == 0; |
|
174 |
|
175 while (my $e = $r->shift_entry) { |
|
176 my $r; |
|
177 |
|
178 my $user = $e->get_value("uid"); |
|
179 my $dn = $e->dn; |
|
180 my $mbox = "user/$user"; |
|
181 |
|
182 my $modified = 0; |
|
183 verbose "$user:"; |
|
184 |
|
185 verbose "\n\t$dn..."; |
|
186 |
|
187 # Fix: iusMailOptions wurde erst später eingeführt, bei Bedarf also hinzufügen |
|
188 #if (!grep /^iusMailOptions$/, @{$e->get("objectClass")}) { |
|
189 #$e->add(objectClass => "iusMailOptions"); |
|
190 #} |
|
191 |
|
192 if (my $cn = $Cf->fullname) { |
|
193 # Aus dem Fullnamen leiten wir cn und sn ab. |
|
194 my $sn = (reverse split " ", $cn)[0]; |
|
195 |
|
196 if ($cn =~ s/^\+//) { |
|
197 $e->replace( |
|
198 cn => [uniq $e->get("cn"), $cn], |
|
199 sn => [uniq $e->get("sn"), $sn]); |
|
200 } elsif ($cn =~ s/^-//) { |
|
201 $e->delete(cn => [$cn], sn => [$sn]); |
|
202 } else { $e->replace(cn => $cn, sn => $sn); } |
|
203 $modified++; |
|
204 } |
|
205 |
|
206 if (defined $Cf->other) { |
|
207 my @o = split /,/, $Cf->other; |
|
208 grep { /^[+-]/ } @o or $e->delete(AT_ADDRESS); |
|
209 |
|
210 foreach my $a (split /,/, $Cf->other) { |
|
211 if ($a =~ s/^-//) { |
|
212 $e->delete((AT_ADDRESS) => [$a]) |
|
213 } else { |
|
214 $a =~ s/^\+//; |
|
215 |
|
216 # Darf noch nicht woanders sein |
|
217 $r = $ldap->search(base => $ubase, filter => "(mail=$a)"); |
|
218 die $r->error if $r->code; |
|
219 die "$a ist schon vergeben\n" if $r->count; |
|
220 |
|
221 $e->add((AT_ADDRESS) => [$a]) |
|
222 } |
|
223 } |
|
224 $modified++; |
|
225 } |
|
226 |
|
227 if (defined $Cf->group) { |
|
228 my @g = split /,/, $Cf->group; |
|
229 grep { /^[+-]/ } @g or $e->delete(AT_GROUP); |
|
230 |
|
231 foreach my $g (@g) { |
|
232 if ($g =~ s/^-//) { |
|
233 $e->delete((AT_GROUP) => [$g]) |
|
234 } else { |
|
235 $g =~ s/^\+//; |
|
236 $e->add((AT_GROUP) => [$g]) |
|
237 } |
|
238 } |
|
239 $modified++; |
|
240 } |
|
241 |
|
242 if (my $a = $Cf->primary) { |
|
243 $r = $ldap->search(base => $ubase, |
|
244 # filter => "(|(mailPrimaryAddress=$a)(mail=$a))"); |
|
245 filter => "(mail=$a)"); |
|
246 die $r->error if $r->code; |
|
247 die "$a ist schon vergeben\n" if $r->count; |
|
248 |
|
249 $e->replace((AT_PRIMARYADDRESS) => $Cf->primary); |
|
250 $modified++; |
|
251 } |
|
252 |
|
253 if (my $pw = _mkpw($Cf->password)) { |
|
254 $e->replace(userPassword => $pw); |
|
255 $modified++; |
|
256 } |
|
257 |
|
258 #if ($Cf->internal ne ":") { |
|
259 #$e->replace(iusRestrictedMail => $Cf->internal ? "TRUE" : "FALSE"); |
|
260 #$modified++; |
|
261 #} |
|
262 |
|
263 $e->dump if $Cf->debug; |
|
264 |
|
265 if ($modified) { |
|
266 $r = $e->update($ldap); |
|
267 die $r->error.$r->code if $r->code; |
|
268 } |
|
269 |
|
270 # FIXME: Wenn keine Mailbox existiert, gibt es hier ein Problem |
|
271 if (defined $Cf->imap_quota) { |
|
272 $imap->setquota($mbox, STORAGE => $Cf->imap_quota * 1024) |
|
273 or die $@; |
|
274 } |
|
275 |
|
276 verbose "ok\n"; |
|
277 |
|
278 print "\n"; |
|
279 } |
|
280 } |
|
281 |
|
282 sub _delete() { |
|
283 # Wir gehen davon aus, daß es einen dn uid=USER,ou=.... gibt, den wir löschen können. |
|
284 # Wir löschen den kompletten Container. Es kann natürlich sein, daß er noch jemand anders gehört. |
|
285 # Dann ist das Pech. Um es besser zu haben, müßten wir für alles unsere eigenen |
|
286 # Objektklassen haben... |
|
287 |
|
288 if (!@ARGV) { |
|
289 print "User: "; |
|
290 chomp($_ = <>); |
|
291 @ARGV = ($_); |
|
292 } |
|
293 |
|
294 |
|
295 foreach (@ARGV) { |
|
296 my $user = $_; |
|
297 my $dn = "uid=$user,$ubase"; |
|
298 my $mbox = "user/$user"; |
|
299 |
|
300 verbose("$user:\n"); |
|
301 |
|
302 # Nachsehen, ob es noch aliase gibt, in denen dieser Nutzer steht: |
|
303 my $r = $ldap->search(base => $abase, |
|
304 filter => "(".AT_FORWARDINGADDRESS."=$_)", |
|
305 attrs => ["mail", AT_FORWARDINGADDRESS]); |
|
306 while (my $e = $r->shift_entry) { |
|
307 verbose("\tdeleting $user from alias ".$e->get_value("mail")."..."); |
|
308 $e->delete((AT_FORWARDINGADDRESS) => [$user]); |
|
309 |
|
310 my $r = $e->update($ldap); |
|
311 if ($r->code == 0) { verbose("ok\n") } |
|
312 else { die $r->error } |
|
313 } |
|
314 |
|
315 verbose("\tdeleting $dn..."); |
|
316 $r = $ldap->delete($dn); |
|
317 |
|
318 if ($r->code == LDAP_NO_SUCH_OBJECT) { |
|
319 verbose("doesn't exist"); |
|
320 } elsif ($r->code == 0) { |
|
321 verbose("ok"); |
|
322 } else { |
|
323 die $r->error; |
|
324 } |
|
325 verbose("\n"); |
|
326 |
|
327 if ($Cf->mbox) { |
|
328 verbose("\tdeleting mbox $mbox..."); |
|
329 $imap->delete($mbox) and verbose("ok") |
|
330 or verbose($imap->error); |
|
331 } |
|
332 |
|
333 verbose("\n"); |
|
334 |
|
335 } |
|
336 } |
|
337 |
|
338 sub _list() { |
|
339 my $filter; |
|
340 @ARGV = ("*") unless @ARGV; |
|
341 $filter = "(|" . join("", map { "(uid=$_)" } @ARGV) . ")"; |
|
342 |
|
343 my $r = $ldap->search( |
|
344 filter => $filter, |
|
345 base => $ubase, |
|
346 attrs => [qw/uid cn mail userPassword/] |
|
347 ); |
|
348 die $r->error if $r->code; |
|
349 |
|
350 |
|
351 while (my $e = $r->shift_entry) { |
|
352 my $uid = $e->get_value("uid"); |
|
353 my $cn = join(", ", $e->get_value("cn")); |
|
354 my $mr = $e->get_value(AT_PRIMARYADDRESS) || "??"; |
|
355 my $ml = join(", ", $e->get_value(AT_ADDRESS)) || "??"; |
|
356 my $mg = join(", ", $e->get_value(AT_GROUP)) || "??"; |
|
357 my $mbox = "user/$uid"; |
|
358 |
|
359 print "$uid: $cn <$mr>"; |
|
360 |
|
361 #if (($e->get_value("iusRestrictedMail")||"") eq "TRUE") { |
|
362 #print " INTERNAL"; |
|
363 #} |
|
364 |
|
365 MBOX: { |
|
366 if (!$imap->list($mbox)) { |
|
367 print ", no mbox"; |
|
368 last MBOX; |
|
369 } |
|
370 print ", mbox"; |
|
371 my %q = $imap->listquota($mbox); |
|
372 my ($used, $max) = map { int($_ / 1024) } @{$q{STORAGE}}; |
|
373 |
|
374 if (!$max) { |
|
375 print ", no quota"; |
|
376 last MBOX; |
|
377 } |
|
378 print ", quota ($used/$max): " . int(100 * $used/$max) . "%"; |
|
379 } |
|
380 print "\n"; |
|
381 |
|
382 print "\tPassword: ", $> == 0 ? $e->get_value("userPassword") : "*", "\n"; |
|
383 |
|
384 print wrap("\t", "\t\t", "Local Adresses: $ml\n") if $ml; |
|
385 print wrap("\t", "\t\t", "Mail Groups: $mg\n") if $mg; |
|
386 |
|
387 } |
|
388 } |
|
389 |
|
390 sub verbose(@) { |
|
391 printf STDERR @_; |
|
392 } |
|
393 |
|
394 sub uniq(@) { |
|
395 my %x; |
|
396 @x{@_} = (); |
|
397 return keys %x; |
|
398 } |
|
399 |
|
400 { my @pw; |
|
401 sub _mkpw($) { |
|
402 my $in = $_[0]; |
|
403 |
|
404 return $in unless $in and $in eq "{pwgen}"; |
|
405 |
|
406 if (!@pw) { |
|
407 chomp(@pw = `pwgen 8 10 2>/dev/null|| mkpasswd`); |
|
408 die "pwgen/mkpasswd: $!" if $?; |
|
409 } |
|
410 return shift @pw; |
|
411 |
|
412 } } |
|
413 |
|
414 1; |
|
415 # vim:sts=4 sw=4 aw ai sm nohlsearch: |