Tcl script examples

# nf_aliasExec.tcl --
#
#   Sample Tcl script containing multiple procedures, call the script from 
#   alias exec commands or from within the Tcl shell.
#   !Do not use with the 'scripting tcl init [location/file.tcl]' global 
#   configuration command and or call with 'tclsh file procedure' as well as
#   using alias exec commands, doing so will cause procedures to be ran twice 
#   when called with tclsh.
#   To use with the 'scripting tcl init...' command remove the control script 
#   section at the bottom and save the file with another name.
#   
#
#    Copyright (C) 2009  Nigel Franklin.
#  
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License,
#    or 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 General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see http://www.gnu.org/licenses/.
#
#
#
#  Revision #          :  1.0
#  Last Revised        :  May 29, 2009
#  Author              :  Nigel Franklin, www.nigelfranklin.co.uk
#  Router Requirements :
#   None
#
#  Cisco Products tested     :   1801, 1841
#  Cisco IOS versions tested :   12.4(11)
#
#   Examples:
# alias exec pings tclsh flash:/tcl/nf_aliasExec.tcl pings {3 47 1 Dialer0 0 1 1 {8.8.4.4 8.8.4.4}}
#       proc pings {repeat size timeout source data validate DF {iplist}}
#       proc pingsD: Calls pings with a default list of fields set in the proc
#                   if pings is called with no fields.
#
# alias exec GetOne tclsh flash:/tcl/nf_aliasExec.tcl snmpGetOne {1.3.6.1.2.1.1.5.0 1.3.6.1.2.1.1.6.0 1.3.6.1.2.1.1.3.0}
#       proc snmpGetOne {oidList}
#
# alias exec ftp tclsh flash:/tcl/nf_aliasExec.tcl ftp filename
#       proc ftp filename arg
 
 
#***************
# ftp --
#
#       Copys via FTP a file to the routers flash, automatically 
#       overwriting existing EEM Policy.
#       Primarily configured for Tcl and EEM Tcl script testing.
#
# Arguments:
#       filename    (required) name of file to be copied, will also be save name
#                   If no extension is given .tcl is assumed and added.
#       args        (optional) if e the file is treated as a EEM Tcl Script, a
#                   new folder source is defined, after upload the script name 
#                   is un/re registered as a global config event manager policy.
#
# Assumption:
#       FTP/Flash folder structure assumed as;
#           root/tcl for tcl files
#           root/tcl/eem for EEM Tcl scripts
#       FTP connection variables need setting.
#       
# Results:
#       File copied to router flash, if EEM script event manager policy renewed.
proc ftp {filename args} {
    #defaults
    set ftpUser cisco
    set ftpPass cisco
    set ftpServer 192.168.1.2
    set routerDest flash:
    set folder "/tcl/"
    set eemScript 0
    
    
    if {![string match *.??? $filename]} {
        set filename  "$filename.tcl"
    }
        switch $args {
            e {
            set eemScript 1
            set folder "/tcl/eem/"
            }
        }
 
    exec [typeahead "\ny\n"]
    exec [copy ftp://$ftpUser:$ftpPass@$ftpServer$folder$filename $routerDest$folder$filename]
  
    if {$eemScript} {
        #un/re register event policy
        ios_config "no event manager policy $filename type user" "end"
        ios_config "event manager policy $filename type user" "end"
    }
}
 
 
 
#***************
# pings --
#
#       Runs cisco ping with shortcut commands.
#       Counts number of none '.' responses and reports, also counts max number 
#       of consecutive dropped packets.
#
# Arguments:
#       {repeat size timeout source data validate DF {iplist}}
#		 repeat, size, timeout  -> Integers
#		 source -> the named interface to send the pings from.
#		 data -> a valid data pattern [0(default)|0000|FFFF|AAAA|rotate|...]
#		 validate (reply), DF (Set DF bit in IP header) -> [0|1] (meaning no|yes)
#		 iplist -> A Tcl list of IP addresses.
#
# Example:
#		pings {repeat size timeout source data validate DF iplist}
#		pings 20 56 1 Dialer0 0 0 1 {8.8.8.8 8.8.4.4}
#         
# Results:
#       Ping ran and results shown
#http://www.cisco.com/en/US/tech/tk365/technologies_tech_note09186a0080093f22.shtml
proc pings {repeat size timeout source data validate DF iplist} {
 
    if {$repeat != 0 } {lappend command repeat $repeat}
    if {$size != 0 } {lappend command size $size}
    if {$timeout != 0 } {lappend command timeout $timeout}
    if {$source != 0 } {
        lappend command source $source
        lappend note "From interface $source, "
    }
    if {$data != 0 } {lappend command data $data}
    if {$validate != 0 } {
        lappend command validate
        lappend note "Reply data validated, "
    }
    if {$DF != 0 } {
        lappend command DF
        lappend note "DF bit set in IP header."    
    }
    
    foreach ip $iplist {
        puts "\n"
        set result [exec ping ip $ip $command]
        if [string match "*%*" $result] {
            regsub {^..} $result "" result
            puts "Cannot ping $ip, error was: $result"
        } else {
            set resultRespAll [regexp -all -line -inline {^[UQM\u003F\u0026!\.]+}  $result]    
            foreach packetResp {U Q M \\u003F \\u0026 \\.} {
                set packetRespCount($packetResp) [regexp -all $packetResp $resultRespAll]
            }
        
            set count 0
            set max 0
 
            for {set x 0} {$x<[llength $resultRespAll]} {incr x} {
                for {set y 0} {$y<[llength [split [lindex $resultRespAll $x] {}]]} {incr y} {
                    if {[lindex [split [lindex $resultRespAll $x] {}] $y] == "."} {
                        incr count
                        if {$count > $max} {set max $count}
                    } elseif {[lindex [split [lindex $resultRespAll $x] {}] $y] == "!"} {
                        set count 0
                    }
                }
            }
            set result [split $result "\n"]
            puts "[lindex $result 2]"
            puts "   [join $note]"
 
            if {$max != 0} {
                puts "   Max timed out packets in a row: $max"
            }
            puts "[lindex $result [expr ([llength $result] - 1)]]"
            foreach name [lsort [array names packetRespCount]] {
                if {$packetRespCount($name) != 0} {
                    set nameDecode [string map -nocase {
                        "\\u003F"      "Lifetime exceeded: "
                        "\\u0026"      "Unknown type: "
                        "\\."           "Timed out: "
                        "U"      "Destination unreachable: "
                        "M"      "Could not fragment: "
                        "Q"      "Destination too busy: "
                    } $name]
                    if {![string match "Timed out: " $nameDecode]} {lappend drops ", $nameDecode$packetRespCount($name)"}
                }
            }
            if {[info exists drops]} {
                puts "   Number of dropped packets by type [join $drops]"
                unset drops
            }
        }
    }
}
#***
proc pingsD {} {
    puts "pings 50 56 1 Dialer0 0 0 1 {8.8.8.8 8.8.4.4}\n"
    pings 50 56 1 Dialer0 0 0 1 {8.8.8.8 8.8.4.4}
}
 
 
#***************
# snmpGetOne --
#
#       Gets one or more snmp entries via the snmp_getone command.
#
# Arguments:
#       oidList     (required) list of one or more OID's
#       
# Results:
#       list of snmp values returned
proc snmpGetOne {oidList} {
    set communityStr tcl
    set oidResult [list]
    #set oidList [join $oidList]
    foreach oid $oidList {
        set snmpResult [snmp_getone $communityStr $oid]
        if [string match "*snmp error*" $snmpResult] {
            regexp {text='(.*)'} $snmpResult regexAll bRefValue
            lappend oidResult "Error: $bRefValue"
        } elseif [string match "*NO_SUCH_I*" $snmpResult] {
            regexp {val='(.*)'} $snmpResult regexExp bRefVal
            lappend oidResult "Error: $bRefVal"
        } else {
        regexp {val='(.*)'} $snmpResult regexExp bRefVal
        lappend oidResult $bRefVal
        }
    }
    return $oidResult 
}   
 
 
#***************
# syslog --
#
#       writes message to syslog
#
# Arguments:
#       scriptName  (required) can be {}, Name of script calling procedure.
#       msg         (required) message to be written
#       
# Results:
#       New syslog entry created
proc syslog {scriptName msg} {
 
    set Syslog [open "syslog: " w+]
    puts $Syslog "%$scriptName-6-ScriptMsg: $msg"
    close $Syslog
}
 
 
 
 
 
# ############################################
#Script control.
#Remove this section and save as a different file if you want to use with \
scripting tcl init
 
 
if {(![info exists argv0]) || ($argc == 0)} {
    #?
} elseif {[string match pings [lindex $argv 0]]} {
    if {[llength [lindex $argv 1]] != 8} {
        puts "This version of pings requires 8 variables, \
        'repeat size timeout source data validate DF iplist. \
        alias exec pings tclsh flash:/tcl/aliasExec.tcl pings {3 47 1 Dialer0 0 1 1 {8.8.4.4 8.8.4.4}}
        \nRunning defaults pingsD"
        pingsD
    } else {
        puts "Running Ping:  [join $argv]"
        eval [join $argv]
    }
} elseif {[string match syslog [lindex $argv 0]]} {
    if {[llength [lindex $argv 1]] != 2} {
        puts "This version of nf_syslog requires 2 variables, \
        'scriptName message'."
    } else {
        puts "nf_syslog:  [join $argv]"
        eval [join $argv]
    }
} elseif {[string match ftp [lindex $argv 0]]} {
    if {[llength $argv] <= 1} {
        puts -nonewline "Enter file to upload and arg 'e' if required, eg 'ciscoInit': "
        flush stdout
        gets stdin args_
        ftp $args_
    } else {
        eval [join $argv]
    }
} elseif {[string match snmpGetOne [lindex $argv 0]]} {
    if {[llength $argv] != 2} {
        puts "snmpGetOne requires a single list of OID's to be provided, {1.3.6.1.2.1.1.5.0 1.3.6.1.2.1.1.6.0 1.3.6.1.2.1.1.3.0}"
        puts -nonewline "Enter a {list} of OID's: "
        flush stdout
        gets stdin oidList
        snmpGetOne $oidList
    } else {
        puts "snmpGetOne:  [lindex $argv 1]"
        puts "[snmpGetOne [lindex $argv 1]]"
    }
} else {
    puts "Procedure not found, available procedures are: [info procs]"
}