File Coverage

blib/lib/Net/MAC/Vendor.pm
Criterion Covered Total %
statement 135 152 88.8
branch 26 44 59.0
condition 3 3 100.0
subroutine 28 29 96.5
pod 16 16 100.0
total 208 244 85.2


line stmt bran cond sub pod time code
1             package Net::MAC::Vendor;
2 9     9   10156 use strict;
  9         23  
  9         262  
3              
4 9     9   131 use v5.10;
  9         35  
5              
6             =encoding utf8
7              
8             =head1 NAME
9              
10             Net::MAC::Vendor - look up the vendor for a MAC
11              
12             =head1 SYNOPSIS
13              
14             use Net::MAC::Vendor;
15              
16             my $mac = "00:0d:93:29:f6:c2";
17              
18             my $array = Net::MAC::Vendor::lookup( $mac );
19              
20             You can also run this as a script with as many arguments as you
21             like. The module realizes it is a script, looks up the information
22             for each MAC, and outputs it.
23              
24             perl Net/MAC/Vendor.pm 00:0d:93:29:f6:c2 00:0d:93:29:f6:c5
25              
26             =head1 DESCRIPTION
27              
28             The Institute of Electrical and Electronics Engineers (IEEE) assigns
29             an Organizational Unique Identifier (OUI) to manufacturers of network
30             interfaces. Each interface has a Media Access Control (MAC) address
31             of six bytes. The first three bytes are the OUI.
32              
33             This module allows you to take a MAC address and turn it into the OUI
34             and vendor information. You can, for instance, scan a network,
35             collect MAC addresses, and turn those addresses into vendors. With
36             vendor information, you can often guess at what what you are looking
37             at (I an Apple product).
38              
39             You can use this as a module as its individual functions, or call it
40             as a script with a list of MAC addresses as arguments. The module can
41             figure it out.
42              
43             The IEEE moves the location of its OUI file. If they do that again, you
44             can set the C environment variable to get the new
45             URL without updating the code.
46              
47             Here are some of the old URLs, which also flip-flop schemes:
48              
49             http://standards.ieee.org/regauth/oui/oui.txt
50             https://standards.ieee.org/regauth/oui/oui.txt
51             http://standards-oui.ieee.org/oui.txt
52              
53             There are older copies of the OUI file in the GitHub repository.
54              
55             These files are large (about 4MB), so you might want to cache a copy.
56              
57             A different source of information is linuxnet.ca that publishes sanitized
58             and compressed versions of the list, such as:
59              
60             http://linuxnet.ca/ieee/oui.txt.bz2
61              
62             The module can read and decompress compressed versions (as long as the url
63             reflects the compression type in the filename as the linuxnet.ca links do).
64              
65             =head2 Functions
66              
67             =over 4
68              
69             =cut
70              
71 9     9   96 use Exporter qw(import);
  9         22  
  9         406  
72              
73             __PACKAGE__->run( @ARGV ) unless caller;
74              
75 9     9   53 use Carp;
  9         32  
  9         646  
76 9     9   5519 use Compress::Bzip2 qw(memBunzip);
  9         90291  
  9         1526  
77 9     9   7010 use Compress::Zlib qw(memGunzip);
  9         575123  
  9         816  
78 9     9   5140 use Mojo::URL;
  9         922134  
  9         113  
79 9     9   5873 use Mojo::UserAgent;
  9         1757606  
  9         94  
