10_login.t 14.9 KB
Newer Older
Francesc Guasch's avatar
Francesc Guasch committed
1
2
3
use warnings;
use strict;

4
use Carp qw(confess);
Francesc Guasch's avatar
Francesc Guasch committed
5
use Data::Dumper;
Francesc Guasch's avatar
Francesc Guasch committed
6
use HTML::Lint;
Francesc Guasch's avatar
Francesc Guasch committed
7
8
9
10
11
12
13
14
15
16
17
18
19
20
use Test::More;
use Test::Mojo;
use Mojo::File 'path';

use lib 't/lib';
use Test::Ravada;

no warnings "experimental::signatures";
use feature qw(signatures);

my $SECONDS_TIMEOUT = 15;

my $t;

21
my $URL_LOGOUT = '/logout';
Francesc Guasch's avatar
Francesc Guasch committed
22
my ($USERNAME, $PASSWORD);
23
my $SCRIPT = path(__FILE__)->dirname->sibling('../script/rvd_front');
Francesc Guasch's avatar
Francesc Guasch committed
24

Francesc Guasch's avatar
Francesc Guasch committed
25
my $BASE_NAME = "zz-test-base-alpine";
Francesc Guasch's avatar
Francesc Guasch committed
26
27
########################################################################################

Francesc Guasch's avatar
Francesc Guasch committed
28
sub remove_machines(@machines) {
Francesc Guasch's avatar
Francesc Guasch committed
29
    my $t0 = time;
Francesc Guasch's avatar
Francesc Guasch committed
30
    for my $name ( @machines ) {
Francesc Guasch's avatar
Francesc Guasch committed
31
        my $domain = rvd_front->search_domain($name) or next;
Francesc Guasch's avatar
Francesc Guasch committed
32
        remove_domain_and_clones_req($domain,1); #remove and wait
Francesc Guasch's avatar
Francesc Guasch committed
33
    }
34
    _wait_request(debug => 1, background => 1, timeout => 120);
Francesc Guasch's avatar
Francesc Guasch committed
35
36
37
38
39
40
}

sub _wait_request(@args) {
    my $t0 = time;
    wait_request(@args);

Francesc Guasch's avatar
Francesc Guasch committed
41
    if ( $USERNAME && time - $t0 > $SECONDS_TIMEOUT ) {
Francesc Guasch's avatar
Francesc Guasch committed
42
43
44
45
46
47
48
        login();
    }

}


sub login( $user=$USERNAME, $pass=$PASSWORD ) {
49
    $t->ua->get($URL_LOGOUT);
Francesc Guasch's avatar
Francesc Guasch committed
50

51
52
    confess "Error: missing user" if !defined $user;

53
    $t->post_ok('/login' => form => {login => $user, password => $pass});
Francesc Guasch's avatar
Francesc Guasch committed
54
55
56
57
58
59
    like($t->tx->res->code(),qr/^(200|302)$/);
    #    ->status_is(302);

    exit if !$t->success;
}

60
61
62
63
64
sub test_many_clones($base) {
    login();

    my $n_clones = 30;
    $n_clones = 100 if $base->type =~ /Void/i;
65

66
    $n_clones = 10 if !$ENV{TEST_STRESS} && ! $ENV{TEST_LONG};
67

Francesc Guasch's avatar
Francesc Guasch committed
68
    $t->post_ok('/machine/copy' => json => {id_base => $base->id, copy_number => $n_clones, copy_ram => 0.128 });
69
70
71
72
73
74
75
    like($t->tx->res->code(),qr/^(200|302)$/) or die $t->tx->res->body->to_string;

    my $response = $t->tx->res->json();
    ok(exists $response->{request}) or return;
    wait_request(request => $response->{request}, background => 1);

    login();
Francesc Guasch's avatar
Francesc Guasch committed
76
77
    my $sequential = 0;
    $sequential = 1 if $base->type eq 'Void';
78
    $t->post_ok('/request/start_clones' => json =>
Francesc Guasch's avatar
Francesc Guasch committed
79
        {   id_domain => $base->id, sequential => $sequential
80
81
82
83
        }
    );
    like($t->tx->res->code(),qr/^(200|302)$/) or die $t->tx->res->body->to_string;
    $response = $t->tx->res->json();
Francesc Guasch's avatar
Francesc Guasch committed
84
    if (exists $response->{request}) {
85
        wait_request(request => $response->{request}, background => 1);
Francesc Guasch's avatar
Francesc Guasch committed
86
87
    } else {
        warn Dumper($response);
88
89
    };

Francesc Guasch's avatar
Francesc Guasch committed
90
91
92
93
    wait_request(debug => 1, background => 1);
    ok(scalar($base->clones)>=$n_clones);

    test_iptables_clones($base);
94
    test_re_expose($base) if $base->type eq 'Void';
Francesc Guasch's avatar
Francesc Guasch committed
95
    test_different_mac($base, $base->clones) if $base->type ne 'Void';
96
97
98
99
100
101
102
103
    for my $clone ( $base->clones ) {
        my $req = Ravada::Request->remove_domain(
            name => $clone->{name}
            ,uid => user_admin->id
        );
    }
}

