# ip.test -*- tcl -*-
#
# Tests for the Tcllib ip package
#
# -------------------------------------------------------------------------
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# -------------------------------------------------------------------------
# RCS: @(#) $Id: ipMore.test,v 1.4 2006/10/09 21:41:40 andreas_kupries Exp $

# -------------------------------------------------------------------------

source [file join \
	[file dirname [file dirname [file join [pwd] [info script]]]] \
	devtools testutilities.tcl]

testsNeedTcl     8.2
testsNeedTcltest 2.2

testing {
    useLocal ip.tcl ip
}

# -------------------------------------------------------------------------

::tcltest::testConstraint Cextension \
    [llength [info commands ::ip::prefixToNativec]]

# -------------------------------------------------------------------------

logger::setlevel critical

namespace eval ::ip::test {

    ::tcltest::test load-1 {} -setup {
    } -constraints {
    } -cleanup {
    } -body {
    } -result {}

    ::tcltest::test ip::prefixToNativeTcl-1 {} -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ip::prefixToNativeTcl 1.1.1.0/24
    } -result {0x01010100 0xffffff00}

    ::tcltest::test ip::prefixToNativeTcl-2 {} -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ip::prefixToNativeTcl {1.1.1.0/24 1.0.0.0/8  2.1.1.0/24 1.1.1.1/32}
    } -result {{0x01010100 0xffffff00} {0x01000000 0xff000000} {0x02010100 0xffffff00} {0x01010101 0xffffffff}}

    ::tcltest::test ip::prefixToNativeTcl-3 {} -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ip::prefixToNativeTcl ""
    } -result {}

    ::tcltest::test ip::prefixToNativec-1 {} -setup {
    } -constraints {
        Cextension
    } -cleanup {
    } -body {
        ip::prefixToNativec 1.1.1.0/24
    } -result {0x01010100 0xFFFFFF00}

    ::tcltest::test ip::prefixToNativec-2 {} -setup {
    } -constraints {
        Cextension
    } -cleanup {
    } -body {
        ip::prefixToNativec 1.1.1.0/255.255.255.0
    } -result {0x01010100 0xFFFFFF00}

    ::tcltest::test ip::prefixToNativec-3 {} -setup {
    } -constraints {
        Cextension
    } -cleanup {
    } -body {
        ip::prefixToNativec 1.1.1.0
    } -result {0x01010100 0xFFFFFFFF}

    ::tcltest::test ip::prefixToNativec-4 {} -setup {
    } -constraints {
        Cextension
    } -cleanup {
    } -body {
        ip::prefixToNativec {1.1.1.0/24 1.0.0.0/8  2.1.1.0/24 1.1.1.1/32}
    } -result {{0x01010100 0xFFFFFF00} {0x01000000 0xFF000000} {0x02010100 0xFFFFFF00} {0x01010101 0xFFFFFFFF}}

    ::tcltest::test ip::prefixToNativec-5 {} -setup {
    } -constraints {
        Cextension
    } -cleanup {
    } -body {
        ip::prefixToNativec {1.1.1.0/24 1.0AAF0/8  2.1.1.0/24 1.1.1.1/32}
    } -result {} -returnCodes error

    ::tcltest::test ip::prefixToNativec-6 {} -setup {
    } -constraints {
        Cextension
    } -cleanup {
        unset y
    } -body {
        set y {1.1.1.0/24 1.0.0.0/8  2.1.1.0/24 1.1.1.1/32}
        ip::prefixToNativec $y
        lindex $y 0
    } -result {1.1.1.0/24}

    ::tcltest::test ip::nativeToPrefix-1 {
        single address test
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
         ip::nativeToPrefix {0x01010100 0xffffff00} -ipv4
    } -result {1.1.1.0/24}

    ::tcltest::test ip::nativeToPrefix-2 {
                multi list test
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ip::nativeToPrefix {{0x01010100 0xffffff00} {0x01000000 0xff000000} {0x02010100 0xffffff00} {0x01010101 0xffffffff}} -ipv4
    } -result {1.1.1.0/24 1.0.0.0/8 2.1.1.0/24 1.1.1.1/32}

    ::tcltest::test ip::nativeToPrefix-3 {
        0 test 
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ip::nativeToPrefix {0x0 0x0} -ipv4
    } -result {0.0.0.0/0}

    ::tcltest::test ip::nativeToPrefix-4 {
        0 test, check default is ipv4
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ip::nativeToPrefix {0x0 0x0}
    } -result {0.0.0.0/0}

    ::tcltest::test ip::toInteger-1 {} -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::toInteger 1.1.1.0
    } -result {16843008}

    ::tcltest::test ::ip::toHex-1 {} -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::toHex 1.1.1.0
    } -result {0x01010100}





    ::tcltest::test ::ip:broadcastAddress-1 {
        dotted form
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::broadcastAddress 1.1.1.0/24
    } -result {1.1.1.255}

    ::tcltest::test ::ip:broadcastAddress-2 {
        native form
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::broadcastAddress {0x01010100 0xffffff00}
    } -result {0x010101ff}


    ::tcltest::test ::ip:maskToLength-1 {
        hexform
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::maskToLength 0xffffff00 -ipv4
    } -result {24}

    ::tcltest::test ::ip:maskToLength-2 {
        dotted form
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::maskToLength 255.255.255.0
    } -result {24}


    ::tcltest::test ::ip:maskToLength-3 {
        zero form
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::maskToLength 0.0.0.0
    } -result {0}

    ::tcltest::test ::ip:maskToLength-4 {
        zero form
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::maskToLength 0x0 -ipv4
    } -result {0}

    ::tcltest::test ::ip:maskToLength-5 {
        zero form, defualt is ipv4
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::maskToLength 0x0
    } -result {0}


    ::tcltest::test ::ip::lengthToMask-1 {
        dotted form
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::lengthToMask 24 -ipv4
    } -result {255.255.255.0}

    ::tcltest::test ::ip::lengthToMask-2 {
        dotted form, default is ipv4
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::lengthToMask 24 
    } -result {255.255.255.0}

    ::tcltest::test ::ip:maskToInt-1 {
        integer form
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::maskToInt 32
    } -result {4294967295}


    ::tcltest::test ::ip:maskToInt-2 {
        dotted form
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::maskToInt 255.255.255.255
    } -result {4294967295}

    ::tcltest::test ::ip:intToString-1 {
        convert 255.255.255.255
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::intToString 4294967295 -ipv4
    } -result {255.255.255.255}

    ::tcltest::test ::ip:intToString-2 {
        convert hex to string
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::intToString 0x01010101 -ipv4
    } -result {1.1.1.1}

    ::tcltest::test ::ip:intToString-3 {
        convert hex to string, default is ipv4
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::intToString 0x01010101
    } -result {1.1.1.1}

    ::tcltest::test ::ip:nextNet-1 {
        255.255.255.0/32 -> 255.255.255.1
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::nextNet 0xffffff00 0xffffffff -ipv4
    } -result {0xffffff01}

    ::tcltest::test ::ip:nextNet-2 {
        1.0.0.0/24 -> 1.0.1.0/24
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ip::nextNet 0x01000000 0xffffff00 -ipv4
    } -result {0x01000100}


    ::tcltest::test ::ip:nextNet-3 {
        1.1.28.0/24 -> 1.1.29.0
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ip::nextNet 0x01011c00 0xffffff00 -ipv4
    } -result {0x01011d00}

    ::tcltest::test ::ip:nextNet-4 {
        1.1.28.0/24 -> 1.1.29.0 by 1
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ip::nextNet 0x01011c00 0xffffff00 1 -ipv4
    } -result {0x01011d00}


    ::tcltest::test ::ip:nextNet-5 {
        1.1.1.1/32 -> 1.1.29.0 by 2
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ip::nextNet 0x01010101 [ip::maskToInt 32] 2 -ipv4
    } -result {0x01010103}

    ::tcltest::test ::ip:nextNet-6 {
        1.1.1.1/32 -> 1.1.29.0 by 2
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ip::nextNet 1.1.1.1 32 2
    } -result {0x01010103}

    ::tcltest::test ::ip:nextNet-7 {
        1.1.1.1/32 -> 1.1.29.0 by 2
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ip::nextNet 1.1.1.1 255.255.255.255 2
    } -result {0x01010103}

    ::tcltest::test ::ip:nextNet-8 {
        1.1.1.1/32 -> 1.1.29.0 by 2, default is ipv4
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ip::nextNet 0x01010101 [ip::maskToInt 32] 2 
    } -result {0x01010103}

    ::tcltest::test ::ip:isOverlap-1 {
        no overlap test
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::isOverlap 1.1.1.0/24 2.1.0.1/32
    } -result {0}


    ::tcltest::test ::ip:isOverlap-2 {
        yes overlap test
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::isOverlap 1.1.1.0/24 2.1.0.1/32 1.1.1.1/32
    } -result {1}


    ::tcltest::test ::ip:isOverlapNative-1 {
        no overlap test
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::isOverlapNative  -ipv4 0x01010100 0xffffff00 {{0x02010001 0xffffffff}}
    } -result {0}


    ::tcltest::test ::ip:isOverlapNative-2 {
        yes overlap test
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        set a [::ip::isOverlapNative  -ipv4 0x01010100 0xffffff00 {{0x02010001 0xffffffff} {0x01010101 0xffffffff}} ]
        expr $a > 0
    } -result {1}

    ::tcltest::test ::ip:isOverlapNativeTcl-1 {
        no overlap test
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::isOverlapNativeTcl  -ipv4 0x01010100 0xffffff00 {{0x02010001 0xffffffff}}
    } -result {0}


    ::tcltest::test ::ip:isOverlapNativeTcl-2 {
        yes overlap test
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        set a [::ip::isOverlapNativeTcl  -ipv4 0x01010100 0xffffff00 {{0x02010001 0xffffffff} {0x01010101 0xffffffff}}]
        expr $a > 0 
    } -result {1}

    ::tcltest::test ::ip:isOverlapNativeTcl-3 {
        yes overlap test
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        set a [::ip::isOverlapNativeTcl  -ipv4 0x01010100 0xffffff00 {{0x02010001 0xffffffff} {0x01010101 0xffffffff}}]
    } -result {2}

    ::tcltest::test ::ip:isOverlapNativeTcl-4 {
        -all overlap test
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        set a [::ip::isOverlapNativeTcl  -ipv4 -all 0x01010100 0xffffff00 {
            {0x02010001 0xffffffff} 
            {0x01010101 0xffffffff}
            {0x01010102 0xffffffff}
        }]
    } -result {2 3}

    ::tcltest::test ::ip:isOverlapNativeTcl-5 {
        -all overlap test with -inline
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        set a [::ip::isOverlapNativeTcl  -ipv4 -all -inline 0x01010100 0xffffff00 {
            {0x02010001 0xffffffff} 
            {0x01010101 0xffffffff}
            {0x01010102 0xffffffff}
        }]
    } -result {{0x01010101 0xffffffff} {0x01010102 0xffffffff}}

    ::tcltest::test ::ip:isOverlapNativeTcl-6 {
        test with -inline
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        set a [::ip::isOverlapNativeTcl -ipv4 -inline 0x01010100 0xffffff00 {
            {0x02010001 0xffffffff} 
            {0x01010101 0xffffffff}
            {0x01010102 0xffffffff}
        }]
    } -result {{0x01010101 0xffffffff}}

    ::tcltest::test ::ip:isOverlapNativeTcl-7 {
        test with -all -inline one element return
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        set a [::ip::isOverlapNativeTcl -ipv4 -all -inline 0x01010100 0xffffff00 {
            {0x02010001 0xffffffff} 
            {0x01010101 0xffffffff}
        }]
    } -result {{0x01010101 0xffffffff}}

    ::tcltest::test ::ip:isOverlapNativeTcl-8 {
        test with -inline
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        set a [::ip::isOverlapNativeTcl -ipv4 -inline 0x01010100 0xffffff00 {
            {0x02010001 0xffffffff} 
        }]
    } -result {}

    ::tcltest::test ::ip:isOverlapNativec-1 {
        no overlap test
    } -setup {
    } -constraints {
        Cextension
    } -cleanup {
    } -body {
        ::ip::isOverlapNativec -ipv4  0x01010100 0xffffff00 {{0x02010001 0xffffffff}}
    } -result {0}


    ::tcltest::test ::ip:isOverlapNativec-2 {
        yes overlap test
    } -setup {
    } -constraints {
        Cextension
    } -cleanup {
    } -body {
        set a [::ip::isOverlapNativec -ipv4 0x01010100 0xffffff00 {{0x02010001 0xffffffff} {0x01010101 0xffffffff}}]
        expr $a > 0
    } -result {1}

    ::tcltest::test ::ip:isOverlapNativec-3 {
        yes overlap test
    } -setup {
    } -constraints {
        Cextension
    } -cleanup {
    } -body {
        set a [::ip::isOverlapNativec -ipv4  0x01010100 0xffffff00 {{0x02010001 0xffffffff} {0x01010101 0xffffffff}}]
    } -result {2}

    ::tcltest::test ::ip:isOverlapNativec-4 {
        -all overlap test
    } -setup {
    } -constraints {
        Cextension
    } -cleanup {
    } -body {
        set a [::ip::isOverlapNativec -ipv4  -all 0x01010100 0xffffff00 {
            {0x02010001 0xffffffff} 
            {0x01010101 0xffffffff}
            {0x01010102 0xffffffff}
        }]
    } -result {2 3}

    ::tcltest::test ::ip:isOverlapNativec-5 {
        -all overlap test with -inline
    } -setup {
    } -constraints {
        Cextension
    } -cleanup {
    } -body {
        set a [::ip::isOverlapNativec -ipv4 -all -inline 0x01010100 0xffffff00 {
            {0x02010001 0xffffffff} 
            {0x01010101 0xffffffff}
            {0x01010102 0xffffffff}
        }]
    } -result {{0x01010101 0xffffffff} {0x01010102 0xffffffff}}

    ::tcltest::test ::ip:isOverlapNativec-6 {
        test with -inline
    } -setup {
    } -constraints {
        Cextension
    } -cleanup {
    } -body {
        set a [::ip::isOverlapNativec -ipv4 -inline 0x01010100 0xffffff00 {
            {0x02010001 0xffffffff} 
            {0x01010101 0xffffffff}
            {0x01010102 0xffffffff}
        }]
    } -result {{0x01010101 0xffffffff}}

    ::tcltest::test ::ip:isOverlapNativec-7 {
        test with -all -inline one element return
    } -setup {
    } -constraints {
        Cextension
    } -cleanup {
    } -body {
        set a [::ip::isOverlapNativec -ipv4 -all -inline 0x01010100 0xffffff00 {
            {0x02010001 0xffffffff} 
            {0x01010101 0xffffffff}
        }]
    } -result {{0x01010101 0xffffffff}}

    ::tcltest::test ::ip:isOverlapNativec-8 {
        test with -inline with not overlaps, returns nothing
    } -setup {
    } -constraints {
        Cextension
    } -cleanup {
    } -body {
        set a [::ip::isOverlapNativec -ipv4  -inline 0x01010100 0xffffff00 {
            {0x02010001 0xffffffff} 
        }]
    } -result {}



    ::tcltest::test ::ip:ipToLayer2Multicast-1 {
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::ipToLayer2Multicast 224.0.0.2
    } -result {01.00.5e.00.00.02}

    ::tcltest::test ::ip:ipHostFromPrefix-1 {
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::ipHostFromPrefix  1.1.1.1/32
    } -result {1.1.1.1}

    ::tcltest::test ::ip:ipHostFromPrefix-2 {
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::ipHostFromPrefix  1.1.1.0/24
    } -result {1.1.1.1}

    ::tcltest::test ::ip:ipHostFromPrefix-3 {
    } -setup {
    } -constraints {
    } -cleanup {
        unset x
        unset exlList
        unset testPrefix
    } -body {
        set testPrefix 1.1.1.0/24
        set exlList {
            1.1.1.18/32
            1.1.1.13/32
            1.1.1.17/32
            2.1.1.0/24 
            1.1.0.0/16 
            1.1.1.12/30
            1.1.1.4/30 
        }
        set x [::ip::ipHostFromPrefix  $testPrefix -exclude $exlList ]
        ip::longestPrefixMatch $x [concat $exlList [list $testPrefix]] -ipv4
    } -result {1.1.1.0/24}

    ::tcltest::test ::ip:reduceToAggregates {
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::reduceToAggregates {1.1.1.0/24 1.1.0.0/8  2.1.1.0/24 1.1.1.1/32 }
    } -result {1.0.0.0/8 2.1.1.0/24}

    ::tcltest::test ::ip:longestPrefixMatch-1 {
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::longestPrefixMatch 1.1.1.1/32 {1.1.1.0/24 1.1.0.0/8  2.1.1.0/24 1.1.1.1/32 } -ipv4
    } -result {1.1.1.1/32}

    ::tcltest::test ::ip:longestPrefixMatch-2 {
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::longestPrefixMatch 1.1.1.1 {1.1.1.0/24 1.0.0.0/8  2.1.1.0/24 1.1.1.0/28 } -ipv4
    } -result {1.1.1.0/28}

    ::tcltest::test ::ip:longestPrefixMatch-3 {
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::longestPrefixMatch 1.1.1.1 {2.1.1.0/24 2.0.0.0/8} -ipv4
    } -result {}

    ::tcltest::test ::ip:longestPrefixMatch-4 {
    } -setup {
    } -constraints {
    } -cleanup {
        unset x
        unset y
    } -body {
        set x 128.0.0.2
        set y {1.0.0.0/8 2.2.0.0/16 128.0.0.0/16 3.3.3.3/32}
        ::ip::longestPrefixMatch $x $y -ipv4
        # there was a problem when using varibles, it looked like
        # tcl was modifying the original variables in an 
        # upvar fashion
        ::ip::longestPrefixMatch $x $y -ipv4
    } -result {128.0.0.0/16}

    ::tcltest::test ::ip:longestPrefixMatch-5 {
        check where the match list is only a single prefix (non-match case)
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::longestPrefixMatch 128.0.0.2 {1.0.0.0/8} -ipv4
    } -result {}

    ::tcltest::test ::ip:longestPrefixMatch-6 {
        check where the match list is only a single prefix (match case)
    } -setup {
    } -constraints {
    } -cleanup {
    } -body {
        ::ip::longestPrefixMatch 128.0.0.2 {128.0.0.0/8} -ipv4
    } -result {128.0.0.0/8}

    ::tcltest::test ::ip:cmpDotIP-1 {
        test sorting of cmpDotIP 
    } -setup {
        set iplist {1.0.0.0 2.2.0.0 128.0.0.0 3.3.3.3}
    } -constraints {
    } -cleanup {
        unset iplist
    } -body {
        set a [lsort -command ip::cmpDotIP $iplist]
    } -result {1.0.0.0 2.2.0.0 3.3.3.3 128.0.0.0}

}

namespace delete ::ip::test

testsuiteCleanup

#
# ;;; Local Variables:
# ;;; mode: tcl
# ;;; indent-tabs-mode:nil
# ;;; End: