#
#    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 "ipconf" module is responsible for basic IP Configuration.
#//#

module require base 1.0
module require interface 1.0
module provide ipconf 1.0

package require dns 1.3.2 ;# Tcllib

namespace eval ::module::ipconf {
namespace import ::helper::* ::module::api::* \
    ::module::interface::dlist_interfaces \
    ::module::interface::iface_print_callback \
    ::module::interface::iface_rename_callback \
    ::module::base::dlist_procedures

proc description {} {
    return "IP Configuration"
}

proc version {} {
    
}

proc check {} {
    foreach feature [list \
                     CONFIG_APP_UDHCPC \
                     CONFIG_FEATURE_UDHCPC_ARPING \
                     CONFIG_FEATURE_UDHCP_RFC3397 \
                     \
                     CONFIG_BB_SYSCTL \
                     CONFIG_HOSTNAME \
                     CONFIG_ROUTE \
                     CONFIG_IFCONFIG \
                     CONFIG_ARP \
                     CONFIG_NETSTAT] {
        if {! [::helper::busybox_has $feature]} { ;# Can return error.
            error "Busybox doesn't have support for $feature."
        }
    }
}

proc reset {} {
    variable HOSTS_FILE
    variable RESOLV_FILE
    variable HOSTNAME_FILE
    
    fileutil::writeFile $HOSTS_FILE "127.0.0.1 localhost"
    
    fileutil::writeFile $RESOLV_FILE ""
    
    # Local hostname
    fileutil::writeFile $HOSTNAME_FILE "Router"
    exec hostname Router
    
    # List of hostnames configured to statically map to IP addresses, in order of configuration.
    variable IpHost_order {}
    
    # Array that maps configured Hostnames to static IP addresses.
    variable ip_host_map
    array set ip_host_map {}
    
    # List of name servers configured, in the order of configuration.
    variable nameservers {}
    
    # The local domain name.
    variable domainname {}
    
    # Restore default value.
    Global -rw DNS_LOOKUPS
    variable dnslookups_def
    set DNS_LOOKUPS $dnslookups_def
    
    # List of {prefix netmask} keys of configured static routes, in order of configuration.
    variable ip_routes [list]
    
    # Array that maps {prefix netmask} keys to route properties.
    variable ip_routes_map
    array set ip_host_map {}
    
    # Array that maps interface names to their ip configuration.
    variable ip_address_map
    array set ip_address_map {}
    
    # DHCP Client configuration per interface (key)
    variable dhcp_client_map
    array set dhcp_client_map {}
    killall udhcpc
}

proc constructor {} {
    log::Info "Loading \"ipconf\" module: [description]"
    
    Global ETC_DIR
    variable HOSTS_FILE [file join $ETC_DIR hosts]
    variable RESOLV_FILE [file join $ETC_DIR resolv.conf]
    variable HOSTNAME_FILE [file join $ETC_DIR hostname]
    
    check

    # Flag to indicate that DNS will be used to resolve IPs to hostnames.
    # Store in this variable the default value.
    Global DNS_LOOKUPS
    variable dnslookups_def $DNS_LOOKUPS
    
    reset

    # Finally load Command Specs
    sysconf loadspecs "modules/ipconf/ipconf.specs"
    
    iface_print_callback [namespace current]::print_ifaceConf
    iface_print_callback [namespace current]::print_dhcpConf
    
    iface_rename_callback [namespace current]::rename_ifaceConf
    iface_rename_callback [namespace current]::rename_dhcpConf
    
    variable dhcp_events_token [event bind DHCPCLIENT EVENT [namespace current]::event_DHCPCLIENT_EVENT]
}

proc destructor {} {
    variable dhcp_events_token
    
    # First unload Command Specs
    sysconf remove "ipconf"
    
    reset
    
    event bind $dhcp_events_token
}

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

command ShArp {cmdline argstart sid out no arguments args} {
    Global DNS_LOOKUPS
    
    exec arp -a [? !$DNS_LOOKUPS "-n"]
}

command ShIpRoute {cmdline argstart sid out no arguments args} {    
    Global DNS_LOOKUPS
    
    exec route [? !$DNS_LOOKUPS "-n"]
}

command ShNetstat {cmdline argstart sid out no arguments args} {
    Global DNS_LOOKUPS
    
    if {[dict exists $arguments TYPE]} {
        set type [string map {tcp -t udp -u raw -u unix -x listening -l} [dict get $arguments TYPE]]
    } else {
        set type "-a" ;# all.
    }
    
    exec netstat [? !$DNS_LOOKUPS "-n"] $type
}

# @limit Local DNS caching.
command ShHosts {cmdline argstart sid out no arguments args} {
    variable ip_host_map
    variable IpHost_order
    variable domainname
    variable nameservers
    
    puts -nonewline $out "Default domain is "
    if {[lempty $domainname]} {
        puts "not set"
    } else {
        puts $domainname
    }
    
    if {[lempty $nameservers]} {
        puts "Name/address lookup uses local mapping\n"
    } else {
        puts "Name/address lookup uses DNS"
        puts "Name servers are $nameservers\n" 
    }

    puts [format {%-40s %-8s %-6s %-s} "Host" "Flags" "Type" "Addresses"]
    foreach hostname $IpHost_order {
        puts [format {%-40s %-8s %-6s %-s} $hostname "Static" "IP" $ip_host_map($hostname)]
    }
    return
}

command Hostname {cmdline argstart sid out no arguments args} {
    variable HOSTNAME_FILE
    
    # We let the 'hostname' tool to verify correctness,
    # which in case of busybox's 'hostname' it relies,
    # in turn, on the 'sethostname' syscall.
    set hostname [dict get $arguments HOSTNAME]
    if {! [ishostname $hostname]} {
        ferror "illegal hostname" [getpos HOSTNAME]
    }
    
    exec hostname [dict get $arguments HOSTNAME]
    fileutil::writeFile $HOSTNAME_FILE [dict get $arguments HOSTNAME]
    return
}

proc print_Hostname {} {
    # 'info hostname' doesn't get updated after hostname changes (Tcl.8.5).
    return "hostname [dict get [uname] node-name]\n"
}

# @limit Support for IPv6.
command IpHost {cmdline argstart sid out no arguments args} {
    variable HOSTS_FILE
    variable ip_host_map
    variable IpHost_order
    
    if {$no} {
        if {! [file exists $HOSTS_FILE]} { return }
        
        set hostname [dict get $arguments HOSTNAME]
        if {! [ishostname $hostname]} {
            ferror "illegal hostname" [getpos HOSTNAME]
        }
        
        if {$hostname ni $IpHost_order} {
            ferror "hostname does not exist" [getpos HOSTNAME]
        }
        
        removeline $HOSTS_FILE "$hostname *"
        unset ip_host_map($hostname)
        lremove IpHost_order $hostname
        
    } else {
        foreach {var val} $arguments {
            switch -exact -- $var {
            "HOSTNAME" {
                set hostname $val
                if {! [ishostname $hostname]} {
                    ferror "illegal hostname" [getpos HOSTNAME]
                }
                if {$hostname in $IpHost_order} {
                    # Note: IPs are not appended to existing ones.
                    lremove IpHost_order $hostname
                    unset ip_host_map($hostname)
                    removeline $HOSTS_FILE "$hostname *"
                }
            }
            "IPADDRESS" {
                if {! [isip $val]} {
                    ferror "illegal ip address" [getpos IPADDRESS]
                }
                lappend ipaddrs $val
                ::fileutil::appendToFile $HOSTS_FILE "$hostname $val\n"
            }
            }
        }
        set ip_host_map($hostname) $ipaddrs
        lappend IpHost_order $hostname
    }
    return
}

proc print_IpHost {} {
    variable IpHost_order
    variable ip_host_map
    set result {}
    foreach hostname $IpHost_order {
        append result "ip host $hostname $ip_host_map($hostname)\n"
    }
    return $result 
}

################################
# DNS Related
################################

command IpNameserver {cmdline argstart sid out no arguments args} {
    variable RESOLV_FILE
    variable nameservers
    
    set ip [dict get $arguments IPADDRESS]
    if {! [isip $ip]} {
        ferror "not a valid IP address" [getpos IPADDRESS]
    }
    
    if {$no} {
        if {$ip ni $nameservers} {
            ferror "name server is not registered" [getpos IPADDRESS]
        }
        removeline $RESOLV_FILE "nameserver $ip"
        lremove nameservers $ip
        return
    }
    
    if {[llength $nameservers] >= 3} {
        error "a maximum of three name servers can be specified"
    }
    ::fileutil::appendToFile $RESOLV_FILE "nameserver $ip\n"
    lappend nameservers $ip
    return
}

proc print_IpNameserver {} {
    variable nameservers
    
    set result {}
    if {! [lempty $nameservers]} {
        foreach ip $nameservers {
            append result "ip name-server $ip" "\n"
        }
    }
    return $result
}

command IpDomainname {cmdline argstart sid out no arguments args} {
    variable RESOLV_FILE
    variable domainname

    set name [dict get $arguments DOMAIN]
    if {! [isdomainname $name]} {
        ferror "not a valid domain name" [getpos DOMAIN]
    }
    
    if {$no} {
        removeline $RESOLV_FILE "domain *"
        set domainname {}
        return
    }
    
    if {! [lempty $domainname]} {
        removeline $RESOLV_FILE "domain *"
    }
    ::fileutil::appendToFile $RESOLV_FILE "domain $name\n"
    set domainname $name
    return
}

proc print_IpDomainname {} {
    variable domainname
    
    if {! [lempty $domainname]} {
        return "ip domain-name $domainname\n"
    }
    return
}

command IpDomainlookup {cmdline argstart sid out no arguments args} {
    Global -rw DNS_LOOKUPS

    if {$no} {
        set DNS_LOOKUPS 0
    } else {
        set DNS_LOOKUPS 1
    }

    return
}

proc print_IpDomainlookup {} {
    Global DNS_LOOKUPS
    
    if {! $DNS_LOOKUPS} {
        return "no ip domain-lookup\n"
    }
    return
}

command IpRoute {cmdline argstart sid out no arguments args} {
    variable ip_routes
    variable ip_routes_map

    set prefix [dict get $arguments PREFIX]
    if {! [isip $prefix]} {
        ferror "not a valid prefix address" [getpos PREFIX]
    }
    
    set netmask [dict get $arguments NETMASK]
    if {! [isip $netmask]} {
        ferror "not a valid netmask" [getpos NETMASK]
    }
    
    set key [list $prefix $netmask]
    set pros [dict create]

    if {$no} {
        exec route del -net $prefix netmask $netmask
        lremove ip_routes $key
        unset ip_routes_map($key)
        return
    }
    
    if {[dict exists $arguments DISTANCE]} {
        set distance [dict get $arguments DISTANCE]
        if {! [string is integer $distance] || ! (0 <= $distance <= 255)} {
            ferror "distance must be an integer in the range 0..255" [getpos DISTANCE]
        }
        dict set pros distance $distance
    } else {
        if {[dict exists $arguments INTERFACE]} {
            set distance 0 ;# Default distance for directly connected interfaces.
        } else {
            set distance 1 ;# Default distance for static routes.
        }
    }
        
    if {[dict exists $arguments INTERFACE]} {
        set iface [dict get $arguments INTERFACE]
        
        if {$iface eq "null"} {
            exec route add -net $prefix netmask $netmask metric $distance reject
            dict set pros next "null"
        } else {
            exec route add -net $prefix netmask $netmask metric $distance dev $iface
            dict set pros next "$iface"
        }
    } else {
        set nexthop [dict get $arguments IPADDRESS]
        if {! [isip $nexthop]} {
            ferror "not a valid IP address" [getpos IPADDRESS]
        }
        
        exec route add -net $prefix netmask $netmask metric $distance gw $nexthop
        dict set pros next "$nexthop"
    }
    
    lappend ip_routes $key
    set ip_routes_map($key) $pros
}

proc print_IpRoute {} {
    variable ip_routes
    variable ip_routes_map
    
    set result {}
    foreach e $ip_routes {
        lassign $e prefix netmask
        set pros $ip_routes_map($e)
        set nexthop [dict get $pros next]
        if {[dict exists $pros distance]} {
            set distance [dict get $pros distance]
            append result "ip route $prefix $netmask $next $distance\n"
        } else {
            append result "ip route $prefix $netmask $next\n"
        }
    }
    return $result
}

command IpAddress {cmdline argstart sid out no arguments args} {
    variable ip_address_map
    variable dhcp_client_map
    
    set iface [sysconf confmode $sid store]

    if {$no} {
        # kill first udhcpc if ip was assigned via dhcp
        dict set dhcp_client_map($iface) "enable" 0
        udhcpc_reset $iface
        
        exec ifconfig $iface 0.0.0.0
        unset ip_address_map($iface)
        return
    }
    
    if {[dict exists $arguments dhcp]} {
        # Remove static address first
        catch { unset ip_address_map($iface) }
        
        dict set dhcp_client_map($iface) "enable" 1
        udhcpc_reset $iface
    } else { ;# Static address
        # Disable dhcp first
        dict set dhcp_client_map($iface) "enable" 0
        udhcpc_reset $iface
        
        set address [dict get $arguments IPADDRESS]
        if {! [isip $address]} {
            ferror "not a valid IP address" [getpos IPADDRESS]
        }
        
        set netmask [dict get $arguments NETMASK]
        if {! [isip $netmask]} {
            ferror "not a valid netmask" [getpos NETMASK]
        }
        
        exec ifconfig $iface $address netmask $netmask
        set ip_address_map($iface) [list $address $netmask]
    }
    return
}

proc print_ifaceConf {iface} {
    variable ip_address_map
 
    if {$iface in [array names ip_address_map]} {
        lassign $ip_address_map($iface) address netmask
        return "  ip address $address $netmask\n"
    }
    return
}

proc rename_ifaceConf {from to} {
    variable ip_address_map
    
    set ip_address_map($to) $ip_address_map($from)
    unset ip_address_map($from)
}

######################
# DHCP Client
######################

proc udhcpc_reset {iface} {
    Global BASE_DIR
    variable dhcp_client_map
    
    if {! [info exists dhcp_client_map($iface)]} {
        return
    }
    
    set properties $dhcp_client_map($iface)
    
    if {[dict exists $properties "pid"]} {
        kill KILL [dict get $properties "pid"]
        dict unset dhcp_client_map($iface) "pid"
    }
    
    if {! [dict exists $properties "enable"] || ! [dict get $properties "enable"]} { return }
    
    set params "-i $iface -s [file join $BASE_DIR scripts udhcpc] -S -R -a "
    
    if {[dict exists $properties "client-id"]} {
        append params "-c [dict get $properties client-id] "
    }

    if {[dict exists $properties "class-id"]} {
        append params "-V [dict get $properties class-id] "
    }
    
    if {[dict exists $properties "hostname"]} {
        append params "-h [dict get $properties hostname] "
    }
    
    if {[dict exists $properties "request-ip"]} {
        append params "-r [dict get $properties request-ip] "
    }
    
    if {[dict exists $properties "request"]} {
        foreach option [dict get $properties "request"] {
            append params "-O [dict get $properties request] "
        }
    }
    
    dict set dhcp_client_map($iface) "pid" [exec udhcpc {*}$params > /dev/null 2> /dev/null &]
}

command IpDhcpClientClientId {cmdline argstart sid out no arguments args} {
    variable dhcp_client_map
    
    set iface [sysconf confmode $sid store]
    
    if {$no} {
        dict unset dhcp_client_map($iface) "client-id"
    } else {
        dict set dhcp_client_map($iface) "client-id" [dict get $arguments CLIENTID]
    }
    
    udhcpc_reset $iface
}

command IpDhcpClientClassId {cmdline argstart sid out no arguments args} {
    variable dhcp_client_map
    
    set iface [sysconf confmode $sid store]
    
    if {$no} {
        dict unset dhcp_client_map($iface) "class-id"
    } else {
        dict set dhcp_client_map($iface) "class-id" [dict get $arguments CLASSID]
    }
    
    udhcpc_reset $iface
}

command IpDhcpClientHostname {cmdline argstart sid out no arguments args} {
    variable dhcp_client_map
    
    set iface [sysconf confmode $sid store]
    
    if {$no} {
        dict unset dhcp_client_map($iface) "hostname"
    } else {
        set hostname [dict get $arguments HOSTNAME]
        if {! [ishostname $hostname]} {
            ferror "illegal hostname" [getpos HOSTNAME]
        }
        
        dict set dhcp_client_map($iface) "hostname" $hostname
    }
    
    udhcpc_reset $iface
}

command IpDhcpClientRequestIp {cmdline argstart sid out no arguments args} {
    variable dhcp_client_map
    
    set iface [sysconf confmode $sid store]
    
    if {$no} {
        dict unset dhcp_client_map($iface) "request-ip"
    } else {
        set ipaddr [dict get $arguments IPADDRESS]
        if {! [isip $ipaddr]} {
            ferror "illegal ip address" [getpos IPADDRESS]
        }
        
        dict set dhcp_client_map($iface) "request-ip" $ipaddr
    }
    
    udhcpc_reset $iface
}
    
command IpDhcpClientRequest {cmdline argstart sid out no arguments args} {
    variable dhcp_client_map
    
    set iface [sysconf confmode $sid store]
    
    set option [dict get $arguments OPTION]
    
    if {$no} {
        if {! [dict exists $dhcp_client_map($iface) "request"] || $option ni [dict get $dhcp_client_map($iface) "request"]} {
            ferror "dhcp option not requested" [getpos OPTION]
        }
        
        dict update dhcp_client_map($iface) "request" newval { lremove newval $option }
        if {[lempty [dict get $dhcp_client_map($iface) "request"]]} {
            dict unset dhcp_client_map($iface) "request"
        }
    } else {
        dict lappend dhcp_client_map($iface) "request" $option
    }
    
    udhcpc_reset $iface
}

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

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

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

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

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

proc event_DHCPCLIENT_EVENT {tag event details} {
    variable dhcp_client_map
    
    lassign $details iface state
    if {! [info exists dhcp_client_map($iface)]} { return }
    set properties $dhcp_client_map($iface)
    
    switch -exact -- $state {
        "bound" {
            if {[dict exists $properties on_dhcp_bound]} {
                set name [dict get $properties on_dhcp_bound]
                if {[catch {
                        procedures::invoke {*}$name
                    } result options]} {
                    log::Error -stack $options "Event while evaluating event handler \"$name\": $result"
                }
            }
        }
        "renew" {
            if {[dict exists $properties on_dhcp_renew]} {
                set name [dict get $properties on_dhcp_renew]
                if {[catch {
                        procedures::invoke {*}$name
                    } result options]} {
                    log::Error -stack $options "Event while evaluating event handler \"$name\": $result"
                }
            }
        }
        "deconfig" {
            if {[dict exists $properties on_dhcp_deconfig]} {
                set name [dict get $properties on_dhcp_deconfig]
                if {[catch {
                        procedures::invoke {*}$name
                    } result options]} {
                    log::Error -stack $options "Event while evaluating event handler \"$name\": $result"
                }
            }
        }
        "leasefail" {
            if {[dict exists $properties on_dhcp_leasefail]} {
                set name [dict get $properties on_dhcp_leasefail]
                if {[catch {
                        procedures::invoke {*}$name
                    } result options]} {
                    log::Error -stack $options "Event while evaluating event handler \"$name\": $result"
                }
            }
        }
        "nak" {
            if {[dict exists $properties on_dhcp_nak]} {
                set name [dict get $properties on_dhcp_nak]
                if {[catch {
                        procedures::invoke {*}$name
                    } result options]} {
                    log::Error -stack $options "Event while evaluating event handler \"$name\": $result"
                }
            }
        }
        default {
            log::Notice "unrecognized dhcp event \"$state\""
        }
    }
}

proc print_dhcpConf {iface} {
    variable dhcp_client_map
    
    if {! [info exists dhcp_client_map($iface)]} {
        return
    }
    
    set result {}
    
    set properties $dhcp_client_map($iface)
    
    if {[dict exists $properties "client-id"]} {
        append result "  ip dhcp client client-id [dict get $properties client-id]\n"
    }

    if {[dict exists $properties "class-id"]} {
        append result "  ip dhcp client class-id [dict get $properties class-id]\n"
    }
    
    if {[dict exists $properties "hostname"]} {
        append result "  ip dhcp client hostname [dict get $properties hostname]\n"
    }
    
    if {[dict exists $properties "request-ip"]} {
        append result "  ip dhcp client request-ip [dict get $properties request-ip]\n"
    }
    
    if {[dict exists $properties "request"]} {
        foreach option [dict get $properties "request"] {
            append result "  ip dhcp client request [dict get $properties request]\n"
        }
    }
    
    if {[dict exists $properties on_dhcp_bound]} {
        append result "  on dhcp bound [dict get $properties on_dhcp_bound]\n"
    }
    
    if {[dict exists $properties on_dhcp_renew]} {
        append result "  on dhcp bound [dict get $properties on_dhcp_renew]\n"
    }
    
    if {[dict exists $properties on_dhcp_deconfig]} {
        append result "  on dhcp bound [dict get $properties on_dhcp_deconfig]\n"
    }
    
    if {[dict exists $properties on_dhcp_leasefail]} {
        append result "  on dhcp bound [dict get $properties on_dhcp_leasefail]\n"
    }
    
    if {[dict exists $properties on_dhcp_nak]} {
        append result "  on dhcp bound [dict get $properties on_dhcp_nak]\n"
    }
    
    if {[dict exists $properties "enable"] && [dict get $properties "enable"]} {
        append result "  ip address dhcp\n"
    }
    
    return $result
}

proc rename_dhcpConf {from to} {
    variable dhcp_client_map
    
    set dhcp_client_map($to) $dhcp_client_map($from)
    unset dhcp_client_map($from)
}

} ;# End of Namespace