diff --git a/README.md b/README.md index cff5e92..3ea75b8 100644 --- a/README.md +++ b/README.md @@ -422,6 +422,48 @@ it "should add X-Common-Name-SSL with Common Name from client SSL certificate if } ``` +### Classes Example + +TesTcl has partial support for the `class` command. For example, we could test the following rule: + +```tcl +rule classes { + when HTTP_REQUEST { + if { [class match [IP::remote_addr] equals blacklist] } { + drop + } else { + pool main-pool + } + } +} +``` + +with code that looks like this + +```tcl +package require -exact testcl 1.0.7 +namespace import testcl::* + +before { + event HTTP_REQUEST + class configure blacklist { + "blacklisted" "192.168.6.66" + } +} + +it "should drop blacklisted addresses" { + on IP::remote_addr return "192.168.6.66" + endstate drop + run irules/classes.tcl classes +} + +it "should drop blacklisted addresses" { + on IP::remote_addr return "192.168.0.1" + endstate pool main-pool + run irules/classes.tcl classes +} +``` + ## How stable is this code? This work is quite stable, but you can expect minor breaking changes. diff --git a/src/classes.tcl b/src/classes.tcl new file mode 100644 index 0000000..af429ea --- /dev/null +++ b/src/classes.tcl @@ -0,0 +1,151 @@ +package provide testcl 1.0.7 +package require log +package require cmdline + +namespace eval ::testcl { + namespace export class + variable classes +} + +# testcl::class -- +# +# stub for class command +# +# See https://devcentral.f5.com/wiki/irules.class.ashx +# +# class match [] +# class search [] +# class lookup +# class element [] +# class type +# class exists +# class size +# class names [-nocase] [] +# class get [-nocase] [] +# class startsearch +# class nextelement [] +# class anymore +# class donesearch +# +# For convenience, we also add an extra helper subcommand: +# class configure +# +# Example: +# class configure servers { +# "server1" "192.168.0.1" +# "server2" "192.168.0.2" +# } +# +# This format bears no resemblance to the formats used in F5 +# load balancers, and is simply the easiest to implement + +proc ::testcl::class {cmd args} { + variable classes + log::log debug "class $cmd $args invoked" + + set cmdargs [concat class $cmd $args] + set rc [catch { return [eval testcl::expected $cmdargs] } res] + if {$rc != 1500} { + log::log debug "skipping class method evaluation - expectation found for $cmdargs" + if {$rc < 1000} { + return $res + } + return -code $rc $res + } + + set options { + {index "Changes the return value to be the index of the matching class element."} + {name "Changes the return value to be the name of the matching class element."} + {value "Changes the return value to be the value of the matching class element."} + {element "Changes the return value to be a list of the name and value of the matching class element."} + } + + set return_command { + if {$params(index)} {return $i} + if {$params(name)} {return $element_name} + if {$params(value)} {return $element_value} + if {$params(element)} {return [list $element_name $element_value]} + return 1 + } + + set return_failure_block { + if {$params(index)} {return -1} + if {$params(name)} {return ""} + if {$params(value)} {return ""} + if {$params(element)} {return ""} + return 0 + } + + array set params [::cmdline::getoptions args $options] + switch -- $cmd { + configure { + set name [lindex $args 0] + set value [lindex $args 1] + set classes($name) $value + } + search { + set classname [lindex $args 0] + set operator [lindex $args 1] + set item [lindex $args 2] + if {[expr ! [info exists classes($classname)]]} $return_failure_block + set clazz $classes($classname) + for {set i 0} {$i < [llength $clazz] / 2} {incr i} { + set element_name [lindex $clazz [expr 2 * $i]] + set element_value [lindex $clazz [expr 2 * $i + 1]] + if "\$element_value $operator \$item" $return_command + } + eval $return_failure_block + } + match { + set item [lindex $args 0] + set operator [lindex $args 1] + set classname [lindex $args 2] + if {[expr ! [info exists classes($classname)]]} $return_failure_block + set clazz $classes($classname) + for {set i 0} {$i < [llength $clazz] / 2} {incr i} { + set element_name [lindex $clazz [expr 2 * $i]] + set element_value [lindex $clazz [expr 2 * $i + 1]] + if "\$item $operator \$element_value" $return_command + } + eval $return_failure_block + } + lookup { + set item [lindex $args 0] + set classname [lindex $args 1] + return [::testcl::class match -value $item equals $classname] + } + element { + set index [lindex $args 0] + set classname [lindex $args 1] + set name [lindex $classes($classname) [expr 2 * $index]] + set value [lindex $classes($classname) [expr 2 * $index + 1]] + if {$params(name)} { + return $name + } + if {$params(value)} { + return $value + } + return [list $name $value] + } + exists { + set classname [lindex $args 0] + return [info exists classes($classname)] + } + size { + set classname [lindex $args 0] + if {[expr ! [info exists classes($classname)]]} { + return 0 + } else { + return [expr [llength $classes($classname)] / 2] + } + } + type - + names - + get - + startsearch - + nextelement - + anymore - + donesearch {error "Not implemented yet"} + } + +} \ No newline at end of file diff --git a/test/test_class.tcl b/test/test_class.tcl new file mode 100644 index 0000000..3a355ef --- /dev/null +++ b/test/test_class.tcl @@ -0,0 +1,38 @@ +source src/on.tcl +source src/assert.tcl +source src/classes.tcl +namespace import ::testcl::* + +# Comment out to suppress logging +#log::lvSuppressLE info 0 + +class configure server { + "server1" "192.168.0.1" + "server2" "192.168.0.2" +} + +class configure protocols { + "http" "http://" + "mailto" "mailto:" + "ftp" "ftp://" +} + +if { $::tcl_platform(platform) eq "java" } { + assertStringEquals [class search -value server ends_with "0.1"] "192.168.0.1" + assertStringEquals [class search -name server ends_with "0.2"] "server2" + assertStringEquals [class match -element "http://localhost" starts_with protocols] [list "http" "http://"] + assertNumberEquals [class match -index "ftp://locahost" starts_with protocols] 2 +} +assertNumberEquals [class search server eq "192.168.0.1"] 1 +assertNumberEquals [class search server eq "doesn't exist"] 0 +assertNumberEquals [class search doesnt_exist eq "192.168.0.1"] 0 +assertStringEquals [class -value search server eq "doesn't exist"] "" +assertStringEquals [class -name search doesnt_exist eq "192.168.0.1"] "" +assertNumberEquals [class size protocols] 3 +assertNumberEquals [class size doesnt_exist] 0 +assertStringEquals [class element 2 protocols] [list "ftp" "ftp://"] +assertStringEquals [class element -name 1 protocols] "mailto" +assertStringEquals [class element -value 0 protocols] "http://" +assertNumberEquals [class exists server] 1 +assertNumberEquals [class exists doesnt_exist] 0 +