Coping without Namespaces - Revisited

Back in the article Coping without Namespaces, we discussed that 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 which 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. Simpy 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