Request.pm

package Ravada::Request;

use strict;
use warnings;

=head1 NAME

Ravada::Request - Requests library for Ravada

=cut

use Carp qw(confess);
use Data::Dumper;
use Hash::Util qw(lock_hash);
use JSON::XS;
use Hash::Util;
use Time::Piece;
use Ravada;
use Ravada::Front;

use vars qw($AUTOLOAD);

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

=pod

Request a command to the ravada backend

=cut

my $COUNT = 0;
our %FIELD = map { $_ => 1 } qw(error output);
our %FIELD_RO = map { $_ => 1 } qw(id name);

our $args_manage = { name => 1 , uid => 1 };
our $args_prepare = { id_domain => 1 , uid => 1, with_cd => 2 };
our $args_remove_base = { id_domain => 1 , uid => 1 };
our $args_manage_iptables = {uid => 1, id_domain => 1, remote_ip => 1};

our %VALID_ARG = (
    create_domain => {
              vm => 2
           ,name => 1
           ,swap => 2
         ,id_iso => 2
         ,iso_file => 2
        ,id_base => 2
       ,id_owner => 1
    ,id_template => 2
         ,memory => 2
           ,disk => 2
           #        ,network => 2
      ,remote_ip => 2
          ,start => 2
           ,data => 2
    }
    ,open_iptables => $args_manage_iptables
      ,remove_base => $args_remove_base
     ,prepare_base => $args_prepare
     ,spinoff => { id_domain => 1, uid => 1 }
     ,pause_domain => $args_manage
    ,resume_domain => {%$args_manage, remote_ip => 1 }
    ,remove_domain => $args_manage
    ,restore_domain => { id_domain => 1, uid => 1 }
    ,shutdown_domain => { name => 2, id_domain => 2, uid => 1, timeout => 2, at => 2
                       , id_vm => 2 }
    ,force_shutdown_domain => { id_domain => 1, uid => 1, at => 2, id_vm => 2 }
    ,screenshot => { id_domain => 1 }
    ,domain_autostart => { id_domain => 1 , uid => 1, value => 2 }
    ,copy_screenshot => { id_domain => 1 }
    ,start_domain => {%$args_manage, remote_ip => 2, name => 2, id_domain => 2 }
    ,start_clones => { id_domain => 1, uid => 1, remote_ip => 1 }
    ,shutdown_clones => { id_domain => 1, uid => 1, timeout => 2 }
    ,rename_domain => { uid => 1, name => 1, id_domain => 1}
    ,dettach => { uid => 1, id_domain => 1 }
    ,set_driver => {uid => 1, id_domain => 1, id_option => 1}
    ,hybernate=> {uid => 1, id_domain => 1}
    ,download => {uid => 2, id_iso => 1, id_vm => 2, verbose => 2, delay => 2, test => 2}
    ,refresh_storage => { id_vm => 2 }
    ,list_storage_pools => { id_vm => 1 , uid => 1 }
    ,check_storage => { uid => 1 }
    ,set_base_vm=> {uid => 1, id_vm=> 1, id_domain => 1, value => 2 }
    ,cleanup => { }
    ,clone => { uid => 1, id_domain => 1, name => 2, memory => 2, number => 2
                # If base has pools, from_pool = 1 if undefined
                # when from_pool is true the clone is picked from the pool
                # when from_pool is false the clone is created
                ,from_pool => 2
                # If base has pools, create anew and add to the pool
                ,add_to_pool => 2
                ,start => 2,
                ,remote_ip => 2
                ,with_cd => 2
    }
    ,change_owner => {uid => 1, id_domain => 1}
    ,add_hardware => {uid => 1, id_domain => 1, name => 1, number => 2, data => 2 }
    ,remove_hardware => {uid => 1, id_domain => 1, name => 1, index => 1}
    ,change_hardware => {uid => 1, id_domain => 1, hardware => 1, index => 2, data => 1 }
    ,enforce_limits => { timeout => 2, _force => 2 }
    ,refresh_machine => { id_domain => 1, uid => 1 }
    ,rebase => { uid => 1, id_base => 1, id_domain => 1 }
    ,set_time => { uid => 1, id_domain => 1 }
    ,rsync_back => { uid => 1, id_domain => 1, id_node => 1 }
    # ports
    ,expose => { uid => 1, id_domain => 1, port => 1, name => 2, restricted => 2, id_port => 2}
    ,remove_expose => { uid => 1, id_domain => 1, port => 1}
    ,open_exposed_ports => {uid => 1, id_domain => 1 }
    # Virtual Managers or Nodes
    ,refresh_vms => { _force => 2, timeout_shutdown => 2 }

    ,shutdown_node => { id_node => 1, at => 2 }
    ,start_node => { id_node => 1, at => 2 }
    ,connect_node => { backend => 2, hostname => 2, id_node =>2, timeout => 2 }
    ,migrate => { uid => 1, id_node => 1, id_domain => 1, start => 2, remote_ip => 2
        ,shutdown => 2, shutdown_timeout => 2
    }
    ,compact => { uid => 1, id_domain => 1 , keep_backup => 2 }
      ,purge => { uid => 1, id_domain => 1 }

    #users
    ,post_login => { user => 1, locale => 2 }

    #networks
    ,list_network_interfaces => { uid => 1, vm_type => 1, type => 2 }

    #isos
    ,list_isos => { vm_type => 1 }

    ,manage_pools => { uid => 2, id_domain => 2 }
    ,ping_backend => {}
);