Francesc Guasch's avatar
Francesc Guasch committed
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
sub test_different_mac(@domain) {
    my %found;
    for my $domain (@domain) {
        $domain = Ravada::Front::Domain->open($domain->{id})
            if ref($domain) !~/^Ravada/;
        my $xml = XML::LibXML->load_xml(string => $domain->_data_extra('xml'));
        my (@if_mac) = $xml->findnodes('/domain/devices/interface/mac');
        for my $if_mac (@if_mac) {
            my $mac = $if_mac->getAttribute('address');
            ok(!exists $found{$mac},"Error: MAC $mac from ".$domain->name
                ." also in domain : ".($found{$mac} or '')) or exit;
            $found{$mac} = $domain->name;
        }
    }
}

Francesc Guasch's avatar
Francesc Guasch committed
120
121
122
123
124
125
126
127
128
129
130
sub test_iptables_clones($base) {
    delete_request('set_time','screenshot','refresh_machine_ports');
    wait_request(background => 1, debug => 1);
    my %port_display;
    for my $clone_data ( $base->clones ) {
        next if $clone_data->{is_base};
        if ($clone_data->{status} ne 'active') {
            diag("$clone_data->{name} $clone_data->{status}");
            next;
        }
        my $clone = Ravada::Front::Domain->open($clone_data->{id});
131
        wait_request();
Francesc Guasch's avatar
Francesc Guasch committed
132
        my $displays = $clone->info(user_admin)->{hardware}->{display};
133
        wait_request();
Francesc Guasch's avatar
Francesc Guasch committed
134
135
136
137
138
139
140
141
142
143
144
145
        for my $display (@$displays) {
            for my $port ($display->{port}, $display->{extra}->{tls_port}) {
                next if !defined $port;
                my $found = $port_display{$port};
                my $value = "$clone_data->{id} $display->{driver}:$port";
                ok(!$found,"Duplicated display $port on $clone_data->{name} $value and ".($found or "")) or exit;
                $port_display{$port} = $value;
            }
        }
    }
}

146
147
148
sub test_re_expose($base) {
    diag("Test re-expose");
    for my $clone ( $base->clones ) {
Francesc Guasch's avatar
Francesc Guasch committed
149
        my $req = Ravada::Request->shutdown_domain(
150
151
152
153
154
            id_domain => $clone->{id}
            , uid => user_admin->id
        )
    }
    wait_request(background => 1);
Francesc Guasch's avatar
Francesc Guasch committed
155
    Ravada::Request->expose(uid => user_admin->id, id_domain => $base->id, port => 23);
156
    wait_request(background => 1);
157

158
    for my $clone ( $base->clones ) {
Francesc Guasch's avatar
Francesc Guasch committed
159
        next if $clone->{is_base};
160
161
162
163
164
165
166
167
168
        my $req = Ravada::Request->start_domain(
            id_domain => $clone->{id}
            , uid => user_admin->id
            , remote_ip => '1.2.3.4'
        );
    }
    wait_request(background => 1, check_error => 1);
}
sub _init_mojo_client {
169
170
171
172
173
174
175
176
177
    my $user_admin = user_admin();
    my $pass = "$$ $$";

    $USERNAME = $user_admin->name;
    $PASSWORD = $pass;

    login($user_admin->name, $pass);
    $t->get_ok('/')->status_is(200)->content_like(qr/choose a machine/i);
}
Francesc Guasch's avatar
Francesc Guasch committed
178

179
180
181
182
sub test_login_fail {
    $t->post_ok('/login' => form => {login => "fail", password => 'bigtime'});
    is($t->tx->res->code(),403);
    $t->get_ok("/admin/machines")->status_is(401);
Francesc Guasch's avatar
Francesc Guasch committed
183
    like($t->tx->res->dom->at("button#submit")->text,qr'Login') or exit;
184

185
    login( user_admin->name, "$$ $$");
186
187
188
189
190

    $t->post_ok('/login' => form => {login => "fail", password => 'bigtime'});
    is($t->tx->res->code(),403);

    $t->get_ok("/admin/machines")->status_is(401);
Francesc Guasch's avatar
Francesc Guasch committed
191
    like($t->tx->res->dom->at("button#submit")->text,qr'Login') or exit;
192
193

    $t->get_ok("/admin/users")->status_is(401);
194
    like($t->tx->res->dom->at("button#submit")->text,qr'Login') or exit;
195
196
197
198
199
200
201
202
203
204
205
206
207
}

