[Tkabber-dev] [tclxmpp commit] r96 - * xmpp/pconnect.tcl, xmpp/https.tcl, xmpp/socks4.tcl, xmpp/socks5.tcl:

codesite-noreply at google.com codesite-noreply at google.com
Sun Mar 29 20:13:44 MSD 2009


Author: sgolovan
Date: Sun Mar 29 09:12:27 2009
New Revision: 96

Modified:
    trunk/ChangeLog
    trunk/xmpp/https.tcl
    trunk/xmpp/pconnect.tcl
    trunk/xmpp/socks4.tcl
    trunk/xmpp/socks5.tcl

Log:
	* xmpp/pconnect.tcl, xmpp/https.tcl, xmpp/socks4.tcl, xmpp/socks5.tcl:
	  Return human-readable messages when errors occur. Added abortion
	  procedures to socks4 and socks5  packages, and a timeout procedure
	  to pconnect package.

	* xmpp/socks4.tcl, xmpp/socks5.tcl: Fixed reconstructing destination
	  address returned by a SOCKS proxy. Added support for IPv6 adresses
	  to socks5 package.


Modified: trunk/ChangeLog
==============================================================================
--- trunk/ChangeLog	(original)
+++ trunk/ChangeLog	Sun Mar 29 09:12:27 2009
@@ -1,3 +1,14 @@
+2009-03-29  Sergei Golovan  <sgolovan at nes.ru>
+
+	* xmpp/pconnect.tcl, xmpp/https.tcl, xmpp/socks4.tcl, xmpp/socks5.tcl:
+	  Return human-readable messages when errors occur. Added abortion
+	  procedures to socks4 and socks5  packages, and a timeout procedure
+	  to pconnect package.
+
+	* xmpp/socks4.tcl, xmpp/socks5.tcl: Fixed reconstructing destination
+	  address returned by a SOCKS proxy. Added support for IPv6 adresses
+	  to socks5 package.
+
  2009-03-27  Sergei Golovan  <sgolovan at nes.ru>

  	* xmpp/zlib.tcl: Added a hack which doesn't allow to load xmpp::zlib

Modified: trunk/xmpp/https.tcl
==============================================================================
--- trunk/xmpp/https.tcl	(original)
+++ trunk/xmpp/https.tcl	Sun Mar 29 09:12:27 2009
@@ -14,6 +14,7 @@
  package require base64
  package require ntlm 1.0
  package require pconnect 0.1
+package require msgcat

  package provide pconnect::https 0.1

@@ -34,7 +35,7 @@
  #       sock        an open socket token to the proxy server
  #       addr        the peer address, not the proxy server
  #       port        the peer port number
-#       args
+#       args
  #               -command    tclProc {status socket}
  #               -username   userid
  #               -password   password
@@ -60,18 +61,17 @@
      Debug $token 2 "sock=$sock, addr=$addr, port=$port, args=$args"

      array set state {
-        -command    ""
-        -timeout    60000
-        -username   ""
-        -password   ""
-        -useragent  ""
-        async       0
-        status      ""
-    }
-    array set state [list   \
-        addr        $addr \
-        port        $port \
-        sock        $sock]
+        -command   ""
+        -timeout   60000
+        -username  ""
+        -password  ""
+        -useragent ""
+        async      0
+        status     ""
+    }
+    array set state [list addr $addr \
+                          port $port \
+                          sock $sock]
      array set state $args

      if {[string length $state(-command)] > 0} {
@@ -81,23 +81,26 @@
      if {[catch {set state(peer) [fconfigure $sock -peername]}]} {
          catch {close $sock}
          if {$state(async)} {
-            after idle [list $state(-command) error network-failure]
+            after idle $state(-command) \
+                  [list error [::msgcat::mc "Failed to conect to HTTPS  
proxy"]]
              Free $token
              return $token
          } else {
              Free $token
-            return -code error network-failure
+            return -code error [::msgcat::mc "Failed to conect to HTTPS  
proxy"]
          }
      }

      PutsConnectQuery $token

-    fileevent $sock readable  \
-        [namespace code [list Readable $token]]
+    fileevent $sock readable \
+              [namespace code [list Readable $token]]

      # Setup timeout timer.
-    set state(timeoutid) \
-        [after $state(-timeout) [namespace code [list Timeout $token]]]
+    if {$state(-timeout) > 0} {
+        set state(timeoutid) \
+            [after $state(-timeout) [namespace code [list Timeout $token]]]
+    }

      if {$state(async)} {
          return $token
@@ -168,9 +171,11 @@
          # Success
          while {[string length [gets $state(sock)]]} {}
          Finish $token ok
+        return
      } elseif {$code != 407} {
          # Failure
          Finish $token error $state(result)
+        return
      } else {
          # Authorization required
          set content_length -1
@@ -196,7 +201,7 @@
              [socket -async [lindex $state(peer) 0] [lindex $state(peer) 2]]

          fileevent $state(sock) writable \
-            [namespace code [list Authorize $token $method]]
+                  [namespace code [list Authorize $token $method]]
      }

      return
@@ -264,7 +269,7 @@
      PutsConnectQuery $token "Basic $auth"

      fileevent $state(sock) readable \
-        [namespace code [list AuthorizeBasicStep2 $token]]
+              [namespace code [list AuthorizeBasicStep2 $token]]

      return
  }
@@ -297,10 +302,13 @@
          # Success
          while {[string length [gets $state(sock)]]} { }
          Finish $token ok
+        return
      } else {
          # Failure
          Finish $token error $state(result)
+        return
      }
+
      return
  }

@@ -342,7 +350,7 @@
      PutsConnectQuery $token "NTLM $message1"

      fileevent $state(sock) readable \
-        [namespace code [list AuthorizeNtlmStep2 $token]]
+              [namespace code [list AuthorizeNtlmStep2 $token]]

      return
  }
