Subject: 25.0.50; Add support for NTLMv2 authentication

From: Thomas Fitzsimmons <[email-masked]>
Date: Wed, 26 Aug 2015 23:22:39 -0400

Hi,

This patch implements NTLMv2 authentication in ntlm.el.  OK to push?

Thanks,
Thomas
>From eebf3ec560545f8a1cfa0eb4139eda20b71d90e3 Mon Sep 17 00:00:00 2001
From: Thomas Fitzsimmons <[email-masked]>
Date: Wed, 26 Aug 2015 23:05:25 -0400
Subject: [PATCH] Add support for NTLMv2 authentication

* net/ntlm.el (ntlm): New customization group.
(ntlm-compatibility-level): New defcustom.
(ntlm-compute-timestamp): New function.
(ntlm-generate-nonce): Likewise.
(ntlm-build-auth-response): Add support for NTLMv2 authentication.
---
 lisp/net/ntlm.el | 154 +++++++++++++++++++++++++++++++++++++++++++------------
 1 file changed, 121 insertions(+), 33 deletions(-)

diff --git a/lisp/net/ntlm.el b/lisp/net/ntlm.el
index 5f02e29..0a1aaad 100644
--- a/lisp/net/ntlm.el
+++ b/lisp/net/ntlm.el
@@ -65,6 +65,27 @@
 ;;; Code:
 
 (require 'md4)
+(require 'hmac-md5)
+(require 'calc)
+
+(defgroup ntlm nil
+  "NTLM (NT LanManager) authentication."
+  :version "25.1"
+  :group 'comm)
+
+(defcustom ntlm-compatibility-level 5
+  "The NTLM compatibility level.
+Ordered from 0, the oldest, least-secure level through 5, the
+newest, most-secure level.  Newer servers may reject lower
+levels.  At levels 3 through 5, send LMv2 and NTLMv2 responses.
+At levels 0, 1 and 2, send LM and NTLM responses.
+
+In this implementation, levels 0, 1 and 2 are the same (old,
+insecure), and levels 3, 4 and 5 are the same (new, secure).  If
+NTLM authentication isn't working at level 5, try level 0.  The
+other levels are only present because other clients have six
+levels."
+  :type '(choice (const 0) (const 1) (const 2) (const 3) (const 4) (const 5)))
 
 ;;;
 ;;; NTLM authentication interface functions
@@ -112,6 +133,39 @@ (eval-when-compile
 	`(string-as-unibyte ,string)
       string)))
 
+(defun ntlm-compute-timestamp ()
+  "Compute an NTLMv2 timestamp.
+Return a unibyte string representing the number of tenths of a
+microsecond since January 1, 1601 as a 64-bit little-endian
+signed integer."
+  (let* ((s-to-tenths-of-us "mul(add(lsh($1,16),$2),10000000)")
+	 (us-to-tenths-of-us "mul($3,10)")
+	 (ps-to-tenths-of-us "idiv($4,100000)")
+	 (tenths-of-us-since-jan-1-1601
+	  (apply 'calc-eval (concat "add(add(add("
+				    s-to-tenths-of-us ","
+				    us-to-tenths-of-us "),"
+				    ps-to-tenths-of-us "),"
+				    ;; tenths of microseconds between
+				    ;; 1601-01-01 and 1970-01-01
+				    "116444736000000000)")
+		 ;; add trailing zeros to support old current-time formats
+		 'rawnum (append (current-time) '(0 0))))
+	 result-bytes)
+    (dotimes (byte 8)
+      (push (calc-eval "and($1,16#FF)" 'rawnum tenths-of-us-since-jan-1-1601)
+	    result-bytes)
+      (setq tenths-of-us-since-jan-1-1601
+	    (calc-eval "rsh($1,8,64)" 'rawnum tenths-of-us-since-jan-1-1601)))
+    (apply 'unibyte-string (nreverse result-bytes))))
+
+(defun ntlm-generate-nonce ()
+  "Generate a random nonce, not to be used more than once.
+Return a random eight byte unibyte string."
+  (unibyte-string
+   (random 256) (random 256) (random 256) (random 256)
+   (random 256) (random 256) (random 256) (random 256)))
+
 (defun ntlm-build-auth-response (challenge user password-hashes)
   "Return the response string to a challenge string CHALLENGE given by
 the NTLM based server for the user USER and the password hash list
@@ -128,9 +182,9 @@ (defun ntlm-build-auth-response (challenge user password-hashes)
 	 uDomain-len uDomain-offs
 	 ;; response struct and its fields
 	 lmRespData			;lmRespData, 24 bytes
-	 ntRespData			;ntRespData, 24 bytes
+	 ntRespData			;ntRespData, variable length
 	 domain				;ascii domain string
-	 lu ld off-lm off-nt off-d off-u off-w off-s)
+	 lu ld ln off-lm off-nt off-d off-u off-w off-s)
     ;; 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)))
@@ -144,30 +198,63 @@ (defun ntlm-build-auth-response (challenge user password-hashes)
       (setq domain (substring user (1+ (match-beginning 0))))
       (setq user (substring user 0 (match-beginning 0))))
 
-    ;; check if "negotiate NTLM2 key" flag is set in type 2 message
-    (if (not (zerop (logand (aref flags 2) 8)))
-	(let (randomString
-	      sessionHash)
-	  ;; generate NTLM2 session response data
-	  (setq randomString (string-make-unibyte
-			      (concat
-			       (make-string 1 (random 256))
-			       (make-string 1 (random 256))
-			       (make-string 1 (random 256))
-			       (make-string 1 (random 256))
-			       (make-string 1 (random 256))
-			       (make-string 1 (random 256))
-			       (make-string 1 (random 256))
-			       (make-string 1 (random 256)))))
-	  (setq sessionHash (secure-hash 'md5
-					 (concat challengeData randomString)
-					 nil nil t))
-	  (setq sessionHash (substring sessionHash 0 8))
-
-	  (setq lmRespData (concat randomString (make-string 16 0)))
-	  (setq ntRespData (ntlm-smb-owf-encrypt
-			    (cadr password-hashes) sessionHash)))
-      (progn
+    (unless (and (integerp ntlm-compatibility-level)
+		 (>= ntlm-compatibility-level 0)
+		 (<= ntlm-compatibility-level 5))
+      (error "Invalid ntlm-compatibility-level value"))
+    (if (and (>= ntlm-compatibility-level 3)
+	     (<= ntlm-compatibility-level 5))
+	;; extract target information block, if it is present
+	(if (< (cdr uDomain-offs) 48)
+	    (error "Failed to find target information block")
+	  (let* ((targetInfo-len (md4-unpack-int16 (substring rchallenge
+							      40 42)))
+		 (targetInfo-offs (md4-unpack-int32 (substring rchallenge
+							       44 48)))
+		 (targetInfo (substring rchallenge
+					(cdr targetInfo-offs)
+					(+ (cdr targetInfo-offs)
+					   targetInfo-len)))
+		 (upcase-user (upcase (ntlm-ascii2unicode user (length user))))
+		 (ntlmv2-hash (hmac-md5 (concat upcase-user
+						(ntlm-ascii2unicode
+						 domain (length domain)))
+					(cadr password-hashes)))
+		 (nonce (ntlm-generate-nonce))
+		 (blob (concat (make-string 2 1)
+			       (make-string 2 0)	; blob signature
+			       (make-string 4 0)	; reserved value
+			       (ntlm-compute-timestamp) ; timestamp
+			       nonce			; client nonce
+			       (make-string 4 0)	; unknown
+			       targetInfo		; target info
+			       (make-string 4 0)))	; unknown
+		 ;; for reference: LMv2 interim calculation
+		 ;; (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 ntRespData (concat nt-interim blob))))
+      ;; compatibility level is 2, 1 or 0
+      ;; level 2 should be treated specially but it's not clear how,
+      ;; so just treat it the same as levels 0 and 1
+      ;; check if "negotiate NTLM2 key" flag is set in type 2 message
+      (if (not (zerop (logand (aref flags 2) 8)))
+	  (let (randomString
+		sessionHash)
+	    ;; generate NTLM2 session response data
+	    (setq randomString (ntlm-generate-nonce))
+	    (setq sessionHash (secure-hash 'md5
+					   (concat challengeData randomString)
+					   nil nil t))
+	    (setq sessionHash (substring sessionHash 0 8))
+	    (setq lmRespData (concat randomString (make-string 16 0)))
+	    (setq ntRespData (ntlm-smb-owf-encrypt
+			      (cadr password-hashes) sessionHash)))
 	;; generate response data
 	(setq lmRespData
 	      (ntlm-smb-owf-encrypt (car password-hashes) challengeData))
@@ -177,12 +264,13 @@ (defun ntlm-build-auth-response (challenge user password-hashes)
     ;; get offsets to fields to pack the response struct in a string
     (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 48))		;offset to string 'uDomain
-    (setq off-u (+ 64 48 (* 2 ld)))	;offset to string 'uUser
-    (setq off-w (+ 64 48 (* 2 (+ ld lu)))) ;offset to string 'uWks
-    (setq off-s (+ 64 48 (* 2 (+ ld lu lu)))) ;offset to string 'sessionKey
+    (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
     ;; 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
@@ -194,9 +282,9 @@ (defun ntlm-build-auth-response (challenge user password-hashes)
 	    (md4-pack-int32 (cons 0 off-lm)) ;field offset
 
 	    ;; ntResponse field, 8 bytes
-	    ;;AddBytes(response,ntResponse,ntRespData,24);
-	    (md4-pack-int16 24)		;len field
-	    (md4-pack-int16 24)		;maxlen field
+	    ;;AddBytes(response,ntResponse,ntRespData,ln);
+	    (md4-pack-int16 ln)	;len field
+	    (md4-pack-int16 ln)	;maxlen field
 	    (md4-pack-int32 (cons 0 off-nt)) ;field offset
 
 	    ;; uDomain field, 8 bytes
-- 
2.4.2