rvd_back 27.6 KB
Newer Older
Francesc Guasch's avatar
Francesc Guasch committed
1
2
3
4
5
#!/usr/bin/perl

use warnings;
use strict;

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

9
use Carp qw(confess);
10
use Data::Dumper;
11
use Getopt::Long;
12
use POSIX ":sys_wait_h";
13
use Proc::PID::File;
14
15
16
use File::Tee;
use File::Path;
use File::Basename;
17

18
use Ravada;
Francesc Guasch's avatar
Francesc Guasch committed
19
use Ravada::Auth::SQL;
20
use Ravada::Auth::LDAP;
21
use Ravada::Utils;
Francesc Guasch's avatar
Francesc Guasch committed
22

Francesc Guasch's avatar
Francesc Guasch committed
23
24
25
no warnings "experimental::signatures";
use feature qw(signatures);

26
$|=1;
Francesc Guasch's avatar
Francesc Guasch committed
27

Francesc Guasch's avatar
Francesc Guasch committed
28
29
my $help;

30
my ($DEBUG, $ADD_USER );
31

32
33
my $VERBOSE = $ENV{TERM};

Francesc Guasch's avatar
Francesc Guasch committed
34
35
my $FILE_CONFIG_DEFAULT = "/etc/ravada.conf";
my $FILE_CONFIG;
36

37
my $ADD_USER_LDAP;
Francesc Guasch's avatar
Francesc Guasch committed
38
39
40
my $ADD_GROUP_LDAP;
my $RM_GROUP_LDAP;
my $ADD_USER_GROUP;
41
my $REMOVE_USER;
42
my $IMPORT_DOMAIN;
fv3rdugo's avatar
fv3rdugo committed
43
my $IMPORT_VBOX;
44
my $CHANGE_PASSWORD;
45
my $NOFORK;
46
47
my $MAKE_ADMIN_USER;
my $REMOVE_ADMIN_USER;
Francesc Guasch's avatar
Francesc Guasch committed
48
my $START = 1;
Francesc Guasch's avatar
Francesc Guasch committed
49
my $TEST_LDAP;
50
my $CLEAN_DB_LEFTOVERS;
51
my $LOG_FILENAME;
52
53

my $URL_ISOS;
Francesc Guasch's avatar
Francesc Guasch committed
54
my $ALL;
55
my $HIBERNATED;
56
my $DISCONNECTED;
57
my $ACTIVE;
58

Francesc Guasch's avatar
Francesc Guasch committed
59
my $LIST;
60
61

my $HIBERNATE_DOMAIN;
Francesc Guasch's avatar
Francesc Guasch committed
62
my $START_DOMAIN;
63
my $SHUTDOWN_DOMAIN;
Francesc Guasch's avatar
Francesc Guasch committed
64
my $REMOVE_DOMAIN;
Francesc Guasch's avatar
Francesc Guasch committed
65
my $REBASE;
Francesc Guasch's avatar
Francesc Guasch committed
66
my $RUN_REQUEST;
67
my $MIGRATE;
68

69
70
my $IMPORT_DOMAIN_OWNER;

Francesc Guasch's avatar
Francesc Guasch committed
71
72
my $ADD_LOCALE_REPOSITORY;

73
my $USAGE = "$0 "
Francesc Guasch's avatar
Francesc Guasch committed
74
        ." [--debug] [--config=$FILE_CONFIG_DEFAULT] [--add-user=name] [--add-user-ldap=name]"
fv3rdugo's avatar
fv3rdugo committed
75
        ." [--change-password] [--make-admin=username] [--import-vbox=image_file.vdi]"
Francesc Guasch's avatar
Francesc Guasch committed
76
        ." [--test-ldap] "
fv3rdugo's avatar
fv3rdugo committed
77
        ." [-X] [start|stop|status]"
Francesc Guasch's avatar
Francesc Guasch committed
78
        ." [--rebase MACHINE]"
79
        ." [--remove-user=name]"
80
        ." [--clean-db-leftovers]"
81
        ." [--log=pathname]"
82
        ."\n"
Francesc Guasch's avatar
Francesc Guasch committed
83
        ." --add-user : adds a new db user\n"
84
        ." --add-user-ldap : adds a new LDAP user\n"
85
        ." --remove-user : removes a db user\n"
Francesc Guasch's avatar
Francesc Guasch committed
86
87
88
        ." --add-group-ldap : creates a new LDAP group\n"
        ." --remove-group-ldap : removes a LDAP group\n"
        ." --add-user-group : adds user to a LDAP group\n"
89
        ." --change-password : changes the password of an user\n"
90
        ." --import-domain : import a domain\n"
91
        ." --import-domain-owner : owner of the domain to import\n"
92
        ." --make-admin : make user admin\n"
Francesc Guasch's avatar
Francesc Guasch committed
93
        ." --config : config file, defaults to $FILE_CONFIG_DEFAULT"
94
        ." --no-fork : start in foreground\n"
95
        ." --url-isos=(URL|default)\n"
fv3rdugo's avatar
fv3rdugo committed
96
        ." --import-vbox : import a VirtualBox image\n"
