]>
Commit | Line | Data |
---|---|---|
261ea3ca DC |
1 | package PVE::LDAP; |
2 | ||
3 | use strict; | |
4 | use warnings; | |
5 | ||
6 | use Net::IP; | |
7 | use Net::LDAP; | |
8 | use Net::LDAP::Control::Paged; | |
9 | use Net::LDAP::Constant qw(LDAP_CONTROL_PAGED); | |
10 | ||
11 | sub ldap_connect { | |
12 | my ($servers, $scheme, $port, $opts) = @_; | |
13 | ||
14 | my $start_tls = 0; | |
15 | ||
16 | if ($scheme eq 'ldap+starttls') { | |
17 | $scheme = 'ldap'; | |
18 | $start_tls = 1; | |
19 | } | |
20 | ||
21 | my %ldap_opts = ( | |
22 | scheme => $scheme, | |
23 | port => $port, | |
24 | timeout => 10, | |
25 | onerror => 'die', | |
26 | ); | |
27 | ||
28 | my $hosts = []; | |
29 | for my $host (@$servers) { | |
30 | if (Net::IP::ip_is_ipv6($host)) { | |
31 | push @$hosts, "[$host]"; | |
32 | } else { | |
33 | push @$hosts, $host; | |
34 | } | |
35 | } | |
36 | ||
37 | for my $opt (qw(clientcert clientkey capath cafile sslversion verify)) { | |
38 | $ldap_opts{$opt} = $opts->{$opt} if $opts->{$opt}; | |
39 | } | |
40 | ||
1175979f | 41 | my $ldap = Net::LDAP->new($hosts, %ldap_opts) || die "$@\n"; |
261ea3ca DC |
42 | |
43 | if ($start_tls) { | |
44 | $ldap->start_tls(%$opts); | |
45 | } | |
46 | ||
47 | return $ldap; | |
48 | } | |
49 | ||
50 | sub ldap_bind { | |
51 | my ($ldap, $dn, $pw) = @_; | |
52 | ||
53 | my $res; | |
54 | if (defined($dn) && defined($pw)) { | |
55 | $res = $ldap->bind($dn, password => $pw); | |
56 | } else { # anonymous bind | |
57 | $res = $ldap->bind(); | |
58 | } | |
59 | ||
60 | my $code = $res->code; | |
61 | my $err = $res->error; | |
62 | ||
63 | die "ldap bind failed: $err\n" if $code; | |
64 | } | |
65 | ||
66 | sub get_user_dn { | |
67 | my ($ldap, $name, $attr, $base_dn) = @_; | |
68 | ||
69 | # search for dn | |
70 | my $result = $ldap->search( | |
71 | base => $base_dn // "", | |
72 | scope => "sub", | |
73 | filter => "$attr=$name", | |
74 | attrs => ['dn'] | |
75 | ); | |
76 | return undef if !$result->entries; | |
77 | my @entries = $result->entries; | |
78 | return $entries[0]->dn; | |
79 | } | |
80 | ||
81 | sub auth_user_dn { | |
82 | my ($ldap, $dn, $pw, $noerr) = @_; | |
83 | my $res = $ldap->bind($dn, password => $pw); | |
84 | ||
85 | my $code = $res->code; | |
86 | my $err = $res->error; | |
87 | ||
88 | if ($code) { | |
89 | return undef if $noerr; | |
90 | die $err; | |
91 | } | |
92 | ||
93 | return 1; | |
94 | } | |
95 | ||
96 | sub query_users { | |
340e0881 | 97 | my ($ldap, $filter, $attributes, $base_dn, $classes) = @_; |
261ea3ca DC |
98 | |
99 | # build filter from given filter and attribute list | |
100 | my $tmp = "(|"; | |
101 | foreach my $att (@$attributes) { | |
102 | $tmp .= "($att=*)"; | |
103 | } | |
104 | $tmp .= ")"; | |
105 | ||
340e0881 DC |
106 | if ($classes) { |
107 | $tmp = "(&$tmp(|"; | |
108 | for my $class (@$classes) { | |
109 | $tmp .= "(objectclass=$class)"; | |
110 | } | |
111 | $tmp .= "))"; | |
112 | } | |
113 | ||
261ea3ca DC |
114 | if ($filter) { |
115 | $filter = "($filter)" if $filter !~ m/^\(.*\)$/; | |
116 | $filter = "(&${filter}${tmp})" | |
117 | } else { | |
118 | $filter = $tmp; | |
119 | } | |
120 | ||
121 | my $page = Net::LDAP::Control::Paged->new(size => 900); | |
122 | ||
123 | my @args = ( | |
124 | base => $base_dn // "", | |
125 | scope => "subtree", | |
126 | filter => $filter, | |
127 | control => [ $page ], | |
128 | attrs => [ @$attributes, 'memberOf'], | |
129 | ); | |
130 | ||
131 | my $cookie; | |
132 | my $err; | |
133 | my $users = []; | |
134 | ||
135 | while(1) { | |
136 | ||
137 | my $mesg = $ldap->search(@args); | |
138 | ||
139 | # stop on error | |
140 | if ($mesg->code) { | |
141 | $err = "ldap user search error: " . $mesg->error; | |
142 | last; | |
143 | } | |
144 | ||
145 | #foreach my $entry ($mesg->entries) { $entry->dump; } | |
146 | foreach my $entry ($mesg->entries) { | |
147 | my $user = { | |
148 | dn => $entry->dn, | |
149 | attributes => {}, | |
150 | groups => [$entry->get_value('memberOf')], | |
151 | }; | |
152 | ||
153 | foreach my $attr (@$attributes) { | |
154 | my $vals = [$entry->get_value($attr)]; | |
155 | if (scalar(@$vals)) { | |
156 | $user->{attributes}->{$attr} = $vals; | |
157 | } | |
158 | } | |
159 | ||
160 | push @$users, $user; | |
161 | } | |
162 | ||
163 | # Get cookie from paged control | |
164 | my ($resp) = $mesg->control(LDAP_CONTROL_PAGED) or last; | |
165 | $cookie = $resp->cookie; | |
166 | ||
167 | last if (!defined($cookie) || !length($cookie)); | |
168 | ||
169 | # Set cookie in paged control | |
170 | $page->cookie($cookie); | |
171 | } | |
172 | ||
173 | if (defined($cookie) && length($cookie)) { | |
174 | # We had an abnormal exit, so let the server know we do not want any more | |
175 | $page->cookie($cookie); | |
176 | $page->size(0); | |
177 | $ldap->search(@args); | |
178 | $err = "LDAP user query unsuccessful" if !$err; | |
179 | } | |
180 | ||
181 | die $err if $err; | |
182 | ||
183 | return $users; | |
184 | } | |
185 | ||
186 | sub query_groups { | |
3c775763 | 187 | my ($ldap, $base_dn, $classes, $filter, $group_name_attr) = @_; |
261ea3ca DC |
188 | |
189 | my $tmp = "(|"; | |
190 | for my $class (@$classes) { | |
191 | $tmp .= "(objectclass=$class)"; | |
192 | } | |
193 | $tmp .= ")"; | |
194 | ||
195 | if ($filter) { | |
196 | $filter = "($filter)" if $filter !~ m/^\(.*\)$/; | |
197 | $filter = "(&${filter}${tmp})" | |
198 | } else { | |
199 | $filter = $tmp; | |
200 | } | |
201 | ||
202 | my $page = Net::LDAP::Control::Paged->new(size => 100); | |
203 | ||
3c775763 DC |
204 | my $attrs = [ 'member', 'uniqueMember' ]; |
205 | push @$attrs, $group_name_attr if $group_name_attr; | |
261ea3ca DC |
206 | my @args = ( |
207 | base => $base_dn, | |
208 | scope => "subtree", | |
209 | filter => $filter, | |
210 | control => [ $page ], | |
3c775763 | 211 | attrs => $attrs, |
261ea3ca DC |
212 | ); |
213 | ||
214 | my $cookie; | |
215 | my $err; | |
216 | my $groups = []; | |
217 | ||
218 | while(1) { | |
219 | ||
220 | my $mesg = $ldap->search(@args); | |
221 | ||
222 | # stop on error | |
223 | if ($mesg->code) { | |
224 | $err = "ldap group search error: " . $mesg->error; | |
225 | last; | |
226 | } | |
227 | ||
228 | foreach my $entry ( $mesg->entries ) { | |
229 | my $group = { | |
230 | dn => $entry->dn, | |
231 | members => [] | |
232 | }; | |
233 | my $members = [$entry->get_value('member')]; | |
234 | if (!scalar(@$members)) { | |
235 | $members = [$entry->get_value('uniqueMember')]; | |
236 | } | |
237 | $group->{members} = $members; | |
3c775763 DC |
238 | if ($group_name_attr && (my $name = $entry->get_value($group_name_attr))) { |
239 | $group->{name} = $name; | |
240 | } | |
261ea3ca DC |
241 | push @$groups, $group; |
242 | } | |
243 | ||
244 | # Get cookie from paged control | |
245 | my ($resp) = $mesg->control(LDAP_CONTROL_PAGED) or last; | |
246 | $cookie = $resp->cookie; | |
247 | ||
248 | last if (!defined($cookie) || !length($cookie)); | |
249 | ||
250 | # Set cookie in paged control | |
251 | $page->cookie($cookie); | |
252 | } | |
253 | ||
254 | if ($cookie) { | |
255 | # We had an abnormal exit, so let the server know we do not want any more | |
256 | $page->cookie($cookie); | |
257 | $page->size(0); | |
258 | $ldap->search(@args); | |
259 | $err = "LDAP group query unsuccessful" if !$err; | |
260 | } | |
261 | ||
262 | die $err if $err; | |
263 | ||
264 | return $groups; | |
265 | } | |
266 | ||
267 | 1; |