原创 学习Tcl（四）——UDP收发包

    这些天在编一个windows操作系统下接收和发送UDP包的程序，由于我C语言编程基础差，时间又紧，所以选择了Tcl作为编程语言。 riple

    在手头一本Tcl编程的书中查找了一下，只有TCP套接字编程的指导，没有UDP的相关内容。 riple

    眼前没有，只好到Tcl Developer Xchange上“大海捞针”一下。相关的内容还真不少，顺着前面几个链接，我终于找到了UDP相关的内容。到Xchange上搜索，真是一个学习、开发Tcl的好方法。 riple

    在Tcl的标准发布包内是没有直接对UDP操作的命令的，需要下载一个TclUDP包，在程序中包含这个包即可。 riple

    经过两天的分解、重组、拷贝、粘贴、尝试和失败，终于把示例程序中提供的程序修改成了我需要的能够连续接收、响应的简单UDP服务器程序。 riple

    Tcl编程中的高级功能（如加载包、事件驱动编程、套接字编程）和几个重要但是难懂的操作（如从用户输入中提取参数、列表操作），以前我是敬而远之的，这次也不得不硬着头皮一一“磨”了下来。学习一门编程语言还是要“躬行”才能学得快啊。 riple

    现在看来，当初觉得很难的UDP网络收发包也不是那么难。分析清楚了，和Tcl下对文件的操作差不多。 riple

    从本机特定端口向目标机特定端口发送特定包的程序：udp_send.tcl

package require udp 1.0.6

proc Event {sock} {
    global forever
    global pkt
    global peer
    set pkt [read $sock]
    set peer [fconfigure $sock -peer]
    puts "Received [string length $pkt] from $peer\n$pkt"
    set forever 1
    return
}

set forever 0
# parse input arguments
if {[lindex $argv 2]    == ""} {
    puts "\n"
    puts "usage: quartus_sh -t udp_send.tcl -srcport -host -desport -msg"
    puts "\n"
} else {
  # parse input arguments
    set srcport [lindex $argv 0]
    set host    [lindex $argv 1]
    set desport [lindex $argv 2]
    set msg     [lindex $argv 3]
  # open udp   
    set s [udp_open $srcport]
    fconfigure $s -blocking 0 -buffering none -translation binary \
        -remote [list $host $desport]
    fileevent $s readable [list Event $s]
  # send message
    if {$msg == {}} {
        for {set i 0} {$i < 512} {incr i 1} {
        append loop_hello "hello"
        }
        puts -nonewline $s $loop_hello
    } else {
        puts -nonewline $s $msg
   
    }
  # close udp
    close $s
}

    监听本机特定端口UDP包，接受后根据发送机IP和端口返回特定信息的程序：udp_reply.tcl

package require udp 1.0.6

proc Event {sock} {
    global forever
    global pkt
    global peer
    set pkt [read $sock]
    set peer [fconfigure $sock -peer]
    puts "Received [string length $pkt] from $peer\n$pkt"
    set forever 1
    return
}

set forever 0

# parse input arguments
  if {[lindex $argv 0] == ""} {
    puts "\n"
    puts "usage: quartus_sh -t udp_reply.tcl -port"
    puts "\n"
  } else {
    # open udp
      set s [udp_open [lindex $argv 0]]
      fconfigure $s -blocking 0 -buffering none -translation binary
   
    # listen to required port
      puts "\n"
      puts "listenning to local port [lindex $argv 0]"
      fileevent $s readable [list Event $s]
      vwait ::forever
     
    # reply to sender host and port
      fconfigure $s -remote [list [lindex $peer 0]  [lindex $peer 1]]
      puts  -nonewline $s hello
      puts "replied remote peer $peer"
      puts "\n"
   
    # close udp
      close $s
  }