sub test_copy_without_prepare($clone) {
    is ($clone->is_base,0) or die "Clone ".$clone->name." is supposed to be non-base";

    my $n_clones = 3;
    mojo_request($t, "clone", { id_domain => $clone->id, number => $n_clones });
    wait_request(debug => 1, check_error => 1, background => 1, timeout => 120);

    my @clones = $clone->clones();
    is(scalar @clones, $n_clones) or exit;

    remove_machines($clone);
208
209
}

Francesc Guasch's avatar
Francesc Guasch committed
210
sub test_validate_html($url) {
Francesc Guasch's avatar
Francesc Guasch committed
211
    mojo_check_login($t);
Francesc Guasch's avatar
Francesc Guasch committed
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
    $t->get_ok($url)->status_is(200);
    my $content = $t->tx->res->body();
    _check_html_lint($url,$content);
}


sub _check_count_divs($url, $content) {
    my $n = 0;
    my $open = 0;
    for my $line (split /\n/,$content) {
        $n++;
        die "Error: too many divs" if $line =~ m{<div.*<div.*<div};

        next if $line =~ m{<div.*<div.*/div>.*/div>};

        $open++ if $line =~ /<div/;
        $open-- if $line =~ m{</div};

        last if $open<0;
    }
    ok(!$open,"$open open divs in $url line $n") ;
}

sub _remove_embedded_perl($content) {
    my $return = '';
    my $changed = 0;
    for my $line (split /\n/,$$content) {
        if ($line =~ /<%=/) {
            $line =~ s/(.*)<%=.*?%>(.*)/$1$2/;
            $changed++;
        }
        $return .= "$line\n";
    }
    $$content = $return if $changed;
}

sub _check_html_lint($url, $content, $option = {}) {
    _remove_embedded_perl(\$content);
    _check_count_divs($url, $content);

    my $lint = HTML::Lint->new;
    #    $lint->only_types( HTML::Lint::Error::STRUCTURE );
    $lint->parse( $content );
    $lint->eof();

    my @errors;
    my @warnings;

    for my $error ( $lint->errors() ) {
        next if $error->errtext =~ /Entity .*is unknown/;
        next if $option->{internal} && $error->errtext =~ /(body|head|html|title).*required/;
        if ( $error->errtext =~ /Unknown element <(footer|header|nav)/
            || $error->errtext =~ /Entity && is unknown/
            || $error->errtext =~ /should be written as/
            || $error->errtext =~ /Unknown attribute.*%/
            || $error->errtext =~ /Unknown attribute "ng-/
            || $error->errtext =~ /Unknown attribute "(aria|align|autofocus|data-|href|novalidate|placeholder|required|tabindex|role|uib-alert)/
            || $error->errtext =~ /img.*(has no.*attributes|does not have ALT)/
            || $error->errtext =~ /Unknown attribute "(min|max).*input/ # Check this one
            || $error->errtext =~ /Unknown attribute "(charset|crossorigin|integrity)/
            || $error->errtext =~ /Unknown attribute "image.* for tag <div/
273
            || $error->errtext =~ /Unknown attribute "ipaddress"/
274
            || $error->errtext =~ /Unknown attribute "sizes" for tag .link/
Francesc Guasch's avatar
Francesc Guasch committed
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
         ) {
             next;
         }
        if ($error->errtext =~ /attribute.*is repeated/
            || $error->errtext =~ /Unknown attribute/
            # TODO next one
            #|| $error->errtext =~ /img.*(has no.*attributes|does not have ALT)/
            || $error->errtext =~ /attribute.*is repeated/
        ) {
            push @warnings, ($error);
            next;
        }
        push @errors, ($error)
    }
    ok(!@errors, $url) or do {
        my $file_out = $url;
        $url =~ s{^/}{};
        $file_out =~ s{/}{_}g;
        $file_out = "/var/tmp/$file_out";
        open my $out, ">", $file_out or die "$! $file_out";
        print $out $content;
        close $out;
        die "Stored in $file_out\n".Dumper([ map { [$_->where,$_->errtext] } @errors ]);
    };
    ok(!@warnings,$url) or warn Dumper([ map { [$_->where,$_->errtext] } @warnings]);


}

