Bug #74468 for Data-Validate-URI: PATCH: add support for is_tel_uri

The attached support adds support for validating tel: type URIs as specified in RFC 3966, 4694, 4759 and 4715. Test coverage provided by using examples from relevant RFCs.

diff -Naur old/lib/Data/Validate/URI.pm new/lib/Data/Validate/URI.pm --- old/lib/Data/Validate/URI.pm 2008-04-08 23:41:55.000000000 +1000 +++ new/lib/Data/Validate/URI.pm 2012-01-28 18:16:06.331733480 +1100 @@ -21,6 +21,7 @@ is_http_uri is_https_uri is_web_uri + is_tel_uri ); %EXPORT_TAGS = (); @@ -400,6 +401,133 @@ return is_https_uri($value); } +# ------------------------------------------------------------------------------- + +=pod + +=item B<is_tel_uri> - is the value a well-formed telephone uri? + + is_tel_uri($value); + +=over 4 + +=item I<Description> + +Specialized version of is_uri() that only likes tel: urls. As a result, it can +also do a much more thorough job validating according to RFC 3966. + +Returns the untainted URI if the test value appears to be well-formed. + +=item I<Arguments> + +=over 4 + +=item $value + +The potential URI to test. + +=back + +=item I<Returns> + +Returns the untainted URI on success, undef on failure. + +=item I<Notes, Exceptions, & Bugs> + +This function does not make any attempt to check whether the URI is accessible +or 'makes sense' in any meaningful way. It just checks that it is formatted +correctly. + +=back + +=cut + +sub is_tel_uri{ + my $self = shift if ref($_[0]); + my $value = shift; + + # extracted from http://tools.ietf.org/html/rfc3966#section-3 + + my $hex_digit = '[a-fA-F0-9]'; # strictly hex digit does not allow lower case letters according to http://tools.ietf.org/html/rfc2234#section-6.1 + my $reserved = '[;/?:@&=+$,]'; + my $alphanum = '[A-Za-z0-9]'; + my $visual_separator = '[\-\.\(\)]'; + my $phonedigit_hex = '(?:' . $hex_digit . '|\*|\#|' . $visual_separator . ')'; + my $phonedigit = '(?:' . '\d' . '|' . $visual_separator . ')'; + my $param_unreserved = '[\[\]\/:&+$]'; + my $pct_encoded = '\\%' . $hex_digit . $hex_digit; + my $mark = "[\-_\.!~*'()]"; + my $unreserved = '(?:' . $alphanum . '|' . $mark . ')'; + my $paramchar = '(?:' . $param_unreserved . '|' . $unreserved . '|' . $pct_encoded . ')'; + my $pvalue = $paramchar . '{1,}'; + my $pname = '(?:' . $alphanum . '|\\-){1,}'; + my $uric = '(?:' . $reserved . '|' . $unreserved . '|' . $pct_encoded . ')'; + my $alpha = '[A-Za-z]'; + my $toplabel = '(?:' . $alpha . '|' . $alpha . '(?:' . $alphanum . '|' . '\\-){0,}' . $alpha . ')'; + my $domainlabel = '(?:' . $alphanum . '|' . $alphanum . '(?:' . $alphanum . '|\\-){0,}' . $alphanum . ')'; + my $domainname = '(?:' . $domainlabel . '\\.){0,}' . $toplabel . '\\.{0,1}'; + + # extracted from http://tools.ietf.org/html/rfc4694#section-4 + my $npdi = ';npdi'; + my $hex_phonedigit = '(?:' . $hex_digit . '|' . $visual_separator . ')'; + my $global_hex_digits = '\\+' . '\\d{1,3}' . $hex_phonedigit . '{0,}'; + my $global_rn = $global_hex_digits; + my $rn_descriptor = '(?:' . $domainname . '|' . $global_hex_digits . ')'; + my $rn_context = ';rn-context=' . $rn_descriptor; + my $local_rn = $hex_phonedigit . '{1,}' . $rn_context; + my $global_cic = $global_hex_digits; + my $cic_context = ';cic-context=' . $rn_descriptor; + my $local_cic = $hex_phonedigit . '{1,}' . $cic_context; + my $cic = ';cic=' . '(?:' . $global_cic . '|' . $local_cic . '){0,1}'; + my $rn = ';rn=' . '(?:' . $global_rn . '|' . $local_rn . '){0,1}'; + + if ($value =~ /$rn.*$rn/xsm) { + return; + } + if ($value =~ /$npdi.*$npdi/xsm) { + return; + } + if ($value =~ /$cic.*$cic/xsm) { + return; + } + my $parameter = '(?:;' . $pname . '(?:=' . $pvalue . ')|' . $rn . '|' . $cic . '|' . $npdi . ')'; + + # end of http://tools.ietf.org/html/rfc4694#section-4 + + my $local_number_digits = '(?:' . $phonedigit_hex . '{0,}' . '(?:' . $hex_digit . '|\*|\#)' . $phonedigit_hex . '{0,})'; + my $global_number_digits = '\+' . $phonedigit . '{0,}' . '[0-9]' . $phonedigit . '{0,}'; + my $descriptor = '(?:' . $domainname . '|' . $global_number_digits . ')'; + my $context = ';phone\-context=' . $descriptor; + my $extension = ';ext=' . $phonedigit . '{1,}'; + my $isdn_subaddress = ';isub=' . $uric . '{1,}'; + + # extracted from http://tools.ietf.org/html/rfc4759 + my $enum_dip_indicator = ';enumdi'; + if ($value =~ /$enum_dip_indicator.*$enum_dip_indicator/xsm) { # http://tools.ietf.org/html/rfc4759#section-3 + return; + } + + # extracted from http://tools.ietf.org/html/rfc4904#section-5 + my $trunk_group_unreserved = '[/&+$]'; + my $escaped = '\\%' . $hex_digit . $hex_digit; # according to http://tools.ietf.org/html/rfc3261#section-25.1 + my $trunk_group_label = '(?:' . $unreserved . '|' . $escaped . '|' . $trunk_group_unreserved . '){1,}'; + my $trunk_group = ';tgrp=' . $trunk_group_label; + my $trunk_context = ';trunk\-context=' . $descriptor; + + + my $par = '(?:' . $parameter . '|' . $extension . '|' . $isdn_subaddress . '|' . $enum_dip_indicator . '|' . $trunk_context . '|' . $trunk_group . ')'; + my $local_number = $local_number_digits . $par . '{0,}' . $context . $par . '{0,}'; + my $global_number = $global_number_digits . $par . '{0,}'; + my $telephone_subscriber = '(?:' . $global_number . '|' . $local_number . ')'; + my $telephone_uri = 'tel:' . $telephone_subscriber; + + if ($value =~ /^($telephone_uri)$/xsm) { + my ($untainted) = ($1); + return $untainted; + } else { + return; + } +} # internal URI spitter method - direct from RFC 3986 sub _split_uri{ @@ -417,7 +545,7 @@ =head1 SEE ALSO -L<URI>, RFC 3986 +L<URI>, RFC 3986, RFC 3966, RFC 4694, RFC 4759, RFC 4904 =head1 AUTHOR diff -Naur old/MANIFEST new/MANIFEST --- old/MANIFEST 2005-09-16 00:05:47.000000000 +1000 +++ new/MANIFEST 2012-01-28 16:48:59.088709108 +1100 @@ -7,6 +7,7 @@ t/ExtUtils/TBone.pm t/is_uri.t t/is_http_uri.t +t/is_tel_uri.t t/is_https_uri.t t/is_web_uri.t META.yml Module meta-data (added by MakeMaker) diff -Naur old/t/is_tel_uri.t new/t/is_tel_uri.t --- old/t/is_tel_uri.t 1970-01-01 10:00:00.000000000 +1000 +++ new/t/is_tel_uri.t 2012-01-28 18:16:19.568755105 +1100 @@ -0,0 +1,62 @@ +#!/usr/bin/perl + +# ------------------------------------------------------------------------------- +# test harness for Data::Validate::URI::is_tel_uri +# +# Author: Richard Sonnen (http://www.richardsonnen.com/) +# ------------------------------------------------------------------------------- + +use lib './t'; +use ExtUtils::TBone; + +use lib './blib'; +use Data::Validate::URI qw(is_tel_uri); + +my $t = ExtUtils::TBone->typical(); + +$t->begin(23); +$t->msg("testing is_tel_uri..."); + +# valid examples taken from http://tools.ietf.org/html/rfc3966#section-6 +$t->ok(defined(is_tel_uri('tel:+1-201-555-0123')), 'tel:+1-201-555-0123'); +$t->ok(defined(is_tel_uri('tel:7042;phone-context=example.com')), 'tel:7042;phone-context=example.com'); +$t->ok(defined(is_tel_uri('tel:863-1234;phone-context=+1-914-555')), 'tel:863-1234;phone-context=+1-914-555'); + +# valid examples taken from http://tools.ietf.org/html/rfc4715#section-5 +$t->ok(defined(is_tel_uri('tel:+17005554141;isub=12345;isub-encoding=nsap-ia5')), 'tel:+17005554141;isub=12345;isub-encoding=nsap-ia5'); + +# valid examples taken from http://tools.ietf.org/html/rfc4759#section-5 +$t->ok(defined(is_tel_uri('tel:+441632960038;enumdi')), 'tel:+441632960038;enumdi'); + +# valid examples taken from http://tools.ietf.org/html/rfc4694#section-6 +$t->ok(defined(is_tel_uri('tel:+1-800-123-4567;cic=+1-6789')), 'tel:+1-800-123-4567;cic=+1-6789'); +$t->ok(defined(is_tel_uri('tel:+1-202-533-1234')), 'tel:+1-202-533-1234'); +$t->ok(defined(is_tel_uri('tel:+1-202-533-1234;npdi;rn=+1-202-544-0000')), 'tel:+1-202-533-1234;npdi;rn=+1-202-544-0000'); +$t->ok(defined(is_tel_uri('tel:+1-202-533-6789;npdi')), 'tel:+1-202-533-6789;npdi'); + +# valid examples taken from http://tools.ietf.org/html/rfc4904#section-5 +$t->ok(defined(is_tel_uri('tel:5550100;phone-context=+1-630;tgrp=TG-1;trunk-context=example.com')), 'tel:5550100;phone-context=+1-630;tgrp=TG-1;trunk-context=example.com'); +$t->ok(defined(is_tel_uri('tel:+16305550100;tgrp=TG-1;trunk-context=example.com')), 'tel:+16305550100;tgrp=TG-1;trunk-context=example.com'); +$t->ok(defined(is_tel_uri('tel:+16305550100;tgrp=TG-1;trunk-context=+1-630')), 'tel:+16305550100;tgrp=TG-1;trunk-context=+1-630'); + +# valid examples taken from http://tools.ietf.org/html/rfc2806#section-2.6 +$t->ok(defined(is_tel_uri('tel:+358-555-1234567')), 'tel:+358-555-1234567'); + +# invalid +$t->ok(!defined(is_tel_uri('')), "bad: ''"); +$t->ok(!defined(is_tel_uri('ftp://ftp.richardsonnen.com')), "bad: 'ftp://ftp.richardsonnen.com'"); +$t->ok(!defined(is_tel_uri('http://www.richardsonnen.com')), "bad: 'http://www.richardsonnen.com'"); +$t->ok(!defined(is_tel_uri('tels:863-1234;phone-context=+1-914-555')), 'tels:863-1234;phone-context=+1-914-555'); +$t->ok(!defined(is_tel_uri('tel:+441632960038;enumdi;enumdi')), 'tel:+441632960038;enumdi;enumdi'); +$t->ok(!defined(is_tel_uri('tel:+441632960038;rn=+1-202-544-0000;rn=+1-202-544-0000')), 'tel:+441632960038;rn=+1-202-544-0000;rn=+1-202-544-0000'); +$t->ok(!defined(is_tel_uri('tel:+441632960038;npdi;npdi')), 'tel:+441632960038;npdi;npdi'); +$t->ok(!defined(is_tel_uri('tel:+1-800-123-4567;cic=+1-6789;cic=+1-6789')), 'tel:+1-800-123-4567;cic=+1-6789;cic=+1-6789'); + +# as an object +my $v = Data::Validate::URI->new(); +$t->ok(defined($v->is_tel_uri('tel:+1-201-555-0111')), 'tel:+1-201-555-0111 (object)'); +$t->ok(!defined($v->is_tel_uri('foo')), 'bad: foo (object)'); + +# we're done +$t->end(); +