1BEGIN {
2
3  foreach (qw(my.cfg test.cfg)) {
4    -f and require "$_" and last;
5  }
6
7  undef $SERVER_EXE unless $SERVER_EXE and -x $SERVER_EXE;
8
9  # If your host cannot be contacted as localhost, change this
10  $HOST     ||= '127.0.0.1';
11
12  # Where to put temporary files while testing
13  # the Makefile is setup to delete temp/ when make clean is run
14  $TEMPDIR  = "./temp";
15  $SCHEMA_DIR ||= "./data";
16  $SLAPD_DB ||= 'ldbm';
17
18  $TESTDB   = "$TEMPDIR/test-db";
19  $CONF     = "$TEMPDIR/conf";
20  $PASSWD   = 'secret';
21  $BASEDN   = "o=University of Michigan, c=US";
22  $MANAGERDN= "cn=Manager, o=University of Michigan, c=US";
23  $JAJDN    = "cn=James A Jones 1, ou=Alumni Association, ou=People, o=University of Michigan, c=US";
24  $BABSDN   = "cn=Barbara Jensen, ou=Information Technology Division, ou=People, o=University of Michigan, c=US";
25  $PORT     = 9009;
26  @URL      = ();
27
28  my @server_opts;
29  ($SERVER_TYPE,@server_opts) = split(/\+/, $SERVER_TYPE || 'none');
30
31  if ($SERVER_TYPE eq 'openldap1') {
32    $CONF_IN	  = "./data/slapd-conf.in";
33    @LDAPD	  = ($SERVER_EXE, '-f',$CONF,'-p',$PORT,qw(-d 1));
34    $LDAP_VERSION = 2;
35  }
36  elsif ($SERVER_TYPE eq 'openldap2') {
37    $SSL_PORT = 9010 if grep { $_ eq 'ssl' } @server_opts
38      and eval { require IO::Socket::SSL; 1};
39    ($IPC_SOCK = "$TEMPDIR/ldapi_sock") =~ s,/,%2f,g if grep { $_ eq 'ipc' } @server_opts;
40    $SASL = 1 if grep { $_ eq 'sasl' } @server_opts
41      and eval { require Authen::SASL; 1 };
42    $CONF_IN	  = "./data/slapd2-conf.in";
43    push @URL, "ldap://${HOST}:$PORT/";
44    push @URL, "ldaps://${HOST}:$SSL_PORT/" if $SSL_PORT;
45    push @URL, "ldapi://$IPC_SOCK/" if $IPC_SOCK;
46    @LDAPD	  = ($SERVER_EXE, '-f',$CONF,'-h', "@URL",qw(-d 1));
47    $LDAP_VERSION = 3;
48  }
49
50  $LDAP_VERSION ||= 2;
51  mkdir($TEMPDIR,0777);
52  die "$TEMPDIR is not a directory" unless -d $TEMPDIR;
53}
54
55use Net::LDAP;
56use Net::LDAP::LDIF;
57use Net::LDAP::Util qw(canonical_dn);
58use File::Path qw(rmtree);
59use File::Basename qw(basename);
60
61my $pid;
62
63sub start_server {
64  my %arg = (version => 2, @_);
65
66  unless ($LDAP_VERSION >= $arg{version}
67	and $LDAPD[0] and -x $LDAPD[0]
68	and (!$arg{ssl} or $SSL_PORT)
69	and (!$arg{ipc} or $IPC_SOCK))
70  {
71    print "1..0 # Skip No server\n";
72    exit;
73  }
74
75  if ($CONF_IN and -f $CONF_IN) {
76    # Create slapd config file
77    open(CONFI,"<$CONF_IN") or die "$!";
78    open(CONFO,">$CONF") or die "$!";
79    while(<CONFI>) {
80      s/\$([A-Z]\w*)/${$1}/g;
81      s/^TLS/#TLS/ unless $SSL_PORT;
82      s/^(sasl.*)/#$1/ unless $SASL;
83      print CONFO;
84    }
85    close(CONFI);
86    close(CONFO);
87  }
88
89  rmtree($TESTDB) if ( -d $TESTDB );
90  mkdir($TESTDB,0777);
91  die "$TESTDB is not a directory" unless -d $TESTDB;
92
93  warn "@LDAPD" if $ENV{TEST_VERBOSE};
94
95  my $log = $TEMPDIR . "/" . basename($0,'.t');
96
97  unless ($pid = fork) {
98    die "fork: $!" unless defined $pid;
99
100    open(STDERR,">$log");
101    open(STDOUT,">&STDERR");
102    close(STDIN);
103
104    exec(@LDAPD) or die "cannot exec @LDAPD";
105  }
106
107  sleep 2; # wait for server to start
108}
109
110sub kill_server {
111  if ($pid) {
112    kill 9, $pid;
113    sleep 2;
114    undef $pid;
115  }
116}
117
118END {
119  kill_server();
120}
121
122sub client {
123  my %arg = @_;
124  my $ldap;
125  my $count;
126  local $^W = 0;
127  if ($arg{ssl}) {
128    require Net::LDAPS;
129    until($ldap = Net::LDAPS->new($HOST, port => $SSL_PORT, version => 3)) {
130      die "ldaps://$HOST:$SSL_PORT/ $@" if ++$count > 10;
131      sleep 1;
132    }
133  }
134  elsif ($arg{ipc}) {
135    require Net::LDAPI;
136    until($ldap = Net::LDAPI->new($IPC_SOCK)) {
137      die "ldapi://$IPC_SOCK/ $@" if ++$count > 10;
138      sleep 1;
139    }
140  }
141  elsif ($arg{url}) {
142    print "Trying $arg{url}\n";
143    until($ldap = Net::LDAP->new($arg{url})) {
144      die "$arg{url} $@" if ++$count > 10;
145      sleep 1;
146    }
147  }
148  else {
149    until($ldap = Net::LDAP->new($HOST, port => $PORT, version => $LDAP_VERSION)) {
150      die "ldap://$HOST:$PORT/ $@" if ++$count > 10;
151      sleep 1;
152    }
153  }
154  $ldap;
155}
156
157sub compare_ldif {
158  my($test,$mesg) = splice(@_,0,2);
159
160  unless (ok(!$mesg->code, $mesg->error)) {
161    skip(2, $mesg->error);
162    return;
163  }
164
165  my $ldif = Net::LDAP::LDIF->new("$TEMPDIR/${test}-out.ldif","w", lowercase => 1);
166  unless (ok($ldif, "Read ${test}-out.ldif")) {
167    skip(1,"Read error");
168    return;
169  }
170
171  my @canon_opt = (casefold => 'lower', separator => ', ');
172  foreach $entry (@_) {
173    $entry->dn(canonical_dn($entry->dn, @canon_opt));
174    foreach $attr ($entry->attributes) {
175      $entry->delete($attr) if $attr =~ /^(modifiersname|modifytimestamp|creatorsname|createtimestamp)$/i;
176      if ($attr =~ /^(seealso|member|owner)$/i) {
177	$entry->replace($attr => [ map { canonical_dn($_, @canon_opt) } $entry->get_value($attr) ]);
178      }
179    }
180    $ldif->write($entry);
181  }
182
183  $ldif->done; # close the file;
184
185  ok(!compare("$TEMPDIR/${test}-out.ldif","data/${test}-cmp.ldif"), "data/${test}-cmp.ldif");
186}
187
188require File::Compare;
189
190sub compare($$) {
191  local(*FH1,*FH2);
192  not( open(FH1,"<".$_[0])
193       && open(FH2,"<".$_[1])
194       && 0 == File::Compare::compare(*FH1,*FH2, -s FH1)
195  );
196}
197
198sub ldif_populate {
199  my ($ldap, $file, $change) = @_;
200  my $ok = 1;
201
202  my $ldif = Net::LDAP::LDIF->new($file,"r", changetype => $change || 'add')
203	or return;
204
205  while (my $e = $ldif->read_entry) {
206    $mesg = $e->update($ldap);
207    if ($mesg->code) {
208      $ok = 0;
209      Net::LDAP::LDIF->new(qw(- w))->write_entry($e);
210      print "# ",$mesg->code,": ",$mesg->error,"\n";
211    }
212  }
213  $ok;
214}
215
216my $number = 0;
217sub ok {
218	my ($condition, $name) = @_;
219
220	my $message = $condition ? "ok " : "not ok ";
221	$message .= ++$number;
222	$message .= " # $name" if defined $name;
223	print $message, "\n";
224	return $condition;
225}
226
227sub is {
228	my ($got, $expected, $name) = @_;
229
230	for ($got, $expected) {
231		$_ = 'undef' unless defined $_;
232	}
233
234	unless (ok($got eq $expected, $name)) {
235		warn "Got: '$got'\nExpected: '$expected'\n" . join(' ', caller) . "\n";
236	}
237}
238
239sub skip {
240	my ($reason, $num) = @_;
241	$reason ||= '';
242	$number ||= 1;
243
244	for (1 .. $num) {
245		$number++;
246		print "ok $number # skip $reason\n";
247	}
248}
249
2501;
251