netdisco/bin/ieee-oui-import

#!/usr/bin/env perl

use strict;
use warnings;

our $home;

BEGIN {
  use FindBin;
  FindBin::again();

  $home = ($ENV{NETDISCO_HOME} || $ENV{HOME});

  # try to find a localenv if one isn't already in place.
  if (!exists $ENV{PERL_LOCAL_LIB_ROOT}) {
      use File::Spec;
      my $localenv = File::Spec->catfile($FindBin::RealBin, 'localenv');
      exec($localenv, $0, @ARGV) if -f $localenv;
      $localenv = File::Spec->catfile($home, 'perl5', 'bin', 'localenv');
      exec($localenv, $0, @ARGV) if -f $localenv;

      die "Sorry, can't find libs required for App::Netdisco.\n"
        if !exists $ENV{PERLBREW_PERL};
  }
}

BEGIN {
  use Path::Class;

  # stuff useful locations into @INC and $PATH
  unshift @INC,
    dir($FindBin::RealBin)->parent->subdir('lib')->stringify,
    dir($FindBin::RealBin, 'lib')->stringify;

  use Config;
  $ENV{PATH} = $FindBin::RealBin . $Config{path_sep} . $ENV{PATH};
}

use App::Netdisco;
use Dancer ':script';
use Dancer::Plugin::DBIC 'schema';

use HTTP::Tiny;
use Text::CSV 'csv';
use Math::BigInt;

binmode STDOUT, ":utf8";

my %urls = (
  MAL => 'https://raw.githubusercontent.com/netdisco/upstream-sources/master/ieee/MA/MA-L.csv',
  MAM => 'https://raw.githubusercontent.com/netdisco/upstream-sources/master/ieee/MA/MA-M.csv',
  MAS => 'https://raw.githubusercontent.com/netdisco/upstream-sources/master/ieee/MA/MA-S.csv',
);

my %oui = ();

foreach my $MA (sort keys %urls) {
    my $resp = HTTP::Tiny->new->get($urls{$MA});
    my $content = $resp->{content};
    my $aoh = csv( in => \$content, headers => 'auto', encoding => 'UTF-8' );
    foreach my $row (@$aoh) {
        next if $row->{'Organization Name'} eq 'IEEE Registration Authority';
        next if exists $oui{ lc $row->{'Assignment'} };

        $row->{abbrev} = shorten($row->{'Organization Name'});

        $row->{base} = lc $row->{'Assignment'};
        $row->{bits} = length($row->{base}) * 4;

        $row->{first} = $row->{'Assignment'} . '0' x ( 12 - length( $row->{'Assignment'} ) );
        $row->{last}  = $row->{'Assignment'} . 'F' x ( 12 - length( $row->{'Assignment'} ) );

        $row->{range} = '['. Math::BigInt->from_hex($row->{first})->as_int()
          .','. Math::BigInt->from_hex($row->{last})->as_int() .']';

        $oui{ $row->{base} } = $row;
    }
}

# roll everything back if we're testing
my $txn_guard = $ENV{ND2_DB_ROLLBACK}
  ? schema('netdisco')->storage->txn_scope_guard : undef;

schema('netdisco')->txn_do(sub{
    schema('netdisco')->resultset('Manufacturer')->delete;

    schema('netdisco')->resultset('Manufacturer')->populate([
        map {{
            company => $oui{$_}->{'Organization Name'},
            abbrev  => $oui{$_}->{abbrev},
            base    => $oui{$_}->{base},
            bits    => $oui{$_}->{bits},
            first   => $oui{$_}->{first},
            last    => $oui{$_}->{last},
            range   => $oui{$_}->{range},
        }} sort keys %oui
    ]);

    schema('netdisco')->storage->dbh_do(
      sub {
        my ($storage, $dbh, @args) = @_;

        local $dbh->{TraceLevel} =
            ($ENV{DBIC_TRACE} ? '1|SQL' : $dbh->{TraceLevel});

        $dbh->do(q{
            UPDATE node SET oui = (
              SELECT base FROM manufacturer
                WHERE ('x' || lpad( translate( mac::text, ':', ''), 16, '0')) ::bit(64) ::bigint <@ range
              LIMIT 1
            )
        });
      },
    );
});

exit 0;

# This subroutine is based on Wireshark's make-manuf
# http://anonsvn.wireshark.org/wireshark/trunk/tools/make-manuf
sub shorten {
    my $manuf = shift;

    #$manuf = decode("utf8", $manuf, Encode::FB_CROAK);
    $manuf = " " . $manuf . " ";

    # Remove any punctuation
    $manuf =~ tr/',.()/    /;

    # & isn't needed when Standalone
    $manuf =~ s/ \& / /g;

    # remove junk whitespace
    $manuf =~ s/\s+/ /g;

    # Remove any "the", "inc", "plc" ...
    $manuf
        =~ s/\s(?:the|inc|incorporated|plc|systems|corp|corporation|s\/a|a\/s|ab|ag|kg|gmbh|co|company|limited|ltd|holding|spa)(?= )//gi;

    # Convert to consistent case
    $manuf =~ s/(\w+)/\u\L$1/g;

    # Deviating from make-manuf for HP
    $manuf =~ s/Hewlett[-]?Packard/Hp/;

    # Truncate all names to first two words max 20 chars
    if (length($manuf) > 21) {
        my @twowords = grep {defined} (split ' ', $manuf)[0 .. 1];
        $manuf = join ' ', @twowords;
    }

    # Remove all spaces
    $manuf =~ s/\s+//g;

    #return encode( "utf8", $manuf );
    return $manuf;
}

__DATA__

    0C15C5000000   {
        Assignment               "0C15C5",
        bits                     24,
        first                    "0C15C5000000",
        last                     "0C15C5FFFFFF",
        "Organization Address"   "167, Churye-2Dong, Sasang-Gu, Busan   KR 617-716 " (dualvar: 167),
        "Organization Name"      "SDTEC Co., Ltd.",
        oui                      "0c:15:c5",
        Registry                 "MA-L",
        abbrev                   "Sdtec"
    },

    [98] {
             Assignment               "8C1F64117" (dualvar: 8),
             "Organization Address"   "Spinnereistrasse 10 St. Gallen  CH 9008 ",
             "Organization Name"      "Grossenbacher Systeme AG",
             Registry                 "MA-S"
         },