Test lib is going become base of future Cli.pm

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

@@ -203,6 +203,7 @@ sub getConf {
                     and $r->{useXForwardedForIP} == 1 )
                 {
                     $r->{trustedProxies} = '*';
+                    delete $r->{useXForwardedForIP};
                 }
 
                 # Force Choice backend

lemonldap-ng-manager/lib/Lemonldap/NG/Manager/Cli/Lib.pm

+package Lemonldap::NG::Manager::Cli::Lib;
+
+use JSON::MaybeXS;
+use 5.10.0;
+use Mouse;
+use Lemonldap::NG::Manager;
+
+has iniFile => ( is => 'ro', isa => 'Str', required => 1 );
+
+has app => (
+    is       => 'ro',
+    isa => 'CodeRef',
+    builder  => sub {
+        return Lemonldap::NG::Manager->run(
+            {
+                configStorage => { confFile => $_[0]->{iniFile} },
+                protection    => 'none',
+            }
+        );
+    }
+);
+
+sub get {
+    my ( $self, $path, $query ) = splice @_;
+    $query //= '';
+    return $self->app->(
+        {
+            'HTTP_ACCEPT'          => 'application/json, text/plain, */*',
+            'SCRIPT_NAME'          => '',
+            'HTTP_ACCEPT_ENCODING' => 'gzip, deflate',
+            'SERVER_NAME'          => '127.0.0.1',
+            'QUERY_STRING'         => $query,
+            'HTTP_CACHE_CONTROL'   => 'max-age=0',
+            'HTTP_ACCEPT_LANGUAGE' => 'fr,fr-FR;q=0.8,en-US;q=0.5,en;q=0.3',
+            'PATH_INFO'            => $path,
+            'REQUEST_METHOD'       => 'GET',
+            'REQUEST_URI'          => $path . ( $query ? "?$query" : '' ),
+            'SERVER_PORT'          => '8002',
+            'SERVER_PROTOCOL'      => 'HTTP/1.1',
+            'HTTP_USER_AGENT' =>
+              'Mozilla/5.0 (VAX-4000; rv:36.0) Gecko/20350101 Firefox',
+            'REMOTE_ADDR' => '127.0.0.1',
+            'HTTP_HOST'   => '127.0.0.1:8002'
+        }
+    );
+}
+
+sub post {
+    my ( $self, $path, $query, $body, $type, $len ) = splice @_;
+    die "$body must be a IO::Handle"
+      unless ( ref($body) and $body->can('read') );
+    return $self->app->(
+        {
+            'HTTP_ACCEPT'          => 'application/json, text/plain, */*',
+            'SCRIPT_NAME'          => '',
+            'HTTP_ACCEPT_ENCODING' => 'gzip, deflate',
+            'SERVER_NAME'          => '127.0.0.1',
+            'QUERY_STRING'         => $query,
+            'HTTP_CACHE_CONTROL'   => 'max-age=0',
+            'HTTP_ACCEPT_LANGUAGE' => 'fr,fr-FR;q=0.8,en-US;q=0.5,en;q=0.3',
+            'PATH_INFO'            => $path,
+            'REQUEST_METHOD'       => 'POST',
+            'REQUEST_URI'          => $path . ( $query ? "?$query" : '' ),
+            'SERVER_PORT'          => '8002',
+            'SERVER_PROTOCOL'      => 'HTTP/1.1',
+            'HTTP_USER_AGENT' =>
+              'Mozilla/5.0 (VAX-4000; rv:36.0) Gecko/20350101 Firefox',
+            'REMOTE_ADDR'          => '127.0.0.1',
+            'HTTP_HOST'            => '127.0.0.1:8002',
+            'psgix.input.buffered' => 1,
+            'psgi.input'           => $body,
+            'CONTENT_LENGTH'       => $len // scalar( ( stat $body )[7] ),
+            'CONTENT_TYPE'         => $type,
+        }
+    );
+}
+
+sub put {
+    my ( $self, $path, $query, $body, $type, $len ) = splice @_;
+    die "$body must be a IO::Handle"
+      unless ( ref($body) and $body->can('read') );
+    return $self->app->(
+        {
+            'HTTP_ACCEPT'          => 'application/json, text/plain, */*',
+            'SCRIPT_NAME'          => '',
+            'HTTP_ACCEPT_ENCODING' => 'gzip, deflate',
+            'SERVER_NAME'          => '127.0.0.1',
+            'QUERY_STRING'         => $query,
+            'HTTP_CACHE_CONTROL'   => 'max-age=0',
+            'HTTP_ACCEPT_LANGUAGE' => 'fr,fr-FR;q=0.8,en-US;q=0.5,en;q=0.3',
+            'PATH_INFO'            => $path,
+            'REQUEST_METHOD'       => 'PUT',
+            'REQUEST_URI'          => $path . ( $query ? "?$query" : '' ),
+            'SERVER_PORT'          => '8002',
+            'SERVER_PROTOCOL'      => 'HTTP/1.1',
+            'HTTP_USER_AGENT' =>
+              'Mozilla/5.0 (VAX-4000; rv:36.0) Gecko/20350101 Firefox',
+            'REMOTE_ADDR'          => '127.0.0.1',
+            'HTTP_HOST'            => '127.0.0.1:8002',
+            'psgix.input.buffered' => 1,
+            'psgi.input'           => $body,
+            'CONTENT_LENGTH'       => $len // scalar( ( stat $body )[7] ),
+            'CONTENT_TYPE'         => $type,
+        }
+    );
+}
+
+sub del {
+    my ( $self, $path, $query ) = splice @_;
+    return $self->app->(
+        {
+            'HTTP_ACCEPT'          => 'application/json, text/plain, */*',
+            'SCRIPT_NAME'          => '',
+            'HTTP_ACCEPT_ENCODING' => 'gzip, deflate',
+            'SERVER_NAME'          => '127.0.0.1',
+            'QUERY_STRING'         => $query,
+            'HTTP_CACHE_CONTROL'   => 'max-age=0',
+            'HTTP_ACCEPT_LANGUAGE' => 'fr,fr-FR;q=0.8,en-US;q=0.5,en;q=0.3',
+            'PATH_INFO'            => $path,
+            'REQUEST_METHOD'       => 'DELETE',
+            'REQUEST_URI'          => $path . ( $query ? "?$query" : '' ),
+            'SERVER_PORT'          => '8002',
+            'SERVER_PROTOCOL'      => 'HTTP/1.1',
+            'HTTP_USER_AGENT' =>
+              'Mozilla/5.0 (VAX-4000; rv:36.0) Gecko/20350101 Firefox',
+            'REMOTE_ADDR' => '127.0.0.1',
+            'HTTP_HOST'   => '127.0.0.1:8002',
+        }
+    );
+}
+
+sub jsonResponse {
+    my ( $self, $path, $query ) = splice @_;
+    my $res = $self->get( $path, $query )
+      or die "Manager lib has refused my get, aborting";
+    die "Manager lib does not return a 200 code, aborting"
+      unless ( $res->[0] == 200 );
+    my $href = decode_json( $res->[2]->[0] ) or die 'Response is not JSON';
+    return $href;
+}
+
+sub jsonPostResponse {
+    my ( $self, $path, $query, $body, $type, $len ) = splice @_;
+    my $res = $self->post( $path, $query, $body, $type, $len )
+      or die "Manager lib has refused my post, aborting";
+    die "Manager lib does not return a 200 code, aborting"
+      unless ( $res->[0] == 200 );
+    my $href = decode_json( $res->[2]->[0] ) or die 'Response is not JSON';
+    return $href;
+}
+
+sub jsonPutResponse {
+    my ( $self, $path, $query, $body, $type, $len ) = splice @_;
+    my $res = $self->put( $path, $query, $body, $type, $len )
+      or die "Manager lib has refused my put, aborting";
+    die "Manager lib does not return a 200 code, aborting"
+      unless ( $res->[0] == 200 );
+    my $href = decode_json( $res->[2]->[0] ) or die 'Response is not JSON';
+    return $href;
+}
+
+1;

