bug#21358: 25.0.50; Add support for NTLMv2 authentication

bug#21358: 25.0.50; Add support for NTLMv2 authentication

[Thomas Fitzsimmons]

[-- Attachment #1: Type: text/plain, Size: 90 bytes --]

Hi,

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

Thanks,
Thomas

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-support-for-NTLMv2-authentication.patch --]
[-- Type: text/x-patch, Size: 9151 bytes --]

From eebf3ec560545f8a1cfa0eb4139eda20b71d90e3 Mon Sep 17 00:00:00 2001
From: Thomas Fitzsimmons <fitzsim@fitzsim.org>
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

bug#21358: 25.0.50; Add support for NTLMv2 authentication

[Stefan Monnier]

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

According to the Git log, this file has seen no local changes other than
cosmetic tweaks like updating the copyright years.  So I suspect that
noone knows any better than you do.

IOW, I think it's OK to push,


        Stefan

bug#21358: 25.0.50; Add support for NTLMv2 authentication

[Thomas Fitzsimmons]

fixed 21358 25.1
thanks

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> This patch implements NTLMv2 authentication in ntlm.el.  OK to push?
>
> According to the Git log, this file has seen no local changes other than
> cosmetic tweaks like updating the copyright years.  So I suspect that
> noone knows any better than you do.
>
> IOW, I think it's OK to push,

Pushed, closing.

I'm also going to bump the version to 2.00, add the "comm" keyword and
add myself as the maintainer, then push the same file to GNU ELPA for
use by pre-25.1 versions of Emacs.

Thanks,
Thomas