rvd_back

#!/usr/bin/perl

use warnings;
use strict;

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

use Carp qw(confess);
use Data::Dumper;
use Getopt::Long;
use POSIX ":sys_wait_h";
use Proc::PID::File;
use File::Tee;
use File::Path;
use File::Basename;

use Ravada;
use Ravada::Auth::SQL;
use Ravada::Auth::LDAP;
use Ravada::Utils;

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

$|=1;

my $help;

my ($DEBUG, $ADD_USER );

my $VERBOSE = $ENV{TERM};

my $FILE_CONFIG_DEFAULT = "/etc/ravada.conf";
my $FILE_CONFIG;

my $ADD_USER_LDAP;
my $ADD_GROUP_LDAP;
my $RM_GROUP_LDAP;
my $ADD_USER_GROUP;
my $REMOVE_USER;
my $IMPORT_DOMAIN;
my $IMPORT_VBOX;
my $CHANGE_PASSWORD;
my $NOFORK;
my $MAKE_ADMIN_USER;
my $REMOVE_ADMIN_USER;
my $START = 1;
my $TEST_LDAP;
my $CLEAN_DB_LEFTOVERS;
my $LOG_FILENAME;

my $URL_ISOS;
my $ALL;
my $HIBERNATED;
my $DISCONNECTED;
my $ACTIVE;

my $LIST;

my $HIBERNATE_DOMAIN;
my $START_DOMAIN;
my $SHUTDOWN_DOMAIN;
my $REMOVE_DOMAIN;
my $REBASE;
my $RUN_REQUEST;
my $MIGRATE;

my $IMPORT_DOMAIN_OWNER;

my $ADD_LOCALE_REPOSITORY;

my $USAGE = "$0 "
        ." [--debug] [--config=$FILE_CONFIG_DEFAULT] [--add-user=name] [--add-user-ldap=name]"
        ." [--change-password] [--make-admin=username] [--import-vbox=image_file.vdi]"
        ." [--test-ldap] "
        ." [-X] [start|stop|status]"
        ." [--rebase MACHINE]"
        ." [--remove-user=name]"
        ." [--clean-db-leftovers]"
        ." [--log=pathname]"
        ."\n"
        ." --add-user : adds a new db user\n"
        ." --add-user-ldap : adds a new LDAP user\n"
        ." --remove-user : removes a db user\n"
        ." --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"
        ." --change-password : changes the password of an user\n"
        ." --import-domain : import a domain\n"
        ." --import-domain-owner : owner of the domain to import\n"
        ." --make-admin : make user admin\n"
        ." --config : config file, defaults to $FILE_CONFIG_DEFAULT"
        ." --no-fork : start in foreground\n"
        ." --url-isos=(URL|default)\n"
        ." --import-vbox : import a VirtualBox image\n"
        .' --add-locale-repository LOCALE : adds ISO repositories for this locale'
        ."\n"
        ."Operations on Virtual Machines:\n"
        ." --list\n"
        ." --start\n"
        ." --hibernate machine\n"
        ." --shutdown machine\n"
        ." --remove machine\n"
        ." --migrate node machine1 machine2 ... machineN\n"
        ."\n"
        ."Operations modifiers:\n"
        ." --all : execute on all virtual machines\n"
        ."          For hibernate, it is executed on all the actives\n"
        ." --hibernated: execute on hibernated machines\n"
        ." --disconnected: execute on disconnected machines\n"
        ." --active: execute on active running machines\n"
        ."Maintenance operations:\n"
        ." --clean-db-leftovers: properly clean database unreferenced entries\n"
        ." --log: saves STDOUT and STDERR app traces to the specified filename\n"
        ."\n"
    ;

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