Francesc Guasch's avatar
Francesc Guasch committed
97
        .' --add-locale-repository LOCALE : adds ISO repositories for this locale'
Francesc Guasch's avatar
Francesc Guasch committed
98
99
100
101
102
        ."\n"
        ."Operations on Virtual Machines:\n"
        ." --list\n"
        ." --start\n"
        ." --hibernate machine\n"
103
        ." --shutdown machine\n"
Francesc Guasch's avatar
Francesc Guasch committed
104
        ." --remove machine\n"
105
        ." --migrate node machine1 machine2 ... machineN\n"
106
107
        ."\n"
        ."Operations modifiers:\n"
Francesc Guasch's avatar
Francesc Guasch committed
108
109
        ." --all : execute on all virtual machines\n"
        ."          For hibernate, it is executed on all the actives\n"
110
        ." --hibernated: execute on hibernated machines\n"
111
        ." --disconnected: execute on disconnected machines\n"
112
        ." --active: execute on active running machines\n"
113
114
        ."Maintenance operations:\n"
        ." --clean-db-leftovers: properly clean database unreferenced entries\n"
115
        ." --log: saves STDOUT and STDERR app traces to the specified filename\n"
116
        ."\n"
Francesc Guasch's avatar
Francesc Guasch committed
117
118
    ;

119
$START = 0 if scalar @ARGV && $ARGV[0] ne '&';
120

121
GetOptions (       help => \$help
Francesc Guasch's avatar
Francesc Guasch committed
122
123
                   ,all => \$ALL
                  ,list => \$LIST
124
                 ,debug => \$DEBUG
Francesc Guasch's avatar
Francesc Guasch committed
125
                ,verbose => \$VERBOSE
Francesc Guasch's avatar
Francesc Guasch committed
126
                ,rebase => \$REBASE
127
              ,'no-fork'=> \$NOFORK
128
               ,'active'=> \$ACTIVE
129
             ,'start=s' => \$START_DOMAIN
130
             ,'config=s'=> \$FILE_CONFIG
131
           ,'hibernated'=> \$HIBERNATED
Francesc Guasch's avatar
Francesc Guasch committed
132
            ,'test-ldap'=> \$TEST_LDAP
133
           ,'add-user=s'=> \$ADD_USER
134
           ,'url-isos=s'=> \$URL_ISOS
135
136
           ,'shutdown:s'=> \$SHUTDOWN_DOMAIN
          ,'hibernate:s'=> \$HIBERNATE_DOMAIN
Francesc Guasch's avatar
Francesc Guasch committed
137
             ,'remove:s'=> \$REMOVE_DOMAIN
138
         ,'disconnected'=> \$DISCONNECTED
139
        ,'remove-user=s'=> \$REMOVE_USER
140
141
        ,'make-admin=s' => \$MAKE_ADMIN_USER
      ,'remove-admin=s' => \$REMOVE_ADMIN_USER
142
      ,'change-password'=> \$CHANGE_PASSWORD
143
      ,'add-user-ldap=s'=> \$ADD_USER_LDAP
Francesc Guasch's avatar
Francesc Guasch committed
144
145
146
147
     ,'add-group-ldap=s'=> \$ADD_GROUP_LDAP
  ,'remove-group-ldap=s'=> \$RM_GROUP_LDAP
     ,'add-user-group=s'=> \$ADD_USER_GROUP

148
      ,'import-domain=s' => \$IMPORT_DOMAIN
fv3rdugo's avatar
fv3rdugo committed
149
      ,'import-vbox=s' => \$IMPORT_VBOX
150
,'import-domain-owner=s' => \$IMPORT_DOMAIN_OWNER
Francesc Guasch's avatar
Francesc Guasch committed
151
152

    ,'add-locale-repository=s' => \$ADD_LOCALE_REPOSITORY
Francesc Guasch's avatar
Francesc Guasch committed
153
    ,'run-request=s' => \$RUN_REQUEST
154
155

        ,'migrate=s'    => \$MIGRATE
156
157

        ,"clean-db-leftovers" => \$CLEAN_DB_LEFTOVERS
158
        ,"log=s"              => \$LOG_FILENAME
159
) or exit;
Francesc Guasch's avatar
Francesc Guasch committed
160

Francesc Guasch's avatar
Francesc Guasch committed
161
162
$START = 1 if $DEBUG || $FILE_CONFIG || $NOFORK;

Francesc Guasch's avatar
Francesc Guasch committed
163

Francesc Guasch's avatar
Francesc Guasch committed
164
165
166
167
168
169
170
171
172
#####################################################################
#
# check arguments
#
if ($help) {
    print $USAGE;
    exit;
}

173
die "Only root can do that\n" if $> && ( $ADD_USER || $REMOVE_USER || $ADD_USER_LDAP || $IMPORT_DOMAIN);
174
175
176
die "ERROR: Missing file config $FILE_CONFIG\n"
    if $FILE_CONFIG && ! -e $FILE_CONFIG;

177
178
179
die "ERROR: Shutdown requires a domain name, or --all , --hibernated , --disconnected\n"
    if defined $SHUTDOWN_DOMAIN && !$SHUTDOWN_DOMAIN && !$ALL && !$HIBERNATED
                                && !$DISCONNECTED;
