From c2f401aae1c01aa1a85c4d3f59a4eb02803b6093 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Sven=20Sch=C3=B6ling?= <s.schoeling@linet-services.de>
Date: Wed, 6 May 2015 15:09:04 +0200
Subject: [PATCH] Sessions: IP nicht bei IPv6 validieren.

---
 SL/Auth.pm                      |  3 +-
 modules/fallback/Regexp/IPv6.pm | 65 +++++++++++++++++++++++++++++++++
 2 files changed, 67 insertions(+), 1 deletion(-)
 create mode 100644 modules/fallback/Regexp/IPv6.pm

diff --git a/SL/Auth.pm b/SL/Auth.pm
index 5629fd770..f6d9e96d7 100644
--- a/SL/Auth.pm
+++ b/SL/Auth.pm
@@ -7,6 +7,7 @@ use IO::File;
 use Time::HiRes qw(gettimeofday);
 use List::MoreUtils qw(uniq);
 use YAML;
+use Regexp::IPv6 qw($IPv6_re);
 
 use SL::Auth::ColumnInformation;
 use SL::Auth::Constants qw(:all);
@@ -541,7 +542,7 @@ sub restore_session {
   my $api_token_cookie = $self->get_api_token_cookie;
   my $cookie_is_bad    = !$cookie || $cookie->{is_expired};
   $cookie_is_bad     ||= $api_token_cookie && ($api_token_cookie ne $cookie->{api_token}) if  $api_token_cookie;
-  $cookie_is_bad     ||= $cookie->{ip_address} ne $ENV{REMOTE_ADDR}                       if !$api_token_cookie;
+  $cookie_is_bad     ||= $cookie->{ip_address} ne $ENV{REMOTE_ADDR}                       if !$api_token_cookie && $ENV{REMOTE_ADDR} !~ /^$IPv6_re$/;
   if ($cookie_is_bad) {
     $self->destroy_session();
     return $self->session_restore_result($cookie ? SESSION_EXPIRED() : SESSION_NONE());
diff --git a/modules/fallback/Regexp/IPv6.pm b/modules/fallback/Regexp/IPv6.pm
new file mode 100644
index 000000000..24ecf5dfa
--- /dev/null
+++ b/modules/fallback/Regexp/IPv6.pm
@@ -0,0 +1,65 @@
+package Regexp::IPv6;
+
+our $VERSION = '0.03';
+
+use strict;
+use warnings;
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw($IPv6_re);
+
+my $IPv4 = "((25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2})[.](25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}))";
+my $G = "[0-9a-fA-F]{1,4}";
+
+my @tail = ( ":",
+       "(:($G)?|$IPv4)",
+             ":($IPv4|$G(:$G)?|)",
+             "(:$IPv4|:$G(:$IPv4|(:$G){0,2})|:)",
+       "((:$G){0,2}(:$IPv4|(:$G){1,2})|:)",
+       "((:$G){0,3}(:$IPv4|(:$G){1,2})|:)",
+       "((:$G){0,4}(:$IPv4|(:$G){1,2})|:)" );
+
+our $IPv6_re = $G;
+$IPv6_re = "$G:($IPv6_re|$_)" for @tail;
+$IPv6_re = qq/:(:$G){0,5}((:$G){1,2}|:$IPv4)|$IPv6_re/;
+$IPv6_re =~ s/\(/(?:/g;
+$IPv6_re = qr/$IPv6_re/;
+
+1;
+__END__
+
+=head1 NAME
+
+Regexp::IPv6 - Regular expression for IPv6 addresses
+
+=head1 SYNOPSIS
+
+  use Regexp::IPv6 qw($IPv6_re);
+
+  $address =~ /^$IPv6_re$/ and print "IPv6 address\n";
+
+=head1 DESCRIPTION
+
+This module exports the $IPv6_re regular expression that matches any
+valid IPv6 address as described in "RFC 2373 - 2.2 Text Representation
+of Addresses" but C<::>. Any string not compliant with such RFC will
+be rejected.
+
+To match full strings use C</^$IPv6_re$/>.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2009, 2010 by Salvador FandiE<ntilde>o
+(sfandino@yahoo.com)
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.10.0 or,
+at your option, any later version of Perl 5 you may have available.
+
+Additionally, you are allowed to use the regexp generated by the
+module in any way you want, without any restriction. For instance, you
+are allowed to copy it verbating in your program.
+
+=cut
+
-- 
2.20.1