our %CMD_SEND_MESSAGE = map { $_ => 1 }
    qw( create start shutdown force_shutdown prepare_base remove remove_base rename_domain screenshot download
            clone
            set_base_vm remove_base_vm
            domain_autostart hibernate hybernate
            change_owner
            add_hardware remove_hardware set_driver change_hardware
            expose remove_expose
            rebase rebase_volumes
            shutdown_node start_node
    );

our %CMD_NO_DUPLICATE = map { $_ => 1 }
qw(
    set_base_vm
    remove_base_vm
    rsync_back
    cleanup
);

our $TIMEOUT_SHUTDOWN = 120;

our $CONNECTOR;

our %COMMAND = (
    long => {
        limit => 4
        ,priority => 10
    } #default

    # list from low to high priority
    ,disk_low_priority => {
        limit => 2
        ,commands => ['rsync_back','check_storage', 'refresh_vms']
        ,priority => 30
    }
    ,disk => {
        limit => 1
        ,commands => ['prepare_base','remove_base','set_base_vm','rebase_volumes'
                    , 'remove_base_vm'
                    , 'screenshot'
                    , 'cleanup'
                    , 'compact'
                ]
        ,priority => 20
    }
    ,huge => {
        limit => 1
        ,commands => ['download']
        ,priority => 15
    }

    ,secondary => {
        limit => 50
        ,priority => 4
        ,commands => ['shutdown','shutdown_now', 'manage_pools','enforce_limits', 'set_time'
            ,'remove_domain'
        ]
    }

    ,important=> {
        limit => 20
        ,priority => 1
        ,commands => ['clone','start','start_clones','shutdown_clones','create','open_iptables','list_network_interfaces','list_isos','ping_backend','refresh_machine']
    }
);
lock_hash %COMMAND;

sub _init_connector {
    $CONNECTOR = \$Ravada::CONNECTOR;
    $CONNECTOR = \$Ravada::Front::CONNECTOR   if !$$CONNECTOR;

}

=head2 BUILD

    Internal object builder, do not call

=cut

sub BUILD {
    _init_connector();
}

sub _request {
    my $proto = shift;
    my $class=ref($proto) || $proto;

    my $self = {};
    bless ($self, $class);
    return $self;
}

=head2 open

Opens the information of a previous request by id

  my $req = Ravada::Request->open($id);

=cut

sub open {
    my $proto = shift;
    my $class = ref($proto) || $proto;

    my $id = shift or confess "Missing request id";

    _init_connector()   if !$CONNECTOR || !$$CONNECTOR;

    my $sth = $$CONNECTOR->dbh->prepare("SELECT * FROM requests "
        ." WHERE id=?");
    $sth->execute($id);
    my $row = $sth->fetchrow_hashref;

    confess "I can't find id=$id " if !defined $row;
    $sth->finish;

    my $args = {};
    $args = decode_json($row->{args}) if $row->{args};

    $row->{args} = $args;

    bless ($row, $class);
    $row->{priority} = $row->_set_priority();

    return $row;
}

=head2 info

Returns information of the request

=cut

sub info {
    my $self = shift;
    my $user = shift;
    confess "USER ".$user->name." not authorized"
        unless $user->is_admin
            || ($self->defined_arg('uid') && $user->id == $self->args('uid'))
            || ($self->defined_arg('id_owner') && $user->id == $self->args('id_owner'));

    return {
        id => $self->id
        ,status => $self->status
        ,error => $self->error
        ,id_domain => $self->id_domain
    }
}