180

181
182
die "ERROR: Hibernate requires a domain name, or --all , --disconnected\n"
    if defined $HIBERNATE_DOMAIN && !$HIBERNATE_DOMAIN && !$ALL && !$DISCONNECTED;
183

Francesc Guasch's avatar
Francesc Guasch committed
184
185
186
die "ERROR: Missing the machine name or id\n$USAGE"
    if $REBASE && !@ARGV;

187
188
my %CONFIG;
%CONFIG = ( config => $FILE_CONFIG )    if $FILE_CONFIG;
189

190
$Ravada::FORCE_DEBUG=1    if $DEBUG;
Francesc Guasch's avatar
Francesc Guasch committed
191
$Ravada::VERBOSE=1      if $VERBOSE;
192
$Ravada::CAN_FORK=0    if $NOFORK;
193

194
195
my $RVD_BACK;

Francesc Guasch's avatar
Francesc Guasch committed
196
197
198
199
200
###################################################################

###################################################################
#

201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
sub _do_start_logging {
    $LOG_FILENAME = $Ravada::CONFIG->{"log"} if (! $LOG_FILENAME);
    if ($LOG_FILENAME)
    {
        File::Path::make_path(File::Basename::dirname($LOG_FILENAME));
        if (open(my $handle, ">>", $LOG_FILENAME))
        {
            print $handle "Starting rvd_back v".Ravada::version."\n";
            close($handle);
        }
        print "Trying to redirect log messages to $LOG_FILENAME\n";
        File::Tee::tee(STDOUT, ">>", $LOG_FILENAME) or warn "Cannot redirect STDOUT to the specified log file";
        File::Tee::tee(STDERR, ">>", $LOG_FILENAME) or warn "Cannot redirect STDERR to the spedicied log file";
    }
}

217
sub do_start {
218
    warn "Starting rvd_back v".Ravada::version."\n";
219
220
221
    my $old_error = ($@ or '');
    my $cnt_error = 0;

222

223
224
    my $t_refresh = 0;

225
    my $ravada = Ravada->new( %CONFIG );
226
    _do_start_logging();
227
    $ravada->_clean_requests('ping_backend');
228

Francesc Guasch's avatar
Francesc Guasch committed
229
230
    #    Ravada::Request->enforce_limits();
    #Ravada::Request->refresh_vms();
231
    Ravada::Request->refresh_storage();
Francesc Guasch's avatar
Francesc Guasch committed
232
    for (;;) {
233
        my $t0 = time;
234
        $ravada->process_requests();
235
		$ravada->set_debug_value();
Francesc Guasch's avatar
Francesc Guasch committed
236
237
        exit if done_request();

238
        if ( time - $t_refresh > 60 ) {
239
            Ravada::Request->cleanup();
240
241
            Ravada::Request->refresh_vms()      if rand(5)<3;
            Ravada::Request->enforce_limits()   if rand(5)<2;
Francesc Guasch's avatar
Francesc Guasch committed
242
            Ravada::Request->manage_pools()     if rand(5)<2;
243
            $t_refresh = time;
244
        }
245
        sleep 1 if time - $t0 <1;
246
247
    }
}
Francesc Guasch's avatar
Francesc Guasch committed
248

Francesc Guasch's avatar
Francesc Guasch committed
249
250
251
252
253
254
255
256
257
258
sub done_request {
    return 0 if !$RUN_REQUEST;
    my $req;
    eval { $req = Ravada::Request->open($RUN_REQUEST) };
    warn $req->status;
    warn $@ if $@;
    return 1 if !$req || $req->status eq 'done';

}

259
sub clean_old_requests {
260
    my $ravada = Ravada->new( %CONFIG );
261
    $ravada->clean_old_requests();
262
    $ravada->_clean_interrupted_downloads();
263
264
}

265
266
sub autostart_machines {
    my $ravada = shift;
267
268
269
270
    my $req = Ravada::Request->check_storage(
        uid => Ravada::Utils::user_daemon->id
        ,retry => 10
    );
271
272
273
274
275
276
277
278
279
    for my $domain ( $ravada->list_domains_data ) {
        next unless $domain->{autostart} && ! $domain->{is_base}
              && $domain->{status} !~ /active/i;

        print "Auto start $domain->{name} [$domain->{status}]\n" if $VERBOSE;

        Ravada::Request->start_domain(
            id_domain => $domain->{id}
            ,uid => $domain->{id_owner}
280
            ,after_request_ok => $req->id
281
282
283
284
        );
    }
}

285
sub start {
286
    {
287
        my $ravada = Ravada->new( %CONFIG );
288
        $Ravada::CONNECTOR->dbh;
289
        $ravada->_install();
290
		$ravada->set_debug_value();
291
        $ravada->_wait_pids();
292
        autostart_machines($ravada);
293
    }
Francesc Guasch's avatar
Francesc Guasch committed
294
    clean_old_requests();
295
    for (;;) {
296
297
        eval { do_start() };
        warn $@ if $@;
Francesc Guasch's avatar
Francesc Guasch committed
298
        exit if done_request();
299
300
301
    }
}

