[interchange] Resolved ticket #328: MV_SESSION_ID broken with IPv6

[Peter Ajamian]

commit af5c7d10f7ff5e52896d97396904f454d4a718ef
Author: Peter Ajamian <peter at pajamian.dhs.org>
Date:   Fri Oct 7 18:29:03 2011 +1300

    Resolved ticket #328: MV_SESSION_ID broken with IPv6
    
    Resolved ticket #328 by adding is_ipv4 and is_ipv6 functions to Util.pm and
    modifying Dispatch.pm to use them.

 lib/Vend/Dispatch.pm |   35 ++++++++++++++++++-----------------
 lib/Vend/Util.pm     |   48 ++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 66 insertions(+), 17 deletions(-)
---
diff --git a/lib/Vend/Dispatch.pm b/lib/Vend/Dispatch.pm
index 9c9e557..611a66a 100644
--- a/lib/Vend/Dispatch.pm
+++ b/lib/Vend/Dispatch.pm
@@ -1280,23 +1280,24 @@ sub dispatch {
 		$::Instance->{ExternalCookie} = $sessionid || 1;
 		$Vend::CookieID = $Vend::Cookie = 1;
 	}
-	elsif (defined $CGI::cookie and
-		 $CGI::cookie =~ /\bMV_SESSION_ID=(\w{8,32})
-								[:_] (
-									(	\d{1,3}\.   # An IP ADDRESS
-										\d{1,3}\.
-										\d{1,3}\.
-										\d{1,3})
-									# A user name or domain
-									|	([A-Za-z0-9][-\@A-Za-z.0-9]+) )?
-									\b/x)
-	{
-		$sessionid = $1
-			unless defined $CGI::values{mv_pc} and $CGI::values{mv_pc} eq 'RESET';
-		$CGI::cookiehost = $3;
-		$CGI::cookieuser = $4;
-		$Vend::CookieID = $Vend::Cookie = 1;
-    }
+	elsif (defined $CGI::cookie and $CGI::cookie =~ /\bMV_SESSION_ID=(\w{8,32})[:_](.+?)\b/) {
+	  SESSION_COOKIE: {
+	      my $id = $1;
+	      my $host = $2;
+	      if (is_ipv4($host) || is_ipv6($host)) {
+		  $CGI::cookiehost = $host;
+	      }
+	      elsif ($host =~ /[A-Za-z0-9][-\@A-Za-z.0-9]+/) {
+		  $CGI::cookieuser = $host;
+	      }
+	      else {
+		  last SESSION_COOKIE;
+	      }
+
+	      $sessionid = $id;
+	      $Vend::CookieID = $Vend::Cookie = 1;
+	    }
+	}
 
 	Vend::Server::set_process_name("$Vend::Cat $CGI::host $sessionid");
 
diff --git a/lib/Vend/Util.pm b/lib/Vend/Util.pm
index 1026925..d92e776 100644
--- a/lib/Vend/Util.pm
+++ b/lib/Vend/Util.pm
@@ -53,6 +53,8 @@ unless( $ENV{MINIVEND_DISABLE_UTF8} ) {
 	header_data_scrub
 	hexify
 	is_hash
+	is_ipv4
+	is_ipv6
 	is_no
 	is_yes
 	l
@@ -852,6 +854,52 @@ sub is_hash {
 	return ref($_[0]) eq 'HASH';
 }
 
+# Verify that passed string is a valid IPv4 address.
+sub is_ipv4 {
+    my $addr = shift or return;
+    my @segs = split '.', $addr;
+    return unless @segs == 4;
+    foreach (@segs) {
+	return unless /^\d{1,3}$/ && !/^0\d/;
+	return unless $_ <= 255;
+    }
+    return 1;
+}
+
+# Verify that passed string is a valid IPv6 address.
+sub is_ipv6 {
+    my $addr = shift or return;
+    my @segs = split ':', $addr;
+
+    my $quads = 8;
+    # Check for IPv4 style ending
+    if ($segs[-1] =~ /\./) {
+	return unless is_ipv4(pop @segs);
+	$quads = 6;
+    }
+
+    # Check the special case of the :: abbreviation.
+    if ($addr =~ /::/) {
+	# Three :'s together is wrong, though.
+	return if $addr =~ /:::/;
+	# Also only one set of :: is allowed.
+	return if $addr =~ /::.*::/;
+	# Check that we don't have too many quads.
+	return if @segs >= $quads;
+    }
+    else {
+	# No :: abbreviation, so the number of quads must be exact.
+	return unless @segs == $quads;
+    }
+
+    # Check the validity of each quad
+    foreach (@segs) {
+	return unless /^[0-9a-f]{1,4}$/i;
+    }
+
+    return 1;
+}
+
 sub dotted_hash {
 	my($hash, $key, $value, $delete_empty) = @_;
 	$hash = get_option_hash($hash) unless is_hash($hash);