|
1 package alias; |
|
2 # © Heiko Schlittermann |
|
3 # $Id$ |
|
4 # $URL$ |
|
5 |
|
6 use strict; |
|
7 use warnings; |
|
8 use Net::LDAP; |
|
9 use Net::LDAP::Constant qw( |
|
10 LDAP_ALREADY_EXISTS |
|
11 LDAP_NO_SUCH_OBJECT |
|
12 LDAP_NO_SUCH_ATTRIBUTE |
|
13 LDAP_TYPE_OR_VALUE_EXISTS); |
|
14 use Net::LDAP::Entry; |
|
15 use Text::Wrap; |
|
16 |
|
17 use password; |
|
18 |
|
19 my $Cf; |
|
20 my ($ldap, $abase); |
|
21 |
|
22 sub _add(); |
|
23 sub _list(); |
|
24 sub _delete(); |
|
25 sub uniq(@); |
|
26 sub verbose(@); |
|
27 sub columns(); |
|
28 |
|
29 sub OU_ALIASES(); |
|
30 sub OC_ALIAS(); |
|
31 sub AT_FORWARDINGADDRESS(); |
|
32 |
|
33 sub import(@) { |
|
34 $Cf = shift; |
|
35 |
|
36 require constant; |
|
37 import constant OU_ALIASES => $Cf->ldap_ou_aliases; |
|
38 import constant OC_ALIAS => $Cf->ldap_oc_alias; |
|
39 import constant AT_FORWARDINGADDRESS => $Cf->ldap_at_forwardingaddress; |
|
40 |
|
41 $abase = OU_ALIASES . "," . $Cf->ldap_base; |
|
42 } |
|
43 |
|
44 sub run($) { |
|
45 # Eigentlich brauchen wir für alles ldap |
|
46 $ldap = new Net::LDAP $Cf->ldap_server or die; |
|
47 my $r = $ldap->bind($Cf->ldap_bind_dn, |
|
48 password => $Cf->ldap_password || $ENV{LDAP_PASS} || password::ask("LDAP (". $Cf->ldap_bind_dn .") password: ")); |
|
49 die $r->error, "\n" if $r->code; |
|
50 |
|
51 |
|
52 if ($Cf->list) { _list() } |
|
53 elsif ($Cf->add) { _add() } |
|
54 elsif ($Cf->delete) { _delete() } |
|
55 elsif ($Cf->modify) { _modify() } |
|
56 else { die "Need action (--add|--modify|--list|--delete)\n" }; |
|
57 |
|
58 } |
|
59 |
|
60 sub _add() { |
|
61 # Wenn's den Alias schon gibt, wird er nicht mehr |
|
62 # angelegt |
|
63 |
|
64 die "Need alias name for creation\n" if not @ARGV; |
|
65 die "Need members\n" if not defined $Cf->members; |
|
66 my $alias = shift @ARGV; |
|
67 my @members = split /,/, $Cf->members; |
|
68 my $dn = "mail=$alias,$abase"; |
|
69 |
|
70 my $r; |
|
71 |
|
72 verbose("$alias:\n"); |
|
73 verbose("\t$dn..."); |
|
74 |
|
75 $r = $ldap->search(base => $abase, filter => "(mail=$alias)"); |
|
76 die $r->error if $r->code; |
|
77 die "Multiple entries not expected" if $r->count > 1; |
|
78 |
|
79 $r = $ldap->add($dn, attrs => [ |
|
80 objectClass => OC_ALIAS, |
|
81 mail => $alias, |
|
82 (AT_FORWARDINGADDRESS) => \@members |
|
83 ]); |
|
84 if ($r->code == LDAP_ALREADY_EXISTS) { verbose "exists" } |
|
85 elsif ($r->code) { die $r->error } |
|
86 else { verbose "ok" } |
|
87 |
|
88 verbose("\n"); |
|
89 } |
|
90 |
|
91 sub _modify() { |
|
92 # Auch hier gehen wir davon aus, daß die dn direkt aus dem Alias-Namen folgt: |
|
93 # dn: cn=USER,... |
|
94 # Jetzt behandeln wir lediglich die Modifikation auf Basis eines |
|
95 # alias-Namens! |
|
96 |
|
97 my (@users) = @ARGV or die "Need alias names(s)\n"; |
|
98 my @members = split /,/, $Cf->members; |
|
99 my @add = grep { s/^\+// } @_ = @members; |
|
100 my @del = grep { s/^-// } @_ = @members; |
|
101 my @set = grep { !/^[\+-]/ } @members; |
|
102 |
|
103 |
|
104 foreach my $alias (@ARGV) { |
|
105 my $dn = "mail=$alias,$abase"; |
|
106 verbose "$alias:"; |
|
107 |
|
108 my $r = $ldap->search(base => $abase, filter => "(mail=$alias)"); |
|
109 die $r->error if $r->code; |
|
110 |
|
111 if ($r->count == 0) { |
|
112 verbose " not found\n"; |
|
113 next; |
|
114 } |
|
115 |
|
116 while (my $e = $r->shift_entry) { |
|
117 |
|
118 verbose "\n\t" . $e->dn . " "; |
|
119 |
|
120 if (@set) { |
|
121 $e->replace((AT_FORWARDINGADDRESS) => \@set); |
|
122 } else { |
|
123 @add and $e->replace((AT_FORWARDINGADDRESS) => [uniq $e->get(AT_FORWARDINGADDRESS), @add]); |
|
124 @del and $e->delete((AT_FORWARDINGADDRESS) => \@del); |
|
125 } |
|
126 |
|
127 $e->dump if $Cf->debug; |
|
128 |
|
129 my $r = $e->update($ldap); |
|
130 if ($r->code == LDAP_NO_SUCH_ATTRIBUTE) { |
|
131 verbose "no member"; |
|
132 } elsif ($r->code) { |
|
133 die $r->error . "/" . $r->code; |
|
134 } else { |
|
135 verbose "ok"; |
|
136 } |
|
137 } |
|
138 |
|
139 print "\n"; |
|
140 } |
|
141 } |
|
142 |
|
143 sub _delete() { |
|
144 # Wir gehen davon aus, daß es einen dn mail=ALIAS,ou=MailAliases,... |
|
145 # gibt und löschen diesen gnadenlos. |
|
146 |
|
147 if (!@ARGV) { |
|
148 print "User: "; |
|
149 chomp($_ = <>); |
|
150 @ARGV = ($_); |
|
151 } |
|
152 |
|
153 foreach (@ARGV) { |
|
154 my $dn = "mail=$_,$abase"; |
|
155 |
|
156 verbose("$_:\n"); |
|
157 verbose("\tdeleting $dn..."); |
|
158 my $r = $ldap->delete($dn); |
|
159 |
|
160 if ($r->code == LDAP_NO_SUCH_OBJECT) { |
|
161 verbose("doesn't exist"); |
|
162 } elsif ($r->code == 0) { |
|
163 verbose("ok"); |
|
164 } else { |
|
165 die $r->error; |
|
166 } |
|
167 |
|
168 verbose("\n"); |
|
169 |
|
170 } |
|
171 } |
|
172 |
|
173 sub _list() { |
|
174 my $filter; |
|
175 @ARGV = ("*") unless @ARGV; |
|
176 $filter = "(|" . join("", map { "(mail=$_)" } @ARGV) . ")"; |
|
177 |
|
178 my $r = $ldap->search( |
|
179 filter => $filter, |
|
180 base => $abase, |
|
181 attrs => [qw/mail/, AT_FORWARDINGADDRESS], |
|
182 ); |
|
183 |
|
184 die $r->error if $r->code; |
|
185 |
|
186 $Text::Wrap::columns = columns() || 80; |
|
187 |
|
188 while (my $e = $r->shift_entry) { |
|
189 my $mail = $e->get("mail"); |
|
190 |
|
191 print wrap("", "\t", $e->get_value("mail") |
|
192 . ": " |
|
193 . join(", ", $e->get(AT_FORWARDINGADDRESS)) |
|
194 . "\n"); |
|
195 |
|
196 } |
|
197 } |
|
198 |
|
199 sub verbose(@) { |
|
200 printf STDERR @_; |
|
201 } |
|
202 |
|
203 sub uniq(@) { |
|
204 my %x; |
|
205 @x{@_} = (); |
|
206 return keys %x; |
|
207 } |
|
208 |
|
209 sub columns() { |
|
210 `stty -a` =~ /columns\s+(\d+)/; |
|
211 $1; |
|
212 } |
|
213 |
|
214 1; |
|
215 # vim:sts=4 sw=4 aw ai sm: |