@@ -406,7 +414,7 @@
      PutsConnectQuery $token "NTLM $message3"

      fileevent $state(sock) readable \
-        [namespace code [list AuthorizeNtlmStep3 $token]]
+              [namespace code [list AuthorizeNtlmStep3 $token]]

      return
  }
@@ -439,10 +447,13 @@
          # Success
          while {[string length [gets $state(sock)]]} { }
          Finish $token ok
+        return
      } else {
          # Failure
          Finish $token error $state(result)
+        return
      }
+
      return
  }

@@ -591,7 +602,7 @@
  #       A proxy negotiation is finished with error.

  proc ::pconnect::https::Timeout {token} {
-    Finish $token error [::msgcat::mc "HTTPS proxy negotiation timeout"]
+    Finish $token abort [::msgcat::mc "HTTPS proxy negotiation timed out"]
      return
  }


Modified: trunk/xmpp/pconnect.tcl
==============================================================================
--- trunk/xmpp/pconnect.tcl	(original)
+++ trunk/xmpp/pconnect.tcl	Sun Mar 29 09:12:27 2009
@@ -74,7 +74,7 @@
  # Arguments:
  #       host             the peer address, not SOCKS server
  #       port             the peer's port number
-#       args
+#       args
  #           -domain      inet (default) | inet6
  #           -proxyfilter A callback which takes host and port as its  
arguments
  #                        and returns a proxy to connect in form of a list
@@ -88,9 +88,7 @@
  #           -password    password
  #           -useragent   user agent (for HTTP proxies)
  #           -command     tclProc {token status}
-#                        the 'status' is any of:
-#                        ok, error, timeout, network-failure,
-#                         rsp_*, err_* (see socks4/5)
+#                        the 'status' is any of: ok, error, abort
  # Results:
  #       A socket if -command is not specified or a token to make
  #       possible to interrupt timed out connect.
@@ -106,6 +104,7 @@
                      -username    ""
                      -password    ""
                      -useragent   ""
+                    -timeout     0
                      -command     ""}
      array set Args $args

@@ -166,14 +165,20 @@
      set state(port)  $port
      set state(sock)  $sock

