#!/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::Front;
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_USER_FILE;
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 $LIST_UNUSED_VOLS;
my $SHOW_VOLUME;

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 $PURGE_NODES;

my $IMPORT_DOMAIN_OWNER;

my $ADD_LOCALE_REPOSITORY;

my $BACKUP;
my $RESTORE;
my $TIME_CONNECTION = 10;

my $TYPE;
my $CREATE;

my $USAGE = "$0 "
        ." [--debug] [--config=$FILE_CONFIG_DEFAULT] [--add-user=name] [--add-user-ldap=name]"
        ." [--add-user-file=filename]"
        ." [--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"
        ." --add-user-file: adds new users from a file\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"
        ." --backup machine1 machine2 ... machineN\n"
        ." --restore machine1 machine2 ... machineN\n"
        ." --restore file1 file2 ... fileN\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"
        ." --list-unused-volumes\n"
        ." --show-volume\n"
        ."Create users modifiers\n"
        ." --type : plain, ldap or sso. Defaults to plain\n"
        ." --create : only valid for LDAP users, creates the entries.\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'=> \$SHUTDOWN_DOMAIN
          ,'hibernate'=> \$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-user-file=s'=> \$ADD_USER_FILE
     ,'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

        ,"backup" => \$BACKUP
        ,"restore" => \$RESTORE
        ,"log=s"              => \$LOG_FILENAME
        ,'list-unused-volumes' => \$LIST_UNUSED_VOLS
        ,'show-volume' => \$SHOW_VOLUME

        ,"purge-nodes"      => \$PURGE_NODES

        ,"time-connection=s" => \$TIME_CONNECTION
        ,"type=s" => \$TYPE
        ,"create" => \$CREATE
) 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;

die "ERROR: Supply either --all or --disconnected or --active\n"
if ( $ALL && ( $DISCONNECTED || $ACTIVE ))
    || ( $DISCONNECTED && ( $ALL || $ACTIVE ));

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 && exists $Ravada::CONFIG->{"log"});
    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();
    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->set_debug_value();
        $ravada->_wait_pids();
        autostart_machines($ravada);
        Ravada::Request->update_iso_urls(uid =>Ravada::Utils::user_daemon->id);
        Ravada::Request->refresh_storage();
    }
    clean_old_requests();
    for (;;) {
        do_start();
        exit if done_request();
    }
}

sub add_user {
    my $login = shift;

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

    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_file($ADD_USER_FILE) {
    my $ravada = Ravada::Front->new();
    die "Error: File $ADD_USER_FILE does not exist\n"
    if !-e $ADD_USER_FILE;

    open my $in,"<",$ADD_USER_FILE or die "$! $ADD_USER_FILE\n";
    my $users = join("",<$in>);
    close $in;

    my ($found, $count, $error)=$ravada->upload_users($users, ($TYPE or 'sql'), $CREATE);

    print "$found found, $count added.\n";
    if (scalar (@$error)) {
        print "Errors:\n";
        for (sort @$error) {
            print "  - $_\n";
        }
    }
}

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(@domains) {

    my $found = 0;
    for my $domain (@domains) {
        next if $domain->is_hibernated;
        if ($domain->can_hibernate) {
            $found++;
            Ravada::Request->hybernate(
                uid => Ravada::Utils->user_daemon->id
                ,id_domain => $domain->id
            );
            if ($VERBOSE) {
                print "Hibernating ".$domain->name."\n";
            }
        } else {
            warn "WARNING: Virtual machine ".$domain->name
            ." can't hibernate because it is not supported in ".$domain->type
            ." domains."
            ."\n";
        }
    }
    print "$found machines hibernated\n" if $VERBOSE;
    exit;
}

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 '';
    my $status = $domain->client_status(1);
    return 'disconnected' if!defined $status || $status eq '';
    return $status;
}

