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