35 |
36 |
36 sub import(@) { |
37 sub import(@) { |
37 $Cf = shift; |
38 $Cf = shift; |
38 |
39 |
39 require constant; |
40 require constant; |
40 import constant OU_ACCOUNTS => $Cf->ldap_ou_accounts; |
41 import constant OU_ACCOUNTS => $Cf->ldap_ou_accounts; |
41 import constant OU_ALIASES => $Cf->ldap_ou_aliases; |
42 import constant OU_ALIASES => $Cf->ldap_ou_aliases; |
42 import constant OC_RECIPIENT => $Cf->ldap_oc_recipient; |
43 import constant OC_RECIPIENT => $Cf->ldap_oc_recipient; |
43 import constant AT_PRIMARYADDRESS => $Cf->ldap_at_primaryaddress; |
44 import constant AT_PRIMARYADDRESS => $Cf->ldap_at_primaryaddress; |
44 import constant AT_ADDRESS => $Cf->ldap_at_address; |
45 import constant AT_ADDRESS => $Cf->ldap_at_address; |
45 import constant AT_GROUP => $Cf->ldap_at_group; |
46 import constant AT_GROUP => $Cf->ldap_at_group; |
46 import constant AT_FORWARDINGADDRESS => $Cf->ldap_at_forwardingaddress; |
47 import constant AT_FORWARDINGADDRESS => $Cf->ldap_at_forwardingaddress; |
47 |
48 |
48 $ubase = OU_ACCOUNTS . "," . $Cf->ldap_base; |
49 $ubase = OU_ACCOUNTS . "," . $Cf->ldap_base; |
49 $abase = OU_ALIASES . "," . $Cf->ldap_base; |
50 $abase = OU_ALIASES . "," . $Cf->ldap_base; |
50 } |
51 } |
51 |
52 |
52 sub run($) { |
53 sub run($) { |
|
54 |
53 # Eigentlich brauchen wir für alles imap und ldap |
55 # Eigentlich brauchen wir für alles imap und ldap |
54 $ldap = new Net::LDAP $Cf->ldap_server or die; |
56 $ldap = new Net::LDAP $Cf->ldap_server or die; |
55 my $r = $ldap->bind($Cf->ldap_bind_dn, |
57 my $r = $ldap->bind( $Cf->ldap_bind_dn, |
56 password => $Cf->ldap_password || $ENV{LDAP_PASS} || password::ask("LDAP (". $Cf->ldap_bind_dn .") password: ")); |
58 password => $Cf->ldap_password |
|
59 || $ENV{LDAP_PASS} |
|
60 || password::ask( "LDAP (" . $Cf->ldap_bind_dn . ") password: " ) ); |
57 die $r->error, "\n" if $r->code; |
61 die $r->error, "\n" if $r->code; |
58 |
62 |
59 $imap = new Cyrus::IMAP::Admin or die $@; |
63 $imap = new Cyrus::IMAP::Admin or die $@; |
60 $imap->authenticate(-server => $Cf->imap_server, -user => $Cf->imap_admin, |
64 $imap->authenticate( |
61 -password => $Cf->imap_password || $ENV{IMAP_PASS} || password::ask("IMAP (". $Cf->imap_admin .") password: ")) |
65 -server => $Cf->imap_server, |
62 or die $@; |
66 -user => $Cf->imap_admin, |
63 |
67 -password => $Cf->imap_password |
64 |
68 || $ENV{IMAP_PASS} |
65 if ($Cf->list) { _list() } |
69 || password::ask( "IMAP (" . $Cf->imap_admin . ") password: " ) |
66 elsif ($Cf->add) { _add() } |
70 ) or die $@; |
67 elsif ($Cf->delete) { _delete() } |
71 |
68 elsif ($Cf->modify) { _modify() } |
72 if ( $Cf->list ) { _list() } |
69 else { die "Need action (--add|--modify|--list|--delete)\n" }; |
73 elsif ( $Cf->add ) { _add() } |
|
74 elsif ( $Cf->delete ) { _delete() } |
|
75 elsif ( $Cf->modify ) { _modify() } |
|
76 else { die "Need action (--add|--modify|--list|--delete)\n" } |
70 |
77 |
71 } |
78 } |
72 |
79 |
73 sub _add() { |
80 sub _add() { |
74 # Beim Hinzufügen tragen wir nur das unbedingt notwendige |
81 |
75 # ein. |
82 # Beim Hinzufügen tragen wir nur das unbedingt notwendige |
76 # Die IMAP-Mailbox wird angelegt. |
83 # ein. |
77 |
84 # Die IMAP-Mailbox wird angelegt. |
78 |
85 |
79 die "Need mailbox name for creation\n" if not @ARGV; |
86 die "Need mailbox name for creation\n" if not @ARGV; |
80 my $mbox = shift @ARGV; |
87 my $mbox = shift @ARGV; |
81 |
88 |
82 verbose("shared mbox:\n"); |
89 verbose("shared mbox:\n"); |
83 |
90 |
84 if($Cf->mbox) { |
91 if ( $Cf->mbox ) { |
85 verbose("\n\t$mbox..."); |
92 verbose("\n\t$mbox..."); |
86 |
93 |
87 if ($imap->list($mbox)) { verbose("exists") } |
94 if ( $imap->list($mbox) ) { verbose("exists") } |
88 else { |
95 else { |
89 $imap->create($mbox) and verbose("ok") or die $@; |
96 $imap->create($mbox) and verbose("ok") or die $@; |
90 $imap->setacl($mbox, $Cf->imap_admin => "lrswipcda") or die $@; |
97 $imap->setacl( $mbox, $Cf->imap_admin => "lrswipcda" ) or die $@; |
91 $imap->setquota($mbox, STORAGE => 1024 * $Cf->imap_quota) or die $@; |
98 $imap->setquota( $mbox, STORAGE => 1024 * $Cf->imap_quota ) |
92 } |
99 or die $@; |
93 } |
100 } |
94 |
101 } |
95 |
102 |
96 verbose("\n"); |
103 verbose("\n"); |
97 } |
104 } |
98 |
105 |
99 sub _modify() { |
106 sub _modify() { |
100 # Auch hier gehen wir davon aus, daß die dn direkt aus dem User-Namen folgt: |
107 |
101 # dn: uid=USER,... |
108 # Auch hier gehen wir davon aus, daß die dn direkt aus dem User-Namen folgt: |
|
109 # dn: uid=USER,... |
102 my (@users) = @ARGV or die "Need username(s)\n"; |
110 my (@users) = @ARGV or die "Need username(s)\n"; |
103 my @dns; |
111 my @dns; |
104 |
112 |
105 my $r = $ldap->search(base => $ubase, |
113 my $r = $ldap->search( |
106 filter => "(|" . join("", map { "(uid=$_)" } @ARGV) . ")"); |
114 base => $ubase, |
|
115 filter => "(|" . join( "", map { "(uid=$_)" } @ARGV ) . ")" |
|
116 ); |
107 die $r->error if $r->code; |
117 die $r->error if $r->code; |
108 die "No entries found.\n" if $r->count == 0; |
118 die "No entries found.\n" if $r->count == 0; |
109 |
119 |
110 while (my $e = $r->shift_entry) { |
120 while ( my $e = $r->shift_entry ) { |
111 my $r; |
121 my $r; |
112 |
122 |
113 my $user = $e->get_value("uid"); |
123 my $user = $e->get_value("uid"); |
114 my $dn = $e->dn; |
124 my $dn = $e->dn; |
115 my $mbox = "user/$user"; |
125 my $mbox = "user/$user"; |
116 |
126 |
117 my $modified = 0; |
127 my $modified = 0; |
118 verbose "$user:"; |
128 verbose "$user:"; |
119 |
129 |
120 verbose "\n\t$dn..."; |
130 verbose "\n\t$dn..."; |
121 |
131 |
122 # Fix: iusMailOptions wurde erst später eingeführt, bei Bedarf also hinzufügen |
132 # Fix: iusMailOptions wurde erst später eingeführt, bei Bedarf also hinzufügen |
123 #if (!grep /^iusMailOptions$/, @{$e->get("objectClass")}) { |
133 #if (!grep /^iusMailOptions$/, @{$e->get("objectClass")}) { |
124 #$e->add(objectClass => "iusMailOptions"); |
134 #$e->add(objectClass => "iusMailOptions"); |
125 #} |
135 #} |
126 |
136 |
127 if (my $cn = $Cf->fullname) { |
137 if ( my $cn = $Cf->fullname ) { |
128 # Aus dem Fullnamen leiten wir cn und sn ab. |
138 |
129 my $sn = (reverse split " ", $cn)[0]; |
139 # Aus dem Fullnamen leiten wir cn und sn ab. |
130 |
140 my $sn = ( reverse split " ", $cn )[0]; |
131 if ($cn =~ s/^\+//) { |
141 |
132 $e->replace( |
142 if ( $cn =~ s/^\+// ) { |
133 cn => [uniq $e->get("cn"), $cn], |
143 $e->replace( |
134 sn => [uniq $e->get("sn"), $sn]); |
144 cn => [ uniq $e->get("cn"), $cn ], |
135 } elsif ($cn =~ s/^-//) { |
145 sn => [ uniq $e->get("sn"), $sn ] |
136 $e->delete(cn => [$cn], sn => [$sn]); |
146 ); |
137 } else { $e->replace(cn => $cn, sn => $sn); } |
147 } elsif ( $cn =~ s/^-// ) { |
138 $modified++; |
148 $e->delete( cn => [$cn], sn => [$sn] ); |
139 } |
149 } else { |
140 |
150 $e->replace( cn => $cn, sn => $sn ); |
141 if (defined $Cf->other) { |
151 } |
142 my @o = split /,/, $Cf->other; |
152 $modified++; |
143 grep { /^[+-]/ } @o or $e->delete(AT_ADDRESS); |
153 } |
144 |
154 |
145 foreach my $a (split /,/, $Cf->other) { |
155 if ( defined $Cf->other ) { |
146 if ($a =~ s/^-//) { |
156 my @o = split /,/, $Cf->other; |
147 $e->delete((AT_ADDRESS) => [$a]) |
157 grep { /^[+-]/ } @o or $e->delete(AT_ADDRESS); |
148 } else { |
158 |
149 $a =~ s/^\+//; |
159 foreach my $a ( split /,/, $Cf->other ) { |
150 |
160 if ( $a =~ s/^-// ) { |
151 # Darf noch nicht woanders sein |
161 $e->delete( (AT_ADDRESS) => [$a] ); |
152 $r = $ldap->search(base => $ubase, filter => "(mail=$a)"); |
162 } else { |
153 die $r->error if $r->code; |
163 $a =~ s/^\+//; |
154 die "$a ist schon vergeben\n" if $r->count; |
164 |
155 |
165 # Darf noch nicht woanders sein |
156 $e->add((AT_ADDRESS) => [$a]) |
166 $r = $ldap->search( base => $ubase, filter => "(mail=$a)" ); |
157 } |
167 die $r->error if $r->code; |
158 } |
168 die "$a ist schon vergeben\n" if $r->count; |
159 $modified++; |
169 |
160 } |
170 $e->add( (AT_ADDRESS) => [$a] ); |
161 |
171 } |
162 if (defined $Cf->group) { |
172 } |
163 my @g = split /,/, $Cf->group; |
173 $modified++; |
164 grep { /^[+-]/ } @g or $e->delete(AT_GROUP) |
174 } |
165 if $e->get_value(AT_GROUP); |
175 |
166 |
176 if ( defined $Cf->group ) { |
167 foreach my $g (@g) { |
177 my @g = split /,/, $Cf->group; |
168 if ($g =~ s/^-//) { |
178 grep { /^[+-]/ } @g |
169 $e->delete((AT_GROUP) => [$g]) |
179 or $e->delete(AT_GROUP) |
170 } else { |
180 if $e->get_value(AT_GROUP); |
171 $g =~ s/^\+//; |
181 |
172 $e->add((AT_GROUP) => [$g]) |
182 foreach my $g (@g) { |
173 } |
183 if ( $g =~ s/^-// ) { |
174 } |
184 $e->delete( (AT_GROUP) => [$g] ); |
175 $modified++; |
185 } else { |
176 } |
186 $g =~ s/^\+//; |
177 |
187 $e->add( (AT_GROUP) => [$g] ); |
178 if (my $a = $Cf->primary) { |
188 } |
179 $r = $ldap->search(base => $ubase, |
189 } |
180 # filter => "(|(mailPrimaryAddress=$a)(mail=$a))"); |
190 $modified++; |
181 filter => "(mail=$a)"); |
191 } |
182 die $r->error if $r->code; |
192 |
183 die "$a ist schon vergeben\n" if $r->count; |
193 if ( my $a = $Cf->primary ) { |
184 |
194 $r = $ldap->search( |
185 $e->replace((AT_PRIMARYADDRESS) => $Cf->primary); |
195 base => $ubase, |
186 $modified++; |
196 |
187 } |
197 # filter => "(|(mailPrimaryAddress=$a)(mail=$a))"); |
188 |
198 filter => "(mail=$a)" |
189 if (my $pw = _mkpw($Cf->password)) { |
199 ); |
190 $e->replace(userPassword => $pw); |
200 die $r->error if $r->code; |
191 $modified++; |
201 die "$a ist schon vergeben\n" if $r->count; |
192 } |
202 |
193 |
203 $e->replace( (AT_PRIMARYADDRESS) => $Cf->primary ); |
194 #if ($Cf->internal ne ":") { |
204 $modified++; |
195 #$e->replace(iusRestrictedMail => $Cf->internal ? "TRUE" : "FALSE"); |
205 } |
196 #$modified++; |
206 |
197 #} |
207 if ( my $pw = _mkpw( $Cf->password ) ) { |
198 |
208 $e->replace( userPassword => $pw ); |
199 $e->dump if $Cf->debug; |
209 $modified++; |
200 |
210 } |
201 if ($modified) { |
211 |
202 $r = $e->update($ldap); |
212 #if ($Cf->internal ne ":") { |
203 die $r->error.$r->code if $r->code; |
213 #$e->replace(iusRestrictedMail => $Cf->internal ? "TRUE" : "FALSE"); |
204 } |
214 #$modified++; |
205 |
215 #} |
206 # FIXME: Wenn keine Mailbox existiert, gibt es hier ein Problem |
216 |
207 if (defined $Cf->imap_quota) { |
217 $e->dump if $Cf->debug; |
208 $imap->setquota($mbox, STORAGE => $Cf->imap_quota * 1024) |
218 |
209 or die $@; |
219 if ($modified) { |
210 } |
220 $r = $e->update($ldap); |
211 |
221 die $r->error . $r->code if $r->code; |
212 verbose "ok\n"; |
222 } |
213 |
223 |
214 print "\n"; |
224 # FIXME: Wenn keine Mailbox existiert, gibt es hier ein Problem |
|
225 if ( defined $Cf->imap_quota ) { |
|
226 $imap->setquota( $mbox, STORAGE => $Cf->imap_quota * 1024 ) |
|
227 or die $@; |
|
228 } |
|
229 |
|
230 verbose "ok\n"; |
|
231 |
|
232 print "\n"; |
215 } |
233 } |
216 } |
234 } |
217 |
235 |
218 sub _delete() { |
236 sub _delete() { |
219 |
237 |
220 if (!@ARGV) { |
238 if ( !@ARGV ) { |
221 print "Mailbox: "; |
239 print "Mailbox: "; |
222 chomp($_ = <>); |
240 chomp( $_ = <> ); |
223 @ARGV = ($_); |
241 @ARGV = ($_); |
224 } |
242 } |
225 |
243 |
226 foreach my $mbox (@ARGV) { |
244 foreach my $mbox (@ARGV) { |
227 |
245 |
228 if ($Cf->mbox) { |
246 if ( $Cf->mbox ) { |
229 verbose("\tdeleting mbox $mbox..."); |
247 verbose("\tdeleting mbox $mbox..."); |
230 $imap->delete($mbox) and verbose("ok") |
248 $imap->delete($mbox) and verbose("ok") |
231 or verbose($imap->error); |
249 or verbose( $imap->error ); |
232 } |
250 } |
233 |
251 |
234 verbose("\n"); |
252 verbose("\n"); |
235 } |
253 } |
236 |
254 |
237 } |
255 } |
238 |
256 |
239 sub _list() { |
257 sub _list() { |
240 @ARGV = ("*") unless @ARGV; |
258 @ARGV = ("*") unless @ARGV; |
241 |
259 |
242 foreach (@ARGV) { |
260 foreach (@ARGV) { |
243 my @mboxes = $imap->list($_); |
261 my @mboxes = $imap->list($_); |
244 |
262 |
245 foreach (@mboxes) { |
263 foreach (@mboxes) { |
246 my ($mbox, $attr, $sep) = @$_; |
264 my ( $mbox, $attr, $sep ) = @$_; |
247 next if $mbox =~ /^user$sep/; |
265 next if $mbox =~ /^user$sep/; |
248 |
266 |
249 print "$mbox: shared mailbox"; |
267 print "$mbox: shared mailbox"; |
250 |
268 |
251 # Quota |
269 # Quota |
252 my %q = $imap->listquota($mbox); |
270 my %q = $imap->listquota($mbox); |
253 my ($used, $max) = map { int($_ / 1024) } @{$q{STORAGE}}; |
271 my ( $used, $max ) = map { int( $_ / 1024 ) } @{ $q{STORAGE} }; |
254 |
272 |
255 if (!$max) { |
273 if ( !$max ) { |
256 print ", no quota"; |
274 print ", no quota"; |
257 } else { |
275 } else { |
258 print ", quota ($used/$max): " . int(100 * $used/$max) . "%"; |
276 print ", quota ($used/$max): " |
259 } |
277 . int( 100 * $used / $max ) . "%"; |
260 print "\n"; |
278 } |
261 |
279 print "\n"; |
262 # ACL |
280 |
263 my %acl = $imap->listacl($mbox); |
281 # ACL |
264 foreach (sort keys %acl) { |
282 my %acl = $imap->listacl($mbox); |
265 print "\t$_: $acl{$_}\n"; |
283 foreach ( sort keys %acl ) { |
266 } |
284 print "\t$_: $acl{$_}\n"; |
267 } |
285 } |
268 |
286 } |
|
287 |
269 } |
288 } |
270 } |
289 } |
271 |
290 |
272 sub verbose(@) { |
291 sub verbose(@) { |
273 printf STDERR @_; |
292 printf STDERR @_; |