Listing 2. A CGI interface to an LDAP server.
1   #!/usr/bin/perl --
2   # jjohn 6/2000
3   # A CGI interface to a LDAP server. 
4   
5   use strict;
6   use CGI         qw/:all *table/;
7   use CGI::Carp   qw/fatalsToBrowser/;
8   use CGI::Pretty qw/:all/;
9   use Net::LDAP;
10
11  # first, set up the main objects
12  my $cgi     = CGI->new();
13
14  my $base_dn = 'dc=daisypark, dc=net';  
15  my $conn    = Net::LDAP->new("ldap.daisypark.net") or
16    die "ERROR: Can't connect: $@";
17
18  # Make a authenticated connection with the s3cr3t password
19  $conn->bind( dn       => "cn=Manager, $base_dn",
20               password => 's3cr3t',
21            );
22
23  # Have we been asked to do anything?
24  my $action = $cgi->param('action');
25
26  for ($action){
27      my $message = '';
28      /search/ && do {
29        $message = search(
30                          ldap	=> $conn,
31                          base_dn	=> $base_dn,
32                          cgi	=> $cgi,
33                         );
34      };
35
36      /modify/ && do {
37        $message = modify(
38                          ldap	=> $conn,
39                          base_dn	=> $base_dn,
40                          cgi	=> $cgi,
41                        );
42      };
43
44      paint( ldap	=> $conn,
45             base_dn	=> $base_dn,
46             cgi	=> $cgi,
47             message	=> $message,
48           );
49  }
50
51  $conn->unbind;
52  exit;
53
54  #-------
55  # Subroutines
56  #-------
57  sub paint{
58      my %params = @_;
59
60      print
61        header,
62        start_html( -bgcolor => "#FFFFFF",
63                   -title   => ($params{title} ||
64                                'View LDAP for Daisypark'),
65                  ),
66        h2( ($params{title} || 'View LDAP for Daisypark') ),
67        hr,
68        ($params{message} || 'Please perform a search');
69
70      print
71        hr,
72        start_form,
73        '<INPUT TYPE="HIDDEN" NAME="action" VALUE="search">',
74        'Search: ',
75        textfield( -name => 'search'),
76        submit,
77        end_form,
78        end_html;
79  }
80
81  # ldap_lookup() returns an LDAP entry object
82  # for the provided search term.
83  sub ldap_lookup {
84      my %params = @_;
85
86      my $criteria = $params{search};
87      my $filter;
88
89      # hack, I want to search for everything
90      # if I have an empty string
91      undef $criteria if $criteria eq '';
92
93      for (qw/c mail sn cn telephonenumber/) {
94          # todo: $params{search} needs to escape meta-chars!
95          if ( defined $criteria ) {
96              $filter .= "($_=*".$criteria."*) ";
97          } else {
98              $filter .= "($_=*) ";
99          }
100     }
101     $filter = "(| $filter)";
102
103     my $mesg = $params{ldap}->search(
104                                      base   => $params{base_dn},
105                                      filter => $filter,
106                                   );
107     if ( $mesg->code ) {
108         die "Oops ($filter): ", $mesg->error;
109     }
110
111     return $mesg;
112  }
113
114  # search() performs a lookup in the LDAP for a given string,
115  # returning a nice HTML table.
116  
117  sub search {
118      my %params = @_;
119
120      my $mesg = ldap_lookup( @_,
121                              search => ( $params{search} ||
122                                          $params{cgi}->param('search')
123                                        ),
124                           );
125
126      if ( $mesg->count == 0 ) {
127          return "No matches found for '$params{search}'";
128      }
129      my $results;
130      $results .= p(small('Matches: ' .
131                          b($mesg->count) .
132                          ' for term ' .
133                          b( $params{cgi}->param('search') )
134                  ));
135      $results .= start_table( -cellspacing => 0,
136                             -cellpadding => 0,
137                             );
138      $results .= Tr(
139                     th({-bgcolor=>'pink'},
140                        [qw/Name E-Mail Phone Change/])
141                    );
142      # add some pretty color every third row
143      my $row = 0;
144      for my $entry ( $mesg->all_entries ) {
145
146          my $cn = $entry->get('cn')->[0];
147
148          $results .= Tr(
149                         {-bgcolor => (!($row%3) ? "#CCCCCC" :"#FFFFFF") },
150                         start_form,
151                         '<INPUT TYPE="HIDDEN" NAME="action" VALUE="modify">',
152                         qq/<INPUT TYPE="HIDDEN" NAME="old_cn" VALUE="$cn">/,
153                         td(textfield( {   -name  => 'cn',
154                                        -default => $entry->get('cn')
155                                   })),
156                         td(textfield( {-name     => 'mail',
157                                        -default => $entry->get('mail')
158                                   })),
159                         td(textfield( {-name     => 'telephonenumber',
160                                        -default => $entry->get('telephonenumber')
161                                   })),
162                         td( submit ),
163                         end_form,
164                       );
165
166          $row++;
167       }
168
169       return $results .= end_table;
170  }
171
172  sub modify {
173    my %params = @_;
174
175    my $old_cn = $params{cgi}->param('old_cn');
176    my $mesg = ldap_lookup( @_,
177                              search => $old_cn );
178
179    if ( $mesg->count == 0 ) {
180        return "Oops: Can't find $old_cn";
181    }
182
183    my $cgi = $params{cgi};
184    my $entry = $mesg->entry(0); # really need to iterate over results
185
186    # Delete if 'cn' is empty, else modify
187    my $report = '';
188    if ( $cgi->param('cn') =~ /^\s*$/ ) {
189        $entry->delete();
190        $report = "Deleted";
191    } else {
192        $entry->replace(
193                        cn	=> $cgi->param('cn'),
194                        mail	=> $cgi->param('mail'),
195                        telephoneNumber	=> $cgi->param('telephonenumber'),
196                       );
197        $report = "Updated";
198    }
199
200    $entry->update( $params{ldap} );
201    return $report . " " . $cgi->param('cn');
202  }