API-MikroTik

 view release on metacpan or  search on metacpan

README.md  view on Meta::CPAN


```perl
  my $api = API::MikroTik->new();

  # Blocking
  my $list = $api->command(
      '/interface/print',
      {'.proplist' => '.id,name,type'},
      {type        => ['ipip-tunnel', 'gre-tunnel'], running => 'true'}
  );
  if (my $err = $api->error) { die "$err\n" }
  printf "%s: %s\n", $_->{name}, $_->{type} for @$list;


  # Non-blocking
  my $tag = $api->command(
      '/system/resource/print',
      {'.proplist' => 'board-name,version,uptime'} => sub {
          my ($api, $err, $list) = @_;
          ...;
      }

lib/API/MikroTik.pm  view on Meta::CPAN

use Scalar::Util 'weaken';

deprecated "API::MikroTik is deprecated in favour of MikroTik::Client\n";

use constant CONN_TIMEOUT => $ENV{API_MIKROTIK_CONNTIMEOUT};
use constant DEBUG        => $ENV{API_MIKROTIK_DEBUG} || 0;
use constant PROMISES     => !!(eval { require Mojo::Promise; 1 });

our $VERSION = 'v0.242';

has error    => '';
has host     => '192.168.88.1';
has ioloop   => sub { Mojo::IOLoop->new() };
has password => '';
has port     => 0;
has timeout  => 10;
has tls      => 1;
has user     => 'admin';
has _tag     => 0;

# Aliases

lib/API/MikroTik.pm  view on Meta::CPAN

        sub {
            return $p->reject($_[1], $_[2]) if $_[1];
            $p->resolve($_[2]);
        }
    );

    return $p;
}

sub subscribe {
    do { $_[0]->{error} = 'can\'t subscribe in blocking mode'; return; }
        unless ref $_[-1] eq 'CODE';
    my $cb = pop;
    my ($self, $cmd, $attr, $query) = @_;
    $attr->{'.subscription'} = 1;
    return $self->_command(Mojo::IOLoop->singleton, $cmd, $attr, $query, $cb);
}

sub _cleanup {
    my $self = shift;
    $_->{timeout} && $_->{loop}->remove($_->{timeout})

lib/API/MikroTik.pm  view on Meta::CPAN


            if ($err) { $self->_fail($_, $err) for @$queue; return }

            warn "-- connection established\n" if DEBUG;

            $self->{handles}{$loop} = $stream;

            weaken $self;
            $stream->on(read => sub { $self->_read($loop, $_[1]) });
            $stream->on(
                error => sub { $self and $self->_fail_all($loop, $_[1]) });
            $stream->on(close => sub { $self && $self->_close($loop) });

            $self->_login(
                $loop,
                sub {
                    if ($_[1]) {
                        $_[0]->_fail($_, $_[1]) for @$queue;
                        $stream->close();
                        return;
                    }

lib/API/MikroTik.pm  view on Meta::CPAN


sub _fail_all {
    $_[0]->_fail($_, $_[2])
        for grep { $_->{loop} eq $_[1] } values %{$_[0]->{requests}};
}

sub _finish {
    my ($self, $r, $err) = @_;
    delete $self->{requests}{$r->{tag}};
    if (my $timer = $r->{timeout}) { $r->{loop}->remove($timer) }
    $r->{cb}->($self, ($self->{error} = $err // ''), $r->{data});
}

sub _login {
    my ($self, $loop, $cb) = @_;
    warn "-- trying to log in\n" if DEBUG;

    $loop->delay(
        sub {
            $self->_command($loop, '/login', {}, undef, $_[0]->begin());
        },

lib/API/MikroTik.pm  view on Meta::CPAN

=head1 SYNOPSIS

  my $api = API::MikroTik->new();

  # Blocking
  my $list = $api->command(
      '/interface/print',
      {'.proplist' => '.id,name,type'},
      {type        => ['ipip-tunnel', 'gre-tunnel'], running => 'true'}
  );
  if (my $err = $api->error) { die "$err\n" }
  printf "%s: %s\n", $_->{name}, $_->{type} for @$list;


  # Non-blocking
  my $tag = $api->command(
      '/system/resource/print',
      {'.proplist' => 'board-name,version,uptime'} => sub {
          my ($api, $err, $list) = @_;
          ...;
      }

lib/API/MikroTik.pm  view on Meta::CPAN

B<This module is deprecated in favour of> L<MikroTik::Client>B<.>

Both blocking and non-blocking interface to a MikroTik API service. With queries,
command subscriptions and Promises/A+ (courtesy of an I/O loop). Based on
L<Mojo::IOLoop> and would work alongside L<EV>.

=head1 ATTRIBUTES

L<API::MikroTik> implements the following attributes.

=head2 error

  my $last_error = $api->error;

Keeps an error from last L</command> call. Empty string on successful commands.

=head2 host

  my $host = $api->host;
  $api     = $api->host('border-gw.local');

Host name or IP address to connect to. Defaults to C<192.168.88.1>.

=head2 ioloop

lib/API/MikroTik.pm  view on Meta::CPAN


An alias for L</command_p>.

=head2 command

  my $command = '/interface/print';
  my $attr    = {'.proplist' => '.id,name,type'};
  my $query   = {type => ['ipip-tunnel', 'gre-tunnel'], running => 'true'};

  my $list = $api->command($command, $attr, $query);
  die $api->error if $api->error;
  for (@$list) {...}

  $api->command('/user/set', {'.id' => 'admin', comment => 'System admin'});

  # Non-blocking
  $api->command('/ip/address/print' => sub {
      my ($api, $err, $list) = @_;

      return if $err;

      for (@$list) {...}
  });

  # Omit attributes
  $api->command('/user/print', undef, {name => 'admin'} => sub {...});

  # Errors handling
  $list = $api->command('/random/command');
  if (my $err = $api->error) {
      die "Error: $err, category: " . $list->[0]{category};
  }

Executes a command on a remote host and returns L<Mojo::Collection> with hashrefs
containing elements returned by a host. You can append a callback for non-blocking
calls.

In a case of error it may return extra attributes to C<!trap> or C<!fatal> API
replies in addition to error messages in an L</error> attribute or an C<$err>
argument. You should never rely on defines of the result to catch errors.

For a query syntax refer to L<API::MikroTik::Query>.

=head2 command_p

  my $promise = $api->command_p('/interface/print');

  $promise->then(
  sub {
      my $res = shift;

t/lib/API/MikroTik/Mockup.pm  view on Meta::CPAN


    $self->{h}->write($sent);
    $self->ioloop->timer(0.5 => sub { $self->{h}->close() });

    return ();
}

sub cmd_err {
    my (undef, $attr) = @_;
    my $tag = $attr->{'.tag'};
    return ['!trap', {message => 'random error', category => 0}, undef, $tag];
}

sub cmd_login {
    my (undef, $attr) = @_;
    my $tag = $attr->{'.tag'};

    return _done($tag, {ret => '098f6bcd4621d373cade4e832627b4f6'})
        unless $attr->{name};

    return _done($tag)

t/mikrotik-online.t  view on Meta::CPAN

    password => ($p   // ''),
    host     => ($h   // '192.168.88.1'),
    tls      => ($tls // 1),
);

my $res;
$res = $a->cmd(
    '/interface/print',
    {'.proplist' => '.id,name,type,running'},
);
ok !$a->error, 'no error';
my @keys = sort keys %{$res->[0]};
is_deeply [@keys], [qw(.id name running type)], 'right result';

done_testing();

t/mikrotik.t  view on Meta::CPAN

    password => 'tset',
    host     => '127.0.0.1',
    port     => $port,
    tls      => 1,
    ioloop   => $loop,
);

# check connection
$api->tls(1);
my $res = $api->cmd('/resp');
like $api->error, qr/IO::Socket::SSL/, 'connection error';
$api->tls(0);

# check login
$api->password('');
$res = $api->cmd('/resp');
like $api->error, qr/cannot log/, 'login error';
$api->password('tset');

# timeouts
$api->timeout(1);
my $ctime = steady_time();
$res = $api->cmd('/nocmd');
ok((steady_time() - $ctime) < 1.1, 'timeout ok');
$api->timeout(0.5);
$ctime = steady_time();
$res   = $api->cmd('/nocmd');
ok((steady_time() - $ctime) < 0.6, 'timeout ok');
$api->timeout(1);

# close connection prematurely, next command should succeed
$res = $api->cmd('/close/premature');
ok !$res, 'no result';
is $api->error, 'closed prematurely', 'right error';

# also check previous test case on errors
$res = $api->cmd('/resp');
isa_ok $res, 'Mojo::Collection', 'right result type';
is_deeply $res, _gen_result(), 'right result';

$res = $api->cmd('/resp', {'.proplist' => 'prop0,prop2'});
is_deeply $res, _gen_result('prop0,prop2'), 'right result';

$res = $api->cmd('/resp', {'.proplist' => 'prop0,prop2', count => 3});
is_deeply $res, _gen_result('prop0,prop2', 3), 'right result';

$res = $api->cmd('/err');
is $api->error, 'random error', 'right error';
is_deeply $res, [{message => 'random error', category => 0}],
    'right error attributes';

# non-blocking
my $mockup_nb = API::MikroTik::Mockup->new()
    ->fd($loop->acceptor($mockup->server)->handle->fileno);
$mockup_nb->server;

$api->cmd(
    '/resp',
    {'.proplist' => 'prop0,prop2', count => 1} => sub {
        is_deeply $_[2], _gen_result('prop0,prop2', 1), 'right result';

t/mikrotik.t  view on Meta::CPAN

);

my ($err1, $err2);
$api->cmd('/err' => sub { $err1 = $_[1] . '1' });
$api->cmd('/err' => sub { $err2 = $_[1] . '2' });

Mojo::IOLoop->timer(1.3 => sub { Mojo::IOLoop->stop() });
Mojo::IOLoop->start();

is_deeply $res, {key => 'nnn'}, 'right result';
is $err,  'interrupted',   'right error';
is $err1, 'random error1', 'right error';
is $err2, 'random error2', 'right error';

done_testing();

sub _gen_result {
    my $attr = API::MikroTik::Mockup::_gen_attr(@_);
    return [$attr, $attr];
}

t/promises.t  view on Meta::CPAN

    user     => 'test',
    password => 'tset',
    host     => '127.0.0.1',
    port     => $port,
    tls      => 1,
);

my $p = $api->cmd_p('/resp');
isa_ok $p, 'Mojo::Promise', 'right result type';

# connection errors
my ($err, $res);
$p->catch(sub { ($err, $res) = @_ })->finally(sub { Mojo::IOLoop->stop() });
Mojo::IOLoop->start();
like $err, qr/IO::Socket::SSL/, 'connection error';
ok !$res, 'no error attributes';
$api->tls(0);

# error
$api->cmd_p('/err')->catch(sub { ($err, $res) = @_ })
    ->finally(sub { Mojo::IOLoop->stop() });
Mojo::IOLoop->start();
is $err, 'random error', 'right error';
is_deeply $res, [{message => 'random error', category => 0}],
    'right error attributes';

# request
$api->cmd_p('/resp')->then(sub { $res = $_[0] })
    ->finally(sub { Mojo::IOLoop->stop() });
Mojo::IOLoop->start();
is_deeply $res, _gen_result(), 'right result';

done_testing();

sub _gen_result {



( run in 0.651 second using v1.01-cache-2.11-cpan-65fba6d93b7 )