|
1 package shared; |
|
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. |
|
77 # Die IMAP-Mailbox wird angelegt. |
|
78 |
|
79 |
|
80 die "Need mailbox name for creation\n" if not @ARGV; |
|
81 my $mbox = shift @ARGV; |
|
82 |
|
83 verbose("shared mbox:\n"); |
|
84 |
|
85 if($Cf->mbox) { |
|
86 verbose("\n\t$mbox..."); |
|
87 |
|
88 if ($imap->list($mbox)) { verbose("exists") } |
|
89 else { |
|
90 $imap->create($mbox) and verbose("ok") or die $@; |
|
91 $imap->setacl($mbox, $Cf->imap_admin => "lrswipcda") or die $@; |
|
92 $imap->setquota($mbox, STORAGE => 1024 * $Cf->imap_quota) or die $@; |
|
93 } |
|
94 } |
|
95 |
|
96 |
|
97 verbose("\n"); |
|
98 } |
|
99 |
|
100 sub _modify() { |
|
101 # Auch hier gehen wir davon aus, daß die dn direkt aus dem User-Namen folgt: |
|
102 # dn: uid=USER,... |
|
103 my (@users) = @ARGV or die "Need username(s)\n"; |
|
104 my @dns; |
|
105 |
|
106 my $r = $ldap->search(base => $ubase, |
|
107 filter => "(|" . join("", map { "(uid=$_)" } @ARGV) . ")"); |
|
108 die $r->error if $r->code; |
|
109 die "No entries found.\n" if $r->count == 0; |
|
110 |
|
111 while (my $e = $r->shift_entry) { |
|
112 my $r; |
|
113 |
|
114 my $user = $e->get_value("uid"); |
|
115 my $dn = $e->dn; |
|
116 my $mbox = "user/$user"; |
|
117 |
|
118 my $modified = 0; |
|
119 verbose "$user:"; |
|
120 |
|
121 verbose "\n\t$dn..."; |
|
122 |
|
123 # Fix: iusMailOptions wurde erst später eingeführt, bei Bedarf also hinzufügen |
|
124 #if (!grep /^iusMailOptions$/, @{$e->get("objectClass")}) { |
|
125 #$e->add(objectClass => "iusMailOptions"); |
|
126 #} |
|
127 |
|
128 if (my $cn = $Cf->fullname) { |
|
129 # Aus dem Fullnamen leiten wir cn und sn ab. |
|
130 my $sn = (reverse split " ", $cn)[0]; |
|
131 |
|
132 if ($cn =~ s/^\+//) { |
|
133 $e->replace( |
|
134 cn => [uniq $e->get("cn"), $cn], |
|
135 sn => [uniq $e->get("sn"), $sn]); |
|
136 } elsif ($cn =~ s/^-//) { |
|
137 $e->delete(cn => [$cn], sn => [$sn]); |
|
138 } else { $e->replace(cn => $cn, sn => $sn); } |
|
139 $modified++; |
|
140 } |
|
141 |
|
142 if (defined $Cf->other) { |
|
143 my @o = split /,/, $Cf->other; |
|
144 grep { /^[+-]/ } @o or $e->delete(AT_ADDRESS); |
|
145 |
|
146 foreach my $a (split /,/, $Cf->other) { |
|
147 if ($a =~ s/^-//) { |
|
148 $e->delete((AT_ADDRESS) => [$a]) |
|
149 } else { |
|
150 $a =~ s/^\+//; |
|
151 |
|
152 # Darf noch nicht woanders sein |
|
153 $r = $ldap->search(base => $ubase, filter => "(mail=$a)"); |
|
154 die $r->error if $r->code; |
|
155 die "$a ist schon vergeben\n" if $r->count; |
|
156 |
|
157 $e->add((AT_ADDRESS) => [$a]) |
|
158 } |
|
159 } |
|
160 $modified++; |
|
161 } |
|
162 |
|
163 if (defined $Cf->group) { |
|
164 my @g = split /,/, $Cf->group; |
|
165 grep { /^[+-]/ } @g or $e->delete(AT_GROUP) |
|
166 if $e->get_value(AT_GROUP); |
|
167 |
|
168 foreach my $g (@g) { |
|
169 if ($g =~ s/^-//) { |
|
170 $e->delete((AT_GROUP) => [$g]) |
|
171 } else { |
|
172 $g =~ s/^\+//; |
|
173 $e->add((AT_GROUP) => [$g]) |
|
174 } |
|
175 } |
|
176 $modified++; |
|
177 } |
|
178 |
|
179 if (my $a = $Cf->primary) { |
|
180 $r = $ldap->search(base => $ubase, |
|
181 # filter => "(|(mailPrimaryAddress=$a)(mail=$a))"); |
|
182 filter => "(mail=$a)"); |
|
183 die $r->error if $r->code; |
|
184 die "$a ist schon vergeben\n" if $r->count; |
|
185 |
|
186 $e->replace((AT_PRIMARYADDRESS) => $Cf->primary); |
|
187 $modified++; |
|
188 } |
|
189 |
|
190 if (my $pw = _mkpw($Cf->password)) { |
|
191 $e->replace(userPassword => $pw); |
|
192 $modified++; |
|
193 } |
|
194 |
|
195 #if ($Cf->internal ne ":") { |
|
196 #$e->replace(iusRestrictedMail => $Cf->internal ? "TRUE" : "FALSE"); |
|
197 #$modified++; |
|
198 #} |
|
199 |
|
200 $e->dump if $Cf->debug; |
|
201 |
|
202 if ($modified) { |
|
203 $r = $e->update($ldap); |
|
204 die $r->error.$r->code if $r->code; |
|
205 } |
|
206 |
|
207 # FIXME: Wenn keine Mailbox existiert, gibt es hier ein Problem |
|
208 if (defined $Cf->imap_quota) { |
|
209 $imap->setquota($mbox, STORAGE => $Cf->imap_quota * 1024) |
|
210 or die $@; |
|
211 } |
|
212 |
|
213 verbose "ok\n"; |
|
214 |
|
215 print "\n"; |
|
216 } |
|
217 } |
|
218 |
|
219 sub _delete() { |
|
220 |
|
221 if (!@ARGV) { |
|
222 print "Mailbox: "; |
|
223 chomp($_ = <>); |
|
224 @ARGV = ($_); |
|
225 } |
|
226 |
|
227 foreach my $mbox (@ARGV) { |
|
228 |
|
229 if ($Cf->mbox) { |
|
230 verbose("\tdeleting mbox $mbox..."); |
|
231 $imap->delete($mbox) and verbose("ok") |
|
232 or verbose($imap->error); |
|
233 } |
|
234 |
|
235 verbose("\n"); |
|
236 } |
|
237 |
|
238 } |
|
239 |
|
240 sub _list() { |
|
241 @ARGV = ("*") unless @ARGV; |
|
242 |
|
243 foreach (@ARGV) { |
|
244 my @mboxes = $imap->list($_); |
|
245 |
|
246 foreach (@mboxes) { |
|
247 my ($mbox, $attr, $sep) = @$_; |
|
248 next if $mbox =~ /^user$sep/; |
|
249 |
|
250 print "$mbox: shared mailbox"; |
|
251 |
|
252 # Quota |
|
253 my %q = $imap->listquota($mbox); |
|
254 my ($used, $max) = map { int($_ / 1024) } @{$q{STORAGE}}; |
|
255 |
|
256 if (!$max) { |
|
257 print ", no quota"; |
|
258 } else { |
|
259 print ", quota ($used/$max): " . int(100 * $used/$max) . "%"; |
|
260 } |
|
261 print "\n"; |
|
262 |
|
263 # ACL |
|
264 my %acl = $imap->listacl($mbox); |
|
265 foreach (sort keys %acl) { |
|
266 print "\t$_: $acl{$_}\n"; |
|
267 } |
|
268 } |
|
269 |
|
270 } |
|
271 } |
|
272 |
|
273 sub verbose(@) { |
|
274 printf STDERR @_; |
|
275 } |
|
276 |
|
277 sub uniq(@) { |
|
278 my %x; |
|
279 @x{@_} = (); |
|
280 return keys %x; |
|
281 } |
|
282 |
|
283 { my @pw; |
|
284 sub _mkpw($) { |
|
285 my $in = $_[0]; |
|
286 |
|
287 return $in unless $in and $in eq "{pwgen}"; |
|
288 |
|
289 if (!@pw) { |
|
290 chomp(@pw = `pwgen 8 10 2>/dev/null|| mkpasswd`); |
|
291 die "pwgen/mkpasswd: $!" if $?; |
|
292 } |
|
293 return shift @pw; |
|
294 |
|
295 } } |
|
296 |
|
297 1; |
|
298 # vim:sts=4 sw=4 aw ai sm nohlsearch: |