Prepare IPv6 functions (#1201)

e2e-tests/env.conf

@@ -1,4 +1,5 @@
 Listen 127.0.0.1:__port__
+Listen ::1:__port__
 FcgidInitialEnv LLNG_DEFAULTCONFFILE __pwd__/e2e-tests/conf/lemonldap-ng.ini
 SetEnv LLNG_DEFAULTCONFFILE __pwd__/e2e-tests/conf/lemonldap-ng.ini
 <perl>

e2e-tests/populate.pl

@@ -28,6 +28,7 @@ my $portal = LLNG::Manager::Test->new(
                 dirName => 'e2e-tests/conf',
             },
             localSessionStorage => undef,
+            localStorage        => undef,
         }
     }
 )->p;
@@ -36,13 +37,51 @@ my @chars = ( "A" .. "Z", "a" .. "z" );
 foreach my $i ( 1 .. COUNT() ) {
     my $string;
     $string .= $chars[ rand @chars ] for 1 .. 8;
+
     #$string = 'dwho';
     my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
       localtime(time);
     $hour = int( rand($hour) );
     $min  = int( rand(60) );
     $sec  = int( rand(60) );
-    my $ipAddr = join('.',int(rand(256)),int(rand(256)),int(rand(256)),int(rand(256)));
+    my $ipAddr = (
+        int( rand(2) ) == 1
+        ? join( '.',
+            int( rand(256) ),
+            int( rand(256) ),
+            int( rand(256) ),
+            int( rand(256) ) )
+        : join(
+            ':',
+
+            # Mix routable IPv6 addresses (2000::/3) and local ones (fe:80::/10)
+            (
+                int( rand(2) ) == 1
+                ? sprintf( "%X",      int( rand(8192) + 8192 ) )
+                : sprintf( "fe80:%X", int( rand(16384) ) )
+            ),
+            sprintf( "%X", int( rand(65536) ) ),
+            sprintf( "%X", int( rand(65536) ) ),
+            sprintf( "%X", int( rand(65536) ) ),
+            sprintf( "%X", int( rand(65536) ) ),
+            sprintf( "%X", int( rand(65536) ) ),
+            sprintf( "%X", int( rand(65536) ) ),
+            sprintf( "%X", int( rand(65536) ) )
+        )
+    );
+
+    # Replace 0 in IPv6 addresses
+    if ( $ipAddr =~ ':0:' ) {
+        my @t   = ( $ipAddr =~ /\:(?:0\:)+/g );
+        my $ind = -1;
+        my $len = 0;
+        for ( my $i = 0 ; $i < @t ; $i++ ) {
+            $ind = $i if ( length( $t[$i] ) > $len );
+        }
+        $ipAddr =~ s/$t[$ind]/::/;
+        $ipAddr =~ s/^0//;
+        print STDERR "Found IPv6 :: => $string\n";
+    }
     my $req = Test::Request->new(
         {
             sessionInfo => {

lemonldap-ng-common/lib/Lemonldap/NG/Common/IPv6.pm

@@ -0,0 +1,55 @@
+package Lemonldap::NG::Common::IPv6;
+
+use base 'Exporter';
+
+@EXPORT = qw(&isIPv6 &net6 &expand6);
+
+sub isIPv6 {
+    my($ip) = @_;
+    return $ip =~ /^[0-9:]+$/;
+}
+
+sub net6 {
+    my ( $ip, $bits ) = @_;
+
+    # Convert to binary
+    my $b = join '',
+      map { unpack( 'B*', pack( 'H*', $_ ) ) } split( ':', expand6($ip) );
+    $net = substr $b, 0, $bits;
+    $net .= '0' x ( 128 - length($net) );
+    $net = unpack( 'H*', pack( 'B*', $net ) );
+    $net = join( ':', ( unpack "a4" x 8, $net ) );
+    $net = compact6($net);
+    return $net;
+}
+
+sub expand6 {
+    my @_parts = ( $_[0] =~ /([0-9A-Fa-f]+)/g );
+    my $nparts = scalar @_parts;
+    if ( $nparts != 8 ) {
+        for ( my $i = 1 ; $i <= ( 8 - $nparts ) ; $i++ ) {
+            push @arr, hex "0000";
+        }
+    }
+
+    my @parts = map { ( $_ eq '::' ) ? @arr : hex $_ }
+      ( $_[0] =~ /((?:[0-9A-Fa-f]+)|(?:::))/g );
+
+    return join( ":", map { sprintf "%04x", $_ } @parts );
+
+}
+
+sub compact6 {
+    $_[0] =~ s/(^|:)0+([\w])/$1$2/g;
+    if ( $_[0] =~ ':0:' ) {
+        my @t   = ( $_[0] =~ /\:(?:0\:)+/g );
+        my $ind = -1;
+        my $len = 0;
+        for ( my $i = 0 ; $i < @t ; $i++ ) {
+            $ind = $i if ( length( $t[$i] ) > $len );
+        }
+        $_[0] =~ s/$t[$ind]/::/;
+        $_[0] =~ s/^0//;
+    }
+    return $_[0];
+}

lemonldap-ng-manager/lib/Lemonldap/NG/Manager/Sessions.pm

@@ -10,6 +10,7 @@ use Lemonldap::NG::Common::Conf::Constants;
 use Lemonldap::NG::Common::Session;
 use Lemonldap::NG::Common::PSGI::Constants;
 use Lemonldap::NG::Common::Conf::ReConstants;
+use Lemonldap::NG::Common::IPv6;
 
 use feature 'state';
 
@@ -74,12 +75,12 @@ sub sessions {
     my @fields = ( '_httpSessionType', $self->{ipField}, $whatToTrace );
     if ( my $groupBy = $params->{groupBy} ) {
         $groupBy =~ s/^substr\((\w+)(?:,\d+(?:,\d+)?)?\)$/$1/
-          or $groupBy =~ s/^net4\((\w+),\d\)$/$1/;
+          or $groupBy =~ s/^net(?:4|6)\(([\w:]+),\d\)$/$1/;
         $groupBy =~ s/^_whatToTrace$/$whatToTrace/o
           or push @fields, $groupBy;
     }
     elsif ( my $order = $params->{orderBy} ) {
-        $order =~ s/^net4\((\w+)\)$/$1/;
+        $order =~ s/^net(?:4|6)\(([\w:]+)\)$/$1/;
         $order =~ s/^_whatToTrace$/$whatToTrace/o
           or push @fields, split( /, /, $order );
     }
@@ -217,7 +218,7 @@ sub sessions {
             $group = $field;
         }
 
-        # Subnets
+        # Subnets IPv4
         elsif ( $group =~ /^net4\((\w+),(\d)\)$/ ) {
             my $field = $1;
             my $nb    = $2 - 1;
@@ -230,6 +231,15 @@ sub sessions {
             $group = $field;
         }
 
+        # Subnets IPv6
+        elsif ( $group =~ /^net6\(([\w:]+),(\d)\)$/ ) {
+            my $ip   = $1;
+            my $bits = $2;
+            foreach my $k ( keys %$res ) {
+                $r->{ net6( $res->{$k}->{$ip}, $bits ) }++ if ( isIPv6($ip) );
+            }
+        }
+
         # Simple field groupBy query
         elsif ( $group =~ /^\w+$/ ) {
             eval {
@@ -271,7 +281,7 @@ qq{Use of an uninitialized attribute "$group" to group sessions},
             my $tmp = { session => $_ };
             foreach my $f (@fields) {
                 my $s = $f;
-                $s =~ s/^net4\((\w+)\)$/$1/;
+                $s =~ s/^net(?:4|6)\(([\w:]+)\)$/$1/;
                 $tmp->{$s} = $res->{$_}->{$s};
             }
             $tmp
@@ -291,6 +301,20 @@ qq{Use of an uninitialized attribute "$group" to group sessions},
                     $cmp;
                 } @r;
             }
+            elsif ( $f =~ s/^net6\(([:\w]+)\)$/$1/ ) {
+                @r = sort {
+                    my @a = split /:/, $a->{$f};
+                    my @b = split /:/, $b->{$f};
+                    my $cmp = 0;
+                  F: for ( my $i = 0 ; $i < 4 ; $i++ ) {
+                        if ( $a[$i] != $b[$i] ) {
+                            $cmp = $a[$i] <=> $b[$i];
+                            last F;
+                        }
+                    }
+                    $cmp;
+                } @r;
+            }
             else {
                 @r = sort { $a->{$f} cmp $b->{$f} } @r;
             }