Friday, 10 February 2012
Coping without Namespaces - Revisited
Back in the article Coping without Namespaces, we discussed the fact that Jim Tcl did not support namespaces, but that small changes to the source could be made to allow namespace-based Tcl code to be ported for use with Jim Tcl.
Now with namespaces supported in Jim Tcl 0.73, porting Tcl code that makes use of namespaces is easier than ever.
Once again, let's consider porting dns.tcl from tcllib to Jim Tcl.
Firstly an explanation of what was changed.
--- dns.tcl.orig 2012-03-05 13:02:36.000000000 +1000 +++ dns.tcl 2012-03-05 13:02:56.000000000 +1000 @@ -1,3 +1,15 @@ +# dns.tcl - Steve Bennett <steveb@workware.net.au> +# +# Modified for Jim Tcl to: +# - use udp transport by default +# - use sendto/recvfrom +# - don't try to determine local nameservers +# - remove support for dns uris and finding local nameservers +# - remove logging calls +# (both of these in order to remove dependencies on tcllib) + +# Based on: + # dns.tcl - Copyright (C) 2002 Pat Thoyts <patthoyts@users.sourceforge.net> # # Provide a Tcl only Domain Name Service client. See RFC 1034 and RFC 1035
For simplicity, we remove the dependencies on tcllib logger, uri and ip to
allow this example to be self contained. In Jim Tcl the binary and namespace
modules are optional, so load them if required.
@@ -31,14 +43,11 @@
#
# $Id: dns.tcl,v 1.36 2008/11/22 12:28:54 mic42 Exp $
-package require Tcl 8.2; # tcl minimum version
-package require logger; # tcllib 1.3
-package require uri; # tcllib 1.1
-package require uri::urn; # tcllib 1.2
-package require ip; # tcllib 1.7
+package require binary
+package require namespace
namespace eval ::dns {
- variable version 1.3.3
+ variable version 1.3.3-jim2
variable rcsid {$Id: dns.tcl,v 1.36 2008/11/22 12:28:54 mic42 Exp $}
namespace export configure resolve name address cname \
Since Jim Tcl supports udp out-of-the-box, and it is more efficient, default to udp rather than tcp. Also comment out the logging calls.
@@ -49,23 +58,13 @@
array set options {
port 53
timeout 30000
- protocol tcp
+ protocol udp
search {}
nameserver {localhost}
loglevel warn
}
- variable log [logger::init dns]
- ${log}::setlevel $options(loglevel)
- }
-
- # We can use either ceptcl or tcludp for UDP support.
- if {![catch {package require udp 1.0.4} msg]} { ;# tcludp 1.0.4+
- # If TclUDP 1.0.4 or better is available, use it.
- set options(protocol) udp
- } else {
- if {![catch {package require ceptcl} msg]} {
- set options(protocol) udp
- }
+ #variable log [logger::init dns]
+ #${log}::setlevel $options(loglevel)
}
variable types
udp is built-in with Jim Tcl.
@@ -248,14 +237,6 @@
return -code error "no nameserver specified"
}
- if {$state(-protocol) == "udp"} {
- if {[llength [package provide ceptcl]] == 0 \
- && [llength [package provide udp]] == 0} {
- return -code error "udp support is not available,\
- get ceptcl or tcludp"
- }
- }
-
# Check for reverse lookups
if {[regexp {^(?:\d{0,3}\.){3}\d{0,3}$} $state(query)]} {
set addr [lreverse [split $state(query) .]]
udp in Jim Tcl works just like tcp, with readable event handler being
triggered when the response is available.
@@ -273,6 +254,7 @@
}
} else {
UdpTransmit $token
+ wait $token
}
return $token
Jim Tcl has no support for async connect, and the parameters to socket are a little different.
@@ -668,9 +650,9 @@
"operation timed out"]]
}
- # Sometimes DNS servers drop TCP requests. So it's better to
- # use asynchronous connect
- set s [socket -async $state(-nameserver) $state(-port)]
+ # Jim Tcl has no async connect ...
+
+ set s [socket stream $state(-nameserver):$state(-port)]
fileevent $s writable [list [namespace origin TcpConnected] $token $s]
set state(sock) $s
set state(status) connect
Comment out the async connect check.
@@ -683,11 +665,13 @@
upvar 0 $token state
fileevent $s writable {}
- if {[catch {fconfigure $s -peername}]} {
- # TCP connection failed
- Finish $token "can't connect to server"
- return
- }
+
+ # Jim Tcl has no async connect ...
+# if {[catch {fconfigure $s -peername}]} {
+# # TCP connection failed
+# Finish $token "can't connect to server"
+# return
+# }
fconfigure $s -blocking 0 -translation binary -buffering none
udp in Jim Tcl is easy. Simply create the socket with socket dgram and
send with sendto.
@@ -722,18 +706,10 @@
"operation timed out"]]
}
- if {[llength [package provide ceptcl]] > 0} {
- # using ceptcl
- set state(sock) [cep -type datagram $state(-nameserver) $state(-port)]
- fconfigure $state(sock) -blocking 0
- } else {
- # using tcludp
- set state(sock) [udp_open]
- udp_conf $state(sock) $state(-nameserver) $state(-port)
- }
- fconfigure $state(sock) -translation binary -buffering none
+ set state(sock) [socket dgram]
+ #fconfigure $state(sock) -translation binary -buffering none
set state(status) connect
- puts -nonewline $state(sock) $state(request)
+ $state(sock) sendto $state(request) $state(-nameserver):$state(-port)
fileevent $state(sock) readable [list [namespace current]::UdpEvent $token]
Reading from a udp socket is best done with recvfrom
@@ -879,7 +855,7 @@
upvar 0 $token state
set s $state(sock)
- set payload [read $state(sock)]
+ set payload [$state(sock) recvfrom 1500]
append state(reply) $payload
binary scan $payload S id
Jim Tcl has lreverse built-in
@@ -1011,17 +987,6 @@
}
# -------------------------------------------------------------------------
-# Description:
-# Reverse a list. Code from http://wiki.tcl.tk/tcl/43
-#
-proc ::dns::lreverse {lst} {
- set res {}
- set i [llength $lst]
- while {$i} {lappend res [lindex $lst [incr i -1]]}
- return $res
-}
-
-# -------------------------------------------------------------------------
proc ::dns::KeyOf {arrayname value {default {}}} {
upvar $arrayname array
Notice that no namespace-related changes were required when porting this module.
The latest version of dns.tcl for Jim Tcl is available in git.
Steve Bennett (steveb@workware.net.au)
comments powered by Disqus