diff options
Diffstat (limited to 'lib/Fripost/Schema/Util.pm')
| -rw-r--r-- | lib/Fripost/Schema/Util.pm | 173 |
1 files changed, 173 insertions, 0 deletions
diff --git a/lib/Fripost/Schema/Util.pm b/lib/Fripost/Schema/Util.pm new file mode 100644 index 0000000..8d75a3a --- /dev/null +++ b/lib/Fripost/Schema/Util.pm @@ -0,0 +1,173 @@ +package Fripost::Schema::Util; + +=head1 NAME + +Util.pm - + +=cut + +use 5.010_000; +use strict; +use warnings; +use utf8; + +use Exporter 'import'; +our @EXPORT_OK = qw /concat get_perms explode + must_attrs email_valid + canonical_dn ldap_explode_dn + split_addr/; +use Email::Valid; +use Net::IDN::Encode; +use Net::LDAP::Util; +use Encode; + + +# Let the first argument, if defined, intersperse the other arguments. +sub concat { + my $concat = shift; + + if (defined $concat) { + return join ($concat, @_); + } + else { + return [ @_ ]; + } +} + +# The reverse of 'concat': takes a single line, and split it along +# "concat", if defined. Returns an array reference in any case. +sub explode { + my $concat = shift; + + my $out; + if (defined $concat) { + $out = [ split /$concat/, $_[0] ]; + } + else { + $out = [ @_ ]; + } + [ grep { !/^\s*$/ } @$out ]; +} + + +# This subroutine displays the access that the given DN has on the entry. +# Possible values are : +# - '': no rights +# - a: can create aliases +# - l: can create lists +# - al: can create aliases & lists +# - o: owner +# - p: postmaster +sub get_perms { + my ($entry, $dn) = @_; + my @dn = @{ldap_explode_dn ($dn)}; + shift @dn; + my $dn2 = canonical_dn (@dn); + my $perms = ''; + + $perms .= 'a' + if grep { $dn eq $_ or $dn2 eq $_ } + $entry->get_value ('fripostCanCreateAlias'); + + $perms .= 'l' + if grep { $dn eq $_ or $dn2 eq $_ } + $entry->get_value ('fripostCanCreateList'); + + $perms = 'o' + if grep { $dn eq $_ } $entry->get_value('fripostOwner'); + + $perms = 'p' + if grep { $dn eq $_ } $entry->get_value('fripostPostmaster'); + + return $perms; +} + + +# "&must_att $h qw/a b c .../" ensures that attributes a b c... are all +# defined in the hash reference. +sub must_attrs { + my $h = shift; + foreach (@_) { + die 'Missing attribute: ‘'.$_."’\n" + unless defined $h->{$_} and + (ref $h->{$_} eq 'ARRAY' ? @{$h->{$_}} : $h->{$_} ne '') + } +} + + +# Ensure that the first argument is a valid email. Can also be used to +# check the validity of domains using the '-prefix' option. +# '-exact' forces the input to be a bare email, ("name <email>" is not +# allowed). +sub email_valid { + my $in = shift; + my %options = @_; + + my $i = $in; + $i =~ s/^[^<>]+\s<([^>]+)>/$1/; + my $mesg = $options{'-error'} // "Invalid e-mail"; + $in = $options{'-prefix'}.$i if defined $options{'-prefix'}; + Encode::_utf8_on($in); + Encode::_utf8_on($i); + $in = Net::IDN::Encode::email_to_ascii($in); + + my $addr = Email::Valid::->address( -address => $in, + -tldcheck => 1, + -fqdn => 1 ); + my $match = defined $addr; + $match &&= $addr eq $in if $options{'-exact'}; + die $mesg." ‘".$i."’\n" unless $match; + $addr =~ s/^$options{'-prefix'}// if defined $options{'-prefix'}; + return $addr; +} + +sub canonical_dn { + Net::LDAP::Util::canonical_dn(\@_, casefold => 'lower' + , mbcescape => 1 + , reverse => 0 + , separator => ','); +}; + +sub ldap_explode_dn { + Net::LDAP::Util::ldap_explode_dn( join (',', @_), casefold => 'lower' ) +} + +sub split_addr { + my $addr = shift; + my %options = @_; + + if (defined $options{'-encode'}) { + my $e = $options{'-encode'}; + if ($e eq 'ascii') { + $addr = Net::IDN::Encode::email_to_ascii($addr); + } + elsif ($e eq 'unicode') { + $addr = Net::IDN::Encode::email_to_unicode($addr); + } + else { + die "Unknown encoding: ". $e; + } + } + + split /\@/, $addr, 2; +} + + +=head1 AUTHOR + +Guilhem Moulin C<< <guilhem at fripost.org> >> + +=head1 COPYRIGHT + +Copyright 2012,2013 Guilhem Moulin. + +=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__ |