On Thu, 2009-03-26 at 22:02 -0400, Alex Vandiver wrote: > That sounds correct. Attached is a patch, which _does_ add a dep of > Unicode::Stringprep, but is probably as faithful of an implementation of > the spec as we might be able to get.
An updated patch is attached, which fixes an error which caused resources with spaces to be (wrongly) treated as illegal. The other two patches make domain checks case-insensitive, and add a flag for backwards compatibility. Any thoughts on getting these applied? - Alex
>From 2f197b0f12c8db8af7ad51e8c9289f3dec4a33c5 Mon Sep 17 00:00:00 2001 From: Alex Vandiver <[email protected]> Date: Thu, 26 Mar 2009 21:24:28 -0400 Subject: [PATCH 1/3] Do stringprep, as specified by the RFC, on JID object creation --- DJabberd/Makefile.PL | 1 + DJabberd/lib/DJabberd/JID.pm | 89 +++++++++++++++++++++++++++++++++++++++++- 2 files changed, 89 insertions(+), 1 deletions(-) diff --git a/DJabberd/Makefile.PL b/DJabberd/Makefile.PL index 6de3e23..cfc06e2 100644 --- a/DJabberd/Makefile.PL +++ b/DJabberd/Makefile.PL @@ -14,6 +14,7 @@ WriteMakefile( 'Net::SSLeay' => 0, 'Log::Log4perl' => 0, 'Digest::HMAC_SHA1' => 0, + 'Unicode::Stringprep' => 0, }, clean => { FILES => 't/log/*' }, AUTHOR => 'Brad Fitzpatrick <[email protected]>', diff --git a/DJabberd/lib/DJabberd/JID.pm b/DJabberd/lib/DJabberd/JID.pm index 3959ee5..f37e29c 100644 --- a/DJabberd/lib/DJabberd/JID.pm +++ b/DJabberd/lib/DJabberd/JID.pm @@ -13,6 +13,84 @@ use constant AS_STRING => 3; use constant AS_BSTRING => 4; use constant AS_STREXML => 5; +# Stringprep functions for converting to canonical form +use Unicode::Stringprep; +use Unicode::Stringprep::Mapping; +use Unicode::Stringprep::Prohibited; +my $nodeprep = Unicode::Stringprep->new( + 3.2, + [ + \...@unicode::Stringprep::Mapping::B1, + \...@unicode::Stringprep::Mapping::B2, + ], + 'KC', + [ + \...@unicode::Stringprep::Prohibited::C11, + \...@unicode::Stringprep::Prohibited::C12, + \...@unicode::Stringprep::Prohibited::C21, + \...@unicode::Stringprep::Prohibited::C22, + \...@unicode::Stringprep::Prohibited::C3, + \...@unicode::Stringprep::Prohibited::C4, + \...@unicode::Stringprep::Prohibited::C5, + \...@unicode::Stringprep::Prohibited::C6, + \...@unicode::Stringprep::Prohibited::C7, + \...@unicode::Stringprep::Prohibited::C8, + \...@unicode::Stringprep::Prohibited::C9, + [ + 0x0022, undef, # " + 0x0026, undef, # & + 0x0027, undef, # ' + 0x002F, undef, # / + 0x003A, undef, # : + 0x003C, undef, # < + 0x003E, undef, # > + 0x0040, undef, # @ + ] + ], + 1, +); +my $nameprep = Unicode::Stringprep->new( + 3.2, + [ + \...@unicode::Stringprep::Mapping::B1, + \...@unicode::Stringprep::Mapping::B2, + ], + 'KC', + [ + \...@unicode::Stringprep::Prohibited::C12, + \...@unicode::Stringprep::Prohibited::C22, + \...@unicode::Stringprep::Prohibited::C3, + \...@unicode::Stringprep::Prohibited::C4, + \...@unicode::Stringprep::Prohibited::C5, + \...@unicode::Stringprep::Prohibited::C6, + \...@unicode::Stringprep::Prohibited::C7, + \...@unicode::Stringprep::Prohibited::C8, + \...@unicode::Stringprep::Prohibited::C9, + ], + 1, +); +my $resourceprep = Unicode::Stringprep->new( + 3.2, + [ + \...@unicode::Stringprep::Mapping::B1, + ], + 'KC', + [ + \...@unicode::Stringprep::Prohibited::C12, + \...@unicode::Stringprep::Prohibited::C21, + \...@unicode::Stringprep::Prohibited::C22, + \...@unicode::Stringprep::Prohibited::C3, + \...@unicode::Stringprep::Prohibited::C4, + \...@unicode::Stringprep::Prohibited::C5, + \...@unicode::Stringprep::Prohibited::C6, + \...@unicode::Stringprep::Prohibited::C7, + \...@unicode::Stringprep::Prohibited::C8, + \...@unicode::Stringprep::Prohibited::C9, + ], + 1, +); + + # returns DJabberd::JID object, or undef on failure due to invalid format sub new { #my ($class, $jidstring) = @_; @@ -29,7 +107,16 @@ sub new { (?: /(.{1,1023}) )? # $3: optional resource $!x; - return bless [ $1, $2, $3 ], $_[0]; + # Stringprep uses regexes, so store these away first + my ($node, $host, $res) = ($1, $2, $3); + + return eval { + bless [ + defined $node ? $nodeprep->($node) : undef, + $nameprep->($host), + defined $res ? $resourceprep->($res) : undef, + ], $_[0] + }; } sub is_bare { -- 1.6.3.rc0.7.g2f866
>From 5553fd59f818ee2fe70913d29ff02d1bef8895dc Mon Sep 17 00:00:00 2001 From: Alex Vandiver <[email protected]> Date: Thu, 9 Apr 2009 13:17:42 -0400 Subject: [PATCH 2/3] Lower-case all domains for checking verification status --- DJabberd/lib/DJabberd/Connection/ServerIn.pm | 4 ++-- 1 files changed, 2 insertions(+), 2 deletions(-) diff --git a/DJabberd/lib/DJabberd/Connection/ServerIn.pm b/DJabberd/lib/DJabberd/Connection/ServerIn.pm index cb92238..005659b 100644 --- a/DJabberd/lib/DJabberd/Connection/ServerIn.pm +++ b/DJabberd/lib/DJabberd/Connection/ServerIn.pm @@ -16,7 +16,7 @@ sub set_vhost { sub peer_domain_is_verified { my ($self, $domain) = @_; - return $self->{verified_remote_domain}->{$domain}; + return $self->{verified_remote_domain}->{lc $domain}; } sub on_stream_start { @@ -132,7 +132,7 @@ sub dialback_result_valid { my %opts = @_; my $res = qq{<db:result from='$opts{recv_server}' to='$opts{orig_server}' type='valid'/>}; - $self->{verified_remote_domain}->{$opts{orig_server}} = $opts{orig_server}; + $self->{verified_remote_domain}->{lc $opts{orig_server}} = $opts{orig_server}; $self->log->debug("Dialback result valid for connection $self->{id}. from=$opts{recv_server}, to=$opts{orig_server}: $res\n"); $self->write($res); } -- 1.6.3.rc0.7.g2f866
>From b74091038bf11ef8f24a405e211510809d32b31b Mon Sep 17 00:00:00 2001 From: Alex Vandiver <[email protected]> Date: Fri, 3 Apr 2009 17:47:36 -0400 Subject: [PATCH 3/3] Add global CaseSensitive flag for backwards compatibility --- DJabberd/lib/DJabberd.pm | 5 +++++ DJabberd/lib/DJabberd/JID.pm | 7 +++++++ 2 files changed, 12 insertions(+), 0 deletions(-) diff --git a/DJabberd/lib/DJabberd.pm b/DJabberd/lib/DJabberd.pm index 9debd3d..a168fdb 100644 --- a/DJabberd/lib/DJabberd.pm +++ b/DJabberd/lib/DJabberd.pm @@ -167,6 +167,11 @@ sub fake_s2s_peer { return $fake_peers{$host}; } +sub set_config_casesensitive { + my ($self, $val) = @_; + $DJabberd::JID::CASE_SENSITIVE = as_bool($val); +} + sub add_vhost { my ($self, $vhost) = @_; my $sname = lc $vhost->name; diff --git a/DJabberd/lib/DJabberd/JID.pm b/DJabberd/lib/DJabberd/JID.pm index f37e29c..bfef24c 100644 --- a/DJabberd/lib/DJabberd/JID.pm +++ b/DJabberd/lib/DJabberd/JID.pm @@ -3,6 +3,9 @@ use strict; use DJabberd::Util qw(exml); use Digest::SHA1; +# Configurable via 'CaseSensitive' config option +our $CASE_SENSITIVE = 0; + use overload '""' => \&as_string_exml; @@ -107,6 +110,10 @@ sub new { (?: /(.{1,1023}) )? # $3: optional resource $!x; + # If we're in case-sensitive mode, for backwards-compatibility, + # then skip stringprep + return bless [ $1, $2, $3 ], $_[0] if $DJabberd::JID::CASE_SENSITIVE; + # Stringprep uses regexes, so store these away first my ($node, $host, $res) = ($1, $2, $3); -- 1.6.3.rc0.7.g2f866