GetOptions (       help => \$help
                   ,all => \$ALL
                  ,list => \$LIST
                 ,debug => \$DEBUG
                ,verbose => \$VERBOSE
                ,rebase => \$REBASE
              ,'no-fork'=> \$NOFORK
               ,'active'=> \$ACTIVE
             ,'start=s' => \$START_DOMAIN
             ,'config=s'=> \$FILE_CONFIG
           ,'hibernated'=> \$HIBERNATED
            ,'test-ldap'=> \$TEST_LDAP
           ,'add-user=s'=> \$ADD_USER
           ,'url-isos=s'=> \$URL_ISOS
           ,'shutdown:s'=> \$SHUTDOWN_DOMAIN
          ,'hibernate:s'=> \$HIBERNATE_DOMAIN
             ,'remove:s'=> \$REMOVE_DOMAIN
         ,'disconnected'=> \$DISCONNECTED
        ,'remove-user=s'=> \$REMOVE_USER
        ,'make-admin=s' => \$MAKE_ADMIN_USER
      ,'remove-admin=s' => \$REMOVE_ADMIN_USER
      ,'change-password'=> \$CHANGE_PASSWORD
      ,'add-user-ldap=s'=> \$ADD_USER_LDAP
     ,'add-group-ldap=s'=> \$ADD_GROUP_LDAP
  ,'remove-group-ldap=s'=> \$RM_GROUP_LDAP
     ,'add-user-group=s'=> \$ADD_USER_GROUP

      ,'import-domain=s' => \$IMPORT_DOMAIN
      ,'import-vbox=s' => \$IMPORT_VBOX
,'import-domain-owner=s' => \$IMPORT_DOMAIN_OWNER

    ,'add-locale-repository=s' => \$ADD_LOCALE_REPOSITORY
    ,'run-request=s' => \$RUN_REQUEST

        ,'migrate=s'    => \$MIGRATE

        ,"clean-db-leftovers" => \$CLEAN_DB_LEFTOVERS
        ,"log=s"              => \$LOG_FILENAME
) or exit;

$START = 1 if $DEBUG || $FILE_CONFIG || $NOFORK;


#####################################################################
#
# check arguments
#
if ($help) {
    print $USAGE;
    exit;
}

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

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

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

die "ERROR: Missing the machine name or id\n$USAGE"
    if $REBASE && !@ARGV;

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

$Ravada::FORCE_DEBUG=1    if $DEBUG;
$Ravada::VERBOSE=1      if $VERBOSE;
$Ravada::CAN_FORK=0    if $NOFORK;

my $RVD_BACK;

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

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

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";
    }
}

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


    my $t_refresh = 0;

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

    #    Ravada::Request->enforce_limits();
    #Ravada::Request->refresh_vms();
    Ravada::Request->refresh_storage();
    for (;;) {
        my $t0 = time;
        $ravada->process_requests();
		$ravada->set_debug_value();
        exit if done_request();

        if ( time - $t_refresh > 60 ) {
            Ravada::Request->cleanup();
            Ravada::Request->refresh_vms()      if rand(5)<3;
            Ravada::Request->enforce_limits()   if rand(5)<2;
            Ravada::Request->manage_pools()     if rand(5)<2;
            $t_refresh = time;
        }
        sleep 1 if time - $t0 <1;
    }
}

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';

}

sub clean_old_requests {
    my $ravada = Ravada->new( %CONFIG );
    $ravada->clean_old_requests();
    $ravada->_clean_interrupted_downloads();
}

sub autostart_machines {
    my $ravada = shift;
    my $req = Ravada::Request->check_storage(
        uid => Ravada::Utils::user_daemon->id
        ,retry => 10
    );
    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}
            ,after_request_ok => $req->id
        );
    }
}

sub start {
    {
        my $ravada = Ravada->new( %CONFIG );
        $Ravada::CONNECTOR->dbh;
        $ravada->_install();
		$ravada->set_debug_value();
        $ravada->_wait_pids();
        autostart_machines($ravada);
    }
    clean_old_requests();
    for (;;) {
        eval { do_start() };
        warn $@ if $@;
        exit if done_request();
    }
}

sub add_user {
    my $login = shift;

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

    print "$login password: ";
    my $password = <STDIN>;
    chomp $password;

    print "is admin ? : [y/n] ";
    my $is_admin_q = <STDIN>;
    my $is_admin = 0;

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


    Ravada::Auth::SQL::add_user(      name => $login
                                , password => $password
                                , is_admin => $is_admin);
}

