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) = @_;
          ...;
      }
  );
  Mojo::IOLoop->start();

  # Subscribe
  $tag = $api->subscribe(
      '/interface/listen' => sub {
          my ($api, $err, $res) = @_;
          ...;
      }
  );
  Mojo::IOLoop->timer(3 => sub { $api->cancel($tag) });
  Mojo::IOLoop->start();

  # Errors handling
  $api->command(
      '/random/command' => sub {
          my ($api, $err, $list) = @_;

          if ($err) {
              warn "Error: $err, category: " . $list->[0]{category};
              return;
          }

          ...;
      }
  );
  Mojo::IOLoop->start();

  # Promises
  $api->cmd_p('/interface/print')
      ->then(sub { my $res = shift }, sub { my ($err, $attr) = @_ })
      ->finally(sub { Mojo::IOLoop->stop() });
  Mojo::IOLoop->start();
```

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

    my $port = $self->port ? $self->{port} : $tls ? 8729 : 8728;

    $r->{loop}->client(
        {
            address     => $self->host,
            port        => $port,
            timeout     => CONN_TIMEOUT,
            tls         => $tls,
            tls_ciphers => 'HIGH'
        } => sub {
            my ($loop, $err, $stream) = @_;

            delete $self->{queues}{$loop};

            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

    push @$queue, $r;
    return $r->{tag};
}

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());
        },
        sub {
            my ($delay, $err, $res) = @_;
            return $self->$cb($err) if $err;
            my $secret
                = md5_sum("\x00", $self->password, pack 'H*', $res->[0]{ret});
            $self->_command($loop, '/login',
                {name => $self->user, response => "00$secret"},
                undef, $delay->begin());
        },
        sub {
            $self->$cb($_[1]);
        },
    );

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) = @_;
          ...;
      }
  );
  Mojo::IOLoop->start();

  # Subscribe
  $tag = $api->subscribe(
      '/interface/listen' => sub {
          my ($api, $err, $el) = @_;
          ...;
      }
  );
  Mojo::IOLoop->timer(3 => sub { $api->cancel($tag) });
  Mojo::IOLoop->start();

  # Errors handling
  $api->command(
      '/random/command' => sub {
          my ($api, $err, $list) = @_;

          if ($err) {
              warn "Error: $err, category: " . $list->[0]{category};
              return;
          }

          ...;
      }
  );
  Mojo::IOLoop->start();

  # Promises
  $api->cmd_p('/interface/print')
      ->then(sub { my $res = shift }, sub { my ($err, $attr) = @_ })
      ->finally(sub { Mojo::IOLoop->stop() });
  Mojo::IOLoop->start();

=head1 DESCRIPTION

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;
      ...
  })->catch(sub {
      my ($err, $attr) = @_;
  });

Same as L</command>, but always performs requests non-blocking and returns a
L<Mojo::Promise> object instead of accepting a callback. L<Mojolicious> v7.54+ is
required for promises functionality.

=head2 subscribe

  my $tag = $api->subscribe('/ping',
      {address => '127.0.0.1'} => sub {
        my ($api, $err, $res) = @_;
      });

  Mojo::IOLoop->timer(
      3 => sub { $api->cancel($tag) }
  );

Subscribe to an output of commands with continuous responses such as C<listen> or
C<ping>. Should be terminated with L</cancel>.

=head1 DEBUGGING

You can set the API_MIKROTIK_DEBUG environment variable to get some debug output
printed to stderr.

Also, you can change connection timeout with the API_MIKROTIK_CONNTIMEOUT variable.

=head1 COPYRIGHT AND LICENSE

Andre Parker, 2017-2018.

This program is free software, you can redistribute it and/or modify it under
the terms of the Artistic License version 2.0.

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

sub cmd_cancel {
    my ($self, $attr) = @_;
    my $tag     = $attr->{'.tag'};
    my $cmd_tag = $attr->{'tag'};

    return ['!trap', {message => 'unknown command'}, undef, $tag]
        unless my $id = delete $self->{timers}{$cmd_tag};
    $self->ioloop->remove($id);

    return (
        ['!trap', {category => 2, message => 'interrupted'}, undef, $cmd_tag],
        _done($tag), _done($cmd_tag));
}

sub cmd_close_premature {
    my ($self, $attr) = @_;

    my $sent = encode_sentence('!re', {message => 'response'}, undef,
        $attr->{'.tag'});
    substr $sent, (length($sent) / 2), -1, '';

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

# subscriptions
my ($err, $tag);
$res = undef;
$tag = $api->subscribe(
    '/subs',
    {key => 'nnn'} => sub {
        $res = $_[2] unless $err = $_[1];
        $api->cancel($tag);
    }
);

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 {

t/query.t  view on Meta::CPAN

$r = build_query({a => {-not => [-and => 1, 2, 3]}});
is_deeply $r, ['?a=1', '?#!', '?a=2', '?#!', '?a=3', '?#!', '?#&&'],
    '-not with arrayref value';

$r = build_query([[], a => 1, [{}, {}, \[]], b => [], c => 5, d => {}]);
is_deeply $r, ['?a=1', '?c=5', '?#|'], 'ignore empty structs';

$r = build_query([a => [{'=', []}, 2, {}]]);
is_deeply $r, ['?a=2'], 'ignore empty structs';

my $err;
$SIG{__WARN__} = sub { $err = $_[0] };
$r = build_query([a => undef, b => [1, undef, 2], c => {'=', undef}]);
ok !$err, 'no warning';
is_deeply $r, ['?a=', '?b=1', '?b=', '?b=2', '?#||', '?c=', '?#||'],
    'right result';

done_testing();

t/sentence.t  view on Meta::CPAN

ok !$s->is_incomplete, 'incomplete is not longer set';

# buffer ends at the end of the word, before an empty closing word
$packed = encode_sentence('/one/two', {three => 'four'});
my $tr = substr $packed, -1, 1, '';
is $tr, "\0", 'trailing empty word';
$words = $s->fetch(\$packed);
is_deeply $words, ['/one/two', '=three=four'], 'right results';
ok $s->is_incomplete, 'incomplete is set';

my $err;
$SIG{__WARN__} = sub { $err = $_[0] };
$packed = encode_sentence('/cmd', {argv => undef});
ok !$err, 'no warning';
$words = $s->reset->fetch(\$packed);
is_deeply $words, ['/cmd', '=argv='], 'right results';

done_testing();