1#!perl
2
3use Test::More;
4
5use Net::LDAP;
6use Net::LDAP::Constant qw(LDAP_CONTROL_MATCHEDVALUES);
7use Net::LDAP::Control::MatchedValues;
8
9BEGIN { require "t/common.pl" }
10
11
12my @tests;
13
14{ # parse DATA into a list (= tests) of hashes (= test parameters) of lists (= parameter values)
15  local $/ = '';
16  while(my $para = <DATA> ) {
17    my @lines = split(/\n/, $para);
18    my %params;
19    chomp(@lines);
20    @lines = grep(!/^\s*(?:#.*?)?$/, @lines);
21    map { push(@{$params{$1}}, $2) if (/^(\w+):\s*(.*)$/) } @lines;
22    push(@tests, \%params)  if (%params);
23  }
24}
25
26start_server()
27? plan tests => 4 + 3 * scalar(@tests)
28: plan skip_all => 'no server';
29
30
31$ldap = client();
32isa_ok($ldap, Net::LDAP, "client");
33
34$rootdse = $ldap->root_dse;
35isa_ok($rootdse, Net::LDAP::RootDSE, "root_dse");
36
37
38SKIP: {
39  skip("RootDSE does not offer MatchedValues control", 2 + 3 * scalar(@tests))
40    unless($rootdse->supported_control(LDAP_CONTROL_MATCHEDVALUES));
41
42  #$mesg = $ldap->start_tls(%tlsargs);
43  #ok(!$mesg->code, "start_tls yields: ". $m->error);
44
45  $mesg = $ldap->bind($MANAGERDN, password => $PASSWD);
46  ok(!$mesg->code, "bind: " . $mesg->code . ": " . $mesg->error);
47
48  ok(ldif_populate($ldap, "data/40-in.ldif"), "data/40-in.ldif");
49
50  foreach my $test (@tests) {
51    $control = Net::LDAP::Control::MatchedValues->new(matchedValues => $test->{match}->[0]);
52    isa_ok($control, Net::LDAP::Control::MatchedValues, "control object");
53
54    $mesg = $ldap->search(base => $test->{dn}->[0],
55  		filter => $test->{filter} ? $test->{filter}->[0] : '(objectclass=*)',
56  		scope => $test->{scope} ? $test->{scope}->[0] : 'sub',
57  		attrs => $test->{attrs} || [ '*' ],
58  		control => $control);
59    ok(!$mesg->code, "search: " . $mesg->code . ": " . $mesg->error);
60
61    my $success = 1;
62    my $entry = $mesg->entry(0);
63    foreach $attr (@{$test->{attrs}}) {
64      my $vals = join(':', sort $entry->get_value($attr));
65      my $expected = $test->{$attr} ? join(':', sort @{$test->{$attr}}) : '';
66
67      $success = 0  if ($vals ne $expected);
68    }
69    ok($success, "values match expectations");
70  }
71}
72
73__DATA__
74
75## each section below represents one test; logic similar to , structure similar to LDIF
76# each tests needs at least the elements
77# - match:  the value of the MatchedValues control
78# - dn:     the base-DN of the search
79# - filter: the filter to use  (first element important only)
80
81# one attribute, no wildcards
82match: ((cn=Babs Jensen))
83dn: cn=Barbara Jensen, ou=Information Technology Division, ou=People, o=University of Michigan, c=US
84filter: (mail=bjensen@mailgw.umich.edu)
85scope: base
86attrs: cn
87cn: Babs Jensen
88
89# one attribute, wildcards
90match: ((cn=Babs*Jensen))
91dn: cn=Barbara Jensen, ou=Information Technology Division, ou=People, o=University of Michigan, c=US
92filter: (mail=bjensen@mailgw.umich.edu)
93scope: base
94attrs: cn
95cn: Babs Jensen
96
97# one attribute, wildcards, attrs beyond match
98match: ((cn=Babs*Jensen))
99dn: cn=Barbara Jensen, ou=Information Technology Division, ou=People, o=University of Michigan, c=US
100filter: (mail=bjensen@mailgw.umich.edu)
101scope: base
102attrs: cn
103attrs: title
104cn: Babs Jensen
105
106# one attribute, wildcards, no matching value
107match: ((description=*LDAP*))
108dn: cn=Barbara Jensen, ou=Information Technology Division, ou=People, o=University of Michigan, c=US
109filter: (mail=bjensen@mailgw.umich.edu)
110scope: base
111attrs: description
112
113# multiple attributes, wildcards
114match: ((cn=* Jensen)(title=*Myth*))
115dn: cn=Barbara Jensen, ou=Information Technology Division, ou=People, o=University of Michigan, c=US
116filter: (mail=bjensen@mailgw.umich.edu)
117scope: base
118attrs: title
119attrs: cn
120title: Mythical Manager, Research Systems
121cn: Barbara Jensen
122cn: Babs Jensen
123
124