sub add_user_ldap {
    my $login = shift;

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

    print "password : ";
    my $password = <STDIN>;
    chomp $password;

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

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";

}


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";
    }
}

sub change_password {
    print "User login name : ";
    my $login = <STDIN>;
    chomp $login;
    return if !$login;

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

    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);
}

sub make_admin {
    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;

    Ravada::Utils::user_daemon()->make_admin($user->id);
    print "USER $login granted admin permissions\n";
}

sub remove_admin {
    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;

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

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";
}

sub import_domain {
    my $name = shift;
    print "Virtual Manager: KVM\n";
    my $user = $IMPORT_DOMAIN_OWNER;
    if (!$user) {
        print "User name that will own the domain in Ravada : ";
        $user = <STDIN>;
        chomp $user;
    }

    my $ravada = Ravada->new( %CONFIG );
    my $domain = $ravada->import_domain(name => $name, vm => 'KVM'
        ,user => $user
        ,spinoff_disks => 0
    );

    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";
        }
    }

}

sub import_vbox {
    my $file_vdi = shift;
    my $rvd = Ravada->new(%CONFIG);
    my $kvm = $rvd->search_vm('KVM');
    my $default_storage_pool = $kvm->storage_pool();
    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 : ";
            $storage_pool = <STDIN>;
            chomp $storage_pool;
        }
        print "STORAGE POOL IS $storage_pool \n";
        print "DEFAULT STORAGE POOL IS $default_storage_pool \n";

        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";
        #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";
}

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

    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";
    }
}

sub list {
    my $all = shift;
    my $rvd_back = Ravada->new(%CONFIG);

    my $found = 0;
    for my $domain ($rvd_back->list_domains) {
        next if !$all && !$domain->is_active && !$domain->is_hibernated;
        $found++;
        print $domain->name."\t";
        if ($domain->is_active) {
            print "active";
            my $status = $domain->client_status;
            if ( $domain->remote_ip ) {
                $status .= " , "    if $status;
                $status .= $domain->remote_ip;
            }
            print " ( $status ) " if $status;
        } elsif ($domain->is_hibernated) {
            print "hibernated";
        } else {
            print "down";
        }
        print "\n";
    }
    print "$found machines found.\n";
}

sub hibernate {
    my $domain_name = shift;
    my $all = shift;

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

    my $down = 0;
    my $found = 0;
    for my $domain ($rvd_back->list_domains) {
        if ( ($all && $domain->is_active)
                || ($domain_name && $domain->name eq $domain_name)
                || ($DISCONNECTED && _client_status($domain) eq 'disconnected')
           ) {
            $found++;
            if (!$domain->is_active) {
                warn "WARNING: Virtual machine ".$domain->name
                    ." is already down.\n";
                next;
            }
            if ( $DISCONNECTED && $domain->client_status() eq 'disconnected') {
                next if _verify_connection($domain);
            }
            if ($domain->can_hibernate) {
                $domain->hibernate( Ravada::Utils::user_daemon() );
                $down++;
            } else {
                warn "WARNING: Virtual machine ".$domain->name
                    ." can't hibernate because it is not supported in ".$domain->type
                    ." domains."
                    ."\n";
            }
        }
    }
    print "$down machines hibernated.\n";
    warn "ERROR: Domain $domain_name not found.\n"
        if !$domain_name && !$found;
}

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";
}

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;
            }
            eval { $domain->start(user => Ravada::Utils::user_daemon() ) };
            if ($@) {
                warn $@;
                next;
            }
            print $domain->name." started.\n"
                if $domain->is_active;
        }
    }
    warn "ERROR: Domain $domain_name not found.\n"
        if !$found;
}

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

