lisp/net/ntlm.el: Match Mozilla Type 1 and 3 message behavior

* lisp/net/ntlm.el (ntlm-build-auth-request): Only set
"negotiate domain supplied" bit when a domain is supplied.  Do
not set "negotiate workstation supplied" bit.
(ntlm-build-auth-response): Set domain to empty string by
default.  Set workstation name to "WORKSTATION".  Set flags to
logical and of Type 1 and Type 2 message flags.  Remove four
trailing 0 bytes.  Always set LM response.  Hard-code domain
offset.  Reorder buffer fields.

1 files changed, 50 insertions, 36 deletions

diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el
index d96f3b1ebea..89f09b07448 100644
--- a/lisp/net/ntlm.el
+++ b/lisp/net/ntlm.el
@@ -101,14 +101,17 @@ is not given."
   (let ((request-ident (concat "NTLMSSP" (make-string 1 0)))
         (request-msgType (concat (make-string 1 1) (make-string 3 0)))
                                         ;0x01 0x00 0x00 0x00
-        (request-flags (concat (make-string 1 7) (make-string 1 178)
+        (request-flags (concat (make-string 1 7) (make-string 1 130)
                                (make-string 1 8) (make-string 1 0)))
-                                        ;0x07 0xb2 0x08 0x00
+                                        ;0x07 0x82 0x08 0x00
         lu ld off-d off-u)
-    (when (string-match "@" user)
+    (when (and user (string-match "@" user))
       (unless domain
         (setq domain (substring user (1+ (match-beginning 0)))))
       (setq user (substring user 0 (match-beginning 0))))
+    (when (and (stringp domain) (> (length domain) 0))
+      ;; set "negotiate domain supplied" bit
+      (aset request-flags 1 (logior (aref request-flags 1) ?\x10)))
     ;; set fields offsets within the request struct
     (setq lu (length user))
     (setq ld (length domain))
@@ -178,6 +181,10 @@ by PASSWORD-HASHES.  PASSWORD-HASHES should be a return value of
          ;;(ident (substring rchallenge 0 8))   ;ident, 8 bytes
          ;;(msgType (substring rchallenge 8 12))        ;msgType, 4 bytes
          (uDomain (substring rchallenge 12 20)) ;uDomain, 8 bytes
+         ;; match default setting in `ntlm-build-auth-request'
+         (request-flags (concat (make-string 1 7) (make-string 1 130)
+                                (make-string 1 8) (make-string 1 0)))
+                                        ;0x07 0x82 0x08 0x00
          (flags (substring rchallenge 20 24))   ;flags, 4 bytes
          (challengeData (substring rchallenge 24 32)) ;challengeData, 8 bytes
          uDomain-len uDomain-offs
@@ -185,19 +192,28 @@ by PASSWORD-HASHES.  PASSWORD-HASHES should be a return value of
          lmRespData                     ;lmRespData, 24 bytes
          ntRespData                     ;ntRespData, variable length
          domain                         ;ascii domain string
-         lu ld ln off-lm off-nt off-d off-u off-w off-s)
+         workstation                    ;ascii workstation string
+         ll ln lu ld lw off-lm off-nt off-u off-d off-w)
     ;; extract domain string from challenge string
     (setq uDomain-len (md4-unpack-int16 (substring uDomain 0 2)))
     (setq uDomain-offs (md4-unpack-int32 (substring uDomain 4 8)))
-    (setq domain
-          (ntlm-unicode2ascii (substring challenge
-                                         (cdr uDomain-offs)
-                                         (+ (cdr uDomain-offs) uDomain-len))
-                              (/ uDomain-len 2)))
+    ;; match Mozilla behavior, which is to send an empty domain string
+    (setq domain "")
+    ;; match Mozilla behavior, which is to send "WORKSTATION"
+    (setq workstation "WORKSTATION")
     ;; overwrite domain in case user is given in <user>@<domain> format
     (when (string-match "@" user)
       (setq domain (substring user (1+ (match-beginning 0))))
       (setq user (substring user 0 (match-beginning 0))))
+    (when (and (stringp domain) (> (length domain) 0))
+      ;; set "negotiate domain supplied" bit, since presumably domain
+      ;; was also set in `ntlm-build-auth-request'
+      (aset request-flags 1 (logior (aref request-flags 1) ?\x10)))
+    ;; match Mozilla behavior, which is to send the logical and of the
+    ;; type 1 and type 2 flags
+    (dotimes (index 4)
+      (aset flags index (logand (aref flags index)
+                                (aref request-flags index))))
 
     (unless (and (integerp ntlm-compatibility-level)
                  (>= ntlm-compatibility-level 0)
@@ -228,17 +244,15 @@ by PASSWORD-HASHES.  PASSWORD-HASHES should be a return value of
                                (ntlm-compute-timestamp) ; timestamp
                                nonce                    ; client nonce
                                (make-string 4 0)        ; unknown
-                               targetInfo               ; target info
-                               (make-string 4 0)))      ; unknown
+                               targetInfo))             ; target info
                  ;; for reference: LMv2 interim calculation
-                 ;; (lm-interim (hmac-md5 (concat challengeData nonce)
-                 ;;                       ntlmv2-hash))
+                 (lm-interim (hmac-md5 (concat challengeData nonce)
+                                       ntlmv2-hash))
                  (nt-interim (hmac-md5 (concat challengeData blob)
                                        ntlmv2-hash)))
             ;; for reference: LMv2 field, but match other clients that
             ;; send all zeros