sub shutdown_domain(@domains) {

    my $down = 0;
    for my $domain (@domains) {
        my $is_active = $domain->is_active;
        if (!$is_active && !$domain->is_hibernated) {
                next;
        }

        my @after_req;
        if ($domain->is_hibernated ) {
            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
            );
            @after_req = ( after_request => $req_start->id
                ,at => time + 180
            );
            for ( 1 .. 30 ) {
                last if $req_start->status eq 'done';
                sleep 1;
            }
        }
        if ($VERBOSE) {
            print "\tShutting down ".$domain->name;
            print "\n";
        }
        Ravada::Request->shutdown_domain(uid => Ravada::Utils::user_daemon()->id
            ,id_domain => $domain->id
            , timeout => 300
            ,@after_req
        );
        $down++;

    }
    print "$down domains shut down.\n" if $VERBOSE;
    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 .. $TIME_CONNECTION ) {
        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 _dump_ldap_entry($ldap_entry) {
    print $ldap_entry->dn."\n";
    for my $attrib (sort $ldap_entry->attributes ) {
        my @value = $ldap_entry->get_value($attrib);
        print "$attrib: ";

        $value[0] =~ tr/./*/c
        if defined $value[0] && $attrib eq 'unicodePwd';

        if (scalar(@value)<2) {
            if (!defined $value[0]) {
                print "<UNDEF>";
            } else {
                print $value[0];
            }
            print "\n";
        } else {
            print "\n";
            for (@value) {
                print "  - $_\n";
            }
        }
    }
}


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;
    my $user = Ravada::Auth::LDAP::search_user($name);
    if (!$user) {
        my $config = \$Ravada::CONFIG;

        my $field = ($$config->{ldap}->{field} or 'cn');

        my $filter = '';

        $filter = $$config->{ldap}->{filter}
        if exists $$config->{ldap}->{filter};

        $filter= "filter=$filter " if $filter;

        my $base = $$config->{ldap}->{base};

        warn "Error: $field=$name not found. base=$base $filter. Either ".$$config->{ldap}->{admin_user}->{dn}." not allowed, or entry does not exist.\n";
    } else {
        _dump_ldap_entry($user);
    }

    print "\nType the password if you want to check the user connection or CTRL-C to stop\npassword: ";
    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";
            _dump_ldap_entry($ok->{_ldap_entry});
        }
    } 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 backup($rvd_back) {
    die "Error: please provide the virtual machine name to backup.\n"
    unless scalar(@ARGV);

    for my $name (@ARGV) {
        my $dom;
        if ( $name =~ /^\d+$/ ) {
            $dom = Ravada::Domain->open($name);
        } else {
            $dom = $rvd_back->search_domain($name);
        }
        if ($dom->is_active) {
            warn "Error: $name is active, not backing up.\n";
            next;
        }
        print $dom->backup()."\n";
    }
    exit 0;
}

sub restore($rvd_back) {
    die "Error: please provide the file to restore.\n"
    unless scalar(@ARGV);

    for my $item (@ARGV) {
        if ($item =~ m{/}) {
            my $dom = $rvd_back->restore_backup($item,1);
            if ($dom) {
                print $dom->name." restored successfuly.\n";
            } else {
                print "backup for $item aborted.\n";
            }
        } else {
            warn "Error: I can't find '$item'. Plese pass the path with the backed up filename.\n";
        }
    }
}

sub _list_domains($rvd_back
        ,$all, $active, $hibernated, $disconnected) {

    my %name = map { $_ => 1 } @ARGV ;

    my @domains;
    for my $domain ($rvd_back->list_domains) {

        next if $domain->is_base;

        if ( $all
            || $name{$domain->name}
            || ( $active && $domain->is_active && !$domain->autostart )
            || ( $hibernated && $domain->is_hibernated )
            || ( $disconnected && $domain->is_active
                && !$domain->autostart
                && _client_status($domain) eq 'disconnected')
        ) {

            delete $name{$domain->name};
            if ( $disconnected && $domain->client_status() eq 'disconnected') {
                next if _verify_connection($domain);
            }
            next if $all && $HIBERNATE_DOMAIN && !$domain->is_active;
            next if $all && $SHUTDOWN_DOMAIN && !$domain->is_active
            && !$domain->is_hibernated;

            if ($HIBERNATE_DOMAIN && $domain->is_hibernated && $VERBOSE) {
                print $domain->name." already hibernated.\n";
                next;
            }

            if ($SHUTDOWN_DOMAIN && $domain->status eq 'down' && $VERBOSE) {
                print $domain->name." already down.\n";
                next;
            }

            push @domains,($domain);

        }
    }
    warn "Warning: Domain not found ".(join(",", sort keys %name))."\n"
    if keys %name;

    return @domains;
}

sub purge_nodes($rvd_back) {
    my $sth = $rvd_back->_dbh->prepare(
        "SELECT id,name FROM domains WHERE is_base=1"
        ." ORDER BY name "
    );
    my $sth_ins = $rvd_back->_dbh->prepare(
            "SELECT di.id,di.id_domain, di.id_vm, d.name, vms.name "
            ." FROM domain_instances di,domains d, vms"
            ." WHERE di.id_domain = d.id "
            ."    AND d.id_base=?"
            ."    AND d.id_vm <> di.id_vm "
            ."    AND vms.id=di.id_vm "
            ."    AND vms.hostname <> 'localhost'"
            ."    AND vms.hostname <> '127.0.0.1'"
            ." ORDER by d.name "
    );
    my $sth_delete = $rvd_back->_dbh->prepare(
        "DELETE FROM domain_instances WHERE id=?"
    );
    $sth->execute();
    while ( my ($id_base,$name) = $sth->fetchrow ) {
        $sth_ins->execute($id_base);
        while (my @row = $sth_ins->fetchrow()) {
            next if !@row;
            my ($id, $id_domain, $id_vm, $name , $vm_name) = @row;
            my $domain =  Ravada::Domain->open($id_domain);
            my $vm = Ravada::VM->open($id_vm);
            if ( !$vm->_connect) {
                warn "Node $vm_name unavailable\n";
                next;
            }
            for my $vol ( $domain->list_volumes ) {
                next if !$vm->file_exists($vol);
            print "Found $name [$id_domain] unused in $vm_name.\n";
            print "Remove $vol\n";
            print "[y/N] ? ";
            my $ok= <stdin>;
            next if $ok !~ /y/i;

                $vm->remove_file($vol);
            }
            $sth_delete->execute($id);
        }

    }
}

sub _vms($rvd_back) {
    my $sth = $rvd_back->connector->dbh->prepare(
        "SELECT id,name FROM vms "
    );
    $sth->execute;
    my @ids;
    while ( my $row = $sth->fetchrow_hashref ) {
        push @ids,($row);
    }
    return @ids;
}

sub list_unused_vols($rvd_back) {
    for my $vm (_vms($rvd_back) ) {
        print "$vm->{name}\n";
        my $req = Ravada::Request->list_unused_volumes(
            uid => Ravada::Utils::user_daemon->id
            ,id_vm => $vm->{id}
            ,at => time + 30
        );
        $req->status('done');
        for my $vol ( $rvd_back->_cmd_list_unused_volumes($req)) {
            print $vol->{file}."\n";
        }
    }
    exit;
}

sub _show_volume_cached($rvd_back, $file) {

    my $sth = $rvd_back->connector->dbh->prepare(
        "SELECT d.name FROM volumes v,domains d "
        ." WHERE d.id=v.id_domain AND v.file=?");
    $sth->execute($file);
    my @dom;
    while (my $row = $sth->fetchrow_hashref()) {
        push @dom,($row->{name})
    }
    return @dom;
}

sub show_volume($rvd_back) {
    die "Error: $0 --show-volume file1 file2 ... filen\n"
    unless @ARGV;

    for my $file (@ARGV) {
        print "$file\n";
        if ($file !~ m{^/}) {
            print "Error: '$file' is not absolute path\n";
            next;
        }
        my @dom = _show_volume_cached($rvd_back, $file);
        if (scalar(@dom)) {
            for (@dom) {
                print "  - $_\n";
            }
        } else {
            print "  - <UNUSED>\n";
        }
    }
}

sub DESTROY {
}

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

{

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

my @domains;
@domains = _list_domains($rvd_back
    , $ALL, $ACTIVE, $HIBERNATED, $DISCONNECTED)
if $HIBERNATE_DOMAIN || $SHUTDOWN_DOMAIN;

add_user($ADD_USER)                 if $ADD_USER;
add_user_ldap($ADD_USER_LDAP)       if $ADD_USER_LDAP;
add_user_file($ADD_USER_FILE)       if $ADD_USER_FILE;
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;
remove_domain($REMOVE_DOMAIN)              if defined $REMOVE_DOMAIN;
start_domain($START_DOMAIN)         if $START_DOMAIN;

shutdown_domain(@domains)           if defined $SHUTDOWN_DOMAIN;
hibernate(@domains)                 if defined $HIBERNATE_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;

backup($rvd_back)                   if $BACKUP;
restore($rvd_back)                  if $RESTORE;

purge_nodes($rvd_back)              if $PURGE_NODES;

list_unused_vols($rvd_back)         if $LIST_UNUSED_VOLS;
show_volume($rvd_back)              if $SHOW_VOLUME;
}


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