Skip to content

Commit

Permalink
replaced Moose with Moo; replaced IO::Socket::INET with IO::Socket::I…
Browse files Browse the repository at this point in the history 
…P; croak instead of die
  • Loading branch information
@martin8883
martin8883 committed Sep 26, 2019
1 parent 3ec2fb0 commit 39b7fa0
Show file tree
Hide file tree
Showing 2 changed files with 100 additions and 56 deletions.
6 changes: 6 additions & 0 deletions Changes
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,11 @@
Revision history for MikroTik-API

2.0.0 20190926
- use Moo instead of Moose
- replaced die with croak
- some more error handling
- replaced IO::Socket::INET with IO::Socket::IP (hostname lookup, IPv6)

1.1.0 20190725
- use return values instead of die() at some places (CAUTION: could break old scripts)
- new MikroTik Login method as default with auto fallback to old method (pre 6.43)
Expand Down
150 changes: 94 additions & 56 deletions lib/MikroTik/API.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,11 +10,13 @@ MikroTik::API - Client to MikroTik RouterOS API
=head1 VERSION
Version 1.1.0
Version 2.0.0
B<CAUTION:> Dependencies change with version 2.0.0. MikroTik::API now relies on Moo instead of Moose. Please be sure, dependencies are met before upgrading.
=cut

our $VERSION = '1.1.0';
our $VERSION = '2.0.0';


=head1 SYNOPSIS
Expand All @@ -37,11 +39,15 @@ our $VERSION = '1.1.0';
=cut

use Moose;
use Moo;
use MooX::Types::MooseLike::Base qw(Bool CodeRef Int Str);
use Carp qw(croak);
use Type::Tiny;
use Try::Tiny;
use namespace::autoclean;

use Digest::MD5;
use IO::Socket::INET;
use IO::Socket::IP;
use IO::Socket::SSL;
use Time::Out qw{ timeout };

