API-MikroTik
view release on metacpan or search on metacpan
make of the Package, you should contact the Copyright Holder and seek
a different licensing arrangement.
Definitions
"Copyright Holder" means the individual(s) or organization(s)
named in the copyright notice for the entire Package.
"Contributor" means any party that has contributed code or other
material to the Package, in accordance with the Copyright Holder's
procedures.
"You" and "your" means any person who would like to copy,
distribute, or modify the Package.
"Package" means the collection of files distributed by the
Copyright Holder, and derivatives of that collection and/or of
those files. A given Package may consist of either the Standard
Version, or a Modified Version.
"Distribute" means providing a copy of the Package or making it
Holder.
"Original License" means this Artistic License as Distributed with
the Standard Version of the Package, in its current version or as
it may be modified by The Perl Foundation in the future.
"Source" form means the source code, documentation source, and
configuration files for the Package.
"Compiled" form means the compiled bytecode, object code, binary,
or any other form resulting from mechanical transformation or
translation of the Source form.
Permission for Use and Modification Without Distribution
(1) You are permitted to use the Standard Version and create and use
Modified Versions for any purpose without restriction, provided that
you do not Distribute the Modified Version.
Permissions for Redistribution of the Standard Version
(2) You may Distribute verbatim copies of the Source form of the
Standard Version of this Package in any medium without restriction,
either gratis or for a Distributor Fee, provided that you duplicate
all of the original copyright notices and associated disclaimers. At
your discretion, such verbatim copies may or may not include a
Compiled form of the Package.
(3) You may apply any bug fixes, portability changes, and other
modifications made available from the Copyright Holder. The resulting
Package will still be considered the Standard Version, and as such
will be subject to the Original License.
Distribution of Modified Versions of the Package as Source
(4) You may Distribute your Modified Version as Source (either gratis
or for a Distributor Fee, and with or without a Compiled form of the
Modified Version) provided that you clearly document how it differs
from the Standard Version, including, but not limited to, documenting
any non-standard features, executables, or modules, and provided that
you do at least ONE of the following:
(a) make the Modified Version available to the Copyright Holder
of the Standard Version, under the Original License, so that the
Copyright Holder may include your modifications in the Standard
Version.
(b) ensure that installation of your Modified Version does not
prevent the user installing or running the Standard Version. In
addition, the Modified Version must bear a name that is different
(c) allow anyone who receives a copy of the Modified Version to
make the Source form of the Modified Version available to others
under
(i) the Original License or
(ii) a license that permits the licensee to freely copy,
modify and redistribute the Modified Version using the same
licensing terms that apply to the copy that the licensee
received, and requires that the Source form of the Modified
Version, and of any works derived from it, be made freely
available in that license fees are prohibited but Distributor
Fees are allowed.
Distribution of Compiled Forms of the Standard Version
or Modified Versions without the Source
(5) You may Distribute Compiled forms of the Standard Version without
the Source, provided that you include complete instructions on how to
get the Source of the Standard Version. Such instructions must be
valid at the time of your distribution. If these instructions, at any
time while you are carrying out such distribution, become invalid, you
must provide new instructions on demand or cease further distribution.
If you provide valid instructions or cease distribution within thirty
days after you become aware that the instructions are invalid, then
you do not forfeit any of your rights under this license.
(6) You may Distribute a Modified Version in Compiled form without
the Source, provided that you comply with Section 4 with respect to
the Source of the Modified Version.
Aggregating or Linking the Package
(7) You may aggregate the Package (either the Standard Version or
Modified Version) with other packages and Distribute the resulting
aggregation provided that you do not charge a licensing fee for the
Package. Distributor Fees are permitted, and licensing fees for other
components in the aggregation are permitted. The terms of this license
apply to the use and Distribution of the Standard or Modified Versions
as included in the aggregation.
(8) You are permitted to link Modified and Standard Versions with
other works, to embed the Package in a larger work of your own, or to
build stand-alone binary or bytecode versions of applications that
include the Package, and Distribute the result without restriction,
provided the result does not expose a direct interface to the Package.
Items That are Not Considered Part of a Modified Version
(9) Works (including, but not limited to, modules and scripts) that
merely extend or make use of the Package, do not, by themselves, cause
the Package to be a Modified Version. In addition, such works are not
considered parts of the Package itself, and are not subject to the
terms of this license.
(11) If your Modified Version has been derived from a Modified
Version made by someone other than you, you are nevertheless required
to ensure that your Modified Version complies with the requirements of
this license.
(12) This license does not grant you the right to use any trademark,
service mark, tradename, or logo of the Copyright Holder.
(13) This license includes the non-exclusive, worldwide,
free-of-charge patent license to make, have made, use, offer to sell,
sell, import and otherwise transfer the Package with respect to any
patent claims licensable by the Copyright Holder that are necessarily
infringed by the Package. If you institute patent litigation
(including a cross-claim or counterclaim) against any party alleging
that the Package constitutes direct or contributory patent
infringement, then this Artistic License to you shall terminate on the
date that such litigation is filed.
(14) Disclaimer of Warranty:
THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS
IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED
MANIFEST This list of files
MANIFEST.SKIP
README.md
t/lib/API/MikroTik/Mockup.pm
t/mikrotik-online.t
t/mikrotik.t
t/pod.t
t/pod_coverage.t
t/promises.t
t/query.t
t/response.t
t/sentence.t
META.yml Module YAML meta-data (added by MakeMaker)
META.json Module JSON meta-data (added by MakeMaker)
"name" : "API-MikroTik",
"no_index" : {
"directory" : [
"t",
"inc",
"t"
]
},
"prereqs" : {
"build" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"Mojolicious" : "7.00",
"perl" : "5.010001"
}
}
},
"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"
---
abstract: 'Non-blocking MikroTik API interface'
author:
- 'Andre Parker <andreparker@gmail.com>'
build_requires:
ExtUtils::MakeMaker: '0'
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 0
generated_by: 'ExtUtils::MakeMaker version 7.34, CPAN::Meta::Converter version 2.143240'
license: artistic_2
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: API-MikroTik
no_index:
directory:
- t
- inc
- t
requires:
Mojolicious: '7.00'
perl: '5.010001'
resources:
bugtracker: https://github.com/anparker/api-mikrotik/issues
license: http://www.opensource.org/licenses/artistic-license-2.0
repository: https://github.com/anparker/api-mikrotik.git
version: v0.242
Makefile.PL view on Meta::CPAN
WriteMakefile(
NAME => 'API::MikroTik',
VERSION_FROM => 'lib/API/MikroTik.pm',
ABSTRACT => 'Non-blocking MikroTik API interface',
AUTHOR => 'Andre Parker <andreparker@gmail.com>',
LICENSE => 'artistic_2',
META_MERGE => {
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',
},
},
'/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) = @_;
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
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;
lib/API/MikroTik.pm view on Meta::CPAN
$_->{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;
lib/API/MikroTik.pm view on Meta::CPAN
warn "-- creating new connection\n" if DEBUG;
my $queue = $self->{queues}{$r->{loop}} = [$r];
my $tls = $self->tls;
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 }
lib/API/MikroTik.pm view on Meta::CPAN
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) = @_;
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, '', $_);
lib/API/MikroTik.pm view on Meta::CPAN
sub _write_sentence {
my ($self, $stream, $r) = @_;
warn "-- writing sentence for tag: $r->{tag}\n" if DEBUG;
$stream->write($r->{sentence});
return $r->{tag} if $r->{subscription};
weaken $self;
$r->{timeout} = $r->{loop}
->timer($self->timeout => sub { $self->_fail($r, 'response timeout') });
return $r->{tag};
}
1;
=encoding utf8
=head1 NAME
lib/API/MikroTik.pm view on Meta::CPAN
'/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 {
lib/API/MikroTik.pm view on Meta::CPAN
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>.
lib/API/MikroTik.pm view on Meta::CPAN
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
my $loop = $api->ioloop;
$api = $api->loop(Mojo::IOLoop->new());
Event loop object to use for blocking operations, defaults to L<Mojo::IOLoop>
object.
=head2 password
lib/API/MikroTik.pm view on Meta::CPAN
$api = $api->password('secret');
Password for authentication. Empty string by default.
=head2 port
my $port = $api->port;
$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
lib/API/MikroTik.pm view on Meta::CPAN
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
lib/API/MikroTik.pm view on Meta::CPAN
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 {...});
lib/API/MikroTik.pm view on Meta::CPAN
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/Query.pm view on Meta::CPAN
return '?' . $name . $op . $val;
}
1;
=encoding utf8
=head1 NAME
API::MikroTik::Query - Build MikroTik queries from perl structures
=head1 SYNOPSIS
use API::MikroTik::Query qw(build_query);
# (a = 1 OR a = 2) AND (b = 3 OR c = 4 OR d = 5)
my $query = {
a => [1, 2],
[
b => 3,
c => 4,
d => 5
]
};
# Some bizarre nested expressions.
# (a = 1 OR b = 2 OR (e = 5 AND f = 6 AND g = 7))
# OR
# (c = 3 AND d = 4)
# OR
# (h = 8 AND i = 9)
$query = [
-or => {
a => 1,
b => 2,
-and => {e => 5, f => 6, g => 7}
lib/API/MikroTik/Query.pm view on Meta::CPAN
=head2 Negation
# !(interface = 'ether5')
my $query = {interface => {-not => 'ether5'}};
# !(interface = 'ether5') AND !(interface = 'ether1')
$query = {interface => {-not => [-and => 'ether5', 'ether1']}};
Since MikroTik API does not have 'not equal' operator, it ends up been 'opposite
of a equals b' expressions.
=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')
my $query = {
{mtu => 1460, 'actual-mtu' => 1460},
[running => 'false', disabled => 'true']
lib/API/MikroTik/Query.pm view on Meta::CPAN
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
return $self->{data} = $data;
}
1;
=encoding utf8
=head1 NAME
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.
=head2 data
my $items = $response->data;
Sentences fetched in last operation;
=head2 sentence
my $sentence = $response->sentence;
$response->sentence(API::MikroTik::Sentence->new());
L<API::MikroTik::Sentence> object used to decode sentences from network buffer.
=head1 METHODS
=head2 parse
my $list = $response->parse(\$buff);
Parses data from a buffer and returns list of hashrefs with attributes for each
sentence. There are some special attributes:
=over 2
=item '.tag'
'.tag' => 1
lib/API/MikroTik/Sentence.pm view on Meta::CPAN
else { $words = $self->{words} = [] }
while (my $w = $self->_fetch_word($buff)) { push @$words, $w }
return $words;
}
sub is_incomplete {
return exists $_[0]->{_buff};
}
sub reset {
delete @{$_[0]}{qw(words _buff)};
return $_[0];
}
sub _encode_length {
my $len = shift;
my $packed;
# Screw you, mikrotik engineers, just pack length as 4 bytes. >_<
lib/API/MikroTik/Sentence.pm view on Meta::CPAN
Can be also called as an object method.
=head2 fetch
my $words = $sentence->fetch(\$buff);
Fetches a sentence from a buffer and parses it into a list of API words. In a
situation when amount of data in the buffer are insufficient to complete the
sentence, already processed words and the remaining buffer will be stored in an
object. On a next call will prepend a buffer with kept data and merge a result
with the one stored from a previous call.
=head2 is_incomplete
my $done = !$sentence->is_incomplete;
Indicates that a processed buffer was incomplete and remaining amount of data was
insufficient to complete a sentence.
=head2 reset
my $sentence->reset;
Clears an incomplete status and removes a remaining buffer.
=head1 SEE ALSO
L<API::MikroTik>
=cut
t/lib/API/MikroTik/Mockup.pm view on Meta::CPAN
package API::MikroTik::Mockup;
use Mojo::Base '-base';
use API::MikroTik::Response;
use API::MikroTik::Sentence qw(encode_sentence);
use Mojo::IOLoop;
has 'fd';
has ioloop => sub { Mojo::IOLoop->singleton };
has 'port';
has res => sub { API::MikroTik::Response->new() };
has server => sub {
my $self = shift;
my $opts = {address => '127.0.0.1'};
if (defined(my $fd = $self->fd)) {
$opts->{fd} = $fd;
}
else {
$opts->{port} = $self->port;
$opts->{reuse} = 1;
}
my $serv_id = $self->ioloop->server(
$opts => sub {
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\": $@";
}
}
);
$stream->on(
close => sub { $loop->remove($_) for values %{$self->{timers}} }
);
}
);
t/lib/API/MikroTik/Mockup.pm view on Meta::CPAN
$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 {
t/lib/API/MikroTik/Mockup.pm view on Meta::CPAN
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}
t/mikrotik-online.t view on Meta::CPAN
use API::MikroTik::Sentence;
my ($h, $u, $p, $tls) = split ':', ($ENV{API_MIKROTIK_ONLINE} || '');
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
user => 'test',
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
my $mockup = API::MikroTik::Mockup->new();
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
$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 {
my $attr = API::MikroTik::Mockup::_gen_attr(@_);
return [$attr, $attr];
}
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
$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';
$w = $r->parse(\$parts[3]);
is_deeply $w, [$attr], 'right result';
ok !$r->sentence->is_incomplete, 'incomplete is not set';
done_testing();
t/sentence.t view on Meta::CPAN
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';
# reset
$s->reset;
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();
( run in 0.898 second using v1.01-cache-2.11-cpan-49f99fa48dc )