=head2 create_domain

    my $req = Ravada::Request->create_domain(
                        name => 'bla'
                    , id_iso => 1
    );


=cut

sub create_domain {
    my $proto = shift;
    my $class=ref($proto) || $proto;

    my %args = @_;

    my $args = _check_args('create_domain', @_ );

    confess "ERROR: Argument vm required without id_base"
        if !exists $args->{vm} && !exists $args->{id_base};

    my $self = {};
    if ($args->{network}) {
        $args->{network} = JSON::XS->new->convert_blessed->encode($args->{network});
    }

    bless($self,$class);
    return $self->_new_request(command => 'create' , args => encode_json($args));
}

=head2 remove_domain

    my $req = Ravada::Request->remove_domain(
                     name => 'bla'
                    , uid => $user->id
    );


=cut


sub remove_domain {
    my $proto = shift;
    my $class=ref($proto) || $proto;

    my %args = @_;
    confess "Missing domain name"   if !$args{name};
    confess "Name is not scalar"    if ref($args{name});
    confess "Missing uid"           if !$args{uid};

    for (keys %args) {
        confess "Invalid argument $_" if !$VALID_ARG{'remove_domain'}->{$_};
    }

    my $self = {};
    bless($self,$class);

    return $self->_new_request(command => 'remove' , args => \%args);

}

=head2 start_domain

Requests to start a domain

  my $req = Ravada::Request->start_domain(
     name => 'name'
    , uid => $user->id
  );

Mandatory arguments: one of those must be passed:

=over

=item * name or id_domain

=item * uid: user id

=item * remote_ip: [optional] IP of the remote client that requested to start the domain

=back

=cut

sub start_domain {
    my $proto = shift;
    my $class=ref($proto) || $proto;

    my $args = _check_args('start_domain', @_);

    confess "ERROR: choose either id_domain or name "
        if $args->{id_domain} && $args->{name};

    _remove_low_priority_requests($args->{id_domain} or $args->{name});

    my $self = {};
    bless($self,$class);

    return $self->_new_request(command => 'start' , args => $args);
}

sub _remove_low_priority_requests($id_domain) {

    _init_connector()   if !$CONNECTOR || !$$CONNECTOR;

    if ($id_domain !~ /^\d+$/) {
        $id_domain = _search_domain_id(undef,$id_domain);
    }
    for my $command (sort @{$COMMAND{disk_low_priority}->{commands}}) {
        my $sth = $$CONNECTOR->dbh->prepare("SELECT id FROM requests "
            ." WHERE command=? AND id_domain=? "
            ."    AND status <> 'done' "
        );
        $sth->execute($command, $id_domain);
        while ( my ($id_request) = $sth->fetchrow ) {
            my $req = Ravada::Request->open($id_request);
            $req->stop();
            warn "Stopping request $id_request";
        }
    }

}


=head2 start_clones

Requests to start the clones of a base

  my $req = Ravada::Request->start_clones( name => 'name', uid => $user->id );

=cut

sub start_clones {
    my $proto = shift;
    my $class=ref($proto) || $proto;

    my $args = _check_args('start_clones', @_);

    my $self = {};
    bless($self,$class);

    return $self->_new_request(command => 'start_clones' , args => $args);
}

=head2 pause_domain

Requests to pause a domain

  my $req = Ravada::Request->pause_domain( name => 'name', uid => $user->id );

=cut

sub pause_domain {
    my $proto = shift;
    my $class=ref($proto) || $proto;

    my $args = _check_args('pause_domain', @_);

    my $self = {};
    bless($self,$class);

    return $self->_new_request(command => 'pause' , args => $args);
}

=head2 resume_domain

Requests to pause a domain

  my $req = Ravada::Request->resume_domain( name => 'name', uid => $user->id );

=cut

sub resume_domain {
    my $proto = shift;
    my $class=ref($proto) || $proto;

    my $args = _check_args('resume_domain', @_);

    my $self = {};
    bless($self,$class);

    return $self->_new_request(command => 'resume' , args => $args);
}