304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
sub test_logout_ldap {
    my ($username, $password) = ( new_domain_name(),$$);
    my $user = create_ldap_user( $username, $password);

    $t->post_ok('/login' => form => {login => $username, password => $password});
    is($t->tx->res->code(),302);

    $t->ua->get($URL_LOGOUT);

    $t->post_ok('/login' => form => {login => $username, password => 'bigtime'});
    is($t->tx->res->code(),403);

    $t->post_ok('/login' => form => {login => $username, password => $password});
    is($t->tx->res->code(),302);
}

Francesc Guasch's avatar
Francesc Guasch committed
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
sub _add_displays($t, $domain) {
    #    mojo_request($t, "add_hardware", { id_domain => $base->id, name => 'network' });
    my $info = $domain->info(user_admin);
    my $options = $info->{drivers}->{display};
    for my $driver (@$options) {
        next if grep { $_->{driver} eq $driver } @{$info->{hardware}->{display}};

        my $req = Ravada::Request->add_hardware(
            uid => user_admin->id
            , id_domain => $domain->id
            , name => 'display'
            , data => { driver => $driver }
        );
    }
    wait_request(background => 1);

}

sub _clone_and_base($vm_name, $t, $base0) {
    mojo_check_login($t);
    my $base1 = $base0;
    if ($vm_name eq 'KVM') {
        my $base = rvd_front->search_domain($BASE_NAME);
343
        die "Error: test base $BASE_NAME not found" if !$base;
Francesc Guasch's avatar
Francesc Guasch committed
344
345
346
347
348
349
350
351
        my $name = new_domain_name()."-".$vm_name."-$$";
        mojo_request_url_post($t,"/machine/copy",{id_base => $base->id, new_name => $name, copy_ram => 0.128, copy_number => 1});
        $base1 = rvd_front->search_domain($name);
        ok($base1, "Expecting domain $name create") or exit;
    }

    mojo_check_login($t);
    _add_displays($t, $base1);
352
    mojo_check_login($t);
Francesc Guasch's avatar
Francesc Guasch committed
353
354
355
356
357
358
359
360
361
362
363
364
    mojo_request_url($t , "/machine/prepare/".$base1->id.".json");
    return $base1;
}

