API-MikroTik

 view release on metacpan or  search on metacpan

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

# Aliases
Mojo::Util::monkey_patch(__PACKAGE__, 'cmd',   \&command);
Mojo::Util::monkey_patch(__PACKAGE__, 'cmd_p', \&command_p);
Mojo::Util::monkey_patch(__PACKAGE__, '_fail', \&_finish);

sub DESTROY { Mojo::Util::_global_destruction() or shift->_cleanup() }

sub cancel {
    my $cb = ref $_[-1] eq 'CODE' ? pop : sub { };
    return shift->_command(Mojo::IOLoop->singleton, '/cancel', {'tag' => shift},
        undef, $cb);
}

sub command {
    my $cb = ref $_[-1] eq 'CODE' ? pop : undef;
    my ($self, $cmd, $attr, $query) = @_;

    # non-blocking
    return $self->_command(Mojo::IOLoop->singleton, $cmd, $attr, $query, $cb)
        if $cb;

    # blocking
    my $res;
    $self->_command($self->ioloop, $cmd, $attr, $query,
        sub { $_[0]->ioloop->stop(); $res = $_[2]; });

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

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

sub _read {
    my ($self, $loop, $bytes) = @_;

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

  # 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.

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

    );

    return $serv_id;
};

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)
        if $attr->{name} eq 'test'
        && $attr->{response} eq '00119ce7e093e33497053e73f37a5d3e15';

    return ['!fatal', {message => 'cannot log in'}, undef, $tag];
}

sub cmd_nocmd {
    return ();
}

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

    my $resp = ['!re', _gen_attr(@{$attr}{'.proplist', 'count'}), undef, $tag];
    return ($resp, $resp, _done($tag));
}

sub cmd_subs {
    my ($self, $attr) = @_;
    my $tag = $attr->{'.tag'} // 0;
    my $key = $attr->{'key'};

    $self->{timers}{$tag} = $self->ioloop->recurring(
        0.5 => sub {
            $self->{h}
                ->write(encode_sentence('!re', {key => $key}, undef, $tag));
        }
    );

    return ();
}

sub _done {
    return ['!done', $_[1], undef, $_[0]];
}

sub _gen_attr {
    my $c    = $_[1] // 0;
    my $attr = {};
    $attr->{$_} = 'attr' . ($c++) for split /,/, ($_[0] // 'prop1,prop2,prop0');
    return $attr;
}

1;

t/mikrotik.t  view on Meta::CPAN

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

t/query.t  view on Meta::CPAN

    '-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/response.t  view on Meta::CPAN

use lib './';

use Test::More;
use API::MikroTik::Response;
use API::MikroTik::Sentence qw(encode_sentence);

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

my $packed = encode_sentence('!re', {a => 1, b => 2});
$packed .= encode_sentence('!re', {c => 3, d => 4, e => 5}, undef, 3);
$packed .= encode_sentence('!done');

my $data = $r->parse(\$packed);
is_deeply $data,
    [
    {a => '1', b => '2', '.tag' => '',  '.type' => '!re'},
    {e => '5', d => '4', c      => '3', '.tag'  => '3', '.type' => '!re'},
    {'.tag' => '', '.type' => '!done'}
    ],
    'right response';

t/sentence.t  view on Meta::CPAN

use Test::More;
use API::MikroTik::Sentence qw(encode_sentence);

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

# length encoding
my ($packed, $len);
for (0x7f, 0x3fff, 0x1fffff, 0xfffffff, 0x10000000) {
    $packed = API::MikroTik::Sentence::_encode_length($_);
    ($len, undef) = API::MikroTik::Sentence::_strip_length(\$packed);
    is $len, $_, "length encoding: $_";
}

# encode word
my $encoded = API::MikroTik::Sentence::_encode_word('bla' x 3);
$encoded .= API::MikroTik::Sentence::_encode_word('bla' x 50);
is length($encoded), 162, 'right length';
is $s->_fetch_word(\$encoded), 'bla' x 3, 'right decoded word';
is length($encoded), 152, 'right length';
is $s->_fetch_word(\$encoded), 'bla' x 50, 'right decoded word';

t/sentence.t  view on Meta::CPAN

# 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();