smeserver-lib/root/usr/share/perl5/vendor_perl/esmith/ethernet.pm

134 lines
3.9 KiB
Perl

#----------------------------------------------------------------------
# Copyright 1999-2005 Mitel Networks Corporation
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#----------------------------------------------------------------------
package esmith::ethernet;
#----------------------------------------------------------------------
use strict;
use File::Basename;
=head1 NAME
esmith::ethernet - Ethernet-related utility routines for e-smith
=head1 VERSION
This file documents C<esmith::ethernet> version B<1.4.0>
=head1 SYNOPSIS
use esmith::ethernet;
=head1 DESCRIPTION
This module contains routines for
=pod
=head2 probeAdapters()
Probe for any recognised adapters
=cut
sub probeAdapters ()
{
opendir(my $dh, "/sys/class/net") or die "Couldn't open /sys/class/net: $!";
my @nics = grep { $_ !~ m/^\./ } readdir($dh);
closedir($dh);
my $adapters = '';
my $index = 1;
foreach my $nic (@nics){
# Untaint $nic and makes sure the name looks OK
next unless ($nic =~ m/^(\w+[\.:]?\d+)$/);
$nic = $1;
next if (
# skip loopback
$nic eq 'lo' ||
# skip non links
!-l "/sys/class/net/$nic" ||
# skip wireless nics
-d "/sys/class/net/$nic/wireless" ||
-l "/sys/class/net/$nic/phy80211" ||
# skip bridges
-d "/sys/class/net/$nic/bridge" ||
# skip vlans
-f "/proc/net/vlan/$nic" ||
# skip bonds
-d "/sys/class/net/$nic/bonding" ||
# skip tun/tap
-f "/sys/class/net/$nic/tun_flags" ||
# skip dummy
-d "/sys/devices/virtual/net/$nic"
);
# Now we should be left only wth ethernet adapters
open HW, "/sys/class/net/$nic/address";
my $mac = join("", <HW>);
close HW;
# Check MAC Addr and untaint it
next unless ($mac =~ m/^(([\da-f]{2}:){5}[\da-f]{2})$/i);
$mac = $1;
# If the device is a slave of a bridge, it's real MAC
# address can be found in /proc/net/bonding/bondX
if (-l "/sys/class/net/$nic/master"){
my $bond = basename (readlink "/sys/class/net/$nic/master");
local $/ = '';
open SLAVES, "/proc/net/bonding/$bond";
my @slaves = <SLAVES>;
close SLAVES;
my @slaveInfo = grep { /^Slave\ Interface:\ $nic/m } @slaves;
foreach (split /\n+/, (join "", @slaveInfo)){
$mac = $1 if (/^Permanent\ HW\ addr:\ (.*)$/);
}
}
chomp($mac);
my $driver = basename (readlink "/sys/class/net/$nic/device/driver");
# Untaint driver name
next unless ($driver =~ m/^([\w\-]+)$/);
$driver = $1;
my $bus = basename (readlink "/sys/class/net/$nic/device/subsystem");
my $desc = $nic;
if ($bus eq 'pci'){
my $dev = basename (readlink "/sys/class/net/$nic/device");
# Untaint $dev
if ($dev =~ m/^(\d+:\d+:\d+\.\d+)$/){
$dev = $1;
$desc = `/sbin/lspci -s $dev`;
# Extract only description
$desc =~ m/^.*:.*:\s+(.*)\s*/;
$desc = $1;
}
}
elsif ($bus eq 'virtio'){
$desc = 'Virtio Network Device';
}
# TODO: we should also try to get the description of USB devices
$adapters .= "EthernetDriver" . $index++ . "\t" . $driver . "\t" .
$mac . "\t" . "\"$desc\"" . "\t" . $nic ."\n";
}
return $adapters;
}
#----------------------------------------------------------------------
# Return one to make the import process return success.
#----------------------------------------------------------------------
1;
=pod
=AUTHOR
SME Server Developers <bugs@e-smith.com>
For more information see http://www.e-smith.org/
=cut