Francesc Guasch's avatar
Francesc Guasch committed
302
303
304
sub add_user {
    my $login = shift;

305
    my $ravada = Ravada->new( %CONFIG);
306
    $ravada->_install();
307

308
    print "$login password: ";
Francesc Guasch's avatar
Francesc Guasch committed
309
310
311
    my $password = <STDIN>;
    chomp $password;

Francesc Guasch's avatar
Francesc Guasch committed
312
313
314
315
316
317
    print "is admin ? : [y/n] ";
    my $is_admin_q = <STDIN>;
    my $is_admin = 0;

    $is_admin = 1 if $is_admin_q =~ /y/i;

318

319
320
321
    Ravada::Auth::SQL::add_user(      name => $login
                                , password => $password
                                , is_admin => $is_admin);
Francesc Guasch's avatar
Francesc Guasch committed
322
323
}

324
325
326
sub add_user_ldap {
    my $login = shift;

327
328
    my $ravada = Ravada->new( %CONFIG);

329
330
331
332
    print "password : ";
    my $password = <STDIN>;
    chomp $password;

333
    Ravada::Auth::LDAP::add_user_posix(name => $login, password => $password);
334
335
}

Francesc Guasch's avatar
Francesc Guasch committed
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
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
405
406
407
408
409
410
sub add_group_ldap {
    my $login = shift;

    my $ravada = Ravada->new( %CONFIG);
    Ravada::Auth::LDAP::_init_ldap_admin();
    Ravada::Auth::LDAP::add_group($login);
}

sub remove_group_ldap {
    my $login = shift;

    my $ravada = Ravada->new( %CONFIG);
    my $ldap = Ravada::Auth::LDAP::_init_ldap_admin();
    my $group = Ravada::Auth::LDAP::search_group( name => $login )
        or die "Error: LDAP group '$login' not found\n";

    $group->delete()->update($ldap);

    print "LDAP group ".$group->dn." removed.\n";
    exit 0;
}


sub add_user_group {
    my $ravada = shift;
    my $login = shift;

    my $user = Ravada::Auth::SQL->new(name => $login);
    die "Error: Unknown user '$login'\n" if !$user->id;

    die "Error: User authentication is not external\n"
    if !$user->is_external;

    die "Error: User authentication is not LDAP : ".($user->external_auth)
        if $user->external_auth !~ /LDAP/i;

    _show_ldap_group_membership($login);

    print "Add user to LDAP group: ";
    my $new_group = <stdin>;
    chomp $new_group;

    my @groups = Ravada::Auth::LDAP::search_group( name => '*' );
    my ($group_ldap) = grep {$_->get_value('cn') eq $new_group } @groups;
    die "Error: group $new_group doesn't exist\n"
    unless $group_ldap;

    my $mesg  = $group_ldap->add(memberUid => $login)
    ->update(Ravada::Auth::LDAP::_init_ldap_admin());

    if ($mesg->code) {
        die "Error: adding $login to $new_group ".$mesg->error;
    }

    _show_ldap_group_membership($login);
}

sub _show_ldap_group_membership($user_name) {
    my $member = 0;
    my @groups = Ravada::Auth::LDAP::search_group( name => '*' );
    print "Groups:\n";
    for my $group ( sort { $a->get_value('cn') cmp $b->get_value('cn') } @groups ) {
        print " - ".$group->get_value('cn'). " : ";
        my @member = $group->get_value('memberUid');
        if ( grep /^$user_name$/,@member ) {
            $member++;
            print "YES";
        }
        print "\n";
    }
    print "  $user_name is member of $member groups\n";

}


411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
sub remove_user {
    my $login = shift;
    my $ravada = Ravada->new( %CONFIG);

    my $user = Ravada::Auth::SQL->new(name => $login);

    die "ERROR: Unknown user '$login'\n" if !$user->id;
    print "Are you sure you want remove $login user ? : [y/n] ";
    my $remove_it = <STDIN>;
    if ( $remove_it =~ /y/i ) {
        $user->remove();
        print "USER $login was removed\n";
    }
}

426
427
428
429
430
431
sub change_password {
    print "User login name : ";
    my $login = <STDIN>;
    chomp $login;
    return if !$login;

432
    my $ravada = Ravada->new( %CONFIG );
433

434
435
436
437
438
439
440
441
442
    my $user = Ravada::Auth::SQL->new(name => $login);
    die "ERROR: Unknown user '$login'\n" if !$user->id;

    print "password : ";
    my $password = <STDIN>;
    chomp $password;
    $user->change_password($password);
}

443
444
445
sub make_admin {
    my $login = shift;

446
    my $ravada = Ravada->new( %CONFIG);
447
448
449
    my $user = Ravada::Auth::SQL->new(name => $login);
    die "ERROR: Unknown user '$login'\n" if !$user->id;

450
    Ravada::Utils::user_daemon()->make_admin($user->id);
451
452
453
454
455
456
    print "USER $login granted admin permissions\n";
}

