Tk Library Source Code

Artifact [47a0dd2558]
Login

Artifact 47a0dd25587183f6c9703da4ef40b521d4cee70c:

Attachment "ntlm.patch" to ticket [1557494fff] added by mpc_janssen 2006-09-13 18:49:31.
--- ntlm.tcl.org	Wed Sep 13 13:36:37 2006
+++ ntlm.tcl	Wed Sep 13 13:45:13 2006
@@ -46,7 +46,7 @@
             set pass [eval [linsert $ctx(callback) end $context password]]
             set ctx(response) [CreateResponse \
                                    $ctx(realm) $ctx(hostname) \
-                                   $user $pass $params(nonce)]
+                                   $user $pass $params(nonce) $params(flags)]
             Decode $ctx(response)
             set result 0
         }
@@ -102,40 +102,46 @@
 # Compose the final client response. This contains the encoded username
 # and password, along with the server nonce value.
 #
-proc ::SASL::NTLM::CreateResponse {domainname hostname username passwd nonce} {
+proc ::SASL::NTLM::CreateResponse {domainname hostname username passwd nonce flags} {
     set lm_resp [LMhash $passwd $nonce]
     set nt_resp [NThash $passwd $nonce]
 
-    set domain [to_unicode_le [string toupper $domainname]]
-    set host   [to_unicode_le [string toupper $hostname]]
-    set user   [to_unicode_le $username]
+    set domain [string toupper $domainname]
+    set host   [string toupper $hostname]
+    set user   $username
+
+    set decoded_flags [decodeflags $flags]
+    if {[lsearch -exact $decoded_flags oem] < 0 } {
+      set domain [to_unicode_le $domain]
+      set host   [to_unicode_le $host]
+      set user   [to_unicode_le $user]
+    } 
 
     set l_len [string length $lm_resp]; # LM response length
     set n_len [string length $nt_resp]; # NT response length
     set d_len [string length $domain];  # Domain name length
     set h_len [string length $host];    # Host name length
     set u_len [string length $user];    # User name length
-
-    # The full message length
-    set m_len [expr {0x40 + $d_len + $u_len + $h_len + $n_len + $l_len}]
+    set s_len 0 ;                       # Session key length
 
     # The offsets to strings appended to the structure
-    set l_off [expr {0x40 + $d_len + $u_len + $h_len}]
-    set n_off [expr {0x40 + $d_len + $u_len + $h_len + $l_len}]
     set d_off [expr {0x40}]
-    set u_off [expr {0x40 + $d_len}]
-    set h_off [expr {0x40 + $d_len + $u_len}]
+    set u_off [expr {$d_off + $d_len}]
+    set h_off [expr {$u_off + $u_len}]
+    set l_off [expr {$h_off + $h_len}]
+    set n_off [expr {$l_off + $l_len}]
+    set s_off [expr {$n_off + $n_len}]
 
-    set msg [binary format a8is4s4s4s4s4iii \
+    set msg [binary format a8is4s4s4s4s4s4i \
                  "NTLMSSP\x00" 3 \
                  [list $l_len $l_len $l_off 0] \
                  [list $n_len $n_len $n_off 0] \
                  [list $d_len $d_len $d_off 0] \
                  [list $u_len $u_len $u_off 0] \
                  [list $h_len $h_len $h_off 0] \
-                 $m_len 0x0201 0]
+                 [list $s_len $s_len $s_off 0] \
+                 $flags]
     append msg $domain $user $host $lm_resp $nt_resp
-
     return $msg
 }
 
@@ -163,7 +169,13 @@
         2 {
             binary scan $msg @12ssiia8a8 dlen dlen2 doff flags nonce pad
             set domain {}; binary scan $msg @${doff}a${dlen} domain
-            set domain [from_unicode_le $domain]
+
+            set decoded_flags [decodeflags $flags]
+            if {[lsearch -exact $decoded_flags oem] < 0 } {
+              # if server doesn't indicate OEM we will use unicode
+              set domain [from_unicode_le $domain]
+            }
+
             binary scan $nonce H* nonce_h
             binary scan $pad   H* pad_h
             #puts stderr "NTLM($type) [decodeflags $flags]\n \
@@ -179,9 +191,12 @@
             set domain {}; binary scan $msg @${doff}a${dlen} domain
             set user {};   binary scan $msg @${uoff}a${ulen} user
             set host {};   binary scan $msg @${hoff}a${hlen} host
-            set domain [from_unicode_le $domain]
-            set user   [from_unicode_le $user]
-            set host   [from_unicode_le $host]
+            set decoded_flags [decodeflags $flags]
+            if {[lsearch -exact $decoded_flags oem] < 0 } {
+              set domain [from_unicode_le $domain]
+              set user   [from_unicode_le $user]
+              set host   [from_unicode_le $host]
+            }
             binary scan $msg @${ntoff}a${ntlen} ntdata
             binary scan $msg @${lmoff}a${lmlen} lmdata
             binary scan $ntdata H* ntdata_h