80              
81             our $VERSION = '1.261';
82              
83             =item run( @macs )
84              
85             If I call this module as a script, this class method automatically
86             runs. It takes the MAC addresses and prints the registered vendor
87             information for each address. I can pass it a list of MAC addresses
88             and run() processes each one of them. It prints out what it
89             discovers.
90              
91             This method does try to use a cache of OUI to cut down on the
92             times it has to access the network. If the cache is fully
93             loaded (perhaps using C), it may not even use the
94             network at all.
95              
96             =cut
97              
98             sub run {
99 1     1 1 2835 my $class = shift;
100              
101 1         6 foreach my $arg ( @_ ) {
102 1         6 my $lines = lookup( $arg );
103 1 50       8 return unless defined $lines;
104              
105 1         6 unshift @$lines, $arg;
106              
107 1         16 print join "\n", @$lines, '';
108             }
109              
110 1         8 return 1;
111             }
112              
113             =item ua
114              
115             Return the Mojo::UserAgent object used to fetch resources.
116              
117             =cut
118              
119             sub ua {
120 19     19 1 5847 state $ua = Mojo::UserAgent->new->max_redirects(3);
121 19         251 $ua;
122             }
123              
124             =item lookup( MAC )
125              
126             Given the MAC address, return an anonymous array with the vendor
127             information. The first element is the vendor name, and the remaining
128             elements are the address lines. Different records may have different
129             numbers of lines, although the first two should be consistent.
130              
131             This makes a direct request to the IEEE website for that OUI to return
132             the information for that vendor.
133              
134             The C function explains the possible formats
135             for MAC.
136              
137             =cut
138              
139             sub lookup {
140 1     1 1 3 my $mac = shift;
141              
142 1         5 $mac = normalize_mac( $mac );
143 1         6 my $lines = fetch_oui( $mac );
144              
145 1         6 return $lines;
146             }
147              
148             =item normalize_mac( MAC )
149              
150             Takes a MAC address and turns it into the form I need to
151             send to the IEEE lookup, which is the first six bytes in hex
152             separated by hyphens. For instance, 00:0d:93:29:f6:c2 turns
153             into 00-0D-93.
154              
155             The input string can be a separated by colons or hyphens. They
156             can omit leading 0's (which might make things look odd). We
157             only need the first three bytes
158              
159             00:0d:93:29:f6:c2 # usual form
160              
161             00-0d-93-29-f6-c2 # with hyphens
162              
163             00:0d:93 # first three bytes
164              
165             0:d:93 # missing leading zero
166              
167             :d:93 # missing all leading zeros
168              
169             =cut
170              
171             sub normalize_mac {
172 9     9   1875 no warnings 'uninitialized';
  9         25  
  9         11828  
173              
174 29     29 1 6049 my $input = uc shift;
175              
176 29 100       157 do {
177 1         76 carp "Could not normalize MAC [$input]";
178             return
179 1         4 } if $input =~ m/[^0-9a-f:-]/i;
180              
181             my @bytes =
182 72         271 grep { /^[0-9A-F]{2}$/ }
183 72         300 map { sprintf "%02X", hex }
184 28         177 grep { defined }
  75         183  
185             ( split /[:-]/, $input )[0..2];
186              
187 28 100       117 do {
188 5         630 carp "Could not normalize MAC [$input]";
189             return
190 5         24 } unless @bytes == 3;
191              
192 23         81 my $mac = join "-", @bytes;
193              
194 23         72 return $mac;
195             }
196              
197             =item fetch_oui( MAC )
198              
199             Looks up the OUI information on the IEEE website, or uses a cached
200             version of it. Pass it the result of C and you
201             should be fine.
202              
203             The C function explains the possible formants for
204             MAC.
205              
206             To avoid multiple calls on the network, use C to preload
207             the entire OUI space into an in-memory cache. This can take a long
208             time over a slow network, though; the file is about 60,000 lines.
209              
210             Also, the IEEE website has been flaky lately, so loading the cache is
211             better. This distribution comes with several versions of the complete
212             OUI data file.
213              
214             =cut
215              
216             sub fetch_oui {
217             # fetch_oui_from_custom( $_[0] ) ||
218 3 50   3 1 2853 fetch_oui_from_cache( $_[0] ) ||
219             fetch_oui_from_ieee( $_[0] );
220             }
221              
222             =item fetch_oui_from_custom( MAC, [ URL ] )
223              
224             Looks up the OUI information from the specified URL or the URL set
225             in the C environment variable.
226              
227             The C function explains the possible formants for
228             MAC.
229              
230             =cut
231              
232             sub fetch_oui_from_custom {
233 3     3 1 4105 my $mac = normalize_mac( shift );
234 3   100     18 my $url = shift // $ENV{NET_MAC_VENDOR_OUI_SOURCE};
235              
236 3 100       12 return unless defined $url;
237              
238 2         11 my $html = __PACKAGE__->_fetch_oui_from_url( $url );
239 2 50       10 unless( defined $html ) {
240 2         278 carp "Could not fetch data from the IEEE!";
241 2         18 return;
242             }
243              
244             parse_oui(
245 0         0 extract_oui_from_html( $html, $mac )
246             );
247             }
248              
249             =item fetch_oui_from_ieee( MAC )
250              
251             Looks up the OUI information on the IEEE website. Pass it the result
252             of C and you should be fine.
253              
254             The C function explains the possible formants for
255             MAC.
256              
257             =cut
258              
259             sub _search_url_base {
260             # https://services13.ieee.org/RST/standards-ra-web/rest/assignments/download/?registry=MA-L&format=html&text=00-0D-93
261 4     4   28 state $url = Mojo::URL->new(
262             'https://services13.ieee.org/RST/standards-ra-web/rest/assignments/download/?registry=MA-L&format=html'
263             );
264              
265 4         648 $url;
266             }
267              
268             sub _search_url {
269 4     4   13 my( $class, $mac ) = @_;
270 4         13 my $url = $class->_search_url_base->clone;
271 4         346 $url->query->merge( text => $mac );
272 4         1295 $url;
273             }
274              
275             sub fetch_oui_from_ieee {
276 4     4 1 2786 my $mac = normalize_mac( shift );
277              
278 4         17 my @urls = __PACKAGE__->_search_url( $mac );
279              
280 4         9 my $html;
281 4         11 URL: foreach my $url ( @urls ) {
282 4         15 $html = __PACKAGE__->_fetch_oui_from_url( $url );
283 4 50       25 next URL unless defined $html;
284 4         15 last;
285             }
286              
287 4 50       27 unless( defined $html ) {
288 0         0 carp "Could not fetch data from the IEEE!";
289 0         0 return;
290             }
291              
292             parse_oui(
293 4         23 extract_oui_from_html( $html, $mac )
294             );
295             }
296              
297             sub _fetch_oui_from_url {
298 6     6   26 my( $class, $url ) = @_;
299 6         14 my $tries = 0;
300              
301 6 50       21 return unless defined $url;
302              
303             TRY: {
304 6         13 my $tx = __PACKAGE__->ua->get( $url );
  16         235  
305 16 100       37383021 unless( $tx->success ) {
306 12 100       383 if( $tries > 3 ) {
307 2         13 carp "Failed fetching [$url]: " . $tx->res->code;
308 2         727 return;
309             }
310              
311 10         27 $tries++;
312 10         22001634 sleep 1 * $tries;
313 10         1803 redo TRY;
314             }
315              
316 4         159 my $html = $tx->res->body;
317 4 50       186 unless( defined $html ) {
318 0         0 carp "No content in response for [$url]!";
319 0         0 return;
320             }
321              
322 4         168 return $html;
323             }
324             }
325              
326             =item fetch_oui_from_cache( MAC )
327              
328             Looks up the OUI information in the cached OUI information (see
329             C).
330              
331             The C function explains the possible formats for
332             MAC.
333              
334             To avoid multiple calls on the network, use C to preload
335             the entire OUI space into an in-memory cache.
336              
337             If it doesn't find the MAC in the cache, it returns nothing.
338              
339             =cut
340              
341             sub fetch_oui_from_cache {
342 4     4 1 372 my $mac = normalize_mac( shift );
343              
344 4         28 __PACKAGE__->get_from_cache( $mac );
345             }
346              
347             =item extract_oui_from_html( HTML, OUI )
348              
349             Gets rid of the HTML around the OUI information. It may still be
350             ugly. The HTML is the search results page of the IEEE ouisearch
351             lookup.
352              
353             Returns false if it could not extract the information. This could
354             mean unexpected input or a change in format.
355              
356             =cut
357              
358             sub extract_oui_from_html {
359 6     6 1 3938 my $html = shift;
360 6         151 my $lookup_mac = normalize_mac( shift );
361              
362 6         157 my( $record ) = $html =~ m|
($lookup_mac.*?)
|is;
363 6         53 $record =~ s|||g;
364              
365 6 100       28 return unless defined $record;
366 5         27 return $record;
367             }
368              
369             =item parse_oui( STRING )
370              
371             Takes a string that looks like this:
372              
373             00-03-93 (hex) Apple Computer, Inc.
374             000393 (base 16) Apple Computer, Inc.
375             20650 Valley Green Dr.
376             Cupertino CA 95014
377             UNITED STATES
378              
379             and turns it into an array of lines. It discards the first
380             line, strips the leading information from the second line,
381             and strips the leading whitespace from all of the lines.
382              
383             With no arguments, it returns an empty anonymous array.
384              
385             =cut
386              
387             sub parse_oui {
388 22302     22302 1 36978 my $oui = shift;
389 22302 100       45430 return [] unless $oui;
390 22294         37165 $oui =~ s|||g;
391 22294 50       334405 my @lines = map { s/^\s+//; $_ ? $_ : () } split /\s*$/m, $oui;
  105336         227348  
  105336         252608  
392 22294         45400 chomp @lines;
393 22294         35535 splice @lines, 1, 1, (); # should have documented this!
394              
395 22294         61908 $lines[0] =~ s/\S+\s+\S+\s+//;
396 22294         56752 return \@lines;
397             }
398              
399             =item oui_url
400              
401             =item oui_urls
402              
403             Returns the URLs of the oui.txt resource. The IEEE likes to move this
404             around. These are the default URL that C will use, but you
405             can also supply your own with the C environment
406             variable.
407              
408             =cut
409              
410 6     6 1 3250000 sub oui_url { (grep { /\Ahttp:/ } &oui_urls)[0] }
  6         71  
411              
412             sub oui_urls {
413 7     7 1 3035 my @urls = 'http://standards-oui.ieee.org/oui.txt';
414              
415             unshift @urls, $ENV{NET_MAC_VENDOR_OUI_URL}
416 7 50       33 if defined $ENV{NET_MAC_VENDOR_OUI_URL};
417              
418 7         24 @urls;
419             }
420              
421             =item load_cache( [ SOURCE[, DEST ] ] )
422              
423             Downloads the current list of all OUIs in SOURCE, parses it with C,
424             and stores it in the cache. The C will use this cache if it exists.
425              
426             By default, this uses the URL from C,
427             but given an argument, it tries to use that. To load from a local
428             file, use the C scheme.
429              
430             If the url indicates that the data is compressed, the response content is
431             decompressed before being stored.
432              
433             If C cannot load the data, it issues a warning and returns
434             nothing.
435              
436             This previously used DBM::Deep if it was installed, but that was much
437             too slow. Instead, if you want persistence, you can play with
438             C<$Net::MAC::Vendor::Cached> yourself.
439              
440             If you want to store the data fetched for later use, add a destination
441             filename to the request. To fetch from the default location and store,
442             specify C as source.
443              
444             =cut
445              
446             sub load_cache {
447 1     1 1 5711 my( $source, $dest ) = @_;
448              
449 1         5 my $data = do {;
450 1 50       8 if( defined $source ) {
451 1 50       23 unless( -e $source ) {
452 0         0 carp "Net::Mac::Vendor cache source [$source] does not exist";
453 0         0 return;
454             }
455              
456 1         2 do { local( @ARGV, $/ ) = $source; <> }
  1         10  
  1         3010  
457             }
458             else {
459             #say time . " Fetching URL";
460 0         0 my $url = oui_url();
461 0         0 my $tx = __PACKAGE__->ua->get( $url );
462             #say time . " Fetched URL";
463             #say "size is " . $tx->res->headers->header( 'content-length' );
464 0 0       0 ($url =~ /\.bz2/) ? memBunzip($tx->res->body) :
    0          
465             ($url =~ /\.gz/) ? memGunzip($tx->res->body) :
466             $tx->res->body;
467             }
468             };
469              
470 1 50       14 if( defined $dest ) {
471 0 0       0 if( open my $fh, '>:utf8', $dest ) {
472 0         0 print { $fh } $data;
  0         0  
473 0         0 close $fh;
474             }
475             else { # notify on error, but continue
476 0         0 carp "Could not write to '$dest': $!";
477             }
478             }
479              
480              
481             # The PRIVATE entries fill in a template with no
482             # company name or address, but the whitespace is
483             # still there. We need to split on a newline
484             # followed by some potentially horizontal whitespace
485             # and another newline
486 1         14 my $CRLF = qr/(?:\r?\n)/;
487 1         253775 my @entries = split /[\t ]* $CRLF [\t ]* $CRLF/x, $data;
488 1         23 shift @entries;
489              
490 1         12 my $count = '';
491 1         7 foreach my $entry ( @entries ) {
492 22296         47482 $entry =~ s/^\s+//;
493 22296         39767 my $oui = substr $entry, 0, 8;
494 22296         39918 __PACKAGE__->add_to_cache( $oui, parse_oui( $entry ) );
495             }
496              
497 1         1848 return 1;
498             }
499              
500             =back
501              
502             =head1 Caching
503              
504             Eventually I want people to write their own caching classes so I've
505             created some class methods for this.
506              
507             =over 4
508              
509             =cut
510              
511 0         0 BEGIN {
512 9     9   292 my $Cached = {};
513              
514             =item add_to_cache( OUI, PARSED_DATA )
515              
516             Add to the cache. This is mostly in place for a future expansion to
517             full objects so you can override this in a subclass.
518              
519             =cut
520              
521             sub add_to_cache {
522 22296     22296 1 40314 my( $class, $oui, $parsed ) = @_;
523              
524 22296         77092 $Cached->{ $oui } = $parsed;
525             }
526              
527             =item get_from_cache( OUI )
528              
529             Get from the cache. This is mostly in place for a future expansion to
530             full objects so you can override this in a subclass.
531              
532             =cut
533              
534             sub get_from_cache {
535 4     4 1 11 my( $class, $oui ) = @_;
536              
537 4         24 $Cached->{ $oui };
538             }
539              
540             =item get_cache_hash()
541              
542             Get the hash the built-in cache uses. You should only use this if you
543             were using the old C<$Cached> package variable.
544              
545             =cut
546              
547 0     0 1   sub get_cache_hash { $Cached }
548             }
549              
550             =back
551              
552             =head1 SEE ALSO
553              
554             L
555              
556             =head1 SOURCE AVAILABILITY
557              
558             The source is in Github:
559              
560             git://github.com/briandfoy/net-mac-vendor.git
561              
562             =head1 AUTHOR
563              
564             brian d foy C<< >>
565              
566             =head1 COPYRIGHT AND LICENSE
567              
568             Copyright © 2004-2015, brian d foy C<< >>. All rights reserved.
569              
570             This program is free software; you can redistribute it and/or modify
571             it under the same terms as Perl itself.
572              
573             =cut
574              
575             1;