rvd_back 27 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 );
Francesc Guasch's avatar
Francesc Guasch committed
496
497
498
    my $domain = $ravada->import_domain(name => $name, vm => 'KVM'
        ,user => $user
        ,spinoff_disks => 0
499
500
    );

Francesc Guasch's avatar
Francesc Guasch committed
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 && $client_status eq 'disconnected' )
711
712
            || $all ){
            $found++;
713
            if (!$is_active && !$domain->is_hibernated) {
714
715
716
717
718
719
                warn "WARNING: Virtual machine ".$domain->name
                    ." is already down.\n"
                        if !$all;
                next;
            }
            if ($domain->is_hibernated) {
720
                print "Starting ".$domain->name."\n";
721
722
723
724
                Ravada::Request->start_domain(
                    uid => Ravada::Utils::user_daemon->id
                    ,id_domain => $domain->id
                );
725

726
            }
727
728
            if ($DISCONNECTED && $client_status
                    && $client_status eq 'disconnected') {
729
730
731

                next DOMAIN if _verify_connection($domain);
            }
732
            print "Shutting down ".$domain->name.".\n";
Francesc Guasch's avatar
Francesc Guasch committed
733
734
735
736
737
            Ravada::Request->shutdown_domain(uid => Ravada::Utils::user_daemon()->id
                ,id_domain => $domain->id
                , timeout => 300
            );
            $down++;
738
            warn $@ if $@;
739
740
741
742
743
        }
    }
    warn "ERROR: Domain $domain_name not found.\n"
        if $domain_name && !$found;
    print "$down domains shut down.\n";
744
    exit;
745
}
Francesc Guasch's avatar
Francesc Guasch committed
746

747
sub _verify_connection {
748
749
    my $domain_f = shift;
    my $domain = Ravada::Domain->open($domain_f->id);
750
751
752
753
    print "Verifying connection for ".$domain->name
                        ." ".($domain->remote_ip or '')." "
        if $VERBOSE;
    for ( 1 .. 25 ) {
754
755
756
        my $status = $domain->client_status(1);
        if ( $status && $status ne 'disconnected' ) {
            print "\n\t".$status." ".$domain->remote_ip
757
758
759
760
761
762
763
764
765
766
                            ." Shutdown dismissed.\n";
            return 1;
        }
        print "." if $VERBOSE && !($_ % 5);
        sleep 1;
     }
     print "\n" if $VERBOSE;
    return 0;
}

Francesc Guasch's avatar
Francesc Guasch committed
767
768
769
770
771
772
773
774
775
776
777
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;
778
    my $ok= Ravada::Auth::LDAP->new(name => $name, password => $password);
Francesc Guasch's avatar
Francesc Guasch committed
779
    if ($ok) {
780
781
782
783
784
785
786
787
788
789
790
791
792
        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
793
794
795
796
797
798
    } else {
        print "LOGIN FAILED\n";
    }
    exit;
}

Francesc Guasch's avatar
Francesc Guasch committed
799
800
801
802
803
804
805
806
807
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
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
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
824
825
826
827
828
829
830
831
832
833
834
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";
}

835
836
837
838
839
840
841
842
843
844
845
846
847
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
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
        );
    }
}

894
sub clean_db_leftovers {
895
896
    my $rvd_back = shift;
    $rvd_back->_clean_db_leftovers();
897
898
}

899
sub DESTROY {
900
901
}

Francesc Guasch's avatar
Francesc Guasch committed
902
#################################################################
903
904
905
906
907

{

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

Francesc Guasch's avatar
Francesc Guasch committed
908
add_user($ADD_USER)                 if $ADD_USER;
909
add_user_ldap($ADD_USER_LDAP)       if $ADD_USER_LDAP;
Francesc Guasch's avatar
Francesc Guasch committed
910
911
912
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;
913
remove_user($REMOVE_USER)           if $REMOVE_USER;
Francesc Guasch's avatar
Francesc Guasch committed
914
915
change_password()                   if $CHANGE_PASSWORD;
import_domain($IMPORT_DOMAIN)       if $IMPORT_DOMAIN;
fv3rdugo's avatar
fv3rdugo committed
916
import_vbox($IMPORT_VBOX)           if $IMPORT_VBOX;
Francesc Guasch's avatar
Francesc Guasch committed
917
918
make_admin($MAKE_ADMIN_USER)        if $MAKE_ADMIN_USER;
remove_admin($REMOVE_ADMIN_USER)    if $REMOVE_ADMIN_USER;
919
set_url_isos($URL_ISOS)             if $URL_ISOS;
Francesc Guasch's avatar
Francesc Guasch committed
920
test_ldap                           if $TEST_LDAP;
Francesc Guasch's avatar
Francesc Guasch committed
921
rebase()                            if $REBASE;
Francesc Guasch's avatar
Francesc Guasch committed
922

Francesc Guasch's avatar
Francesc Guasch committed
923
list($ALL)                          if $LIST;
924
hibernate($HIBERNATE_DOMAIN , $ALL) if defined $HIBERNATE_DOMAIN;
Francesc Guasch's avatar
Francesc Guasch committed
925
remove_domain($REMOVE_DOMAIN)              if defined $REMOVE_DOMAIN;
Francesc Guasch's avatar
Francesc Guasch committed
926
start_domain($START_DOMAIN)         if $START_DOMAIN;
927

928
929
930
shutdown_domain($SHUTDOWN_DOMAIN, $ALL, $HIBERNATED)
                                    if defined $SHUTDOWN_DOMAIN;

Francesc Guasch's avatar
Francesc Guasch committed
931
add_locale_repository($ADD_LOCALE_REPOSITORY) if $ADD_LOCALE_REPOSITORY;
Francesc Guasch's avatar
Francesc Guasch committed
932
933

run_request($RUN_REQUEST)           if $RUN_REQUEST;
934
935

migrate($MIGRATE)                   if $MIGRATE;
936

937
clean_db_leftovers($rvd_back)       if $CLEAN_DB_LEFTOVERS;
938
939
940
}


Francesc Guasch's avatar
Francesc Guasch committed
941
942
943
944
if ($START) {
    die "Already started" if Proc::PID::File->running( name => 'rvd_back');
    start();
}