sub _check_args {
    my $sub = shift;
    confess "Odd number of elements ".Dumper(\@_)   if scalar(@_) % 2;
    my $args = { @_ };

    my $valid_args = $VALID_ARG{$sub};
    for (qw(at after_request after_request_ok retry _no_duplicate)) {
        $valid_args->{$_}=2 if !exists $valid_args->{$_};
    }

    confess "Unknown method $sub" if !$valid_args;
    for (keys %{$args}) {
        confess "Invalid argument $_ , valid args ".Dumper($valid_args)
            if !$valid_args->{$_};
    }

    for (keys %{$VALID_ARG{$sub}}) {
        next if $VALID_ARG{$sub}->{$_} == 2; # optional arg
        confess "Missing argument $_"   if !exists $args->{$_};
    }

    return $args;
}

=head2 force_shutdown_domain

Requests to stop a domain now !

  my $req = Ravada::Request->shutdown_domain( name => 'name' , uid => $user->id );

=cut

sub force_shutdown_domain {
    my $proto = shift;
    my $class=ref($proto) || $proto;

    my $args = _check_args('force_shutdown_domain', @_ );

    my $self = {};
    bless($self,$class);

    return $self->_new_request(command => 'force_shutdown' , args => $args);
}

=head2 shutdown_domain

Requests to stop a domain

  my $req = Ravada::Request->shutdown_domain( name => 'name' , uid => $user->id );
  my $req = Ravada::Request->shutdown_domain( name => 'name' , uid => $user->id
                                            ,timeout => $timeout );

=cut

sub shutdown_domain {
    my $proto = shift;
    my $class=ref($proto) || $proto;

    my $args = _check_args('shutdown_domain', @_ );

    $args->{timeout} = $TIMEOUT_SHUTDOWN if !exists $args->{timeout};

    confess "ERROR: You must supply either id_domain or name ".Dumper($args)
        if !$args->{id_domain} && !$args->{name};

    my $self = {};
    bless($self,$class);

    return $self->_new_request(command => 'shutdown' , args => $args);
}

=head2 new_request

Creates a new request

    $req = Ravada::Request->new_request(
        start_domain
        ,uid => $user->id
        ,id_domain => $domain->id
    );

=cut

sub new_request($self, $command, @args) {
    die "Error: Unknown request '$command'" if !$VALID_ARG{$command};
    return _new_request(
        $self
        ,command => $command
           ,args => _check_args($command, @args)
    );
}

sub _duplicated_request($self=undef, $command=undef, $args=undef) {
    _init_connector()   if !$CONNECTOR || !$$CONNECTOR;

    my $args_d;
    if ($self) {
        confess "Error: do not supply args if you supply request" if $args;
        confess "Error: do not supply command if you supply request" if $command;
        $args_d = $self->args;
        $command = $self->command;
    } else {
        $args_d = decode_json($args);
    }
    delete $args_d->{uid};
    delete $args_d->{at};
    my $sth = $$CONNECTOR->dbh->prepare(
        "SELECT id,args FROM requests WHERE (status <> 'done')"
        ." AND command=?"
    );
    $sth->execute($command);
    while (my ($id,$args_found) = $sth->fetchrow) {
        next if $self && $self->id == $id;

        my $args_found_d = decode_json($args_found);
        delete $args_found_d->{uid};
        delete $args_found_d->{at};

        next if join(".",sort keys %$args_d) ne join(".",sort keys %$args_found_d);
        my $args_d_s = join(".",map { $args_d->{$_} } sort keys %$args_d);
        my $args_found_s = join(".",map {$args_found_d->{$_} } sort keys %$args_found_d);
        next if $args_d_s ne $args_found_s;

        return Ravada::Request->open($id);
    }
    return 0;
}

