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.

diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el
index d96f3b1ebeaf31624c4a57ade21ba4a035e47398..89f09b0744858148dd4781845072f540cdbae741 100644 (file)
--- 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)