File Coverage

blib/lib/No/Worries/DN.pm

Criterion	Covered	Total	%
statement	52	55	94.5
branch	16	20	80.0
condition	0	3	0.0
subroutine	11	11	100.0
pod	2	2	100.0
total	81	91	89.0

#+##############################################################################
#                                                                              #
# File: No/Worries/DN.pm                                                       #
#                                                                              #
# Description: Distinguished Names handling without worries                    #
#                                                                              #
#-##############################################################################

#
# module definition
#

package No::Worries::DN;
use strict;
use warnings;
our $VERSION  = "1.7";
our $REVISION = sprintf("%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/);

#
# used modules
#

use No::Worries::Die qw(dief);
use No::Worries::Export qw(export_control);
use Params::Validate qw(validate_pos :types);

#
# constants
#

use constant FORMAT_RFC2253 => "rfc2253";
use constant FORMAT_JAVA    => "java";
use constant FORMAT_OPENSSL => "openssl";

#
# global variables
#

our(
    %_Map,        # map of known attribute types
    $_TypeRE,     # regexp for a valid attribute type
    $_ValueRE,    # regexp for a valid attribute value
);

foreach my $type (qw(Email emailAddress EMAILADDRESS)) {
    $_Map{$type} = $type;
}

foreach my $type (qw(C CN DC L O OU ST)) {
    $_Map{$type} = $_Map{lc($type)} = $type;
}

$_TypeRE = join("|", keys(%_Map));

$_ValueRE = "[" .
    "0-9a-zA-Z" .   # alphanumerical
    "\\x20" .       # space
    "\\x27" .       # quote
    "\\x28" .       # left parenthesis
    "\\x29" .       # right parenthesis
    "\\x2d" .       # dash
    "\\x2e" .       # dot
    "\\x2f" .       # slash
    "\\x3a" .       # colon
    "\\x40" .       # at sign
    "\\x5f" .       # underscore
    "\\xa0-\\xff" . # some high-bit characters that may come from ISO-8859-1
"]+";

#
# parse a string containing a DN and return an array reference
#

sub dn_parse ($) {
    my($string) = @_;
    my($sep, @list, @dn);

    validate_pos(@_, { type => SCALAR });
    if ($string =~ m/^(\/[a-z]+=[^=]*){3,}$/i) {
        $sep = "/";
    } elsif ($string =~ m/^[a-z]+=[^=]*(,[a-z]+=[^=]*){2,}$/i) {
        $sep = ",";
    } elsif ($string =~ m/^[a-z]+=[^=]*(, [a-z]+=[^=]*){2,}$/i) {
        $sep = ", ";
    } else {
        dief("unexpected DN: %s", $string);
    }
    @list = split(/$sep/, $string);
    shift(@list) if $sep eq "/";
    @dn = ();
    foreach my $attr (@list) {
        if ($attr =~ /^($_TypeRE)=($_ValueRE)$/) {
            # type=value
            push(@dn, "$_Map{$1}=$2");
        } elsif (@dn and $attr =~ /^($_ValueRE)$/) {
            # value only, assumed to come from previous attribute
            $dn[-1] .= $sep . $attr;
        } else {
            dief("invalid DN: %s", $string);
        }
    }
    @dn = reverse(@dn) if $sep eq "/";
    return(\@dn);
}

#
# convert the given parsed DN into a string
#

sub dn_string ($$) {
    my($dn, $format) = @_;

    validate_pos(@_, { type => ARRAYREF }, { type => SCALAR });
    return(join(",", @{ $dn })) if $format eq FORMAT_RFC2253;
    return(join(", ", @{ $dn })) if $format eq FORMAT_JAVA;
    return(join("/", "", reverse(@{ $dn }))) if $format eq FORMAT_OPENSSL;
    dief("unsupported DN format: %s", $format);
}

#
# export control
#

sub import : method {
    my($pkg, %exported);

    $pkg = shift(@_);
    grep($exported{$_}++, map("dn_$_", qw(parse string)));
    export_control(scalar(caller()), $pkg, \%exported, @_);
}

1;

__DATA__