#!/usr/bin/perl

# rename-eths -- Make network interfaces named from ifcfg-interface

# make Ethernet interface names the same as the configuration in
# /etc/sysconfig/network-scripts/ifcfg-*, given by DEVICE=name
# Match them by MAC address.

# Allow names to be different to start with than the names in the
# ifcfg-* files.

# This is to be run from systemd.

# Copyright (C) 2016  Nick Urbanik <nicku@nicku.org>

# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

use strict;
use warnings;
use Getopt::Long;
use Data::Dumper;
use IO::File;

use Carp;
use Cwd;
$Data::Dumper::Indent    = 1;
$Data::Dumper::Quotekeys = 0;
$Data::Dumper::Sortkeys  = 1;
$Data::Dumper::Deepcopy  = 1;
my $LOGDIR = '/var/log/rename-eths';

sub usage {
    ( my $prog = $0 ) =~ s{.*/}{};
    print <<END_USAGE;
$prog [--dry-run] [--debug]
$prog [--help]

END_USAGE
    exit 0;
}

sub _utime_to_iso {
    my ( $utime ) = @_;
    my( $sec, $min, $hour, $mday, $mon, $year ) = localtime $utime;
    return sprintf '%04d-%02d-%02d %02d:%02d:%02d',
        $year + 1900, $mon + 1, $mday, $hour, $min, $sec
}
{
    my $log_fh;
    mkdir $LOGDIR or CORE::warn "CANNOT CREATE LOG DIRECTORY $LOGDIR"
        unless -d $LOGDIR;
    ( my $prog = $0 ) =~ s{.*/}{};
    my ( $min, $hour, $mday, $mon, $year ) = ( localtime )[ 1..5 ];
    my $timestamp = sprintf '%04d%02d%02d-%02d%02d',
        $year + 1900, $mon + 1, $mday, $hour, $min;
    my $logfile = "$LOGDIR/$prog-$timestamp.log";

    sub note {
        my @msg = @_;
        push @msg, '[EMPTY MESSAGE]' unless @msg;

        $msg[ -1 ] =~ s{[\n\r ]*$}{};
        my $timestamp_pid = _utime_to_iso( time ) . " [$$]: ";
        $msg[ 0 ] = "$timestamp_pid$msg[ 0 ]";
        s{[\n\r]}{\n$timestamp_pid}msg foreach @msg;

        unless ( $log_fh and -f $logfile and ( stat _ )[1] == ( $log_fh->stat )[1] ) {
            $log_fh = IO::File->new( $logfile, O_WRONLY|O_CREAT|O_APPEND, 0644 )
                or CORE::warn  "Cannot open '$logfile': $!";
            $log_fh->autoflush( 1 );
        }
        print $log_fh @msg, "\n"
            or CORE::warn "Cannot write '", @msg, "' to '$logfile': $!";

        return 1;
    }
}

my $debug;

sub debug {
    return unless $debug;
    goto &note;
}

# The die and warn handlers are disabled while they run (p. 655 of Cookbook 2e),
# so we don't death spiral calling warn from note.
$SIG{__WARN__} = sub {
    note "WARNING:\n", Carp::longmess, @_;
    warn @_;
};

$SIG{__DIE__} = sub {
    note "TERMINATING:\n", Carp::longmess, @_ unless $^S;
    die @_;
};

sub slurp_file_lines {
    my ( $file ) = @_;
    open my $fh, '<', $file
        or die "Cannot open '$file': $!";
    my @text = <$fh>;
    close $fh;
    chomp @text if @text;
    return @text;
}

sub get_eths {
    my $dir = getcwd;
    chdir '/sys/class/net'
        or die "Cannot chdir to '/sys/class/net': $!";
    #my @eths = grep { -d } glob( 'eth*' );
    my @eths = grep { $_ ne 'lo' and -d } glob( '*' );
    chdir $dir or die "Cannot chdir to '$dir': $!";
    return @eths;
}

sub get_distinct {
    my %seen;
    my @diff = grep { ! $seen{$_}++ } @_;
    return @diff;
}

sub only_good_macs {
    return grep { m{(?:[a-f\d]{2}:){5}[a-f\d]{2}$}i } @_;
}

sub get_eths_macs {
    my %dev;
    my @eths = get_eths();
    chdir '/sys/class/net'
        or die "Cannot chdir to '/sys/class/net': $!";
    for my $eth ( @eths ) {
        if ( -r "$eth/address" ) {
            my @mac = only_good_macs
                map { uc } slurp_file_lines( "$eth/address" );
            next unless $mac[ 0 ];

            $dev{$mac[ 0 ]} = $eth;
            debug "DEV: '$eth' MAC: '$mac[ 0 ]'\n";
        }
        else {
            my ( $mac ) = qx{ip -o link show $eth}
                        =~ m{\blink/\S*\s([a-f\d:]{17})};
            next unless $mac and $mac =~ m{(?:[a-f\d]{2}:){5}[a-f\d]{2}$}i;
            $dev{ uc $mac } = $eth;
            debug "ip: DEV: '$eth' MAC: '$mac'\n";
        }
    }
    return %dev;
}

