File: ldap-netgroups.pl

package info (click to toggle)
webmin-ldap-netgroups 0.17
  • links: PTS
  • area: main
  • in suites: sarge
  • size: 240 kB
  • ctags: 35
  • sloc: perl: 856; makefile: 65; sh: 15
file content (305 lines) | stat: -rw-r--r-- 8,672 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
=head1 DESCRIPTION

This file contains subroutines for editing netgroups - adding, removing netgroups and adding and removing triples in a netgroup.

=cut

use Net::LDAP;
use Net::LDAP::Entry;
use strict;
use vars qw($ldap %in %config %text);

# Connect to LDAP server.

=head2 ldap_connect

Connects to the LDAP server.
Takes the hostname of the server as the one and only argument.
Note that it opens a TLS-connection, so the hostname has to match the hostname in the certificate!

Example:
ldap_connect($server);

=cut

sub ldap_connect {
    my $server = shift;

    return $ldap if($ldap);

    # Take a look at bug 404 if this doesn't work
    $ldap = Net::LDAP->new($server,version => '3') || &error("Cannot connect to LDAP server '$server'");
    my $result = $ldap->start_tls(verify => 'none');
    die "LDAP Error: " . $result->error() if $result->code();

}

=head2 ldap_netgroups_get

Takes a basedn as the one and only argument.
Returns an array of all netgroups in that basedn.

Example:
@netgroups = ldap_netgroups_get($basedn);

=cut

# Get all Netgroups in a given domain $basedn.
sub ldap_netgroups_get($){
    my ($basedn) = @_;

    my $mesg = $ldap->search (base   => "ou=Netgroup,$basedn",
			      filter => "objectClass=nisNetgroup",
                              );
    return $mesg->all_entries();
}

=head2 ldap_netgroup_get_by_name

Takes a basedn and cn as argument.
Returns an array of all netgroups with that name. (Although there should only be one)

Example:
$netgroup = (ldap_netgroup_get_by_name({ basedn => $basedn, cn => $cn}))[0];

=cut

# Get all Netgroups in a given domain $basedn.
sub ldap_netgroup_get_by_name {
    my $args = shift;

    return $ldap->search(base   => "ou=Netgroup," . $args->{basedn},filter => "cn=" . $args->{cn})->all_entries();
}

=head2 ldap_netgroup_exists

Returns true if a netgroup in the basedn with the cn exists.

Example:
if(ldap_netgroup_exists({ basedn => $basedn, cn => $cn })) {
...
}

=cut

# Returns true if the group $gidNumber exists in domain $basedn.

sub ldap_netgroup_exists {
    my $args = shift;
    ldap_connect($config{'server'}, $config{'rootdn'} ) unless($ldap);
    return $ldap->search(base   => "ou=Netgroup," . $args->{basedn},filter => "cn=" . $args->{cn})->count();
}

=head2 ldap_netgroup_add

Given a basedn, cn and rootpassword and -dn, it creates a new netgroup.

Example:
ldap_netgroup_add({ basedn => $basedn, cn => $cn, rootdn => $rootdn, rootpw => $rootpw});

=cut


sub ldap_netgroup_add
{
    my $args = shift;

    $ldap->bind($args->{rootdn}, password => $args->{rootpw});
    my $entry = Net::LDAP::Entry->new();
    $entry->dn("cn=" . $args->{cn} . ",ou=Netgroup," . $args->{basedn});
    $entry->add(
                objectclass => ['top','nisNetgroup'],
                cn => $args->{cn}
    );

    return $entry->update($ldap);
}

=head2 ldap_netgroup_delete

Given basedn, cn, rootdn and -pw, it deletes the netgroup.

Example:
ldap_netgroup_delete({ basedn => $basedn, cn => $cn, rootdn => $rootdn, rootpw => $rootpw});

=cut

sub ldap_netgroup_delete
{
    my $args = shift;
    $ldap->bind($args->{rootdn}, password => $args->{rootpw});
    return $ldap->delete("cn=" . $args->{cn} . ",ou=Netgroup,". $args->{basedn});
}

=head2 ldap_netgroup_rmtriple

Given basedn, cn, triple, rootdn and -pw, it removes the triple from the netgroup.

Example:
ldap_netgroup_rmtriple({ basedn => $basedn, cn => $cn, triples => $triplearrayref, rootdn => $rootdn, rootpw => $rootpw});

=cut

sub ldap_netgroup_rmtriple
{
    my $args = shift;

    $ldap->bind($args->{rootdn}, password => $args->{rootpw});

    # Removing a triple means removing everything and then adding those who shouldn't been deleted back again.
    # Just removing or adding one triple simply doesn't work. :-(

    # Get the existing triples.
    my $mesg = $ldap->search (base => "ou=Netgroup," . $args->{basedn},filter => "cn=" . $args->{cn});

    my $entry = ( $mesg->entries )[0];
    my @triples =  $entry->get_value('nisNetgroupTriple');

    # XXX
    # Remove $triple from @triples -- can this be done in a more efficiently?
    my @newtriples;
    for (@triples) {
        my $triple = quotemeta($_); #If not, the ()-es in the triple string will be interpreted as sub expressions.
    	push(@newtriples, $_) unless( grep(/^$triple$/, @{$args->{triples}}) );
    }
    # XXX
    
    my @changes;
    push(@changes, add => [ nisNetgroupTriple => \@newtriples ]) if($newtriples[0]);

    return $ldap->modify("cn=" . $args->{cn} . ",ou=Netgroup," . $args->{basedn},
    	changes => [ 
		delete => [ nisNetgroupTriple => [] ],
		@changes,
	]
    );
}

