API-MikroTik
view release on metacpan or search on metacpan
# API::MikroTik - Non-blocking interface to MikroTik API. [](https://travis-ci.org/anparker/api-mikrotik)
Blocking and non-blocking API interface with queries, command subscriptions
and Promises/A+ (courtesy of [Mojo::IOLoop](http://github.com/kraih/mojo/)).
```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;
}
...;
}
);
lib/API/MikroTik.pm view on Meta::CPAN
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
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]; });
$self->ioloop->start();
return $res;
}
sub command_p {
Carp::croak 'Mojolicious v7.54+ is required for using promises.'
unless PROMISES;
my ($self, $cmd, $attr, $query) = @_;
my $p = Mojo::Promise->new();
$self->_command(
Mojo::IOLoop->singleton,
$cmd, $attr, $query,
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})
for values %{$self->{requests}};
$_ && $_->unsubscribe('close')->close() for values %{$self->{handles}};
delete $self->{handles};
}
sub _close {
my ($self, $loop) = @_;
$self->_fail_all($loop, 'closed prematurely');
delete $self->{handles}{$loop};
delete $self->{responses}{$loop};
}
sub _command {
my ($self, $loop, $cmd, $attr, $query, $cb) = @_;
my $tag = ++$self->{_tag};
my $r = $self->{requests}{$tag} = {tag => $tag, loop => $loop, cb => $cb};
$r->{subscription} = delete $attr->{'.subscription'};
warn "-- got request for command '$cmd' (tag: $tag)\n" if DEBUG;
$r->{sentence} = encode_sentence($cmd, $attr, $query, $tag);
return $self->_send_request($r);
}
sub _connect {
my ($self, $r) = @_;
warn "-- creating new connection\n" if DEBUG;
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 {
lib/API/MikroTik.pm view on Meta::CPAN
=head1 NAME
API::MikroTik - Non-blocking interface to MikroTik API
=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;
}
...;
}
);
lib/API/MikroTik.pm view on Meta::CPAN
$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
$api = $api->port(8000);
API service port for connection. Defaults to C<8729> and C<8728> for TLS and
clear text connections respectively.
=head2 timeout
my $timeout = $api->timeout;
$api = $api->timeout(15);
Timeout in seconds for sending request and receiving response before command
will be canceled. Default is C<10> seconds.
=head2 tls
my $tls = $api->tls;
$api = $api->tls(1);
Use TLS for connection. Enabled by default.
=head2 user
my $user = $api->user;
$api = $api->user('admin');
User name for authentication purposes. Defaults to C<admin>.
=head1 METHODS
=head2 cancel
# subscribe to a command output
my $tag = $api->subscribe('/ping', {address => '127.0.0.1'} => sub {...});
# cancel command after 10 seconds
Mojo::IOLoop->timer(10 => sub { $api->cancel($tag) });
# or with callback
$api->cancel($tag => sub {...});
Cancels background commands. Can accept a callback as last argument.
=head2 cmd
my $list = $api->cmd('/interface/print');
An alias for L</command>.
=head2 cmd_p
my $promise = $api->cmd_p('/interface/print');
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
lib/API/MikroTik/Sentence.pm view on Meta::CPAN
use Exporter 'import';
our @EXPORT_OK = qw(encode_sentence);
use API::MikroTik::Query 'build_query';
has words => sub { [] };
sub encode_sentence {
shift if ref $_[0];
my ($command, $attr, $query, $tag)
= (shift // '', shift // {}, shift, shift);
my $sentence = _encode_word($command);
$sentence .= _encode_word("=$_=" . ($attr->{$_} // '')) for keys %$attr;
if ($query) {
$sentence .= _encode_word($_) for @{build_query($query)};
}
$sentence .= _encode_word(".tag=$tag") if $tag;
# Closing empty word.
lib/API/MikroTik/Sentence.pm view on Meta::CPAN
=encoding utf8
=head1 NAME
API::MikroTik::Sentence - Encode and decode API sentences
=head1 SYNOPSIS
use API::MikroTik::Sentence qw(encode_sentence);
my $command = '/interface/print';
my $attr = {'.proplist' => '.id,name,type'};
my $query = {type => ['ipip-tunnel', 'gre-tunnel'], running => 'true'};
my $tag = 1;
my $bytes = encode_sentence($command, $attr, $query, $tag);
my $sentence = API::MikroTik::Sentence->new();
my $words = $sentence->fetch(\$bytes);
say $_ for @$words;
=head1 DESCRIPTION
Provides subroutines for encoding API sentences and parsing them back into words.
=head1 METHODS
=head2 encode_sentence
my $bytes = encode_sentence($command, $attr, $query, $tag);
Encodes sentence. Attributes is a hashref with attribute-value pairs. Query will
be parsed with L<API::MikroTik::Query/build_query>.
Can be also called as an object method.
=head2 fetch
my $words = $sentence->fetch(\$buff);
t/lib/API/MikroTik/Mockup.pm view on Meta::CPAN
$self->{h} = $stream;
$stream->on(
read => sub {
my ($stream, $bytes) = @_;
my $data = $self->res->parse(\$bytes);
for (@$data) {
my $cmd = $_->{'.type'} // '';
warn "wrong command \"$cmd\"\n" and next
unless $cmd =~ s/^\//cmd_/;
$cmd =~ s/\//_/g;
eval {
my $resp = '';
$resp .= encode_sentence(@$_) for ($self->$cmd($_));
$stream->write($resp);
} or warn "unhandled command \"$cmd\": $@";
}
}
);
$stream->on(
close => sub { $loop->remove($_) for values %{$self->{timers}} }
);
}
);
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) = @_;
t/mikrotik.t view on Meta::CPAN
$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'});
t/sentence.t view on Meta::CPAN
$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';
$packed = encode_sentence('/cmd/1', {a => 1, b => 2});
$packed
.= encode_sentence('/cmd/2', {c => 'foo', d => 'bar'}, {e => 'baz'}, 11);
my $words = $s->fetch(\$packed);
is shift @$words, '/cmd/1', 'right command';
is_deeply [sort @$words], ['=a=1', '=b=2'], 'right attributes';
$words = $s->fetch(\$packed);
is shift @$words, '/cmd/2', 'right command';
is_deeply [sort @$words], ['.tag=11', '=c=foo', '=d=bar', '?e=baz'],
'right attributes';
# buffer ends in the middle of a word
$packed = encode_sentence('/one/two/three', {test => 1, another => 2});
substr $packed, 20, 20, '';
$words = $s->fetch(\$packed);
is_deeply $words, ['/one/two/three'], 'right results';
ok $s->is_incomplete, 'incomplete is set';
( run in 0.911 second using v1.01-cache-2.11-cpan-f56aa216473 )