lemonldap-ng-manager/t/02-HTML-template.t

@@ -2,13 +2,12 @@
 
 use Test::More;
 use strict;
-use 5.10.0;
 
 require 't/test-lib.pm';
 
 my $res;
 
-ok( $res = get('/'), 'Succeed to get /' );
+ok( $res = &client->get('/'), 'Succeed to get /' );
 my %hdrs = @{ $res->[1] };
 ok( $res->[0] == 200, 'Return a 200 code' )
   or print STDERR "Received" . Dumper($res);

lemonldap-ng-manager/t/03-HTML-forms.t

@@ -2,7 +2,6 @@
 
 use Test::More;
 use strict;
-use 5.10.0;
 
 my $formDir = 'site/static/forms';
 
@@ -22,7 +21,7 @@ delete $forms{restore};
 my ( @types, $attr, $tree, $ctrees );
 ok( $tree   = Lemonldap::NG::Manager::Build::Tree::tree(),     'Get tree' );
 ok( $ctrees = Lemonldap::NG::Manager::Build::CTrees::cTrees(), 'Get cTrees' );
-ok( $attr   = Lemonldap::NG::Manager::Build::Attributes::attributes(),
+ok( $attr = Lemonldap::NG::Manager::Build::Attributes::attributes(),
     'Get attributes' );
 $count += 4;
 

lemonldap-ng-manager/t/05-rest-api.t

@@ -3,7 +3,6 @@
 use Test::More;
 use JSON::MaybeXS;
 use strict;
-use 5.10.0;
 
 require 't/test-lib.pm';
 my $struct = 'site/static/struct.json';
@@ -35,11 +34,11 @@ my @good = qw(
 );
 
 foreach my $query (@good) {
-    my $href = jsonResponse($query);
+    my $href = &client->jsonResponse($query);
 }
 
 foreach my $query (@bad) {
-    my $res = get( $query, '' );
+    my $res = &client->get( $query, '' );
     ok( $res->[0] == 400, "Request reject for $query" )
       or print STDERR "# Receive a $res->[0] code";
     my $href;
@@ -64,7 +63,7 @@ ok( ref $hstruct eq 'ARRAY', 'struct.json is an array' );
 count(2);
 
 foreach my $query (@hkeys) {
-    my $href = jsonResponse( "/confs/1/$query", '' );
+    my $href = &client->jsonResponse( "/confs/1/$query", '' );
     ok( ref $href eq 'ARRAY', 'Response is an array' );
     count(1);
     foreach my $k (@$href) {
@@ -76,7 +75,7 @@ foreach my $query (@hkeys) {
 
 # Metadatas
 {
-    my $href = jsonResponse( 'confs/1', '' );
+    my $href = &client->jsonResponse( 'confs/1', '' );
     foreach (qw(cfgNum cfgAuthor cfgAuthorIP cfgDate)) {
         ok( exists( $href->{$_} ), "Key $_ exists" );
     }

lemonldap-ng-manager/t/06-rest-api.t

 #!/usr/bin/env perl
 
 use Test::More;
-use 5.10.0;
 use strict;
 use JSON::MaybeXS;
 use IO::String;
@@ -9,9 +8,9 @@ require 't/test-lib.pm';
 
 my $res;
 ok(
-    $res =
-      post( '/confs/newRSAKey', '',
-        IO::String->new(''), 'application/json', 0, ),
+    $res = &client->post(
+        '/confs/newRSAKey', '', IO::String->new(''), 'application/json', 0,
+    ),
     "Request succeed"
 );
 ok( $res->[0] == 200, "Result code is 200" );
@@ -20,7 +19,7 @@ ok( $key = decode_json( $res->[2]->[0] ), 'Response is JSON' );
 count(3);
 
 ok(
-    $res = post(
+    $res = &client->post(
         '/confs/newRSAKey', '', IO::String->new('{"password":"hello"}'),
         'application/json', 20,
     ),

lemonldap-ng-manager/t/10-save-unchanged-conf.t

 #!/usr/bin/env perl -I pl/lib
 
 use Test::More;
-use 5.10.0;
 use strict;
 use JSON::MaybeXS;
 use Data::Dumper;
@@ -25,8 +24,11 @@ eval { unlink $confFiles->[1]; };
 while ( my $body = &body() ) {
     my $desc = shift @desc;
     my ( $res, $resBody );
-    ok( $res = post( '/confs/', 'cfgNum=1', $body, 'application/json' ),
-        "$desc: positive result" );
+    ok(
+        $res =
+          &client->post( '/confs/', 'cfgNum=1', $body, 'application/json' ),
+        "$desc: positive result"
+    );
     ok( $res->[0] == 200, "$desc: result code is 200" );
     ok(
         $resBody = decode_json( $res->[2]->[0] ),

lemonldap-ng-manager/t/12-save-changed-conf.t

 #!/usr/bin/env perl -I pl/lib
 
 use Test::More;
-use 5.10.0;
 use strict;
 use JSON::MaybeXS;
 use Data::Dumper;
@@ -18,7 +17,7 @@ sub body {
 eval { unlink $confFiles->[1]; };
 
 my ( $res, $resBody );
-ok( $res = post( '/confs/', 'cfgNum=1', &body, 'application/json' ),
+ok( $res = &client->post( '/confs/', 'cfgNum=1', &body, 'application/json' ),
     "Request succeed" );
 ok( $res->[0] == 200, "Result code is 200" );
 ok( $resBody = decode_json( $res->[2]->[0] ),

lemonldap-ng-manager/t/40-sessions.t

@@ -3,7 +3,6 @@
 use Test::More;
 use JSON::MaybeXS;
 use strict;
-use 5.10.0;
 use Lemonldap::NG::Common::Session;
 
 eval { mkdir 't/sessions' };
@@ -36,13 +35,13 @@ sub newSession {
 my @ids;
 $ids[0] = newSession( 'dwho',  '127.10.0.1' );
 $ids[1] = newSession( 'dwho2', '127.2.0.2' );
-my $res = jsonResponse("/sessions/global/$ids[0]");
+my $res = &client->jsonResponse("/sessions/global/$ids[0]");
 ok( ( $res->{uid}    and $res->{uid} eq 'dwho' ),          'Uid found' );
 ok( ( $res->{ipAddr} and $res->{ipAddr} eq '127.10.0.1' ), 'IP found' );
 count(2);
 
 # "All" query
-$res = jsonResponse("/sessions/global/");
+$res = &client->jsonResponse("/sessions/global/");
 ok( $res->{result} == 1,      'Result code = 1' );
 ok( $res->{count} == 2,       'Found 2 sessions' );
 ok( @{ $res->{values} } == 2, 'List 2 sessions' );
@@ -52,7 +51,7 @@ ok( $res->{values}->[$_]->{session} =~ /^(?:$ids[0]|$ids[1])$/,
 count(5);
 
 # GroupBy query
-$res = jsonResponse( '/sessions/global', 'groupBy=substr(uid,1)' );
+$res = &client->jsonResponse( '/sessions/global', 'groupBy=substr(uid,1)' );
 ok( $res->{result} == 1, 'Result code = 1' );
 ok( $res->{count} == 1,  'Found 1 entry' );
 ok( $res->{values}->[0]->{value} && $res->{values}->[0]->{value} eq 'd',
@@ -62,25 +61,25 @@ ok( $res->{values}->[0]->{count} == 2, 'Found 2 sessions starting with "d"' );
 count(4);
 
 $ids[2] = newSession( 'foo', '127.3.0.3' );
-$res = jsonResponse( '/sessions/global', 'groupBy=substr(uid,1)' );
+$res = &client->jsonResponse( '/sessions/global', 'groupBy=substr(uid,1)' );
 ok( $res->{count} == 2, 'Found 2 entries' );
 count(1);
 
 # Filtered queries
-$res = jsonResponse( '/sessions/global', 'uid=d*' );
+$res = &client->jsonResponse( '/sessions/global', 'uid=d*' );
 ok( $res->{count} == 2, 'Found 2 sessions' );
 ok( $res->{values}->[$_]->{session} =~ /^(?:$ids[0]|$ids[1])$/,
     'Good session id' )
   foreach ( 0 .. 1 );
 count(3);
-$res = jsonResponse( '/sessions/global', 'uid=f*' );
+$res = &client->jsonResponse( '/sessions/global', 'uid=f*' );
 ok( $res->{count} == 1,                        'Found 1 sessions' );
 ok( $res->{values}->[0]->{session} eq $ids[2], 'Good session id' );
 count(2);
 
 # DoubleIp
 $ids[3] = newSession( 'foo', '127.3.0.4' );
-$res = jsonResponse( '/sessions/global', 'doubleIp' );
+$res = &client->jsonResponse( '/sessions/global', 'doubleIp' );
 ok( $res->{count} == 1,                    'Found 1 user' );
 ok( $res->{values}->[0]->{value} eq 'foo', 'User is foo' );
 ok(
@@ -90,7 +89,7 @@ ok(
 count(4);
 
 # New GroupBy query test with 4 sessions
-$res = jsonResponse( '/sessions/global', 'groupBy=uid' );
+$res = &client->jsonResponse( '/sessions/global', 'groupBy=uid' );
 ok(
     (
               $res->{values}->[0]->{value} eq 'dwho'
@@ -115,7 +114,7 @@ ok(
 count(3);
 
 # Ordered queries
-$res = jsonResponse( '/sessions/global', 'orderBy=uid' );
+$res = &client->jsonResponse( '/sessions/global', 'orderBy=uid' );
 ok( $res->{values}->[0]->{uid} eq 'dwho',  '1st user is dwho' );
 ok( $res->{values}->[1]->{uid} eq 'dwho2', '2nd user is dwho2' );
 ok( $res->{values}->[2]->{uid} eq 'foo',   '3rd user is foo' );
@@ -123,15 +122,15 @@ ok( $res->{values}->[3]->{uid} eq 'foo',   '4rd user is foo' );
 count(4);
 
 # IPv4 networks
-$res = jsonResponse( '/sessions/global', 'groupBy=net4(ipAddr,1)' );
+$res = &client->jsonResponse( '/sessions/global', 'groupBy=net4(ipAddr,1)' );
 ok( $res->{count} == 1,                'One A subnet' );
 ok( $res->{values}->[0]->{count} == 4, 'All sessions found' );
-$res = jsonResponse( '/sessions/global', 'groupBy=net4(ipAddr,2)' );
+$res = &client->jsonResponse( '/sessions/global', 'groupBy=net4(ipAddr,2)' );
 ok( $res->{count} == 3,                'Three B subnet' );
 ok( $res->{values}->[2]->{count} == 2, 'All sessions found' );
 count(4);
 
-$res = jsonResponse( '/sessions/global', 'orderBy=net4(ipAddr)' );
+$res = &client->jsonResponse( '/sessions/global', 'orderBy=net4(ipAddr)' );
 ok( $res->{count} == 4,                        '4 sessions ordered' );
 ok( $res->{values}->[0]->{session} eq $ids[1], '1st is id[1]' );
 ok( $res->{values}->[1]->{session} eq $ids[2], '2nd is id[2]' );
@@ -144,7 +143,7 @@ count(5);
 # Delete sessions
 foreach (@ids) {
     my $res;
-    ok( $res = del("/sessions/global/$_"), "Delete $_" );
+    ok( $res = &client->del("/sessions/global/$_"), "Delete $_" );
     ok( $res->[0] == 200, 'Result code is 200' );
     ok( decode_json( $res->[2]->[0] )->{result} == 1,
         'Body is JSON and result==1' );

lemonldap-ng-manager/t/50-notifications.t

@@ -2,7 +2,6 @@
 
 use Test::More;
 use strict;
-use 5.10.0;
 use IO::String;
 
 eval { mkdir 't/notifications' };
@@ -13,7 +12,8 @@ require 't/test-lib.pm';
 my $notif =
 '{"date":"2015-05-03","uid":"dwho","reference":"Test","xml":"<title>Test</title>"}';
 my $res =
-  jsonPostResponse( 'notifications/actives', '', IO::String->new($notif),
+  &client->jsonPostResponse( 'notifications/actives', '',
+    IO::String->new($notif),
     'application/json', length($notif) );
 
 ok( $res->{result}, 'Result is true' );
@@ -24,7 +24,7 @@ displayTests('actives');
 
 # Mark notification as done
 $notif = '{"done":1}';
-$res   = jsonPutResponse(
+$res   = &client->jsonPutResponse(
     'notifications/actives/dwho_Test',
     '', IO::String->new($notif),
     'application/json', length($notif)
@@ -32,7 +32,8 @@ $res   = jsonPutResponse(
 ok( $res->{result} == 1, 'Result = 1' );
 
 # Test that notification is not active now
-$res = jsonResponse( 'notifications/actives', 'groupBy=substr(uid,1)' );
+$res =
+  &client->jsonResponse( 'notifications/actives', 'groupBy=substr(uid,1)' );
 ok( $res->{result} == 1, 'Result = 1' );
 ok( $res->{count} == 0,  'Count = 0' );
 count(3);
@@ -41,8 +42,8 @@ count(3);
 displayTests('done');
 
 # Delete notification
-$res = del('notifications/done/20150503_dwho_VGVzdA==.done');
-$res = jsonResponse( 'notifications/done', 'groupBy=substr(uid,1)' );
+$res = &client->del('notifications/done/20150503_dwho_VGVzdA==.done');
+$res = &client->jsonResponse( 'notifications/done', 'groupBy=substr(uid,1)' );
 ok( $res->{result} == 1, 'Result = 1' );
 ok( $res->{count} == 0,  'Count = 0' );
 count(2);
@@ -55,38 +56,39 @@ done_testing( count() );
 
 sub displayTests {
     my $type = shift;
-    $res = jsonResponse( "notifications/$type", 'groupBy=substr(uid,1)' );
+    $res =
+      &client->jsonResponse( "notifications/$type", 'groupBy=substr(uid,1)' );
     ok( $res->{result} == 1,                 'Result = 1' );
     ok( $res->{count} == 1,                  'Count = 1' );
     ok( $res->{values}->[0]->{value} eq 'd', 'Value is "d"' );
     count(3);
 
-    $res = jsonResponse( "notifications/$type", 'groupBy=uid' );
+    $res = &client->jsonResponse( "notifications/$type", 'groupBy=uid' );
     ok( $res->{result} == 1,                    'Result = 1' );
     ok( $res->{count} == 1,                     'Count = 1' );
     ok( $res->{values}->[0]->{value} eq 'dwho', 'Value is "dwho"' );
     count(3);
 
-    $res = jsonResponse( "notifications/$type", 'uid=d*&groupBy=uid' );
+    $res = &client->jsonResponse( "notifications/$type", 'uid=d*&groupBy=uid' );
     ok( $res->{result} == 1,                    'Result = 1' );
     ok( $res->{count} == 1,                     'Count = 1' );
     ok( $res->{values}->[0]->{value} eq 'dwho', 'Value is "dwho"' );
     count(3);
 
-    $res = jsonResponse( "notifications/$type", 'uid=d*' );
+    $res = &client->jsonResponse( "notifications/$type", 'uid=d*' );
     ok( $res->{result} == 1,                  'Result = 1' );
     ok( $res->{count} == 1,                   'Count = 1' );
     ok( $res->{values}->[0]->{uid} eq 'dwho', 'Value is "dwho"' );
     count(3);
 
-    $res = jsonResponse( "notifications/$type", 'uid=dwho' );
+    $res = &client->jsonResponse( "notifications/$type", 'uid=dwho' );
     ok( $res->{result} == 1,                  'Result = 1' );
     ok( $res->{count} == 1,                   'Count = 1' );
     ok( $res->{values}->[0]->{uid} eq 'dwho', 'Value is "dwho"' );
     count(3);
 
     if ( $type eq 'actives' ) {
-        $res = jsonResponse( "notifications/$type/dwho_Test", '' );
+        $res = &client