aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Fripost/Schema/Type/Domain.pm
blob: 448eaed43046ef4ae8eb03b14548f1c8e3a5c017 (plain)
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
package Fripost::Schema::Type::Domain;

use 5.010_000;
use warnings;
use strict;

use base qw/Net::LDAP/;
use Fripost::Schema::Utils;

our $VERSION = '0.01';


#######################################################################

# Search a domain, and return the corresponding entries if found. If no
# domain is given, returns all domains.
# Filters on values of both keys `domain' and `owner' (unless they are
# undefined).
# If `owner' is the empty string, search for non self-managed domains
# only.
sub search {
    my $self = shift;
    my $domain = shift;

    my $owner;
    $owner = Fripost::Schema::Utils::mkDN ( $self->{_options}, $domain->{owner} )
        if defined $domain->{owner};

    my @filters = ('(ObjectClass=virtualDomain)');
    push @filters, "(dc=" .$domain->{domain}. ")" if defined $domain->{domain};
    if (defined $domain->{owner}) {
        if ($domain->{owner} eq '') {
            push @filters, "(!(owner=*))";
        }
        else {
            push @filters, "(owner=" .$owner. ")";
        }
    }
    my $filter = Fripost::Schema::Utils::mkAndFilter( @filters );

    if ($self->{_options}->{debug}) {
        say STDERR "DEBUG: Search base: " .$self->{_options}->{base_dn};
        say STDERR "DEBUG: Search filter: " .$filter;
    }

    my $res = $self->{_ldap}->search(
                  base   => $self->{_options}->{base_dn},
                  scope  => 'one',
                  attrs  => [ 'dc', 'owner', 'isActive' ],
                  filter => $filter
            );
    die "Error: " .$res->error. "\n" if $res->code;
    return $res;
}

# Add the given domain. If it already exists, adds the new owner; Or
# fails if the new domains is not self-manageable.
sub add {
    my $self = shift;
    my $domain = shift;

    my ($base, $owner);
    $base = Fripost::Schema::Utils::mkDN ( $self->{_options}, $domain->{domain} );
    $owner = Fripost::Schema::Utils::mkDN ( $self->{_options}, $domain->{owner} )
        if defined $domain->{owner};

    say STDERR "DEBUG: Ownership: " .$owner
        if $self->{_options}->{debug} and (defined $owner);

    my $res;
    if ($self->search({ domain => $domain->{domain} })->count) {
        die "Error: Cannot create self-managed domain `"
            .$domain->{domain}. "' since it already exists.\n"
          unless defined $domain->{owner};

        say STDERR "DEBUG: Modify base: " .$base
            if $self->{_options}->{debug};
        $res = $self->{_ldap}->modify( $base, add => [ owner => $owner ] );
    }
    else {
        my @attrs = ( objectClass  => 'virtualDomain',
                    , isActive     => $domain->{isActive}
                    );
        push @attrs, (owner => $owner)
            if defined $domain->{owner};

        say STDERR "DEBUG: Add base: " .$base
            if $self->{_options}->{debug};
        $res = $self->{_ldap}->add( $base, attrs => [ @attrs ] );
    }
    die "Error: " .$res->error. "\n" if $res->code;
    return $res;
}


#######################################################################


1;

=head1 NAME

Fripost::Schema::Type::Domain -

=head1 AUTHOR

Guilhem Moulin C<< <guilhem at fripost.org> >>

=head1 COPYRIGHT

Copyright 2012 Guilhem Moulin, all rights reserved.

=head1 LICENSE

This program is free software; you can redistribute it and/or modify it
under the same terms as perl itself.

=cut

1; # End of Domain.pm

__END__