sub _new_request {
    my $self = shift;
    if ( !ref($self) ) {
        my $proto = $self ;
        my $class = ref($proto) || $proto;
        $self = {};
        bless ($self, $class);
    }
    my %args = @_;

    $args{status} = 'initializing';

    if ($args{name}) {
        $args{domain_name} = $args{name};
        delete $args{name};
    }
    my $no_duplicate = delete $args{_no_duplicate};
    my $uid;
    if ( ref $args{args} ) {
        $args{args}->{uid} = $args{args}->{id_owner}
            if !exists $args{args}->{uid};
        $uid = $args{args}->{uid} if exists $args{args}->{uid};

        $args{at_time} = $args{args}->{at} if exists $args{args}->{at};
        my $id_domain_args = $args{args}->{id_domain};

        if ($id_domain_args) {
            confess "ERROR: Different id_domain: ".Dumper(\%args)
                if $args{id_domain} && $args{id_domain} ne $id_domain_args;
            $args{id_domain} = $id_domain_args;
        }
        for (qw(after_request after_request_ok retry)) {
            $args{$_} = delete $args{args}->{$_}
            if exists $args{args}->{$_};
        }

        $args{args} = encode_json($args{args});
    }
    _init_connector()   if !$CONNECTOR || !$$CONNECTOR;
    if ($args{command} =~ /^(clone|manage_pools)$/
        || $CMD_NO_DUPLICATE{$args{command}}
        || ($no_duplicate && $args{command} =~ /^(screenshot)$/)) {
        my $dupe = _duplicated_request(undef, $args{command}, $args{args});
        return $dupe if $dupe;

        my $recent;
        $recent = done_recently(undef, 60, $args{command})
        if $args{command} !~ /^(clone|migrate|set_base_vm)$/;
        return if $recent;

    }

    my $sth = $$CONNECTOR->dbh->prepare(
        "INSERT INTO requests (".join(",",sort keys %args).")"
        ."  VALUES ( "
                .join(",", map { '?' } keys %args)
                ." )"
    );
    $sth->execute(map { $args{$_} } sort keys %args);
    $sth->finish;

    $self->{id} = $self->_last_insert_id();

    $sth = $$CONNECTOR->dbh->prepare(
    "UPDATE requests set date_req=date_changed"
    ." WHERE id=?");
    $sth->execute($self->{id});


    my $request = $self->open($self->{id});
    $request->status('requested');

    return $request;
}

sub _last_insert_id {
    my $driver = $$CONNECTOR->dbh->{Driver}->{Name};

    if ( $driver =~ /sqlite/i ) {
        return _last_insert_id_sqlite(@_);
    } elsif ( $driver =~ /mysql/i ) {
        return _last_insert_id_mysql(@_);
    } else {
        confess "I don't know how to get last_insert_id for $driver";
    }
}

sub _last_insert_id_mysql {
    my $self = shift;
    my $sth = $$CONNECTOR->dbh->prepare("SELECT last_insert_id()");
    $sth->execute;
    my ($id) = $sth->fetchrow;
    $sth->finish;
    return $id;

}

sub _last_insert_id_sqlite {
    my $self = shift;

    my $sth = $$CONNECTOR->dbh->prepare("SELECT last_insert_rowid()");
    $sth->execute;
    my ($id) = $sth->fetchrow;
    $sth->finish;
    return $id;
}

=head2 status

Returns or sets the status of a request

  $req->status('done');

  my $status = $req->status();

=cut

sub status {
    my $self = shift;
    my $status = shift;
    my $message = shift;

    if (!defined $status) {
        my $sth = $$CONNECTOR->dbh->prepare("SELECT * FROM requests "
            ." WHERE id=?");
        $sth->execute($self->{id});
        my $row = $sth->fetchrow_hashref;
        $sth->finish;

        return ($row->{status} or 'unknown');
    }

    my $sth = $$CONNECTOR->dbh->prepare("UPDATE requests set status=? "
            ." WHERE id=?");

    $status = substr($status,0,64);
    $sth->execute($status, $self->{id});
    $sth->finish;

    $self->_send_message($status, $message)
        if $CMD_SEND_MESSAGE{$self->command} || $self->error ;
    return $status;
}

=head2 at

Sets the time when the request will be scheduled

=cut

sub at($self, $value) {
    my $sth = $$CONNECTOR->dbh->prepare("UPDATE requests set at_time=? "
            ." WHERE id=?");
    $sth->execute($value, $self->{id});
}

sub _search_domain_name {
    my $self = shift;
    my $domain_id = shift;

    my $sth = $$CONNECTOR->dbh->prepare("SELECT name FROM domains where id=?");
    $sth->execute($domain_id);
    return $sth->fetchrow;
}

sub _search_domain_id($self,$domain_name) {

    my $sth = $$CONNECTOR->dbh->prepare("SELECT id FROM domains where name=?");
    $sth->execute($domain_name);
    return $sth->fetchrow;
}


