<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">=head1 NAME

Mikrotik - Perl interface for Mikrotik devices.

=head1 SYNOPSIS

  use Mikrotik;

  $user = 'foo';
  $password = 'bar';
  $ip = '1.1.1.1';
  
  $dev = new Mikrotik ( ip=&gt; $ip, user=&gt;$user, password=&gt; $password);
  
  $dev-&gt;ip;           # get the IP address object;
  
  $dev-&gt;arp;          # get the ARP table from  device;
  
  $dev-&gt;set_clock;    # set the device clock 
  $dev-&gt;reboot;       # reboot the device
  
  $dev-&gt;address_add ( ethernet_interface, ip_address, netmask );  # Edd the IP address for ethernet interface. 
                                                                  # Ethernet_interface= 'eth0', 'eth1' .. etc     
                                                                                                                             
  $dev-&gt;address_remove ( ethernet_interface, ip_address )         # Remove the IP addreess from ethernet interface
  
  $dev-&gt;address_change  ( ethernet_interface, ip_address , user , password);      # Change the current ip address to the new one. 
                                                                                  # User/password are needed for connection to new IP address
                                                                            
  $dev-&gt;dns_set ( ip_address, type);  # Set the DNS. type = primary/sevondary.
  
  $dev-&gt;dns_get;    # Get the DNS.
  
  $dev-&gt;free_space; # Free space onm the device;
  
  $dev-&gt;time        # Get the time;
  
  $dev-&gt;free_memory;
  
  $dev-&gt;total_memory;
  

=cut
=head2 NOTES

This is tested for RB333.

=cut

# The POD text continues at the end of the file.


package Mikrotik;
use strict;
use Net::SSH::Perl;
use Net::IP;
use Net::Netmask;
use Class::Date;
use Log::Log4perl;

$VERSION = 0.1;

our $ssh;

sub new { 
  my ($this,%params) = @_;
  my $class = ref $this|| $this;
  my $ip = new Net::IP ( $params{ip} )|| die ('IP ERROR');
  
  $ssh = Net::SSH::Perl-&gt;new ($ip-&gt;ip);
  
  $ssh-&gt;login( $params{user}, $params{password} );

  my $debug = 0;
  $debug = 1
    if $params{debug} == 1;
  #TO DO - debug  
  return  bless { debug =&gt; $debug }, $class;

};

sub ip (){
   my ($self,$ip_address)=@_;
   my $netmask;
   
   my ($ip) = $ip_address =~ m/^\W*(\d+\W\d+\W\d+\W\d+)/;
   my $netmask = $ip_address =~ m/\/(\S+)$/;
   $ip = new Net::IP ($ip) or die ( Net::IP::Error() );
   $netmask =  new Net::Netmask ($ip_address)
      if $netmask;
   return ($ip,$netmask);
}

sub arp {
   my ($output,$err,$std_err)= $ssh-&gt;cmd('/ip arp print');
   
   return 
      unless $output;

   my @list; 
   while ( $output =~ /(\d+\.\d+\.\d+\.\d+)\W+(\w+:\w+:\w+:\w+:\w+:\w+)\W+(\w+)/g ) {
      push @list ,{  ip =&gt; $1, mac_address =&gt;  $2, interface =&gt; $3 ,};
   }
   return @list;
};


sub set_clock {
   my ($self,$param)= @_;
   my ($output,$err,$std_err);
   
   if ( defined $param-&gt;{time} ){      
      ($output,$err,$std_err)= $ssh-&gt;cmd('system clock set time=' . $param-&gt;{time} )
         if $param-&gt;{time} =~ /\d{1,2}:\d{1,2}:\d{1,2}/;
   }
   
   if ( defined $param-&gt;{date} ){      
      ($output,$err,$std_err)= $ssh-&gt;cmd('system clock set date=' . $param-&gt;{date})
          if  $param-&gt;{date} =~ /\w+\/\d{1,2}\/\d{4}/;
   }
  return 1;  
};

sub reboot {
   my ($self,$param)= @_;
   my ($output,$err,$std_err)= $ssh-&gt;cmd('system reboot' );

  return 1;  
};

sub address_add {
   my ($self,$interface,$ip_address,$netmask)=@_;

   return 
      unless $interface;
   
   my ($ip,$netmask) = $self-&gt;ip($ip_address);
 
   my $cmd = "/ip addr add interface=$interface address=" . $ip-&gt;ip . " netmask=" . $netmask-&gt;mask;

   my ($output,$err,$std_err)= $ssh-&gt;cmd("$cmd");
   
   return 1
     unless $err;
         
   return;
};