sub test_clone($base1) {
    $t->get_ok("/machine/clone/".$base1->id.".html")->status_is(200);
    my $body = $t->tx->res->body;
    my ($id_req) = $body =~ m{subscribe',(\d+)};

    my $req = Ravada::Request->open($id_req);
    ok($req, "Expecting request on /machine/clone") or return;
    for ( ;; ) {
365
366
        last if $req->status eq 'done' && $req->error !~ /Retry.?$/;
        warn $req->error if $req->status eq 'done';
Francesc Guasch's avatar
Francesc Guasch committed
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
        sleep 1;
    }
    ok($req->status,'done');
    is($req->error, '') or return;

    my $id_domain = $req->id_domain;
    my $clone = Ravada::Front::Domain->open($id_domain);

    my $clone_name  = $base1->name."-".user_admin->name;
    is($clone->name, $clone_name);
    ok($clone->name);
    is($clone->is_volatile,0) or exit;
    is(scalar($clone->list_ports),2);
    return $clone;
}

sub test_admin_can_do_anything($t, $base) {

    my $pass = "$$ $$";
    my $user = create_user(new_domain_name()."-$$", $pass, 1);

    login( $user->name, $pass );

    $t->get_ok("/machine/info/".$base->id.".json");
    is($t->tx->res->code(),200);

    my $response = $t->tx->res->json();
    for my $field( keys %$response) {
        next if $field !~ /^can_/;
        is($response->{$field},1,"Admin user ".$user->name
            ." should be able to $field ".$base->name)
    }

    login($USERNAME, $PASSWORD);

    $user->remove();
}

Francesc Guasch's avatar
Francesc Guasch committed
405
406
########################################################################################

Francesc Guasch's avatar
Francesc Guasch committed
407
$ENV{MOJO_MODE} = 'devel';
Francesc Guasch's avatar
Francesc Guasch committed
408
409
410
411
init('/etc/ravada.conf',0);
my $connector = rvd_back->connector;
like($connector->{driver} , qr/mysql/i) or BAIL_OUT;

Francesc Guasch's avatar
Francesc Guasch committed
412
if (!ping_backend()) {
413
414
415
416
    diag("SKIPPED: no backend");
    done_testing();
    exit;
}
417
$Test::Ravada::BACKGROUND=1;
418

Francesc Guasch's avatar
Francesc Guasch committed
419
$t = Test::Mojo->new($SCRIPT);
420
421
$t->ua->inactivity_timeout(900);
$t->ua->connect_timeout(60);
Francesc Guasch's avatar
Francesc Guasch committed
422
423
424
my @bases;
my @clones;

425
426
test_logout_ldap();

427
428
test_login_fail();

Francesc Guasch's avatar
Francesc Guasch committed
429
430
test_validate_html("/login");

431
432
remove_old_domains_req();

Francesc Guasch's avatar
Francesc Guasch committed
433
434
435
my $t0 = time;
diag("starting tests at ".localtime($t0));
for my $vm_name ( @{rvd_front->list_vm_types} ) {
Francesc Guasch's avatar
Francesc Guasch committed
436
437
438

    diag("Testing new machine in $vm_name");

439
    my $name = new_domain_name()."-".$vm_name;
Francesc Guasch's avatar
Francesc Guasch committed
440
441
    remove_machines($name,"$name-".user_admin->name);

442
443
    $name .= "-".$$;

444
445
    _init_mojo_client();

Francesc Guasch's avatar
Francesc Guasch committed
446
447
448
449
450
451
452
453
454
455
456
    $t->post_ok('/new_machine.html' => form => {
            backend => $vm_name
            ,id_iso => search_id_iso('Alpine%')
            ,name => $name
            ,disk => 1
            ,ram => 1
            ,swap => 1
            ,submit => 1
        }
    )->status_is(302);

457
    _wait_request(debug => 1, background => 1, check_error => 1);
Francesc Guasch's avatar
Francesc Guasch committed
458
    my $base0;
459
    for ( 1 .. 10 ) {
Francesc Guasch's avatar
Francesc Guasch committed
460
461
        $base0 = rvd_front->search_domain($name);
        last if $base0;
462
463
        sleep 1;
    }
Francesc Guasch's avatar
Francesc Guasch committed
464
465
466
467
    ok($base0, "Expecting domain $name create") or exit;
    push @bases,($base0->name);

    test_admin_can_do_anything($t, $base0);
Francesc Guasch's avatar
Francesc Guasch committed
468

Francesc Guasch's avatar
Francesc Guasch committed
469
    mojo_request($t, "add_hardware", { id_domain => $base0->id, name => 'network' });
Francesc Guasch's avatar
Francesc Guasch committed
470
471
    wait_request(debug => 1, check_error => 1, background => 1, timeout => 120);

Francesc Guasch's avatar
Francesc Guasch committed
472
    test_validate_html("/machine/manage/".$base0->id.".html");
Francesc Guasch's avatar
Francesc Guasch committed
473

Francesc Guasch's avatar
Francesc Guasch committed
474
    my $base1 = _clone_and_base($vm_name, $t, $base0);
Francesc Guasch's avatar
Francesc Guasch committed
475

Francesc Guasch's avatar
Francesc Guasch committed
476
477
    push @bases,($base1->name);
    is($base1->is_base,1) or next;
Francesc Guasch's avatar
Francesc Guasch committed
478

Francesc Guasch's avatar
Francesc Guasch committed
479
    is(scalar($base1->list_ports),2);
Francesc Guasch's avatar
Francesc Guasch committed
480
    mojo_check_login($t);
Francesc Guasch's avatar
Francesc Guasch committed
481
482
483

    my $clone = test_clone($base1);
    push @bases, ( $clone->name );
Francesc Guasch's avatar
Francesc Guasch committed
484
    mojo_check_login($t);
Francesc Guasch's avatar
Francesc Guasch committed
485
486
    test_many_clones($base1);
    remove_machines(reverse @bases);
Francesc Guasch's avatar
Francesc Guasch committed
487
488
}
ok(@bases,"Expecting some machines created");
Francesc Guasch's avatar
Francesc Guasch committed
489
remove_machines(reverse @bases);
Francesc Guasch's avatar
Francesc Guasch committed
490
_wait_request(background => 1);
Francesc Guasch's avatar
Francesc Guasch committed
491
remove_old_domains_req(0); # 0=do not wait for them
Francesc Guasch's avatar
Francesc Guasch committed
492

Francesc Guasch's avatar
Francesc Guasch committed
493
494
495
496
497
498
499
my $t1 = time;
diag("ending tests at ".localtime($t1));
my $run_time = $t1-$t0;
diag("$run_time seconds");
my $m = int($run_time/60);
my $s = ($run_time % 60);
diag("$m:$s run time");
Francesc Guasch's avatar
Francesc Guasch committed
500
done_testing();