· 5 years ago · Mar 02, 2021, 08:02 PM
1#! /usr/bin/perl -w
2# Mtik.pm - a simple Mikrotik Router API client
3# Version 1.0 Beta
4# Hugh Messenger - hugh at alaweb dot com
5# Released under Creative Commons license.
6# Do with it what you will, but don't blame me!
7#----------------
8
9package Mtik;
10$VERSION = '0.01';
11$debug = 0;
12$error_msg = '';
13
14use strict;
15use vars qw(
16 $VERSION
17 @ISA
18 @EXPORT
19 @EXPORT_OK
20 $debug
21 $error_msg
22 );
23
24use IO::Socket;
25use Digest::MD5;
26
27@ISA = qw(Exporter);
28@EXPORT = qw();
29@EXPORT_OK = qw(
30 $debug
31 $error_msg
32 );
33
34my($sock);
35my($sel);
36
37sub mtik_connect
38{
39 my($host) = shift;
40 my($port) = shift || 8728;
41 if (!($host))
42 {
43 print "no host!\n";
44 return 0;
45 }
46 my($sock) = new IO::Socket::INET(
47 PeerAddr => $host,
48 PeerPort => $port,
49 Proto => 'tcp',
50 Timeout => 3);
51 if (!($sock))
52 {
53 print "no socket :$!\n";
54 return 0;
55 }
56
57# $sel = IO::Select->new($sock);
58 return $sock;
59}
60
61sub write_word {
62 my($word) = shift;
63 &write_len(length($word));
64 print $sock $word;
65}
66
67sub write_sentence {
68 my($sentence_ref) = shift;
69 my(@sentence) = @$sentence_ref;
70 foreach my $word (@sentence)
71 {
72 write_word($word);
73 if ($debug > 2)
74 {
75 print "write_sentence: >>> $word\n";
76 }
77 }
78 write_word('');
79}
80
81sub write_len {
82 my($len) = shift;
83 if ($len < 0x80)
84 {
85 print $sock chr($len);
86 }
87 elsif ($len < 0x4000)
88 {
89 $len |= 0x8000;
90 print $sock chr(($len >> 8) & 0xFF);
91 print $sock chr($len & 0xFF);
92 }
93 elsif ($len < 0x200000)
94 {
95 $len |= 0xC00000;
96 print $sock chr(($len >> 16) & 0xFF);
97 print $sock chr(($len >> 8) & 0xFF);
98 print $sock chr($len & 0xFF);
99 }
100 elsif ($len < 0x10000000)
101 {
102 $len |= 0xE0000000;
103 print $sock chr(($len >> 24) & 0xFF);
104 print $sock chr(($len >> 16) & 0xFF);
105 print $sock chr(($len >> 8) & 0xFF);
106 print $sock chr($len & 0xFF);
107 }
108 else
109 {
110 print $sock chr(0xF0);
111 print $sock chr(($len >> 24) & 0xFF);
112 print $sock chr(($len >> 16) & 0xFF);
113 print $sock chr(($len >> 8) & 0xFF);
114 print $sock chr($len & 0xFF);
115 }
116}
117
118sub read_byte{
119 if ($debug > 4) { print "read_byte: start read_byte\n"; }
120
121 my $line;
122
123# $sel->can_read
124
125 $sock->recv($line,1);
126
127 if ($debug > 4) { print "read_byte: line=".$line."\n"; }
128 if ($debug > 4) { print "read_byte: line=".ord($line)."\n"; }
129
130 if ($line eq "") {
131 return -1;
132 } else {
133 return ord($line);
134 }
135}
136
137sub read_len {
138 if ($debug > 4) { print "read_len: start read_len\n"; }
139
140 my $len = read_byte();
141
142 if ($len == -1)
143 {
144 return -1;
145 }
146
147 if (($len & 0x80) == 0x00)
148 {
149 return $len
150 }
151 elsif (($len & 0xC0) == 0x80)
152 {
153 $len &= ~0x80;
154 $len <<= 8;
155 $len += read_byte();
156 }
157 elsif (($len & 0xE0) == 0xC0)
158 {
159 $len &= ~0xC0;
160 $len <<= 8;
161 $len += read_byte();
162 $len <<= 8;
163 $len += read_byte();
164 }
165 elsif (($len & 0xF0) == 0xE0)
166 {
167 $len &= ~0xE0;
168 $len <<= 8;
169 $len += read_byte();
170 $len <<= 8;
171 $len += read_byte();
172 $len <<= 8;
173 $len += read_byte();
174 }
175 elsif (($len & 0xF8) == 0xF0)
176 {
177 $len = read_byte();
178 $len <<= 8;
179 $len += read_byte();
180 $len <<= 8;
181 $len += read_byte();
182 $len <<= 8;
183 $len += read_byte();
184 }
185 if ($debug > 4)
186 {
187 print "read_len: read_len got $len\n";
188 }
189 return $len;
190}
191
192sub read_word {
193 if ($debug > 1) { print "read_word sub\n"; }
194
195 my($ret_line) = '';
196 my($len) = &read_len();
197 if ($len > 0)
198 {
199 if ($debug > 3)
200 {
201 print "read_word: recv $len\n";
202 }
203 while (1) {
204 my($line) = '';
205 $sock->recv($line,$len);
206 # append to $ret_line, in case we didn't get the whole word and are going round again
207 $ret_line .= $line;
208 my $got_len = length($line);
209
210 if ($got_len < $len)
211 {
212 # we didn't get the whole word, so adjust length and try again
213 $len -= $got_len;
214 }
215 else
216 {
217 # woot woot! we got the required length
218 last;
219 }
220 }
221 }
222 elsif($len == 0)
223 {
224 if ($debug > 3) { print "read_word: recv length = 0!\n"; }
225 }
226 elsif($len == -1)
227 {
228 if ($debug > 3) { print "read_word: recv length = -1!\n"; }
229 $ret_line = -1;
230 }
231
232 if ($debug > 3) { print "read_word: ret_line=$ret_line\n"; }
233 return $ret_line;
234}
235
236sub read_sentence {
237 if ($debug > 1) { print "read_sentence sub\n"; }
238
239 my ($word);
240 my ($i) = 0;
241 my (@reply);
242 my($retval) = 0;
243 while ($word = &read_word())
244 {
245 if ($debug > 1)
246 {
247 print "read_sentence: <<< $word\n"
248 }
249
250 if ($word == -1)
251 {
252 $retval = -1;
253 last;
254 }
255
256 if ($word =~ /!done/)
257 {
258 $retval = 1;
259 }
260 elsif ($word =~ /!trap/)
261 {
262 $retval = 2;
263 }
264 elsif ($word =~ /!fatal/)
265 {
266 $retval = 3;
267 }
268
269 $reply[$i++] = $word;
270 }
271 if ($debug > 3) { print "read_sentence: end while loop.\n"; }
272
273
274 return ($retval,@reply);
275}
276
277######## PUBLIC FUNCTIONS ############
278
279sub talk
280{
281 if ($debug > 1) { print "talk sub\n"; }
282
283 #my(@sentence) = shift;
284 my($sentence_ref) = shift;
285 my(@sentence) = @$sentence_ref;
286 &write_sentence(\@sentence);
287
288 my(@reply);
289 my(@attrs);
290 my($i) = 0;
291 my($retval) = 0;
292
293 while (($retval,@reply) = &read_sentence())
294 {
295
296 if ($debug > 3) { print "talk: retval=$retval\n"; }
297
298 if ($retval == -1)
299 {
300 last;
301 }
302
303 foreach my $line (@reply)
304 {
305 if ($line =~ /^=(\S+)=(.*)/s)
306 {
307 $attrs[$i]{$1} = $2;
308 }
309
310 }
311 if ($retval > 0)
312 {
313 last;
314 }
315 $i++;
316 }
317 return ($retval, @attrs);
318}
319
320sub raw_talk
321{
322 my(@sentence) = @{(shift)};
323 &write_sentence(\@sentence);
324 my(@reply);
325 my(@response);
326 my($i) = 0;
327 my($retval) = 0;
328 while (($retval,@reply) = &read_sentence())
329 {
330 if ($retval == -1)
331 {
332 last;
333 }
334
335 foreach my $line (@reply)
336 {
337 push(@response, $line);
338 }
339 if ($retval > 0)
340 {
341 last;
342 }
343 }
344 return ($retval,@response);
345}
346
347sub login
348{
349 my($host) = shift;
350 my($username) = shift;
351 my($passwd) = shift;
352
353 if ($debug > 1) { print "login sub\n"; }
354
355 if (!($sock = &mtik_connect($host)))
356 {
357 return 0;
358 }
359
360 my(@command);
361 push(@command,'/login');
362
363 my($retval,@results) = talk(\@command);
364
365 if ($results[0]{'ret'} ne "") {
366
367 # pre-v6.43
368 my($chal) = pack("H*",$results[0]{'ret'});
369 my($md) = new Digest::MD5;
370 $md->add(chr(0));
371 $md->add($passwd);
372 $md->add($chal);
373 my($hexdigest) = $md->hexdigest;
374 undef(@command);
375 push(@command, '/login');
376 push(@command, '=name=' . $username);
377 push(@command, '=response=00' . $hexdigest);
378 ($retval,@results) = &talk(\@command);
379
380 # pre 6.43 did not work, try post 6.43 login method
381 if ($retval > 1) {
382 # post-v6.43
383 &logout();
384
385 if (!($sock = &mtik_connect($host)))
386 {
387 return 0;
388 }
389
390 undef(@command);
391 push(@command, '/login');
392 push(@command, '=name=' . $username);
393 push(@command, '=password=' . $passwd);
394 ($retval,@results) = &talk(\@command);
395
396 }
397
398 }
399
400
401
402
403 if ($retval > 1)
404 {
405 $error_msg = $results[0]{'message'};
406 return 0;
407 }
408
409 if ($debug > 0) { print "login: Logged in to $host as $username\n"; }
410
411 return 1;
412}
413
414sub logout
415{
416 close $sock;
417}
418
419sub get_by_key
420{
421 my($cmd) = shift;
422 my($id) = shift || '.id';
423 $error_msg = '';
424 my(@command);
425 push(@command,$cmd);
426 my(%ids);
427 my($retval,@results) = &Mtik::talk(\@command);
428 if ($retval > 1)
429 {
430 $error_msg = $results[0]{'message'};
431 return %ids;
432 }
433 foreach my $attrs (@results)
434 {
435 my $key = '';
436 foreach my $attr (keys (%{$attrs}))
437 {
438 my $val = ${$attrs}{$attr};
439 if ($attr eq $id)
440 {
441 $key = $val;
442 #delete(${$attrs}{$attr});
443 }
444 }
445 if ($key)
446 {
447 $ids{$key} = $attrs;
448 }
449 }
450 return %ids;
451}
452
453sub mtik_cmd
454{
455 my($cmd) = shift;
456 my(%attrs) = %{(shift)};
457 $error_msg = '';
458 my(@command);
459 push(@command,$cmd);
460 foreach my $attr (keys (%attrs))
461 {
462 push(@command,'=' . $attr . '=' . $attrs{$attr});
463 }
464 my($retval,@results) = talk(\@command);
465 if ($retval > 1)
466 {
467 $error_msg = $results[0]{'message'};
468 }
469 return ($retval,@results);
470}
471
472sub mtik_query
473{
474 my($cmd) = shift;
475 my(%attrs) = %{(shift)};
476 my(%queries) = %{(shift)};
477 $error_msg = '';
478 my(@command);
479 push(@command,$cmd);
480 foreach my $attr (keys (%attrs))
481 {
482 push(@command,'=' . $attr . '=' . $attrs{$attr});
483 }
484 foreach my $query (keys (%queries))
485 {
486 push(@command,'?' . $query . '=' . $queries{$query});
487 }
488 my($retval,@results) = talk(\@command);
489 if ($retval > 1)
490 {
491 $error_msg = $results[0]{'message'};
492 }
493 return ($retval,@results);
494}
495
4961;
497