sub address_remove {
   my ($self,$interface,$ip_address)=@_;
   return
     unless $interface;
   return 
     unless $ip_address;
   
   my ($ip,$netmask) =  $self-&gt;ip($ip_address);
   $ip_address = $ip-&gt;ip .'/' . $netmask-&gt;bits;
     
   my $cmd = '{ :foreach a in=[/ip address find interface=' . $interface .'] do={ :if ( [ /ip address get $a address  ] = "' . $ip_address . '" ) do={ /ip address remove $a  } } }' ;

   my ($output,$err,$std_err)= $ssh-&gt;cmd("$cmd");
  
   return 1
      unless $err == 0 ;

   return;
};

sub address_change {
   my ($self,$interface,$ip_address,$user,$password) = @_ ;
   return 
      unless $interface;
      
   my ($ip,$netmask) =  $self-&gt;ip($ip_address);
   
   my $cmd = "/ip address print terse  where interface=$interface";
   
   my($output, $stderr, $exit) =  $ssh-&gt;cmd($cmd);
   return 
      if $stderr;

   my ($ip_old) = $output =~ m/address=(\S+)\b/;
   
   my ($ip_old,$netmask_old) = $self-&gt;ip($ip_old);      

   $netmask = $netmask_old
       unless $netmask;

   $ip_address = $ip-&gt;ip .'/' . $netmask-&gt;bits;

  return
     unless $self-&gt;address_add($interface,$ip_address);
     
   ###Connect to new IP
   if ($user &amp;&amp; $password){
      $ssh = Net::SSH::Perl-&gt;new ($ip-&gt;ip);
      $ssh-&gt;login($user,$password);
   }
   
   my $cmd = "/ip address print count-only  where interface=$interface";
   ($output, $stderr, $exit) = $ssh -&gt;cmd($cmd);

   return 
      unless $output&gt;1;
   print 'OK';
   ###delete old IP
   return 1
      if $self-&gt;address_remove ($interface,$ip_old);

   return;
   
};

sub dns_set {
    my ($self,$ip_address,$type) = @_ ;
    return
       unless $ip_address;
       
    return 
       unless $type;
       
    $type = $type . '-dns';
    
    my ($ip,$netmask) =  $self-&gt;ip($ip_address);   
    my $cmd = "/ip dns set $type=" . $ip-&gt;ip;
    my ($output, $stderr, $exit) = $ssh -&gt;cmd($cmd);
    return $output;
}

sub dns_get {
    my ($self,$type) = @_ ;
    
    return 
       unless $type;
    $type = $type . '-dns';

    my $cmd = "{:put [ ip dns get $type ]}";

    my ($output, $stderr, $exit) = $ssh -&gt;cmd($cmd);
    return $output;
}

sub uptime {
   my ($output,$err,$std_err)= $ssh-&gt;cmd('{:put [/system resource get uptime]}');
   
   return 
      unless $output;
   return $output;
};

sub device {
   my ($output,$err,$std_err)= $ssh-&gt;cmd('{:put [/system resource get board-name]}');
   
   return 
      unless $output;
   return $output;
};

sub free_memory {
   my ($output,$err,$std_err)= $ssh-&gt;cmd('{:put [/system resource get free-memory]}');
   
   return 
      unless $output;
   return $output;
};

sub total_memory {
   my ($output,$err,$std_err)= $ssh-&gt;cmd('{:put [/system resource get total-memory]}');
   
   return 
      unless $output;
   return $output;
};

sub free_space {
   my ($output,$err,$std_err)= $ssh-&gt;cmd('{:put [/system resource get free-hdd-space]}');
   
   return 
      unless $output;
   return $output;
};

sub time {
   my $month_map = {
      'jan' =&gt; 1,
      'feb' =&gt; 2,
      'mar' =&gt; 3,
      'apr' =&gt; 4,
      'may' =&gt; 5,
      'jun' =&gt; 6,
      'jul' =&gt; 7,
      'aug' =&gt; 8,
      'sep' =&gt; 9,
      'oct' =&gt; 10,
      'nov' =&gt; 11,
      'dec' =&gt; 12,
   };
   my ($output,$err,$std_err)= $ssh-&gt;cmd('{:put [/system clock get date]}');
   return 
      unless $output;
   my ($month,$day,$year) = $output=~ /(\w+)\/(\d{1,2})\/(\d{4})/;
    
   $month = $month_map-&gt;{$month};
   
   my ($output,$err,$std_err)= $ssh-&gt;cmd('{:put [/system clock get time]}');
   return 
      unless $output;
   my ($hour,$min,$sec) = $output=~ /(\d{1,2}):(\d{1,2}):(\d{1,2})/;

   return   new Class::Date([$year,$month,$day,$hour,$min,$sec]);

};

package Hotspot::Device::RB333;
1;
</pre></body></html>