Projekt

Allgemein

Profil

« Zurück | Weiter » 

Revision c2f401aa

Von Sven Schöling vor mehr als 9 Jahren hinzugefügt

  • ID c2f401aae1c01aa1a85c4d3f59a4eb02803b6093
  • Vorgänger 05463301
  • Nachfolger ece6d212

Sessions: IP nicht bei IPv6 validieren.

Unterschiede anzeigen:

SL/Auth.pm
7 7 
use Time::HiRes qw(gettimeofday);
8 8 
use List::MoreUtils qw(uniq);
9 9 
use YAML;
10 
use Regexp::IPv6 qw($IPv6_re);
10 11 

  		




  11
  12
  
    
use SL::Auth::ColumnInformation;


  		




  12
  13
  
    
use SL::Auth::Constants qw(:all);


  		




  ......




  541
  542
  
    
  my $api_token_cookie = $self->get_api_token_cookie;


  		




  542
  543
  
    
  my $cookie_is_bad    = !$cookie || $cookie->{is_expired};


  		




  543
  544
  
    
  $cookie_is_bad     ||= $api_token_cookie && ($api_token_cookie ne $cookie->{api_token}) if  $api_token_cookie;


  		




  544
  
  
    
  $cookie_is_bad     ||= $cookie->{ip_address} ne $ENV{REMOTE_ADDR}                       if !$api_token_cookie;


  		




  
  545
  
    
  $cookie_is_bad     ||= $cookie->{ip_address} ne $ENV{REMOTE_ADDR}                       if !$api_token_cookie && $ENV{REMOTE_ADDR} !~ /^$IPv6_re$/;


  		




  545
  546
  
    
  if ($cookie_is_bad) {


  		




  546
  547
  
    
    $self->destroy_session();


  		




  547
  548
  
    
    return $self->session_restore_result($cookie ? SESSION_EXPIRED() : SESSION_NONE());


  		












  

    
      modules/fallback/Regexp/IPv6.pm
    
  





  
  1
  
    
package Regexp::IPv6;


  		




  
  2
  
    

  		




  
  3
  
    
our $VERSION = '0.03';


  		




  
  4
  
    

  		




  
  5
  
    
use strict;


  		




  
  6
  
    
use warnings;


  		




  
  7
  
    

  		




  
  8
  
    
require Exporter;


  		




  
  9
  
    
our @ISA = qw(Exporter);


  		




  
  10
  
    
our @EXPORT_OK = qw($IPv6_re);


  		




  
  11
  
    

  		




  
  12
  
    
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}))";


  		




  
  13
  
    
my $G = "[0-9a-fA-F]{1,4}";


  		




  
  14
  
    

  		




  
  15
  
    
my @tail = ( ":",


  		




  
  16
  
    
       "(:($G)?|$IPv4)",


  		




  
  17
  
    
             ":($IPv4|$G(:$G)?|)",


  		




  
  18
  
    
             "(:$IPv4|:$G(:$IPv4|(:$G){0,2})|:)",


  		




  
  19
  
    
       "((:$G){0,2}(:$IPv4|(:$G){1,2})|:)",


  		




  
  20
  
    
       "((:$G){0,3}(:$IPv4|(:$G){1,2})|:)",


  		




  
  21
  
    
       "((:$G){0,4}(:$IPv4|(:$G){1,2})|:)" );


  		




  
  22
  
    

  		




  
  23
  
    
our $IPv6_re = $G;


  		




  
  24
  
    
$IPv6_re = "$G:($IPv6_re|$_)" for @tail;


  		




  
  25
  
    
$IPv6_re = qq/:(:$G){0,5}((:$G){1,2}|:$IPv4)|$IPv6_re/;


  		




  
  26
  
    
$IPv6_re =~ s/\(/(?:/g;


  		




  
  27
  
    
$IPv6_re = qr/$IPv6_re/;


  		




  
  28
  
    

  		




  
  29
  
    
1;


  		




  
  30
  
    
__END__


  		




  
  31
  
    

  		




  
  32
  
    
=head1 NAME


  		




  
  33
  
    

  		




  
  34
  
    
Regexp::IPv6 - Regular expression for IPv6 addresses


  		




  
  35
  
    

  		




  
  36
  
    
=head1 SYNOPSIS


  		




  
  37
  
    

  		




  
  38
  
    
  use Regexp::IPv6 qw($IPv6_re);


  		




  
  39
  
    

  		




  
  40
  
    
  $address =~ /^$IPv6_re$/ and print "IPv6 address\n";


  		




  
  41
  
    

  		




  
  42
  
    
=head1 DESCRIPTION


  		




  
  43
  
    

  		




  
  44
  
    
This module exports the $IPv6_re regular expression that matches any


  		




  
  45
  
    
valid IPv6 address as described in "RFC 2373 - 2.2 Text Representation


  		




  
  46
  
    
of Addresses" but C<::>. Any string not compliant with such RFC will


  		




  
  47
  
    
be rejected.


  		




  
  48
  
    

  		




  
  49
  
    
To match full strings use C</^$IPv6_re$/>.


  		




  
  50
  
    

  		




  
  51
  
    
=head1 COPYRIGHT AND LICENSE


  		




  
  52
  
    

  		




  
  53
  
    
Copyright (C) 2009, 2010 by Salvador FandiE<ntilde>o


  		




  
  54
  
    
(sfandino@yahoo.com)


  		




  
  55
  
    

  		




  
  56
  
    
This library is free software; you can redistribute it and/or modify


  		




  
  57
  
    
it under the same terms as Perl itself, either Perl version 5.10.0 or,


  		




  
  58
  
    
at your option, any later version of Perl 5 you may have available.


  		




  
  59
  
    

  		




  
  60
  
    
Additionally, you are allowed to use the regexp generated by the


  		




  
  61
  
    
module in any way you want, without any restriction. For instance, you


  		




  
  62
  
    
are allowed to copy it verbating in your program.


  		




  
  63
  
    

  		




  
  64
  
    
=cut


  		




  
  65
  
    

  		












Auch abrufbar als:  Unified diff