#! /usr/bin/env tclsh
    
    # return the ip address of an interface
    proc ipofif {if} {
        return [lindex [regexp -inline {inet addr:([0-9.]+)} [exec /sbin/ifconfig $if]] 1]
    }
    
    # return the network mask of interface
    proc nmofif {if} {
        return [lindex [regexp -inline {Mask:([0-9.]+)} [exec /sbin/ifconfig $if]] 1]
    }
    
    # return the complete set of enabled interfaces
    proc enumerateif {} {
        set result {}
        foreach {junk if} [regexp -all -inline -line {^([a-zA-Z0-9:]+)[ \t]} [exec /sbin/ifconfig]] {
            lappend result $if
        }
        return $result
    }
    
    proc iptables {args} {
        set code [catch {eval exec iptables $args} result]
        if {$code} {
            puts stderr "IPTABLES ERROR: $args - $result"
        }
    }
    
    # Create new chain, or flush existing
    proc newchain {chain} {
        if {[catch {exec iptables -F $chain}]} {
            iptables -N $chain
        }
    }
    
    # block anything to or from this IP
    proc block {ip {how REJECT}} {
        set how LOGDROP
        iptables -A INPUT -j $how --source $ip
        iptables -A FORWARD -j $how --destination $ip
        iptables -A OUTPUT -j $how --destination $ip
    }
    
    proc accept {input args} {
        eval iptables -A $input $args -j ACCEPT
    }
    
    proc drop {input args} {
        set log [string range [string map {-- ""} $args] 0 28]
        eval iptables -A $input $args -j LOG --log-level warning --log-prefix [list $log]
        eval iptables -A $input $args -j LOGDROP
        #eval iptables -A $input $args -j DROP
    }
    
    # Accept tcp connections on a certain interface to a certain port
    proc allow {dest ifs {proto tcp}} {
        puts stderr "Allow $proto connections to port $dest from interfaces $ifs"
        foreach if $ifs {
            iptables -A ${proto}_ok -m multiport -p $proto --in-interface $if --destination $::all($if) --destination-ports [join $dest ,] -j ACCEPT
        }
    }
    
    ## redirect $destport $sourceIF $to
    proc redir {dest_port source to {proto tcp}} {
        puts stderr "Redirect $proto connections from $source interface to port $dest_port to $to"
        #allow $dest_port $source $proto
    
        set me [lindex [split $::all($source) /] 0]
    
        iptables -t nat -p $proto -A PREROUTING --destination $me --destination-port $dest_port -j DNAT --to-destination $to
    }
    
    # classify interfaces into global arrays by category
    # by string matching network masks
    proc classify {args} {
        foreach if [enumerateif] {
            set ::all($if) "[ipofif $if]/[nmofif $if]"
            puts stderr "if $if: $::all($if)"
    
            foreach {arr match} {
                if {[string match $match $::all($if)]} {
                    array set ::$arr $if $::all($if)
                }
            }
        }
    }