sub get_config_hwaddr {
    chdir '/etc/sysconfig/network-scripts'
        or die "Cannot chdir to '/etc/sysconfig/network-scripts': $!";

    my %conf;
    for my $eth ( get_eths() ) {
        debug "looking at ifcfg-$eth\n";
        next unless -r "ifcfg-$eth";
        debug "Found ifcfg-$eth\n";
        my @conf = slurp_file_lines "ifcfg-$eth";
        my @devs = get_distinct map { m{^\s*DEVICE=['"]?(\S+?)['"]?\s*$} } @conf;
        warn "No DEVICE= statements in ifcfg-$eth\n" and next
            unless @devs;
        debug "DEVS: @devs\n";
        my @diffs = grep { $_ ne $eth } @devs;
        warn "@diffs from ifcfg-$eth should be $eth??\n" if @diffs;
        warn "Different multiple DEVICE= statements for $eth: @devs\n"
            if @devs > 1;

        my @hwaddr = only_good_macs get_distinct
            map { m{^\s*HWADDR=['"]?(\S+?)['"]?\s*$} } @conf;
        next unless @hwaddr;
        debug "HWADDR: @hwaddr\n";
        warn "Different HWADDR= statements in ifcfg-$eth: @hwaddr\n"
            if @hwaddr > 1;
        $conf{ uc $hwaddr[ 0 ] } = $eth;
    }
    return %conf;
}

# Generate a list of moves that do not include
# moving an Ethernet device name to itself:

sub find_required_moves {
    my ( $hw, $conf ) = @_;
    my %move;
    while ( my ( $mac, $dev ) = each %$conf ) {
        if ( exists $hw->{$mac} and $hw->{$mac} ne $dev ) {
            $move{$hw->{$mac}} = $dev;
        }
    }
    return %move;
}


sub move {
    my ( $src, $dst, $dry_run ) = @_;
    die "src=$src, dst=$dst; undefined value:"
        unless defined $src and defined $dst;
    return if $src eq $dst;
    my @cmd = ( 'ip', 'link', 'set', 'name', $dst, 'dev', $src );
    note "EXECUTE: @cmd\n";
    return if $dry_run;
    system( @cmd ) == 0 or warn "Failed to execute @cmd: $?";
}

sub show_chain {
    my @chain = @_;
    return unless $debug;
    note '-' x 18, "\n";
    for my $c ( @chain ) {
        note sprintf "[ %-5s -> %-5s ]\n", @{$c}{ qw( src dst ) };
    }
    note '-' x 18, "\n";
}

# A chain of two involves moving an Ethernet interface to
# a name that is not used.
# A longer chain requires a temporary name to avoid
# trying to have two network interfaces with the same name.
# When we have a longer chain, we expect the first source
# to have the same name as the last target.

sub make_chain {
    my ( $moves ) = @_;
    die "usage: make_chain( \%moves )"
        unless ref $moves eq 'HASH';
    return unless keys %$moves;
    my @chain;
    my $eth = ( sort keys %$moves )[ 0 ];
    while ( 1 ) {
        unshift @chain, { src => $eth, dst => $moves->{$eth} };
        my $last = delete $moves->{$eth};
        die "Moving an interface '$eth' to itself\n"
            if $eth eq $last;
        last unless exists $moves->{$last};
        $eth = $last;
    }
    warn "No chain for $moves?" and return
        unless @chain;
    return @chain if @chain == 1;
    my $first_dest  = $chain[  0 ]{dst};
    my $last_source = $chain[ -1 ]{src};
    die "Expect first destination='$first_dest' and last ",
        "source='$last_source' to be the same in this chain:\n",
        show_chain( @chain )
        unless $first_dest eq $last_source;
    unshift @chain, { src => $first_dest, dst => 'tmp' };
    $chain[ -1 ]{src} = 'tmp';
    return @chain;
}

sub remove_moves_to_self {
    my %move = @_;
    my @srcs = sort keys %move;
    for my $src ( @srcs ) {
        delete $move{$src} if $move{$src} eq $src;
    }
    return %move;
}

sub process_moves {
    my ( $moves, $dry_run ) = @_;
    for my $mv ( @$moves ) {
        move( @{$mv}{ qw( src dst ) }, $dry_run );
    }
}

note "$0 starting";

GetOptions(
    help => \&usage,
    debug => \$debug,
    'dry-run' => \my $dry_run,
) or usage;

my %hw   = get_eths_macs();
my %conf = get_config_hwaddr();
my %move = find_required_moves( \%hw, \%conf );

note( Data::Dumper->Dump( [ \%hw, \%conf, \%move ],
                          [ qw( *hw *conf *move ) ] ) );

while ( keys %move ) {
    my @chain = make_chain( \%move );
    show_chain( @chain );
    process_moves( \@chain, $dry_run );
}

note "$0 finishing";

END {
    exit 0;
}