sub remove_admin {
    my $login = shift;

457
    my $ravada = Ravada->new( %CONFIG);
458
459
460
    my $user = Ravada::Auth::SQL->new(name => $login);
    die "ERROR: Unknown user '$login'\n" if !$user->id;

461
    Ravada::Utils::user_daemon()->remove_admin($user->id);
462
463
464
    print "USER $login removed admin permissions, granted normal user permissions.\n";
}

465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
sub _ask_yes_no($default = undef) {
    confess "Error: default must be y/n" unless $default =~ /^(y|n)/i;
    my $answer = "";
    for ( ;; ) {
        print "Please answer y/n ";
        print "[$default]" if defined $default;
        print ":";
        $answer = <STDIN>;
        chomp $answer;
        $answer = $default if !$answer && defined $default;
        return $answer if $answer =~ /^(y|n)/i;
    }
}

sub _one_zero($value) {
    return 1 if $value =~ /^y/i;
    return 0 if $value =~ /^n/i;
    confess "Error: unknown value $value , expecting yes/no";
}
484

485
486
487
sub import_domain {
    my $name = shift;
    print "Virtual Manager: KVM\n";
488
489
490
491
492
493
    my $user = $IMPORT_DOMAIN_OWNER;
    if (!$user) {
        print "User name that will own the domain in Ravada : ";
        $user = <STDIN>;
        chomp $user;
    }
494

495
    my $ravada = Ravada->new( %CONFIG );
496
497
498
    my $domain = $ravada->import_domain(name => $name, vm => 'KVM'
        ,user => $user
        ,spinoff_disks => 0
499
500
    );

501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
    my @backing_files;

    for my $vol ($domain->list_volumes_info) {
        push @backing_files,( $vol->backing_file) if $vol->backing_file;
    }

    return if !@backing_files;

    print "This virtual machine has ".@backing_files." backing files."
        ." Do you want to import it as a base ? ";
    my $import_base = _one_zero(_ask_yes_no("yes"));
    if ($import_base) {
        $domain->_vm->_import_base($domain);
        return;
    }

    print "Do you want to spinoff the virtual machine volumes ? This will flatten the volumes out of backing files. ";

    if ( _one_zero(_ask_yes_no("no")) ) {
        $domain->spinoff;
        if (@backing_files) {
            print "This backing files may be removed:\n"
            .join("\n",@backing_files)."\n";
        }
    }
526

527
528
}

fv3rdugo's avatar
fv3rdugo committed
529
530
sub import_vbox {
    my $file_vdi = shift;
fv3rdugo's avatar
fv3rdugo committed
531
532
533
    my $rvd = Ravada->new(%CONFIG);
    my $kvm = $rvd->search_vm('KVM');
    my $default_storage_pool = $kvm->storage_pool();
fv3rdugo's avatar
fv3rdugo committed
534
535
536
537
538
539
540
541
542
543
544
    if ($file_vdi =~ /\.vdi$/i) {
        print "Import VirtualBox image from vdi file\n";
        print "Name for the new domain : ";
        my $name = <STDIN>;
        chomp $name;
        print "Change default storage pool in /var/lib/libvirt/images/ [y/N]:";
        my $default_pool_q = <STDIN>;
        my $storage_pool = "/var/lib/libvirt/images";

        if ( $default_pool_q =~ /y/i ) {
            print "Insert storage pool path : ";
fv3rdugo's avatar
fv3rdugo committed
545
            $storage_pool = <STDIN>;
fv3rdugo's avatar
fv3rdugo committed
546
547
548
            chomp $storage_pool;
        }
        print "STORAGE POOL IS $storage_pool \n";
fv3rdugo's avatar
fv3rdugo committed
549
550
        print "DEFAULT STORAGE POOL IS $default_storage_pool \n";

fv3rdugo's avatar
fv3rdugo committed
551
552
553
554
555
        if ( $name && $file_vdi ) {
            my @cmd = ("qemu-img convert -p -f vdi -O qcow2 $file_vdi $storage_pool/$name.qcow2");
            system(@cmd);
        }
        print "Warning: Missing args! \n";
fv3rdugo's avatar
fv3rdugo committed
556
557
558
559
560
561
562
563
564
565
        #new machine xml change source file
        #remove swap
        #remove cdrom

        exit;
    }
    print "Warning: $file_vdi is not a vdi file \n";
    print "Check if the path has spaces, if so insert it in quotes \n";
}

566
567
568
sub set_url_isos {
    my $url = shift;
    my $rvd_back = Ravada->new(%CONFIG);
569

570
571
572
573
574
575
576
577
578
579
580
    if ($url =~ /^default$/i) {
        my $sth = $rvd_back->connector->dbh->prepare("DROP TABLE iso_images");
        $sth->execute;
        $sth->finish;
        my $rvd_back2 = Ravada->new(%CONFIG);
    } else {
        $rvd_back->_set_url_isos($url);
        print "ISO_IMAGES table URLs set from $url\n";
    }
}

