#
#    Copyright (C) 2010 Alexandros Stergiakis <alsterg@gmail.com>
#
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU Affero General Public License as
#    published by the Free Software Foundation, either version 3 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 Affero General Public License for more details.
#
#    You should have received a copy of the GNU Affero General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
#

#//#
# The "interface" module defines commands for interface configuration. 
#
# @todo Better value checking within each handler: Mtu, Mac, ...
#//#

module require base 1.0
module provide interface 1.0

namespace eval ::module::interface {
    
namespace import ::helper::* ::module::api::* \
    ::module::base::dlist_procedures \
    ::module::base::dlist_avail_procs

namespace export dlist_interfaces \
                 get_interfaces \
                 get_mac \
                 get_state \
                 get_mtu \
                 iface_print_callback \
                 iface_rename_callback

proc description {} {
    return "Interface configuration"
}

proc version {} {
    
}

proc check {} {
    foreach feature [list \
                     CONFIG_NAMEIF \
                     CONFIG_IFCONFIG \
                     CONFIG_IFPLUGD \
                     CONFIG_FEATURE_IFCONFIG_STATUS \
                     CONFIG_FEATURE_IFCONFIG_SLIP \
                     CONFIG_FEATURE_IFCONFIG_HW \
                     CONFIG_FEATURE_IFCONFIG_BROADCAST_PLUS] {
        if {! [::helper::busybox_has $feature]} { ;# Can return error.
            error "Busybox doesn't have support for $feature."
        }
    }
}

proc reset {} {
    variable renames
    variable interface

    # All interfaces present on boot are 'up' by default, shutdown is explicitly listed in running-conf,
    # for those interfaces that need to be in 'down' state. Any interface however that appears after boot
    # will be on any state the kernel puts it, typically in 'down' state. That's why we use get_state,
    # so that we are able to sence the state of newly created interfaces as dictated by the kernel.    
    foreach iface [get_interfaces] {
        exec ifconfig $iface up 
    }
    
    # Restore original names.
    foreach iface [array names renames] {
        set mac [get_mac $iface]
        exec nameif -s $renames($iface) $mac
        unset renames($iface)
        unset interface($iface)
    }
    
    array set renames {}
    array set interface {}
    
    foreach iface [get_interfaces] {
        set interface($iface) [dict create]
    }
}

proc constructor {} {
    Global BASE_DIR
    
    log::Info "Loading \"interface\" module: [description]"
    
    check

    # Mapping of <current name> => <original name> of an interface.
    # An entry only present if interface has been renamed.
    variable renames
    array set renames {}
    
    # Mapping of <interface> => <dict> of interface properties.
    variable interface
    array set interface {}
    
    # List of callback procedures to execute while generating the
    # interface running configuration section. This flexibility is
    # not currently provided from the XML-based mechanism.
    # Order matters. They are executed in order of registration.
    # No need to reset this variable.
    variable print_callbacks [list]
    
    log::Debug "Interfaces found: [get_interfaces]"
    
    reset
    
    #        -f/-F           Treat link detection error as link down/link up
    #                        (otherwise exit on error)
    #        -a              Do not up interface automatically
    #        -M              Monitor creation/destruction of interface
    #                        (otherwise it must exist)
    #        -r PROG         Script to run
    #        -x ARG          Extra argument for script
    #        -I              Don't exit on nonzero exit code from script
    #        -p              Don't run script on daemon startup
    #        -q              Don't run script on daemon quit
    #        -l              Run script on startup even if no cable is detected
    #        -t SECS         Poll time in seconds
    #        -u SECS         Delay before running script after link up
    #        -d SECS         Delay after link down
    #        -m MODE         API mode (mii, priv, ethtool, wlan, auto)
    killall ifplugd
    variable interface_event_token [event bind INTERFACE LINKSTATE [namespace current]::event_INTERFACE_LINKSTATE]
    foreach iface [get_interfaces -loopback] {
        exec ifplugd -i $iface -f -a -I -p -q -t 1 -u 0 -d 0 -m auto -r [file join $BASE_DIR scripts ifplugd]
    }

    # Finally load Command Specs
    sysconf loadspecs "modules/interface/interface.specs"
}

proc destructor {} {
    variable interface_event_token
    
    # First unload Command Specs
    sysconf remove "interface"
    
    killall ifplugd
    
    reset
    
    event unbind $interface_event_token
}

################
# Exported
################

# Get the the mac addess of an interface.
#
# @param iface Interface name.
# @return Corresponding mac.
proc get_mac {iface} {
    Global SYS_DIR
    return [string trim [::fileutil::cat [file join $SYS_DIR class net $iface address]]]
}

# Get interface state.
#
# @param iface Interface name.
# @return "up", "down", or "unknown".
proc get_state {iface} {
    Global SYS_DIR
    return [string trim [::fileutil::cat [file join $SYS_DIR class net $iface operstate]]]
}

# Get interface MTU.
#
# @param iface Interface name.
# @return Corresponding mtu.
proc get_mtu {iface} {
    Global SYS_DIR
    return [string trim [::fileutil::cat [file join $SYS_DIR class net $iface mtu]]]
}

# Get the list of intefaces currently on the system
#
# @param flags -loopback : Don't include loopback interfaces in returned list.
# @return A list consisting of all the interface names.
proc get_interfaces {args} {
    Global SYS_DIR
    set ifs [glob -directory [file join $SYS_DIR class net] -tails -nocomplain -- *]
    foreach p $args {
        switch -exact -- $p {
            "-loopback" { lremove ifs "lo" }
            "+null" { lappend ifs "null" }
            default { error "unrecognized option $p "}
        }
    }
    return $ifs
}

# Alias of get_interfaces.
proc dlist_interfaces {sid args} {
    get_interfaces {*}$args
}

# Register callback procs to be called when generating interface running-conf section.
proc iface_print_callback {name} {
    variable print_callbacks
    lappend print_callbacks $name
}

# Register callback procs to be called when renaming an interface.
proc iface_rename_callback {name} {
    variable rename_callbacks
    lappend rename_callbacks $name
}

################
# Handlers
################

command ShInterface {cmdline argstart sid out no arguments args} {
    if {[dict exists $arguments INTERFACE]} {
        set iface [dict get $arguments INTERFACE]
        exec ifconfig $iface
    } else { 
        exec ifconfig -a
    }
}

command Interface {cmdline argstart sid out no arguments args} {
    set iface [dict get $arguments INTERFACE]
    sysconf confmode $sid set "interface"
    sysconf confmode $sid setstring "(interface-${iface})"
    sysconf confmode $sid store $iface
    return
}

proc print_Interface {} {
    variable print_callbacks
    variable interface
    
    set result "\n"
    foreach iface [lsort [array names interface]] {
        set properties $interface($iface)
        append result "interface $iface\n"
        
        if {[dict exists $properties description]} {
            set val [dict get $properties description]
            append result "  description {$val}\n"
        }

        foreach c $print_callbacks { append result [$c $iface] }
        
        if {[dict exists $properties mtu]} {
            set val [dict get $properties mtu]
            append result "  mtu $val\n"
        }
        
        if {[dict exists $properties mac]} {
            set val [dict get $properties mac]
            append result "  mac $val\n"
        }
        
        if {[dict exists $properties onlinkup]} {
            set val [dict get $properties onlinkup]
            append result "  on linkup $val\n"
        }

        if {[dict exists $properties onlinkdown]} {
            set val [dict get $properties onlinkdown]
            append result "  on linkdown $val\n"
        }
        
        if {[get_state $iface] eq "down"} {
            append result "  shutdown\n"
        }
        
        append result "  exit\n"
        append result "#\n"
    }
    return $result
}

command RenameInterface {cmdline argstart sid out no arguments args} {
    variable renames
    variable interface
    
    set iface [dict get $arguments INTERFACE]
    set properties $interface($iface)
    
    if {[get_state $iface] eq "up"} {
        error "interface must be in shutdown state to rename"
    }
    
    if {$no} {
        if {! [info exists renames($iface)]} {
            error "interface already in its original name"
        }
        set origname $renames($iface)
        set mac [get_mac $iface]
        exec nameif -s $origname $mac
        unset renames($iface)
        set interface($origname) $interface($iface)
        unset interface($iface)
        
        # Call rename callbacks, so that other MikroConf modules update their state as well.
        foreach cb $rename_callbacks {
            $cb $iface $origname ;# from to
        }
        return
    }
    
    set newname [dict get $arguments NAME]
    if {$newname in [get_interfaces]} {
        error "interface with this name already exists"
    }
    
    set mac [get_mac $iface]
    exec nameif -s $newname $mac
    
    if {[info exists renames($iface)]} { ;# renamed before
        set origname $renames($iface)
        unset renames($iface)
    } else { ;# first time renamed
        set origname $iface
    }
    set renames($newname) $origname
    set interface($newname) $interface($origname)
    unset interface($origname)
    
    # Call rename callbacks, so that other MikroConf modules update their state as well.
    foreach cb $rename_callbacks {
        $cb $iface $newname ;# from to
    }
    return
}

proc print_RenameInterface {} {
    variable renames
    
    set result {}
    foreach iface [array names renames] {
        append result "rename $renames($iface) $iface\n"
    }
    
    if {! [lempty $result]} {
        set result "#\n${result}#\n"
    }
    return $result
}

command Shutdown {cmdline argstart sid out no arguments args} {
    variable interface
    set iface [sysconf confmode $sid store]
    
    if {$no} {
        exec ifconfig $iface up
    } else {
        exec ifconfig $iface down
    }
    return
}

command Description {cmdline argstart sid out no arguments args} {
    variable interface
    set iface [sysconf confmode $sid store]
    
    if {$no} {
        dict unset interface($iface) description
    } else {
        dict set interface($iface) description [dict get $arguments DESCRIPTION]
    }
    return
}

# We let 'ifconfig' to check validity of provided value.
command Mtu {cmdline argstart sid out no arguments args} {
    variable interface
    set iface [sysconf confmode $sid store]
    
    if {$no} {
        exec ifconfig $iface mtu [dict get interface($iface) mtu_orig]
        dict unset interface($iface) mtu mtu_orig
    } else {
        set old [get_mtu $iface]
        set new [dict get $arguments MTU]
        
        if {! [string is integer $new]} {
            ferror "illegal MTU" [getpos MTU]
        }
        exec ifconfig $iface mtu $new
        dict set interface($iface) mtu $new
        dict set interface($iface) mtu_orig $old
    }
    return
}

# We let 'ifconfig' to check validity of provided value.
command Mac {cmdline argstart sid out no arguments args} {
    variable interface
    set iface [sysconf confmode $sid store]
    
    if {$no} {
        exec ifconfig $iface hw ether [dict get interface($iface) mac_orig]
        dict unset interface($iface) mac mac_orig
    } else {
        set old [get_mac $iface]
        set new [dict get $arguments MAC]
        exec ifconfig $iface hw ether $new
        dict set interface($iface) mac $new
        dict set interface($iface) mac_orig $old
    }
    return
}

command OnLinkdown {cmdline argstart sid out no arguments args} {
    variable interface
    
    set iface [sysconf confmode $sid store]
    
    if {$no} {
        dict unset interface($iface) onlinkdown
    } else {
        dict set interface($iface) onlinkdown [concat [dict get $arguments PROCEDURE] [getall ARGUMENT]]
    }
    return
}

command OnLinkup {cmdline argstart sid out no arguments args} {
    variable interface
    
    set iface [sysconf confmode $sid store]
    
    if {$no} {
        dict unset interface($iface) onlinkup
    } else {
        dict set interface($iface) onlinkup [concat [dict get $arguments PROCEDURE] [getall ARGUMENT]]
    }
    return
}

proc event_INTERFACE_LINKSTATE {tag event details} {
    variable interface
    
    lassign $details iface state
    if {! [info exists interface($iface)]} { return }
    set properties $interface($iface)
    
    switch -exact -- $state {
        "up" {
            if {[dict exists $properties onlinkup]} {
                set name [dict get $properties onlinkup]
                if {[catch {
                        procedures::invoke {*}$name
                    } result options]} {
                    log::Error -stack $options "Event handler error \"$name\": $result"
                }
            }
        }
        "down" {
            if {[dict exists $properties onlinkdown]} {
                set name [dict get $properties onlinkdown]
                if {[catch {
                        procedures::invoke {*}$name
                    } result options]} {
                    log::Error -stack $options "Event handler error \"$name\": $result"
                }
            }
        }
        default {
            log::Notice "unrecognized interface state \"$state\""
        }
    }
}

} ;# End of Namespace