Tcl语言TIOBE的排名是100左右,对于很多人来说,可能根本就没听说过TCL这门语言。一些大型公司(思科、F5、Radware等硬件类的厂商,百度之类的互联网公司等)仍然在积极的使用Tcl,它可以非常快速简单的把Tcl变成它独有的Domain Specific Language,让它易读易写,在使用过程中,每家公司都加入了很多自己需要的特性,用在不同领域的Tcl也完全不一样,从某种意义上来说,使用TCL很像使用Linux内核,以TCL为基础可以创造出各种可能性。
网上有大量的关于TCL的介绍和示例,在此不再赘述。
下例是笔者接受了一项新的任务,在负载均衡硬件设备上,解析MQTT协议,从协议中提取user_name,并以user_name作为负载分发的依据,下边的逻辑中只包含了核心的逻辑部分。
#tcl mqtt
#从TCP payload中提取的MQTT协议的内容,16进制格式
set payload_content "103f00044d51545404c2003c00203332303032316531623566363436343238666634336634616239646262316533000661646d696e310009706173737730726440"
set binary_payload_content ""
binary scan [binary format H* $payload_content] B* binary_payload_content
#固定头部分
set fixed_header [string range $binary_payload_content 0 7]
#剩余报文长度
set byte2_high_bit [string range $binary_payload_content 8 8]
set length_byte_num 1
#最高位为0,表示只有一个字节表示长度
if { $byte2_high_bit == 0 } {
#scan [string range $payload_content 2 3] %x remain_length
set length_byte_num 1
} else {
if { [string range $binary_payload_content 16 16] == 0}{
set length_byte_num 2
} else {
if { [string range $binary_payload_content 24 24] == 0}{
set length_byte_num 3
} else {
if { [string range $binary_payload_content 32 32] == 0}{
set length_byte_num 4
}
}
}
}
set remain_length [scan [ string range $payload_content 2 [ expr {$length_byte_num*2-1}] ] %x]
#puts $remain_length
#解析MQTT协议中的protocol_name
set protocal_name_start [expr {2+$length_byte_num*2}]
set protocal_name_end [expr {14+$length_byte_num*2-1}]
set protocal_name [string range $payload_content $protocal_name_start $protocal_name_end]
#puts $protocal_name
#解析connect_flags
set connect_flags_start [expr { $protocal_name_end + 3 }]
set connect_flags_end [expr { $connect_flags_start + 2 -1 }]
set connect_flags [string range $payload_content $connect_flags_start $connect_flags_end]
#puts $connect_flags
binary scan [binary format H* $connect_flags] B* connect_flags_bits
#puts $connect_flags_bits
set username_flag [string range $connect_flags_bits 0 0]
set will_flag [string range $connect_flags_bits 5 5]
#puts $will_flag
#解析client id
set client_id_length_start [expr {$connect_flags_end + 4 + 1} ]
set client_id_length_end [expr {$client_id_length_start + 4 -1} ]
set client_id_length_hex [string range $payload_content $client_id_length_start $client_id_length_end]
#client_id长度,十进制
scan $client_id_length_hex %x client_id_length
set client_id_hex [string range $payload_content $client_id_length_end+1 [expr {$client_id_length_end+2*$client_id_length}]]
set client_id [binary format H* $client_id_hex]
#解析null topic和null message
set will_topic "null_topic"
set will_message "null_message"
set username_length_start [expr {$client_id_length_end + $client_id_length *2 + 1}]
set username_length_end [expr {$username_length_start + 4 -1}]
set will_topic_length 0
if { $will_flag == 1 } {
set will_topic_length_start [expr {$client_id_length_end + $client_id_length *2 + 1}]
set will_topic_length_end [expr {$will_topic_length_start + 4 -1}]
set will_topic_length_hex [ string range $payload_content $will_topic_length_start $will_topic_length_end]
set will_topic_length [scan $will_topic_length_hex %x]
set will_message_length_start [expr {$will_topic_length_end + $will_topic_length *2 + 1}]
set will_message_length_end [expr {$will_message_length_start + 4 -1}]
set will_message_length_hex [ string range $payload_content $will_message_length_start $will_message_length_end]
set will_message_length [scan $will_message_length_hex %x]
set username_length_start [expr {$will_message_length_end + $will_message_length *2 + 1}]
set username_length_end [expr {$username_length_start + 4 -1}]
set will_topic [binary format %x [string range $will_topic_length_end+1 [expr {$will_topic_length_end + 2*$will_topic_length}]
set will_message [binary format %x [string range $will_message_length_end+1 [expr {$will_message_length_end + 2*$will_message_length}]
}
#puts $will_topic_length
#解析user name
set user_name_length_hex [ string range $payload_content $username_length_start $username_length_end]
#puts $user_name_length_hex
scan $user_name_length_hex %x user_name_length
#puts $user_name_length
set user_name_start [expr { $username_length_end + 1}]
set user_name_end [expr { $user_name_start + $user_name_length * 2 -1}]
set user_name [binary format H* [string range $payload_content $user_name_start $user_name_end] ]
puts $user_name