=head2 ldap_netgroup_addtriple

Given basedn, cn, triple, rootdn and rootpw, it adds one or more triples to the netgroup.
It does so by deleting and then readding, as just adding or removing one triple doesn't work.

Example:
ldap_netgroup_addtriple({ basedn => $basedn, cn => $cn, triples => $triplearrayref, rootdn => $rootdn, rootpw => $rootpw});

=cut

sub ldap_netgroup_addtriple
{
    my $args = shift;
    my @changes;

    #Get existing triples.
    $ldap->bind($args->{rootdn}, password => $args->{rootpw});
    my $mesg = $ldap->search (base => "ou=Netgroup," . $args->{basedn}, filter => "cn=" . $args->{cn});
    
    my $entry = ( $mesg->entries )[0];
    my @existing_triples =  $entry->get_value('nisNetgroupTriple');

    #@triples is still only the old values.
    #If old triples exist, we want to delete them first.
    
    push(@changes, delete => [ nisNetgroupTriple => [] ]) and push(@{$args->{triples}}, @existing_triples) if( $existing_triples[0] );

    # Deleting or adding one at a time doesn't work for some reason, so we must add and delete all
    # entries simultaneously
    push(@changes, add => [ nisNetgroupTriple => $args->{triples} ] ) if( $args->{triples}->[0] );

    return $ldap->modify("cn=" . $args->{cn} . ",ou=Netgroup," . $args->{basedn}, changes => \@changes);
}

sub ldap_netgroup_addsubgroup
{
    my $args = shift;


    $ldap->bind($args->{rootdn}, password => $args->{rootpw});
    my $mesg = $ldap->search (base => "ou=Netgroup," . $args->{basedn}, filter => "cn=" . $args->{cn});

    my $entry = ( $mesg->entries )[0];
    my @existing_subgroups =  $entry->get_value('memberNisNetgroup');

    my @changes;
    push(@changes, delete => [ memberNisNetgroup => [] ]) if( $existing_subgroups[0] );
    push(@changes, add => [ memberNisNetgroup => $args->{subgroups} ] ) if( $args->{subgroups}->[0] );

    return $ldap->modify("cn=" . $args->{cn} . ",ou=Netgroup," . $args->{basedn}, changes => \@changes);
}

sub ldap_netgroup_rmsubgroup
{
    my $args = shift;

    $ldap->bind($args->{rootdn}, password => $args->{rootpw});

    # Removing a triple means removing everything and then adding those who shouldn't been deleted back again.
    # Just removing or adding one triple simply doesn't work. :-(

    # Get the existing triples.
    my $mesg = $ldap->search (base => "ou=Netgroup," . $args->{basedn},filter => "cn=" . $args->{cn});

    my $entry = ( $mesg->entries )[0];
    my @existing_subgroups =  $entry->get_value('memberNisNetgroup');

    my @subgroups;
    for (@existing_subgroups) {
        my $subgroup = quotemeta($_); 
    	push(@subgroups, $_) unless( grep(/^$subgroup$/, @{$args->{subgroups}}) );
    }

    my @changes;

    push(@changes, add => [ memberNisNetgroup => \@subgroups ]) if($subgroups[0]);

    return $ldap->modify("cn=" . $args->{cn} . ",ou=Netgroup," . $args->{basedn},
    	changes => [ 
		delete => [ memberNisNetgroup => [] ],
		@changes,
	]
    );
}
=head2 create

This subroutine takes no arguments, but uses the global values given by webmin. (Ugly, but it's the Webmin Way(tm)).
It does some sanity checks on the input given and creates the group if everything is okay.

Example:
create();

=cut

sub create {
    if ( !$in{group} !~ /\W/ && length( $in{group} ) < 9 ) {
        if ( $in{group} =~ /\W/ ) {
            Error( $text{invalid_chars} );
        }
        if ( length( $in{group} ) < 9 ) {
            Error( $text{invalid_length} );
        }
        new_form(%in);
    }
    else {
        if ( ldap_netgroup_exists({ basedn => $config{basedn}, cn => $in{group} }) ) {
            Error( $text{exists} );
        }
        else {
            my $result = ldap_add_netgroup({ basedn => $config{basedn}, cn => $in{group}, rootdn => $config{rootdn}, rootpw => $in{password}});

            if ( $result->code() ) {
                Error( $text{ldap_failed}, $result );
            }
            else {
                print "$text{created}<br>";
            }
        }
    }
}

=head1 AUTHOR

Alex Brasetvik

=cut

1;