API-MikroTik
view release on metacpan or search on metacpan
},
"release_status" : "stable",
"resources" : {
"bugtracker" : {
"web" : "https://github.com/anparker/api-mikrotik/issues"
},
"license" : [
"http://www.opensource.org/licenses/artistic-license-2.0"
],
"repository" : {
"type" : "git",
"url" : "https://github.com/anparker/api-mikrotik.git",
"web" : "https://github.com/anparker/api-mikrotik"
}
},
"version" : "v0.242"
}
Makefile.PL view on Meta::CPAN
dynamic_config => 0,
'meta-spec' => {version => 2},
no_index => {directory => ['t']},
prereqs => {runtime => {requires => {perl => '5.010001'}}},
resources => {
bugtracker =>
{web => 'https://github.com/anparker/api-mikrotik/issues'},
license =>
['http://www.opensource.org/licenses/artistic-license-2.0'],
repository => {
type => 'git',
url => 'https://github.com/anparker/api-mikrotik.git',
web => 'https://github.com/anparker/api-mikrotik',
},
},
},
PREREQ_PM => {'Mojolicious' => '7.00'},
test => {TESTS => 't/*.t'},
);
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) = @_;
...;
}
);
lib/API/MikroTik.pm view on Meta::CPAN
sub _read {
my ($self, $loop, $bytes) = @_;
warn "-- read bytes from socket: " . (length $bytes) . "\n" if DEBUG;
my $response = $self->{responses}{$loop} ||= API::MikroTik::Response->new();
my $data = $response->parse(\$bytes);
for (@$data) {
next unless my $r = $self->{requests}{delete $_->{'.tag'}};
my $type = delete $_->{'.type'};
push @{$r->{data} ||= Mojo::Collection->new()}, $_
if %$_ && !$r->{subscription};
if ($type eq '!re' && $r->{subscription}) {
$r->{cb}->($self, '', $_);
}
elsif ($type eq '!done') {
$r->{data} ||= Mojo::Collection->new();
$self->_finish($r);
}
elsif ($type eq '!trap' || $type eq '!fatal') {
$self->_fail($r, $_->{message});
}
}
}
sub _send_request {
my ($self, $r) = @_;
return $self->_enqueue($r) unless my $stream = $self->{handles}{$r->{loop}};
return $self->_write_sentence($stream, $r);
}
lib/API/MikroTik.pm view on Meta::CPAN
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) = @_;
...;
}
);
lib/API/MikroTik.pm view on Meta::CPAN
=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) = @_;
lib/API/MikroTik/Query.pm view on Meta::CPAN
use Scalar::Util 'blessed';
our @EXPORT_OK = ('build_query');
sub build_query {
my $query = blessed $_[0] ? $_[1] : $_[0];
return $$query if ref $query eq 'REF' && ref $$query eq 'ARRAY';
if (my $type = ref $query) {
return [_block(_ref_op($type), $query)];
}
else { return [] }
}
sub _block {
my ($logic, $items) = @_;
@{($items = [])} = map { $_ => $items->{$_} } sort keys %$items
if ref $items eq 'HASH';
my ($count, @words) = (0, ());
while (my $el = shift @$items) {
my @expr;
if (ref $el eq 'REF' && ref $$el eq 'ARRAY') {
@expr = @{$$el};
}
elsif (my $type = ref $el) {
@expr = _block(_ref_op($type), $el);
}
elsif ($el =~ /^-(?:and|or)$/) {
@expr = _block(_ref_op($el), shift @$items);
}
elsif ($el =~ /^-has(?:_not)?$/) {
push @words, '?' . ($el eq '-has_not' ? '-' : '') . (shift @$items);
$count++;
next;
lib/API/MikroTik/Query.pm view on Meta::CPAN
sub _ref_op {
return
($_[0] eq 'HASH' || $_[0] eq '-and') ? '&'
: ($_[0] eq 'ARRAY' || $_[0] eq '-or') ? '|'
: '';
}
sub _value {
my ($name, $val) = @_;
my $type = ref $val;
if ($type eq 'HASH') {
return _value_hash($name, $val);
}
elsif ($type eq 'ARRAY') {
return _value_array($name, '=', $val);
}
# SCALAR
return "?$name=" . ($val // '');
}
sub _value_array {
my ($name, $op, $block) = @_;
lib/API/MikroTik/Query.pm view on Meta::CPAN
Simple and supposedly intuitive way to build MikroTik API queries. Following
ideas of L<SQL::Abstract>.
=head1 METHODS
=head2 build_query
use API::MikroTik::Query qw(build_query);
# (type = 'ipip-tunnel' OR type = 'gre-tunnel') AND running = 'true'
# $query
# = ['?type=ipip-tunnel', '?type=gre-tunnel', '?#|', '?running=true', '?#&'];
my $query
= build_query({type => ['ipip-tunnel', 'gre-tunnel'], running => 'true'});
Builds a query and returns an arrayref with API query words.
=head1 QUERY SYNTAX
Basic idea is that everything in arrayrefs are C<OR>'ed and everything in hashrefs
are C<AND>'ed unless specified otherwise. Another thing is, where a C<value> is
expected, you should be able to use a list to compare against a set of values.
=head2 Key-value pairs
# type = 'gre-tunnel' AND running = 'true'
my $query = {type => 'gre-tunnel', running => 'true'};
# disabled = 'true' OR running = 'false'
$query = [disabled => 'true', running => 'false'];
Simple attribute value comparison.
=head2 List of values
# type = 'ether' OR type = 'wlan'
my $query = {type => ['ether', 'wlan']};
You can use arrayrefs for a list of possible values for an attribute. By default,
it will be expanded into an C<OR> statement.
=head2 Comparison operators
# comment isn't empty (more than empty string)
my $query = {comment => {'>', ''}};
# mtu > 1000 AND mtu < 1500
lib/API/MikroTik/Query.pm view on Meta::CPAN
=head2 Checking for an attributes
my $query = {-has => 'dafault-name'};
$query = {-has_not => 'dafault-name'};
Checks if an element has an attribute with specific name.
=head2 Literal queries
my $query = \['?type=ether', '?running=true', '?actual-mtu=1500', '?#&&'];
$query = [
type => 'ipip-tunnel',
\['?type=ether', '?running=true', '?actual-mtu=1500', '?#&&']
];
Reference to an arrayref can be used to pass list of prepared words. Those will
be treated as blocks in nested expressions.
=head2 Logic and nesting
# (mtu = 1460 AND actual-mtu = 1460)
# AND
# (running = 'false' OR disabled = 'true')
lib/API/MikroTik/Query.pm view on Meta::CPAN
# Same thing, but with prefixes
my $query = {
-and => [mtu => 1460, 'actual-mtu' => 1460],
-or => {running => 'false', disabled => 'true'}
};
You can change logic applied to a block by using keywords. Those keywords
will go outside for blocks that affect multiple attributes, or ...
# !(type = 'ether') AND !(type = 'wlan')
# Will produce the same result
my $query = {type => [-and => {-not => 'ether'}, {-not => 'wlan'}]};
$query = {type => {-not => [-and => 'ether', 'wlan']}};
# Wrong, second condition will replace first
$query = {type => {-not => 'ether', -not => 'wlan'}};
... inside for a list of values of a single attribute.
# This is wrong
my $query = [
-and =>
{type => 'ether'},
{running => 'true'}
];
# It will actually results in
# type = 'ether' OR running = 'true'
C<-and> will be treated as prefix for the first hashref and, since this hash has
only one element, won't affect anything at all.
=cut
lib/API/MikroTik/Response.pm view on Meta::CPAN
sub parse {
my ($self, $buff) = @_;
my $data = [];
my $sentence = $self->sentence;
while ($$buff) {
my $words = $sentence->fetch($buff);
last if $sentence->is_incomplete;
my $item = {'.tag' => '', '.type' => (shift @$words)};
push @$data, $item;
next unless @$words;
while (my $w = shift @$words) {
$item->{$1 || $2} = $3 if ($w =~ /^(?:=([^=]+)|(\.tag))=(.*)/);
}
}
return $self->{data} = $data;
lib/API/MikroTik/Response.pm view on Meta::CPAN
API::MikroTik::Response - Parse responses from a buffer
=head1 SYNOPSIS
use API::MikroTik::Response;
my $response = API::MikroTik::Response->new();
my $list = $response->parse(\$buff);
for my $re (@$list) {
my ($type, $tag) = delete @{$re}{'.type'. '.tag'};
say "$_ => $re->{$_}" for keys %$re;
}
=head1 DESCRIPTION
Parser for API protocol responses.
=head1 ATTRIBUTES
L<API::MikroTik::Response> implements the following attributes.
lib/API/MikroTik/Response.pm view on Meta::CPAN
sentence. There are some special attributes:
=over 2
=item '.tag'
'.tag' => 1
Reply tag.
=item '.type'
'.type' => '!re'
Reply type.
=back
=head1 SEE ALSO
L<API::MikroTik>
=cut
lib/API/MikroTik/Sentence.pm view on Meta::CPAN
=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
t/lib/API/MikroTik/Mockup.pm view on Meta::CPAN
my ($loop, $stream, $id) = @_;
$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\": $@";
}
t/mikrotik-online.t view on Meta::CPAN
my $a = API::MikroTik->new(
user => ($u // 'admin'),
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
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';
t/promises.t view on Meta::CPAN
my $port = Mojo::IOLoop->acceptor($mockup->server)->port;
my $api = API::MikroTik->new(
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
t/response.t view on Meta::CPAN
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';
# reassemble partial buffer
my ($attr, @parts);
$attr->{$_} = $_ x 200 for 1 .. 4;
$packed = encode_sentence('!re', $attr);
$packed .= $packed . $packed . $packed;
push @parts, (substr $packed, 0, $_, '') for (900, 700, 880, 820);
$attr->{'.tag'} = '';
$attr->{'.type'} = '!re';
my $w = $r->parse(\$parts[0]);
is_deeply $w, [$attr], 'right result';
ok $r->sentence->is_incomplete, 'incomplete is set';
$w = $r->parse(\$parts[1]);
is_deeply $w, [], 'right result';
ok $r->sentence->is_incomplete, 'incomplete is set';
$w = $r->parse(\$parts[2]);
is_deeply $w, [($attr) x 2], 'right result';
ok $r->sentence->is_incomplete, 'incomplete is set';
( run in 1.421 second using v1.01-cache-2.11-cpan-df04353d9ac )