Francesc Guasch's avatar
Francesc Guasch committed
581
582
583
584
585
586
sub list {
    my $all = shift;
    my $rvd_back = Ravada->new(%CONFIG);

    my $found = 0;
    for my $domain ($rvd_back->list_domains) {
587
        next if !$all && !$domain->is_active && !$domain->is_hibernated;
Francesc Guasch's avatar
Francesc Guasch committed
588
589
590
591
        $found++;
        print $domain->name."\t";
        if ($domain->is_active) {
            print "active";
592
593
594
595
596
597
            my $status = $domain->client_status;
            if ( $domain->remote_ip ) {
                $status .= " , "    if $status;
                $status .= $domain->remote_ip;
            }
            print " ( $status ) " if $status;
Francesc Guasch's avatar
Francesc Guasch committed
598
599
600
601
602
603
604
605
606
607
        } elsif ($domain->is_hibernated) {
            print "hibernated";
        } else {
            print "down";
        }
        print "\n";
    }
    print "$found machines found.\n";
}

608
609
sub hibernate {
    my $domain_name = shift;
Francesc Guasch's avatar
Francesc Guasch committed
610
611
    my $all = shift;

612
613
614
615
616
    my $rvd_back = Ravada->new(%CONFIG);

    my $down = 0;
    my $found = 0;
    for my $domain ($rvd_back->list_domains) {
Francesc Guasch's avatar
Francesc Guasch committed
617
        if ( ($all && $domain->is_active)
618
                || ($domain_name && $domain->name eq $domain_name)
619
                || ($DISCONNECTED && _client_status($domain) eq 'disconnected')
620
           ) {
621
622
623
            $found++;
            if (!$domain->is_active) {
                warn "WARNING: Virtual machine ".$domain->name
624
                    ." is already down.\n";
625
626
                next;
            }
627
            if ( $DISCONNECTED && $domain->client_status() eq 'disconnected') {
628
629
                next if _verify_connection($domain);
            }
630
            if ($domain->can_hibernate) {
631
                $domain->hibernate( Ravada::Utils::user_daemon() );
Francesc Guasch's avatar
Francesc Guasch committed
632
                $down++;
633
634
635
636
637
638
            } else {
                warn "WARNING: Virtual machine ".$domain->name
                    ." can't hibernate because it is not supported in ".$domain->type
                    ." domains."
                    ."\n";
            }
639
640
641
        }
    }
    print "$down machines hibernated.\n";
642
    warn "ERROR: Domain $domain_name not found.\n"
643
        if !$domain_name && !$found;
644
645
}

Francesc Guasch's avatar
Francesc Guasch committed
646
647
648
649
650
651
652
653
654
655
656
657
658
659
sub remove_domain {
    my $domain_name = shift;

    my $rvd_back = Ravada->new(%CONFIG);
    my $domain = $rvd_back->search_domain($domain_name);
    die "Error: domain $domain_name not found\n" if !$domain;

    Ravada::Request->remove_domain(
                uid => Ravada::Utils::user_daemon()->id
                ,name => $domain->name
    );
    print "Removing $domain_name\n";
}

Francesc Guasch's avatar
Francesc Guasch committed
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
sub start_domain {
    my $domain_name = shift;

    my $rvd_back = Ravada->new(%CONFIG);

    my $up= 0;
    my $found = 0;
    for my $domain ($rvd_back->list_domains) {
        if ($domain->name eq $domain_name) {
            $found++;
            if ($domain->is_active) {
                warn "WARNING: Virtual machine ".$domain->name
                    ." is already up.\n";
                next;
            }
675
            eval { $domain->start(user => Ravada::Utils::user_daemon() ) };
676
677
678
679
            if ($@) {
                warn $@;
                next;
            }
Francesc Guasch's avatar
Francesc Guasch committed
680
681
682
683
684
685
686
687
            print $domain->name." started.\n"
                if $domain->is_active;
        }
    }
    warn "ERROR: Domain $domain_name not found.\n"
        if !$found;
}

688
689
690
691
692
sub _client_status($domain_f) {
    my $domain = Ravada::Domain->open($domain_f->id) or return '';
    return $domain->client_status(1);
}