sub _send_message {
    my $self = shift;
    my $status = shift;
    my $message = ( shift or $self->error );

    my $uid;

    $uid = $self->args('id_owner') if $self->defined_arg('id_owner');
    $uid = $self->args('uid')      if !$uid && $self->defined_arg('uid');

    if (!$uid) {
        my $user = $self->defined_arg('user');
        $uid = $user->id if $user;
    }

    return if !$uid;

    my $domain_name = $self->defined_arg('name');
    if (!$domain_name) {
        my $domain_id = $self->defined_arg('id_domain');
        $domain_name = $self->_search_domain_name($domain_id)   if $domain_id;
        $domain_name = '' if !defined $domain_name;
    }
    $domain_name = "$domain_name "  if length $domain_name;

    $self->_remove_unnecessary_messages() if $self->status eq 'done';

    my $subject = $self->command." $domain_name ".$self->status;
    $subject = $message if $message && $self->status eq 'done'
            && length ($message)<60;

    my $sth = $$CONNECTOR->dbh->prepare(
        "INSERT INTO messages ( id_user, id_request, subject, message, date_shown ) "
        ." VALUES ( ?,?,?,?, NULL)"
    );
    $sth->execute($uid, $self->id,$subject, $message);
    $sth->finish;
}

sub _remove_unnecessary_messages {
    my $self = shift;

    my $uid;
    $uid = $self->defined_arg('id_owner');
    $uid = $self->defined_arg('uid')        if !$uid;
    return if !$uid;


    my $sth = $$CONNECTOR->dbh->prepare(
        "DELETE FROM messages WHERE id_user=? AND id_request=? "
        ." AND (message='' OR message IS NULL)"
    );

    $sth->execute($uid, $self->id);
    $sth->finish;

}

sub _remove_messages {
    my $self = shift;

    my $uid;
    $uid = $self->defined_arg('id_owner');
    $uid = $self->defined_arg('uid')        if !$uid;
    return if !$uid;


    my $sth = $$CONNECTOR->dbh->prepare(
        "DELETE FROM messages WHERE id_user=? AND id_request=? "
    );

    $sth->execute($uid, $self->id);
    $sth->finish;

}



=head2 result

  Returns the result of the request if any

  my $result = $req->result;

=cut

sub result {
    my $self = shift;

    my $value = shift;

    if (defined $value ) {
        my $sth = $$CONNECTOR->dbh->prepare("UPDATE requests set result=? "
            ." WHERE id=?");
        $sth->execute(encode_json($value), $self->{id});
        $sth->finish;

    } else {
        my $sth = $$CONNECTOR->dbh->prepare("SELECT result FROM requests where id=? ");
        $sth->execute($self->{id});
        ($value) = $sth->fetchrow;
        $value = decode_json($value)    if defined $value;
        $sth->finish;

    }

    return $value;
}

=head2 command

Returns the requested command

=cut

sub command {
    my $self = shift;
    return $self->{command};
}

=head2 args

Returns the requested command

  my $command = $req->command;

=cut


=head2 args

Returns the arguments of a request or the value of one argument field

  my $args = $request->args();
  print $args->{name};

  print $request->args('name');

=cut


sub args {
    my $self = shift;
    my $name = shift;
    return $self->{args}    if !$name;

    confess "Unknown argument $name ".Dumper($self->{args})
        if !exists $self->{args}->{$name};
    return $self->{args}->{$name};
}

=head2 arg

Sets or gets de value of an argument of a Request

=cut

sub arg($self, $name, $value) {

    confess "Unknown argument $name ".Dumper($self->{args})
        if !exists $self->{args}->{$name} && !defined $value;

    $self->{args}->{$name} = $value if defined $value;
    return $self->{args}->{$name};
}


=head2 defined_arg

Returns if an argument is defined

=cut

sub defined_arg {
    my $self = shift;
    my $name = shift;
    confess "ERROR: missing arg name" if !defined $name;
    return $self->{args}->{$name};
}

=head2 copy_screenshot

Request to copy a screenshot from a domain to another

=cut

sub copy_screenshot {
  my $proto = shift;
  my $class=ref($proto) || $proto;

  my $args = _check_args('copy_screenshot', @_ );

  my $self = {};
  bless($self,$class);

  return $self->_new_request(
       command => 'copy_screenshot'
      ,id_domain => $args->{id_domain}
      ,args => $args
      );

}

=head2 refresh_vms

Refreshes the Virtual Mangers

=cut

sub refresh_vms {
    my $proto = shift;
    my $class = ref($proto) || $proto;

    my $args = _check_args('refresh_vms', @_ );
    if  (!$args->{_force} ) {
          return if done_recently(undef,60,'refresh_vms') || _requested('refresh_vms');
    }

    my $self = {};
    bless($self,$class);

    _init_connector();
    return $self->_new_request(
        command => 'refresh_vms'
        , args => $args
    );


}