Expand Down Expand Up @@ -94,33 +100,56 @@ sub connect {
my ( $self ) = @_;

if ( ! $self->get_host() ) {
die 'host must be set before connect()'
}

if ( $self->get_use_ssl() ) {
$self->set_socket(
IO::Socket::SSL->new(
PeerAddr => $self->get_host(),
PeerPort => $self->get_port(),
Proto => 'tcp',
SSL_cipher_list => 'HIGH',
SSL_verify_mode => $self->get_ssl_verify(),
Timeout => $self->get_timeout(),
) or die "failed connect or ssl handshake ($!: ". IO::Socket::SSL::errstr() .')'
);
croak 'host must be set before connect()'
}

if ( $self->get_use_ssl ) {
my $socket
= try {
IO::Socket::SSL->new(
PeerHost => $self->get_host,
PeerPort => $self->get_port,
Proto => 'tcp',
SSL_cipher_list => 'HIGH',
SSL_verify_mode => $self->get_ssl_verify(),
Timeout => $self->get_timeout,
);
}
catch {
croak sprintf
'failed connect %s:%s or ssl handshake (%s: %s)',
$self->get_host,
$self->get_port,
$_,
IO::Socket::SSL::errstr();
};
# obsolete?
$socket
or croak sprintf
'failed connect %s:%s or ssl handshake (%s: %s)',
$self->get_host,
$self->get_port,
$!,
IO::Socket::SSL::errstr();
$self->set_socket($socket);
}
else {
$self->set_socket(
IO::Socket::INET->new(
PeerAddr => $self->get_host(),
PeerPort => $self->get_port(),
Proto => 'tcp',
Timeout => $self->get_timeout(),
) or die "failed connect ($!)"
IO::Socket::IP->new(
PeerHost => $self->get_host,
PeerPort => $self->get_port,
Proto => 'tcp',
Timeout => $self->get_timeout,
)
or croak sprintf
'failed connect %s:%s (%s)',
$self->get_host,
$self->get_port,
$@,
);
}
if ( ! $self->get_socket() ) {
die "socket creation failed ($!)";
if ( ! $self->get_socket ) {
croak "socket creation failed ($!)";
}
$self->get_socket()->sockopt(SO_KEEPALIVE,1);
$self->get_socket()->sockopt(SO_RCVTIMEO,$self->get_timeout());
Expand All @@ -145,7 +174,7 @@ sub login {
my ( $self ) = @_;

if ( ! $self->get_username() && defined( $self->get_password() ) ) {
die 'username and password must be set before connect()';
croak 'username and password must be set before connect()';
}
if ( ! $self->get_socket() ) {
$self->connect();
Expand All @@ -156,9 +185,9 @@ sub login {
push( @command, '=name=' . $self->get_username() );
push( @command, '=password=' . $self->get_password() );
my ( $retval, @results ) = $self->talk( \@command );
die 'disconnected while logging in' if !defined $retval;
croak 'disconnected while logging in' if !defined $retval;
if ( $retval > 1 ) {
die 'error during establishing login: ' . $results[0]{'message'};
croak 'error during establishing login: ' . $results[0]{'message'};
}

# if we got "=ret=" in response - then assuming this is old style AUTH
Expand All @@ -174,9 +203,9 @@ sub login {
push( @command, '=response=00' . $md5->hexdigest() );
( $retval, @results ) = $self->talk( \@command );
}
die 'disconnected while logging in' if !defined $retval;
croak 'disconnected while logging in' if !defined $retval;
if ( $retval > 1 ) {
die 'error during establishing login: ' . $results[0]{'message'};
croak 'error during establishing login: ' . $results[0]{'message'};
}

if ( $self->get_debug() > 0 ) {
Expand Down Expand Up @@ -233,6 +262,7 @@ sub cmd {
}
}
my ( $retval, @results ) = $self->talk( \@command );

return ( $retval, @results );
}

Expand Down Expand Up @@ -287,6 +317,7 @@ sub query {
}
}
my ( $retval, @results ) = $self->talk( \@command );

return ( $retval, @results );
}

Expand All @@ -303,9 +334,9 @@ sub get_by_key {
my @command = ($cmd);
my %ids;
my ( $retval, @results ) = $self->talk( \@command );
die 'disconnected' if !defined $retval;
croak 'disconnected' if !defined $retval;
if ($retval > 1) {
die $results[0]{'message'};
croak $results[0]{'message'};
}
foreach my $attrs ( @results ) {
my $key = '';
Expand All @@ -328,37 +359,37 @@ sub get_by_key {
=cut

has 'host' => ( is => 'rw', reader => 'get_host', writer => 'set_host', isa => 'Str' );
has 'host' => ( is => 'rw', reader => 'get_host', writer => 'set_host', isa => Str );

=head2 $api->get_port(), $api->set_port( $portnumber )
=cut

has 'port' => ( is => 'ro', reader => '_get_port', writer => 'set_port', isa => 'Int' );
has 'port' => ( is => 'ro', reader => '_get_port', writer => 'set_port', isa => Int );

=head2 $api->get_username(), $api->set_username( $username )
=cut

has 'username' => ( is => 'rw', reader => 'get_username', writer => 'set_username', isa => 'Str' );
has 'username' => ( is => 'rw', reader => 'get_username', writer => 'set_username', isa => Str );

=head2 $api->get_password(), $api->set_password( $password )
=cut

has 'password' => ( is => 'rw', reader => 'get_password', writer => 'set_password', isa => 'Str' );
has 'password' => ( is => 'rw', reader => 'get_password', writer => 'set_password', isa => Str );

=head2 $api->get_use_ssl(), $api->set_use_ssl( $zero_or_one )
=cut

has 'use_ssl' => ( is => 'rw', reader => 'get_use_ssl', writer => 'set_use_ssl', isa => 'Bool' );
has 'use_ssl' => ( is => 'rw', reader => 'get_use_ssl', writer => 'set_use_ssl', isa => Bool );

=head2 $api->get_ssl_verify(), $api->set_ssl_verify( $zero_or_one )
=cut

has 'ssl_verify' => ( is => 'rw', reader => 'get_ssl_verify', writer => 'set_ssl_verify', isa => 'Int', default => 1 );
has 'ssl_verify' => ( is => 'rw', reader => 'get_ssl_verify', writer => 'set_ssl_verify', isa => Int, default => 1 );

=head2 $api->get_new_auth_method(), $api->set_new_auth_method( $zero_or_one )
Expand All @@ -367,13 +398,13 @@ Auth method changed in RouterOS v6.43+ (https://wiki.mikrotik.com/wiki/Manual:AP
=cut

has 'new_auth_method' => ( is => 'rw', reader => 'get_new_auth_method', writer => 'set_new_auth_method', isa => 'Bool', default => 0 );
has 'new_auth_method' => ( is => 'rw', reader => 'get_new_auth_method', writer => 'set_new_auth_method', isa => Bool, default => 0 );

=head2 $api->get_autoconnect(), $api->set_autoconnect( $zero_or_one )
=cut

has 'autoconnect' => ( is => 'rw', reader => 'get_autoconnect', writer => 'set_autoconnect', isa => 'Bool', default => 1 );
has 'autoconnect' => ( is => 'rw', reader => 'get_autoconnect', writer => 'set_autoconnect', isa => Bool, default => 1 );

=head2 $api->get_socket(), $api->set_socket( $io_socket )
Expand All @@ -384,7 +415,14 @@ If you need to use an existing socket for the API connection.
=cut

has 'socket' => ( is => 'rw', reader => 'get_socket', writer => 'set_socket', isa => 'Maybe[IO::Socket]' );
sub MaybeIOSocket {
return Type::Tiny->new(
name => 'MaybeIOSocket',
constraint => sub { defined $_ ? $_->isa('IO::Socket') : 1 },
message => sub { "$_ ain't an IO::Socket or undef" },
);
}
has 'socket' => ( is => 'rw', reader => 'get_socket', writer => 'set_socket', isa => MaybeIOSocket );

=head2 $api->get_debug(), $api->set_debug( $int )
Expand All @@ -393,15 +431,15 @@ has 'socket' => ( is => 'rw', reader => 'get_socket', writer => 'set_socket', is
=cut

has 'debug' => ( is => 'rw', reader => 'get_debug', writer => 'set_debug', isa => 'Int', default => 0 );
has 'debug' => ( is => 'rw', reader => 'get_debug', writer => 'set_debug', isa => Int, default => 0 );

=head2 $api->get_timeout(), $api->set_timeout( $seconds )
Abort connect after $seconds of no reply from MikroTik. This _will not_ affect lost connections. Use probe_before_talk for this.
=cut

has 'timeout' => ( is => 'rw', reader => 'get_timeout', writer => 'set_timeout', isa => 'Int', default => 5 );
has 'timeout' => ( is => 'rw', reader => 'get_timeout', writer => 'set_timeout', isa => Int, default => 5 );

=head2 $api->get_probe_before_talk(), $api->set_probe_before_talk( $seconds )
Expand All @@ -415,15 +453,15 @@ commands are still possible. Set this to 0 if you use many consequent commands a
=cut

has 'probe_before_talk' => ( is => 'rw', reader => 'get_probe_before_talk', writer => 'set_probe_before_talk', isa => 'Int', default => 0 );
has 'probe_before_talk' => ( is => 'rw', reader => 'get_probe_before_talk', writer => 'set_probe_before_talk', isa => Int, default => 0 );

=head2 $api->get_reconnect_after_failed_probe(), $api->set_reconnect_after_failed_probe( $zero_or_one )
If connection is recognized as broken then either reconnect or die otherwise.
=cut

has 'reconnect_after_failed_probe' => ( is => 'rw', reader => 'get_reconnect_after_failed_probe', writer => 'set_reconnect_after_failed_probe', isa => 'Bool', default => 1 );
has 'reconnect_after_failed_probe' => ( is => 'rw', reader => 'get_reconnect_after_failed_probe', writer => 'set_reconnect_after_failed_probe', isa => Bool, default => 1 );

=head1 SEMI-PUBLIC METHODS
Expand Down Expand Up @@ -598,7 +636,7 @@ sub _read_sentence {
my $word = $self->_read_word();
return if (!$word);

die "Protocol error (sentence word does being with \"!\"\n" if ($word !~ /^!/);
croak "Protocol error (sentence word does being with \"!\"\n" if ($word !~ /^!/);

do {
push( @reply, $word );
Expand Down Expand Up @@ -692,7 +730,7 @@ sub _read_byte{
my ( $self ) = @_;
my $line = '';
$self->get_socket()->read( $line, 1 );
die 'EOF' if !defined($line) || length($line) != 1;
croak 'EOF' if !defined($line) || length($line) != 1;
return ord($line);
}

Expand All @@ -716,6 +754,10 @@ added C<timeout parameter> and fixes by elcamlost: https://github.com/elcamlost/
SSL support by akschu: https://github.com/akschu/MikroTikPerl/commit/9b689a7d7511a1639ffa2118c8e549b5cec1290d
=item *
upgrade to v2.0.0 by Steffen Winkler
=back
=head2 Design decisions
Expand All @@ -724,15 +766,15 @@ SSL support by akschu: https://github.com/akschu/MikroTikPerl/commit/9b689a7d751
=item *
Use of Moose for OO
Use of Moo for OO
=item *
higher compilation time of Moose based lib negligible because of slow I/O operations
higher compilation time of Moo based lib negligible because of slow I/O operations
=item *
Moose is more common than Moo or similar
Change from Moose to Moo with version 2.0.0 because of XS dependencies of Moose
=back
Expand All @@ -752,11 +794,7 @@ automatically be notified of progress on your bug as I make changes.
=item *
Quite high compile time because of using Moose. Use of a persistent running framework recommended.
=item *
Login to RouterOS v6.43rc* not possible because of a changed auth method using plaintext passwords
Quite high compile time because of using Moo. Use of a persistent running framework recommended.
=back
Expand Down

0 comments on commit 39b7fa0

Please sign in to comment.