-    if {[string length $state(-command)] > 0} {
+    # Setup timeout timer.
+    if {$state(-timeout) > 0} {
+        set state(timeoutid) \
+            [after $state(-timeout) [namespace code [list Timeout $token]]]
+    }
+
+    if {![string equal $state(-command) ""]} {
          return $token
      } else {
          vwait $token\(status)

          set status $state(status)
          set sock $state(sock)
-        catch {unset state}
+        Free $token

          if {[string equal $status ok]} {
              return $sock
@@ -219,7 +224,7 @@
          uplevel #0 [lindex $packs($proxy) 1] [list $state(ptoken)]
      } else {
          if {[string length $proxy] > 0} {
-            Finish $token abort [::msgcat::mc "Connection to proxy  
aborted"]
+            Finish $token abort [::msgcat::mc "Connection via proxy  
aborted"]
          } else {
              Finish $token abort [::msgcat::mc "Connection aborted"]
          }
@@ -256,9 +261,11 @@
          if {[string length $proxy] > 0} {
              Finish $token error [::msgcat::mc "Cannot connect to  
proxy %s:%s" \
                                                $ahost $aport]
+            return
          } else {
              Finish $token error [::msgcat::mc "Cannot connect to %s:%s" \
                                                $ahost $aport]
+            return
          }
      } else {
          if {[string length $proxy] > 0} {
@@ -268,10 +275,13 @@
                                 -command [namespace code [list  
ProxyCallback \
                                                                $token]]] \
                           [GetOpts $token]]
+            return
          } else {
              Finish $token ok
+            return
          }
      }
+
      return
  }

@@ -332,13 +342,71 @@
      if {[string equal $status ok]} {
          set state(sock) $sock
          Finish $token ok
+        return
      } else {
          # If $status equals to error or abort then $sock contains error  
message
          Finish $token $status $sock
+        return
+    }
+
+    return
+}
+
+# ::pconnect::Timeout --
+#
+#       Abort connection which is in progress with a timeout.
+#
+# Arguments:
+#       token       A control token which is returned by pconnect::socket
+#
+# Result:
+#       An empty string or error.
+#
+# Side effects:
+#       A connection which is establising currently is aborted. If a  
callback
+#       procedure was supplied then it is called with error.
+
+proc ::pconnect::Timeout {token} {
+    variable packs
+    variable $token
+    upvar 0 $token state
+
+    set proxy $state(-proxy)
+
+    if {[info exists state(ptoken)]} {
+        uplevel #0 [lindex $packs($proxy) 1] [list $state(ptoken)]
+    } else {
+        if {[string length $proxy] > 0} {
+            Finish $token abort [::msgcat::mc "Connection via proxy timed  
out"]
+        } else {
+            Finish $token abort [::msgcat::mc "Connection timed out"]
+        }
      }
      return
  }

+# ::pconnect::Free --
+#
+#       Frees a connection token.
+#
+# Arguments:
+#       token            A connection token.
+#
+# Result:
+#       An empty string.
+#
+# Side effects:
+#       A connection token and its state informationa are destroyed.
+
+proc ::pconnect::Free {token} {
+    variable $token
+    upvar 0 $token state
+
+    catch {after cancel $state(timeoutid)}
+    catch {unset state}
+    return
+}
+
  # ::pconnect::Finish --
  #
  #       A helper procedure which cleans up state and calls a callback  
command
@@ -361,10 +429,12 @@
      variable $token
      upvar 0 $token state

+    catch {after cancel $state(timeoutid)}
+
      if {[string length $state(-command)]} {
          set sock $state(sock)
          set cmd $state(-command)
-        catch {unset state}
+        Free $token
          if {[string equal $status ok]} {
              uplevel #0 $cmd [list ok $sock]
          } else {

Modified: trunk/xmpp/socks4.tcl
==============================================================================
--- trunk/xmpp/socks4.tcl	(original)
+++ trunk/xmpp/socks4.tcl	Sun Mar 29 09:12:27 2009
@@ -12,6 +12,7 @@
  # $Id$

  package require pconnect
+package require msgcat

  package provide pconnect::socks4 0.1

@@ -29,17 +30,11 @@
          rsp_erruserid  \x5d
      }

-    # Practical when mapping errors to error codes.
-    variable iconst
-    array set iconst {
-        4   ver
-        1   cmd_connect
-        2   cmd_bind
-        90  rsp_granted
-        91  rsp_failure
-        92  rsp_errconnect
-        93  rsp_erruserid
-    }
+    variable msg
+    array set msg [list \
+        91  [::msgcat::mc "Request rejected or failed"] \
+        92  [::msgcat::mc "Server cannot reach client's identd"] \
+        93  [::msgcat::mc "Client's identd could not confirm the userid"]]

      variable debug 0

@@ -53,7 +48,7 @@
  #       Negotiates with a SOCKS server.
  #
  # Arguments:
-#       sock        an open socket token to the SOCKS server
+#       sock        an open socket to the SOCKS server
  #       addr        the peer address, not SOCKS server
  #       port        the peer's port number
  #       args
@@ -62,7 +57,7 @@
  #               -timeout    millisecs (default 60000)
  #
  # Results:
-#       The connect socket or error if no -command, else empty string.
+#       The connect socket or error if no -command, else a connection  
token.
  #
  # Side effects:
  #       Socket is prepared for data transfer.
@@ -85,13 +80,12 @@
          bnd_port    ""
          status      ""
      }
-    array set state [list \
-        addr        $addr \
-        port        $port \
-        sock        $sock]
+    array set state [list addr $addr \
+                          port $port \
+                          sock $sock]
      array set state $args

-    if {[string length $state(-command)]} {
+    if {![string equal $state(-command) ""]} {
          set state(async) 1
      }

@@ -113,24 +107,27 @@
      } err]} {
          catch {close $sock}
          if {$state(async)} {
-            after idle [list $state(-command) error network-failure]
+            after idle $state(-command) \
+                  [list error [::msgcat::mc "Failed to send SOCKS4a  
request"]]
              Free $token
              return
          } else {
              Free $token
-            return -code error network-failure
+            return -code error [::msgcat::mc "Failed to send SOCKS4a  
request"]
          }
      }

      # Setup timeout timer.
-    set state(timeoutid)  \
-        [after $state(-timeout) [namespace current]::Timeout $token]
+    if {$state(-timeout) > 0} {
+        set state(timeoutid) \
+            [after $state(-timeout) [namespace code [list Timeout $token]]]
+    }

-    fileevent $sock readable  \
-        [list [namespace current]::Response $token]
+    fileevent $sock readable \
+              [namespace code [list Response $token]]

      if {$state(async)} {
-        return
+        return $token
      } else {
          # We should not return from this proc until finished!
          vwait $token\(status)
@@ -144,11 +141,33 @@
              return $sock
          } else {
              catch {close $sock}
-            return -code error $sock
+            if {[string equal $status abort]} {
+                return -code break $sock
+            } else {
+                return -code error $sock
+            }
          }
      }
  }

+# ::pconnect::socks4::abort --
+#
+#       Abort proxy negotiation.
+#
+# Arguments:
+#       token       A connection token.
+#
+# Result:
+#       An empty string.
+#
+# Side effects:
+#       A proxy negotiation is finished with error.
+
+proc ::pconnect::socks4::abort {token} {
+    Finish $token abort [::msgcat::mc "SOCKS4a proxy negotiation aborted"]
+    return
+}
+
  # ::pconnect::socks4::Response --
  #
  #       Receive the reply from a proxy and finish the negotiations.
@@ -166,7 +185,7 @@
      variable $token
      upvar 0 $token state
      variable const
-    variable iconst
+    variable msg

      Debug $token 2 ""

@@ -175,42 +194,43 @@

      # Read and parse status.
      if {[catch {read $sock 2} data] || [eof $sock]} {
-        Finish $token network-failure
+        Finish $token error [::msgcat::mc "Failed to read SOCKS4a  
response"]
          return
      }
      binary scan $data cc null status
      if {![string equal $null 0]} {
-        Finish $token err_version
+        Finish $token error [::msgcat::mc "Incorrect SOCKS4a server  
version"]
          return
      }
-    if {![info exists iconst($status)]} {
-        Finish $token err_unknown
+    if {$status == 90} {
+        # ok
+    } elseif {[info exists msg($status)]} {
+        Finish $token error $msg($status)
          return
-    } elseif {![string equal $iconst($status) rsp_granted]} {
-        Finish $token $iconst($status)
+    } else {
+        Finish $token error [::msgcat::mc "Unknown SOCKS4a server error"]
          return
      }

      # Read and parse port (2 bytes) and ip (4 bytes).
      if {[catch {read $sock 6} data] || [eof $sock]} {
-        Finish $token network-failure
+        Finish $token error [::msgcat::mc "Failed to read SOCKS4a\
+                                     destination address"]
          return
      }
      binary scan $data ccccS i0 i1 i2 i3 port
-    set addr ""
+    set addr {}
      foreach n [list $i0 $i1 $i2 $i3] {
          # Translate to unsigned!
-        append addr [expr ( $n + 0x100 ) % 0x100]
-        if {$n <= 2} {
-            append addr .
-        }
+        lappend addr [expr {$n & 0xff}]
      }
      # Translate to unsigned!
-    set port [expr ( $port + 0x10000 ) % 0x10000]
+    set port [expr {$port & 0xffff}]
+
+    set state(bnd_addr) [join $addr .]
      set state(bnd_port) $port
-    set state(bnd_addr) $addr

-    Finish $token
+    Finish $token ok
      return
  }

@@ -228,7 +248,7 @@
  #       A proxy negotiation is finished with error.

  proc ::pconnect::socks4::Timeout {token} {
-    Finish $token timeout
+    Finish $token abort [::msgcat::mc "SOCKS4a proxy negotiation timed  
out"]
      return
  }

@@ -270,31 +290,33 @@
  #       Otherwise state(status) is set to allow ::pconnect::socks4::connect
  #       to return with either success or error.

-proc ::pconnect::socks4::Finish {token {errormsg ""}} {
+proc ::pconnect::socks4::Finish {token status {errormsg ""}} {
      variable $token
      upvar 0 $token state

-    Debug $token 2 "$errormsg"
+    Debug $token 2 "status=$status, errormsg=$errormsg"

      catch {after cancel $state(timeoutid)}

      if {$state(async)} {
          # In case of asynchronous connection we do the cleanup.
-        if {[string length $errormsg]} {
-            catch {close $state(sock)}
-            uplevel #0 $state(-command) [list error $errormsg]
+        set command $state(-command)
+        set sock $state(sock)
+        Free $token
+        if {[string equal $status ok]} {
+            uplevel #0 $command [list ok $sock]
          } else {
-            uplevel #0 $state(-command) [list ok $state(sock)]
+            catch {close $sock}
+            uplevel #0 $command [list $status $errormsg]
          }
-        Free $token
      } else {
          # Otherwise we trigger state(status).
-        if {[string length $errormsg]} {
+        if {[string equal $status ok]} {
+            set state(status) ok
+        } else {
              catch {close $state(sock)}
              set state(sock) $errormsg
-            set state(status) error
-        } else {
-            set state(status) ok
+            set state(status) $status
          }
      }
      return

Modified: trunk/xmpp/socks5.tcl
==============================================================================
--- trunk/xmpp/socks5.tcl	(original)
+++ trunk/xmpp/socks5.tcl	Sun Mar 29 09:12:27 2009
@@ -15,6 +15,7 @@

  package require pconnect
  package require ip
+package require msgcat

  package provide pconnect::socks5 0.1

@@ -41,42 +42,18 @@
          atyp_ipv4           \x01
          atyp_domainname     \x03
          atyp_ipv6           \x04
-        rsp_succeeded       \x00
-        rsp_failure         \x01
-        rsp_notallowed      \x02
-        rsp_netunreachable  \x03
-        rsp_hostunreachable \x04
-        rsp_refused         \x05
-        rsp_expired         \x06
-        rsp_cmdunsupported  \x07
-        rsp_addrunsupported \x08
-    }
-
-    # Practical when mapping errors to error codes.
-    variable iconst
-    array set iconst {
-        0    rsp_succeeded
-        1    rsp_failure
-        2    rsp_notallowed
-        3    rsp_netunreachable
-        4    rsp_hostunreachable
-        5    rsp_refused
-        6    rsp_expired
-        7    rsp_cmdunsupported
-        8    rsp_addrunsupported
      }

      variable msg
-    array set msg {
-        1 "General SOCKS server failure"
-        2 "Connection not allowed by ruleset"
-        3 "Network unreachable"
-        4 "Host unreachable"
-        5 "Connection refused"
-        6 "TTL expired"
-        7 "Command not supported"
-        8 "Address type not supported"
-    }
+    array set msg [list \
+        1   [::msgcat::mc "General SOCKS server failure"] \
+        2   [::msgcat::mc "Connection not allowed by ruleset"] \
+        3   [::msgcat::mc "Network unreachable"] \
+        4   [::msgcat::mc "Host unreachable"] \
+        5   [::msgcat::mc "Connection refused by destination host"] \
+        6   [::msgcat::mc "TTL expired"] \
+        7   [::msgcat::mc "Command not supported"] \
+        8   [::msgcat::mc "Address type not supported"]]

      variable debug 0

@@ -90,8 +67,8 @@
  #       Negotiates with a SOCKS server.
  #
  # Arguments:
-#       sock        an open socket token to the SOCKS server
-#       addr        the peer address, not SOCKS server
+#       sock        an open socket to the SOCKS5 server
+#       addr        the peer address, not SOCKS5 server
  #       port        the peer's port number
  #       args
  #               -command    tclProc {status socket}
@@ -100,7 +77,7 @@
  #               -timeout    millisecs (default 60000)
  #
  # Results:
-#       The connect socket or error if no -command, else empty string.
+#       The connect socket or error if no -command, else a connection  
token.
  #
  # Side effects:
  #       Socket is prepared for data transfer.
@@ -121,27 +98,27 @@
      Debug $token 2 "$addr $port $args"

      array set state {
-        -password         ""
-        -timeout          60000
-        -username         ""
-        async             0
-        auth              0
-        bnd_addr          ""
-        bnd_port          ""
-        state             ""
-        status            ""
-    }
-    array set state [list     \
-      addr          $addr     \
-      port          $port     \
-      sock          $sock]
+        -password ""
+        -timeout  60000
+        -username ""
+        -command  ""
+        async     0
+        auth      0
+        bnd_addr  ""
+        bnd_port  ""
+        state     ""
+        status    ""
+    }
+    array set state [list addr $addr \
+                          port $port \
+                          sock $sock]
      array set state $args

-    if {[string length $state(-username)] ||  \
-      [string length $state(-password)]} {
+    if {[string length $state(-username)] || \
+            [string length $state(-password)]} {
          set state(auth) 1
      }
-    if {[info exists state(-command)] && [string length $state(-command)]}  
{
+    if {![string equal $state(-command) ""]} {
          set state(async) 1
      }
      if {$state(auth)} {
@@ -163,24 +140,29 @@
      } err]} {
          catch {close $sock}
          if {$state(async)} {
-            after idle [list $state(-command) error network-failure]
+            after idle $state(-command) \
+                  [list error [::msgcat::mc "Failed to send SOCKS5\
+                                             authorization methods  
request"]]
              Free $token
              return
          } else {
              Free $token
-            return -code error $err
+            return -code error [::msgcat::mc "Failed to send SOCKS5\
+                                              authorization methods  
request"]
          }
      }

      # Setup timeout timer.
-    set state(timeoutid)  \
-        [after $state(-timeout) [namespace current]::Timeout $token]
+    if {$state(-timeout) > 0} {
+        set state(timeoutid) \
+            [after $state(-timeout) [namespace code [list Timeout $token]]]
+    }

-    fileevent $sock readable  \
-        [list [namespace current]::ResponseMethod $token]
+    fileevent $sock readable \
+              [namespace code [list ResponseMethod $token]]

      if {$state(async)} {
-        return
+        return $token
      } else {
          # We should not return from this proc until finished!
          vwait $token\(status)
@@ -194,11 +176,33 @@
              return $sock
          } else {
              catch {close $sock}
-            return -code error $sock
+            if {[string equal $status abort]} {
+                return -code break $sock
+            } else {
+                return -code error $sock
+            }
          }
      }
  }

+# ::pconnect::socks5::abort --
+#
+#       Abort proxy negotiation.
+#
+# Arguments:
+#       token       A connection token.
+#
+# Result:
+#       An empty string.
+#
+# Side effects:
+#       A proxy negotiation is finished with error.
+
+proc ::pconnect::socks5::abort {token} {
+    Finish $token abort [::msgcat::mc "SOCKS5 proxy negotiation aborted"]
+    return
+}
+
  # ::pconnect::socks5::ResponseMethod --
  #
  #       Receive the reply from a proxy and choose authorization method.
@@ -223,7 +227,8 @@
      set sock $state(sock)

      if {[catch {read $sock 2} data] || [eof $sock]} {
-        Finish $token network-failure
+        Finish $token error [::msgcat::mc "Failed to read SOCKS5\
+                                     authorization methods response"]
          return
      }
      set serv_ver ""
@@ -232,7 +237,7 @@
      Debug $token 2 "serv_ver=$serv_ver, smethod=$smethod"

      if {![string equal $serv_ver 5]} {
-        Finish $token err_version
+        Finish $token error [::msgcat::mc "Incorrect SOCKS5 server  
version"]
          return
      }

@@ -242,7 +247,7 @@
      } elseif {[string equal $smethod 2]} {
          # User/Pass authorization required
          if {$state(auth) == 0} {
-            Finish $token err_authorization_required
+            Finish $token error [::msgcat::mc "SOCKS5 server authorization  
required"]
              return
          }

@@ -252,19 +257,22 @@

          Debug $token 2 "send: auth_userpass ulen -username plen -password"
          if {[catch {
-            puts -nonewline $sock  \
+            puts -nonewline $sock \
                   "$const(auth_userpass)$ulen$state(-username)$plen$state(-password)"
              flush $sock
          } err]} {
-            Finish $token network-failure
+            Finish $token error [::msgcat::mc "Failed to send SOCKS5\
+                                         authorization request"]
              return
          }

-        fileevent $sock readable  \
-            [list [namespace current]::ResponseAuth $token]
+        fileevent $sock readable \
+                  [namespace code [list ResponseAuth $token]]
      } else {
-        Finish $token err_unsupported_method
+        Finish $token error [::msgcat::mc "Unsupported SOCKS5  
authorization method"]
+        return
      }
+
      return
  }

@@ -291,7 +299,8 @@
      set sock $state(sock)

      if {[catch {read $sock 2} data] || [eof $sock]} {
-        Finish $token network-failure
+        Finish $token error [::msgcat::mc "Failed to read SOCKS5\
+                                     authorization response"]
          return
      }

@@ -301,11 +310,11 @@
      Debug $token 2 "auth_ver=$auth_ver, status=$status"

      if {![string equal $auth_ver 1]} {
-        Finish $token err_authentication_unsupported
+        Finish $token error [::msgcat::mc "Unsupported SOCKS5  
authorization method"]
          return
      }
      if {![string equal $status 0]} {
-        Finish $token err_authorization
+        Finish $token error [::msgcat::mc "SOCKS5 server authorization  
failed"]
          return
      }

@@ -375,12 +384,12 @@
          puts -nonewline $sock "$aconst$atyp_addr_port"
          flush $sock
      } err]} {
-        Finish $token network-failure
+        Finish $token error [::msgcat::mc "Failed to send SOCKS5  
connection request"]
          return
      }

-    fileevent $sock readable  \
-        [list [namespace current]::Response $token]
+    fileevent $sock readable \
+              [namespace code [list Response $token]]
      return
  }

@@ -398,9 +407,9 @@
  #       The negotiation is finished with either success or error.

  proc ::pconnect::socks5::Response {token} {
+    variable msg
      variable $token
      upvar 0 $token state
-    variable iconst

      Debug $token 2 ""

@@ -409,7 +418,7 @@

      # Start by reading ver+cmd+rsv.
      if {[catch {read $sock 3} data] || [eof $sock]} {
-        Finish $token network-failure
+        Finish $token error [::msgcat::mc "Failed to read SOCKS5  
connection response"]
          return
      }
      set serv_ver ""
@@ -417,22 +426,22 @@
      binary scan $data ccc serv_ver rep rsv

      if {![string equal $serv_ver 5]} {
-        Finish $token err_version
+        Finish $token error [::msgcat::mc "Incorrect SOCKS5 server  
version"]
          return
      }
      if {$rep == 0} {
          # ok
-    } elseif {[info exists iconst($rep)]} {
-        Finish $token $iconst($rep)
+    } elseif {[info exists msg($rep)]} {
+        Finish $token error $msg($rep)
          return
      } else {
-        Finish $token err_unknown
+        Finish $token error [::msgcat::msg "Unknown SOCKS5 server error"]
          return
      }

      # Now parse the variable length atyp+addr+host.
      if {[catch {ParseAtypAddr $token addr port} err]} {
-        Finish $token $err
+        Finish $token error $err
          return
      }

@@ -441,7 +450,7 @@
      set state(bnd_port) $port

      # And finally let the client know that the bytestream is set up.
-    Finish $token
+    Finish $token ok
      return
  }

@@ -473,7 +482,8 @@

      # Start by reading atyp.
      if {[catch {read $sock 1} data] || [eof $sock]} {
-        return -code error network-failure
+        return -code error [::msgcat::mc "Failed to read SOCKS5\
+                                          destination address type"]
      }
      set atyp ""
      binary scan $data c atyp
@@ -482,46 +492,70 @@
      # Treat the three address types in order.
      switch -- $atyp {
          1 {
+            # IPv4
+
              if {[catch {read $sock 6} data] || [eof $sock]} {
-                return -code error network-failure
+                return -code error [::msgcat::mc "Failed to read SOCKS5\
+                                                  destination IPv4 address\
+                                                  and port"]
              }
              binary scan $data ccccS i0 i1 i2 i3 port
-            set addr ""
+            set addr {}
              foreach n [list $i0 $i1 $i2 $i3] {
                  # Translate to unsigned!
-                append addr [expr ( $n + 0x100 ) % 0x100]
-                if {$n <= 2} {
-                    append addr .
-                }
+                lappend addr [expr {$n & 0xff}]
              }
+            set addr [join $addr .]
              # Translate to unsigned!
-            set port [expr ( $port + 0x10000 ) % 0x10000]
+            set port [expr {$port & 0xffff}]
          }
          3 {
+            # Domain
+
              if {[catch {read $sock 1} data] || [eof $sock]} {
-                return -code error network-failure
+                return -code error [::msgcat::mc "Failed to read SOCKS5\
+                                                  destination domain\
+                                                  length"]
              }
              binary scan $data c len
              Debug $token 2 "len=$len"
-            set len [expr ( $len + 0x100 ) % 0x100]
+            set len [expr {$len & 0xff}]
              if {[catch {read $sock $len} data] || [eof $sock]} {
-                return -code error network-failure
+                return -code error [::msgcat::mc "Failed to read SOCKS5\
+                                                  destination domain"]
              }
              set addr $data
              Debug $token 2 "addr=$addr"
              if {[catch {read $sock 2} data] || [eof $sock]} {
-                return -code error network-failure
+                return -code error [::msgcat::mc "Failed to read SOCKS5\
+                                                  destination port"]
              }
              binary scan $data S port
              # Translate to unsigned!
-            set port [expr ( $port + 0x10000 ) % 0x10000]
+            set port [expr {$port & 0xffff}]
              Debug $token 2 "port=$port"
          }
          4 {
-            # todo
+            # IPv6
+
+            if {[catch {read $sock 18} data] || [eof $sock]} {
+                return -code error [::msgcat::mc "Failed to read SOCKS5\
+                                                  destination IPv6 address\
+                                                  and port"]
+            }
+            binary scan $data SSSSSSSSS s0 s1 s2 s3 s4 s5 s6 s7 s8 port
+            set addr {}
+            foreach n [list $s0 $s1 $s2 $s3 $s4 $s5 $s6 $s7 $s8] {
+                # Translate to unsigned!
+                lappend addr [format %x [expr {$n & 0xffff}]]
+            }
+            set addr [join $addr :]
+            # Translate to unsigned!
+            set port [expr {$port & 0xffff}]
          }
          default {
-            return -code error err_unknown_address_type
+            return -code error [::msgcat::mc "Unknown SOCKS5 destination\
+                                              address type"]
          }
      }
  }
@@ -546,7 +580,7 @@
  #       A proxy negotiation is finished with error.

  proc ::pconnect::socks5::Timeout {token} {
-    Finish $token timeout
+    Finish $token abort [::msgcat::mc "SOCKS5 negotiation timed out"]
      return
  }

@@ -587,31 +621,33 @@
  #       Otherwise state(status) is set to allow ::pconnect::socks5::connect
  #       to return with either success or error.

-proc ::pconnect::socks5::Finish {token {errormsg ""}} {
+proc ::pconnect::socks5::Finish {token status {errormsg ""}} {
      variable $token
      upvar 0 $token state

-    Debug $token 2 "$errormsg"
+    Debug $token 2 "status=$status, errormsg=$errormsg"

      catch {after cancel $state(timeoutid)}

      if {$state(async)} {
          # In case of asynchronous connection we do the cleanup.
-        if {[string length $errormsg]} {
-            catch {close $state(sock)}
-            uplevel #0 $state(-command) [list error $errormsg]
+        set command $state(-command)
+        set sock $state(sock)
+        Free $token
+        if {[string equal $status ok]} {
+            uplevel #0 $command [list ok $sock]
          } else {
-            uplevel #0 $state(-command) [list ok $state(sock)]
+            catch {close $sock}
+            uplevel #0 $command [list $status $errormsg]
          }
-        Free $token
      } else {
          # Otherwise we trigger state(status).
-        if {[string length $errormsg]} {
+        if {[string equal $status ok]} {
+            set state(status) ok
+        } else {
              catch {close $state(sock)}
              set state(sock) $errormsg
-            set state(status) error
-        } else {
-            set state(status) ok
+            set state(status) $status
          }
      }
      return


More information about the Tkabber-dev mailing list