sub shutdown_domain {
    my $domain_name = shift;
    my ($all,$hibernated) = @_;

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

    my $down = 0;
    my $found = 0;
    DOMAIN:
    for my $domain_data ($rvd_back->list_domains_data) {
        my $domain = Ravada::Front::Domain->open($domain_data->{id});
        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;
        if ((defined $domain_name && $domain->name eq $domain_name)
            || ($hibernated && $domain->is_hibernated)
            || ($DISCONNECTED && $is_active && ( $client_status eq 'disconnected' || !$client_status) )
            || $all ){
            $found++;
            if (!$is_active && !$domain->is_hibernated) {
                warn "WARNING: Virtual machine ".$domain->name
                    ." is already down.\n"
                        if !$all;
                next;
            }
            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(
                    uid => Ravada::Utils::user_daemon->id
                    ,id_domain => $domain->id
                );
                $at = time + 180;
                $txt_time = " in 3 minutes";
                my @after_req = ( after_request => $req_start->id);
            }

            print "\tShutting down ".$domain->name;
            print " in ".($at - time)." seconds" if $at;
            print "\n";
            Ravada::Request->shutdown_domain(uid => Ravada::Utils::user_daemon()->id
                ,id_domain => $domain->id
                , timeout => 300
                ,@after_req
                ,at => $at
            );
            $down++;
            warn $@ if $@;
        }
    }
    warn "ERROR: Domain $domain_name not found.\n"
        if $domain_name && !$found;
    print "$down domains shut down.\n";
    exit;
}

sub _verify_connection {
    my $domain_f = shift;
    my $domain = Ravada::Domain->open($domain_f->id);
    print "Verifying connection for ".$domain->name
                        ." ".($domain->remote_ip or '')." "
        if $VERBOSE;
    for ( 1 .. 25 ) {
        my $status = $domain->client_status(1);
        if ( $status && $status ne 'disconnected' ) {
            print "\n\t".$status." ".$domain->remote_ip
                            ." Shutdown dismissed.\n";
            return 1;
        }
        print "." if $VERBOSE && !($_ % 5);
        sleep 1;
     }
     print "\n" if $VERBOSE;
    return 0;
}

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;
    my $ok= Ravada::Auth::LDAP->new(name => $name, password => $password);
    if ($ok) {
        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";
            }

        }
    } else {
        print "LOGIN FAILED\n";
    }
    exit;
}

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";
    }
}

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);
}

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";
}

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
        );
    }
}

sub clean_db_leftovers {
    my $rvd_back = shift;
    $rvd_back->_clean_db_leftovers();
}

sub DESTROY {
}

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

{

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

add_user($ADD_USER)                 if $ADD_USER;
add_user_ldap($ADD_USER_LDAP)       if $ADD_USER_LDAP;
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;
remove_user($REMOVE_USER)           if $REMOVE_USER;
change_password()                   if $CHANGE_PASSWORD;
import_domain($IMPORT_DOMAIN)       if $IMPORT_DOMAIN;
import_vbox($IMPORT_VBOX)           if $IMPORT_VBOX;
make_admin($MAKE_ADMIN_USER)        if $MAKE_ADMIN_USER;
remove_admin($REMOVE_ADMIN_USER)    if $REMOVE_ADMIN_USER;
set_url_isos($URL_ISOS)             if $URL_ISOS;
test_ldap                           if $TEST_LDAP;
rebase()                            if $REBASE;

list($ALL)                          if $LIST;
hibernate($HIBERNATE_DOMAIN , $ALL) if defined $HIBERNATE_DOMAIN;
remove_domain($REMOVE_DOMAIN)              if defined $REMOVE_DOMAIN;
start_domain($START_DOMAIN)         if $START_DOMAIN;

shutdown_domain($SHUTDOWN_DOMAIN, $ALL, $HIBERNATED)
                                    if defined $SHUTDOWN_DOMAIN;

add_locale_repository($ADD_LOCALE_REPOSITORY) if $ADD_LOCALE_REPOSITORY;

run_request($RUN_REQUEST)           if $RUN_REQUEST;

migrate($MIGRATE)                   if $MIGRATE;

clean_db_leftovers($rvd_back)       if $CLEAN_DB_LEFTOVERS;
}


if ($START) {
    die "Already started" if Proc::PID::File->running( name => 'rvd_back');
    start();
}