使用TCL语言解析MQTT协议简单示例

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