-            ;; (setq lmRespData (concat lm-interim nonce))
-            (setq lmRespData (make-string 24 0))
+            (setq lmRespData (concat lm-interim nonce))
             (setq ntRespData (concat nt-interim blob))))
       ;; compatibility level is 2, 1 or 0
       ;; level 2 should be treated specially but it's not clear how,
@@ -263,23 +277,24 @@ by PASSWORD-HASHES.  PASSWORD-HASHES should be a return value of
               (ntlm-smb-owf-encrypt (cadr password-hashes) challengeData))))
 
     ;; get offsets to fields to pack the response struct in a string
+    (setq ll (length lmRespData))
+    (setq ln (length ntRespData))
     (setq lu (length user))
     (setq ld (length domain))
-    (setq ln (length ntRespData))
-    (setq off-lm 64)                    ;offset to string 'lmResponse
-    (setq off-nt (+ 64 24))             ;offset to string 'ntResponse
-    (setq off-d (+ 64 24 ln))           ;offset to string 'uDomain
-    (setq off-u (+ 64 24 ln (* 2 ld)))  ;offset to string 'uUser
-    (setq off-w (+ 64 24 ln (* 2 (+ ld lu)))) ;offset to string 'uWks
-    (setq off-s (+ 64 24 ln (* 2 (+ ld lu lu)))) ;offset to string 'sessionKey
+    (setq lw (length workstation))
+    (setq off-u 64)                     ;offset to string 'uUser
+    (setq off-d (+ off-u (* 2 lu)))     ;offset to string 'uDomain
+    (setq off-w (+ off-d (* 2 ld)))     ;offset to string 'uWks
+    (setq off-lm (+ off-w (* 2 lw)))    ;offset to string 'lmResponse
+    (setq off-nt (+ off-lm ll))         ;offset to string 'ntResponse
     ;; pack the response struct in a string
     (concat "NTLMSSP\0"                 ;response ident field, 8 bytes
             (md4-pack-int32 '(0 . 3))   ;response msgType field, 4 bytes
 
             ;; lmResponse field, 8 bytes
             ;;AddBytes(response,lmResponse,lmRespData,24);
-            (md4-pack-int16 24)         ;len field
-            (md4-pack-int16 24)         ;maxlen field
+            (md4-pack-int16 ll)         ;len field
+            (md4-pack-int16 ll)         ;maxlen field
             (md4-pack-int32 (cons 0 off-lm)) ;field offset
 
             ;; ntResponse field, 8 bytes
@@ -293,7 +308,9 @@ by PASSWORD-HASHES.  PASSWORD-HASHES should be a return value of
             ;;AddBytes(response, uDomain, udomain, 2*ld);
             (md4-pack-int16 (* 2 ld))   ;len field
             (md4-pack-int16 (* 2 ld))   ;maxlen field
-            (md4-pack-int32 (cons 0 off-d)) ;field offset
+            ;; match Mozilla behavior, which is to hard-code the
+            ;; domain offset to 64
+            (md4-pack-int32 (cons 0 64)) ;field offset
 
             ;; uUser field, 8 bytes
             ;;AddUnicodeString(response,uUser,u);
@@ -304,28 +321,25 @@ by PASSWORD-HASHES.  PASSWORD-HASHES should be a return value of
 
             ;; uWks field, 8 bytes
             ;;AddUnicodeString(response,uWks,u);
-            (md4-pack-int16 (* 2 lu))   ;len field
-            (md4-pack-int16 (* 2 lu))   ;maxlen field
+            (md4-pack-int16 (* 2 lw))   ;len field
+            (md4-pack-int16 (* 2 lw))   ;maxlen field
             (md4-pack-int32 (cons 0 off-w)) ;field offset
 
-            ;; sessionKey field, 8 bytes
+            ;; sessionKey field, blank, 8 bytes
             ;;AddString(response,sessionKey,NULL);
             (md4-pack-int16 0)          ;len field
             (md4-pack-int16 0)          ;maxlen field
-            (md4-pack-int32 (cons 0 (- off-s off-lm))) ;field offset
+            (md4-pack-int32 (cons 0 0)) ;field offset
 
             ;; flags field, 4 bytes
             flags                       ;
 
             ;; buffer field
+            (ntlm-ascii2unicode user lu)        ;Unicode user, 2*lu bytes
+            (ntlm-ascii2unicode domain ld)      ;Unicode domain, 2*ld bytes
+            (ntlm-ascii2unicode workstation lw) ;Unicode workstation, 2*lw bytes
             lmRespData                  ;lmResponse, 24 bytes
-            ntRespData                  ;ntResponse, 24 bytes
-            (ntlm-ascii2unicode domain  ;Unicode domain string, 2*ld bytes
-                                (length domain)) ;
-            (ntlm-ascii2unicode user    ;Unicode user string, 2*lu bytes
-                                (length user)) ;
-            (ntlm-ascii2unicode user    ;Unicode user string, 2*lu bytes
-                                (length user)) ;
+            ntRespData                  ;ntResponse, ln bytes
             )))
 
 (defun ntlm-get-password-hashes (password)