693
694
695
696
697
698
699
700
sub shutdown_domain {
    my $domain_name = shift;
    my ($all,$hibernated) = @_;

    my $rvd_back = Ravada->new(%CONFIG);

    my $down = 0;
    my $found = 0;
701
    DOMAIN:
Francesc Guasch's avatar
Francesc Guasch committed
702
703
    for my $domain_data ($rvd_back->list_domains_data) {
        my $domain = Ravada::Front::Domain->open($domain_data->{id});
704
705
706
707
        my $is_active = $domain->is_active;
        my $client_status = '?';
        $client_status = _client_status($domain) if $DISCONNECTED;
        print $domain->name." status = ".($client_status or '<UNDEF>')."\n" if $DISCONNECTED && $VERBOSE && $is_active;
708
709
        if ((defined $domain_name && $domain->name eq $domain_name)
            || ($hibernated && $domain->is_hibernated)
710
            || ($DISCONNECTED && $is_active && ( $client_status eq 'disconnected' || !$client_status) )
711
712
            || $all ){
            $found++;
713
            if (!$is_active && !$domain->is_hibernated) {
714
715
716
717
718
                warn "WARNING: Virtual machine ".$domain->name
                    ." is already down.\n"
                        if !$all;
                next;
            }
719
720
721
722
723
724
725
726
727
728
729
730
731
732
            if ($DISCONNECTED && $client_status
                    && $client_status eq 'disconnected') {
                if ( $domain->autostart() ) {
                    print "\tautostart set, skipping shutdown\n";
                    next;
                }
                next DOMAIN if _verify_connection($domain);
            }
            my $at = 0;
            my $txt_time = '';
            my @after_req;
            if ($domain->is_hibernated && !$DISCONNECTED) {
                print $domain->name." is hibernated. Starting ".$domain->name."\n";
                my $req_start = Ravada::Request->start_domain(
733
734
735
                    uid => Ravada::Utils::user_daemon->id
                    ,id_domain => $domain->id
                );
736
737
738
                $at = time + 180;
                $txt_time = " in 3 minutes";
                my @after_req = ( after_request => $req_start->id);
739
            }
740

741
742
743
            print "\tShutting down ".$domain->name;
            print " in ".($at - time)." seconds" if $at;
            print "\n";
Francesc Guasch's avatar
Francesc Guasch committed
744
745
746
            Ravada::Request->shutdown_domain(uid => Ravada::Utils::user_daemon()->id
                ,id_domain => $domain->id
                , timeout => 300
747
748
                ,@after_req
                ,at => $at
Francesc Guasch's avatar
Francesc Guasch committed
749
750
            );
            $down++;
751
            warn $@ if $@;
752
753
754
755
756
        }
    }
    warn "ERROR: Domain $domain_name not found.\n"
        if $domain_name && !$found;
    print "$down domains shut down.\n";
757
    exit;
758
}
Francesc Guasch's avatar
Francesc Guasch committed
759

760
sub _verify_connection {
761
762
    my $domain_f = shift;
    my $domain = Ravada::Domain->open($domain_f->id);
763
764
765
766
    print "Verifying connection for ".$domain->name
                        ." ".($domain->remote_ip or '')." "
        if $VERBOSE;
    for ( 1 .. 25 ) {
767
768
769
        my $status = $domain->client_status(1);
        if ( $status && $status ne 'disconnected' ) {
            print "\n\t".$status." ".$domain->remote_ip
770
771
772
773
774
775
776
777
778
779
                            ." Shutdown dismissed.\n";
            return 1;
        }
        print "." if $VERBOSE && !($_ % 5);
        sleep 1;
     }
     print "\n" if $VERBOSE;
    return 0;
}

Francesc Guasch's avatar
Francesc Guasch committed
780
781
782
783
784
785
786
787
788
789
790
sub test_ldap {
    my $rvd_back = Ravada->new(%CONFIG);
    eval { Ravada::Auth::LDAP::_init_ldap_admin() };
    die "No LDAP connection, error: $@\n" if $@;
    print "Connection to LDAP ok\n";
    print "login: ";
    my $name=<STDIN>;
    chomp $name;
    print "password: ";
    my $password = <STDIN>;
    chomp $password;
791
    my $ok= Ravada::Auth::LDAP->new(name => $name, password => $password);
Francesc Guasch's avatar
Francesc Guasch committed
792
    if ($ok) {
793
794
795
796
797
798
799
800
801
802
803
804
805
        if (!$ok->{_ldap_entry}) {
            warn "No LDAP data found ".Dumper($ok->{_data});
        } else {
            print "LOGIN OK $ok->{_auth}\n";
            print $ok->{_ldap_entry}->dn."\n";
            for my $attrib (sort $ok->{_ldap_entry}->attributes ) {
                my @value = $ok->{_ldap_entry}->get_value($attrib);
                print "$attrib: ";
                print join(",",@value);
                print "\n";
            }

        }
Francesc Guasch's avatar
Francesc Guasch committed
806
807
808
809
810
811
    } else {
        print "LOGIN FAILED\n";
    }
    exit;
}

Francesc Guasch's avatar
Francesc Guasch committed
812
813
814
815
816
817
818
819
820
sub add_locale_repository {
    my $locale = shift;
    for my $lang ( split /,/, $locale ) {
        print "Adding locales for $lang.\n";
        my $found = Ravada::Repository::ISO::insert_iso_locale($lang, 'verbose');
        print "$found found.\n";
    }
}

Francesc Guasch's avatar
Francesc Guasch committed
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
sub rebase {
    my ($domain_name) = $ARGV[0];
    my $rvd_back = Ravada->new(%CONFIG);
    my $domain;
    if ($domain_name =~ /^\d+$/) {
        $domain = Ravada::Domain->open($domain_name);
    } else {
        $domain = $rvd_back->search_domain($domain_name);
    }
    die "Error: Unknown domain $domain_name\n"      if !$domain;
    die "Error: ".$domain->name." is not a clone\n" if !$domain->id_base;

    my $base = Ravada::Domain->open($domain->id_base);
    $base->rebase(Ravada::Utils::user_daemon, $domain);
}

Francesc Guasch's avatar
Francesc Guasch committed
837
838
839
840
841
842
843
844
845
846
847
sub run_request {
    my $id_request = shift;
    my $rvd_back = Ravada->new(%CONFIG);
    my $req = Ravada::Request->open($id_request);
    $req->status('requested');
    $rvd_back->_execute($req,1);
    warn $req->command." ".$req->status
        .($req->error or '')
    ."\n";
}

848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
sub rvd_back {
    return $RVD_BACK if $RVD_BACK;

    $RVD_BACK = Ravada->new(%CONFIG);
    return $RVD_BACK;
}

sub list_active_machines {
    my @domains = rvd_back->list_domains(active => 1);
    if (!@domains) {
        die "No active domains\n";
    }
    return @domains;
}

sub migrate($node_name) {
    my $vms = rvd_back->vm();
    my ($node ) = grep{ $_->name eq $node_name } @$vms
        or die "Error: Node $node_name not found\n"
    .Dumper([ map {$_->name} @$vms]);

    $node->start() if !$node->is_active;

    my @machines;
    if ( $ACTIVE ) {
        @machines = list_active_machines();
    } else {
        @machines = @ARGV;
    }
    if (!scalar(@machines)) {
        die "Error: supply machines to migrate:\n"
        ."    rvd_back --migrate=node --active\n"
        ."    rvd_back --migrate=node machine1 machine2 machine3\n";
    }
    for my $machine (@machines) {
        my ($domain, $name, $id_domain);
        if (!ref($machine)) {
            $domain = rvd_back->search_domain($machine) or do {
                warn "Error: machine $machine not found\n";
                next;
            };
        } else {
            $domain = $machine;
        }
        $name = $domain->name;
        $id_domain = $domain->id;
        if ($domain->_data('id_vm') == $node->id) {
            warn "Warning: machine $name already in node $node_name\n";
            next;
        }
        warn "migrate $node_name $name\n";
        Ravada::Request->migrate(id_node => $node->id, uid => Ravada::Utils::user_daemon->id
            ,id_domain => $id_domain
            ,start => $domain->is_active
            ,shutdown => 1
        );
    }
}

907
sub clean_db_leftovers {
908
909
    my $rvd_back = shift;
    $rvd_back->_clean_db_leftovers();
910
911
}

912
sub DESTROY {
913
914
}

Francesc Guasch's avatar
Francesc Guasch committed
915
#################################################################
916
917
918
919
920

{

my $rvd_back = Ravada->new(%CONFIG);

Francesc Guasch's avatar
Francesc Guasch committed
921
add_user($ADD_USER)                 if $ADD_USER;
922
add_user_ldap($ADD_USER_LDAP)       if $ADD_USER_LDAP;
Francesc Guasch's avatar
Francesc Guasch committed
923
924
925
add_group_ldap($ADD_GROUP_LDAP)     if $ADD_GROUP_LDAP;
remove_group_ldap($RM_GROUP_LDAP)   if $RM_GROUP_LDAP;
add_user_group($rvd_back, $ADD_USER_GROUP)     if $ADD_USER_GROUP;
926
remove_user($REMOVE_USER)           if $REMOVE_USER;
Francesc Guasch's avatar
Francesc Guasch committed
927
928
change_password()                   if $CHANGE_PASSWORD;
import_domain($IMPORT_DOMAIN)       if $IMPORT_DOMAIN;
fv3rdugo's avatar
fv3rdugo committed
929
import_vbox($IMPORT_VBOX)           if $IMPORT_VBOX;
Francesc Guasch's avatar
Francesc Guasch committed
930
931
make_admin($MAKE_ADMIN_USER)        if $MAKE_ADMIN_USER;
remove_admin($REMOVE_ADMIN_USER)    if $REMOVE_ADMIN_USER;
932
set_url_isos($URL_ISOS)             if $URL_ISOS;
Francesc Guasch's avatar
Francesc Guasch committed
933
test_ldap                           if $TEST_LDAP;
Francesc Guasch's avatar
Francesc Guasch committed
934
rebase()                            if $REBASE;
Francesc Guasch's avatar
Francesc Guasch committed
935

Francesc Guasch's avatar
Francesc Guasch committed
936
list($ALL)                          if $LIST;
937
hibernate($HIBERNATE_DOMAIN , $ALL) if defined $HIBERNATE_DOMAIN;
Francesc Guasch's avatar
Francesc Guasch committed
938
remove_domain($REMOVE_DOMAIN)              if defined $REMOVE_DOMAIN;
Francesc Guasch's avatar
Francesc Guasch committed
939
start_domain($START_DOMAIN)         if $START_DOMAIN;
940

941
942
943
shutdown_domain($SHUTDOWN_DOMAIN, $ALL, $HIBERNATED)
                                    if defined $SHUTDOWN_DOMAIN;

Francesc Guasch's avatar
Francesc Guasch committed
944
add_locale_repository($ADD_LOCALE_REPOSITORY) if $ADD_LOCALE_REPOSITORY;
Francesc Guasch's avatar
Francesc Guasch committed
945
946

run_request($RUN_REQUEST)           if $RUN_REQUEST;
947
948

migrate($MIGRATE)                   if $MIGRATE;
949

950
clean_db_leftovers($rvd_back)       if $CLEAN_DB_LEFTOVERS;
951
952
953
}


Francesc Guasch's avatar
Francesc Guasch committed
954
955
956
957
if ($START) {
    die "Already started" if Proc::PID::File->running( name => 'rvd_back');
    start();
}