Function: ntlm-build-auth-response
ntlm-build-auth-response is a byte-compiled function defined in
ntlm.el.gz.
Signature
(ntlm-build-auth-response CHALLENGE USER PASSWORD-HASHES)
Documentation
Return the NTLM authentication response string.
Return the response string to a challenge string CHALLENGE given by the NTLM based server for the user USER and the password hash list PASSWORD-HASHES. NTLM uses two hash values which are represented by PASSWORD-HASHES. PASSWORD-HASHES should be the return value of (list (ntlm-smb-passwd-hash password) (ntlm-md4hash password))
Source Code
;; Defined in /usr/src/emacs/lisp/net/ntlm.el.gz
(defun ntlm-build-auth-response (challenge user password-hashes)
"Return the NTLM authentication response string.
Return the response string to a challenge string CHALLENGE given by the
NTLM based server for the user USER and the password hash list
PASSWORD-HASHES. NTLM uses two hash values which are represented by
PASSWORD-HASHES. PASSWORD-HASHES should be the return value
of (list (ntlm-smb-passwd-hash password) (ntlm-md4hash password))"
(let* ((rchallenge (if (multibyte-string-p challenge)
(progn
;; FIXME: Maybe it would be better to
;; signal an error.
(message "Incorrect challenge string type in ntlm-build-auth-response")
(encode-coding-string challenge 'binary))
challenge))
;; get fields within challenge struct
;;(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 (unibyte-string #x07 #x82 #x08 #x00))
(flags (substring rchallenge 20 24)) ;flags, 4 bytes
(challengeData (substring rchallenge 24 32)) ;challengeData, 8 bytes
;; Extract domain string from challenge string.
;;(uDomain-len (md4-unpack-int16 (substring uDomain 0 2)))
(uDomain-offs (md4-unpack-int32 (substring uDomain 4 8)))
;; Response struct and its fields.
lmRespData ;lmRespData, 24 bytes
ntRespData ;ntRespData, variable length
;; Match Mozilla behavior, which is to send an empty domain string
(domain "") ;ascii domain string
;; Match Mozilla behavior, which is to send "WORKSTATION".
(workstation "WORKSTATION")) ;ascii workstation string
;; 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)
(<= 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
;; 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 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)))
;; generate NTLM2 session response data
(let* ((randomString (ntlm-generate-nonce))
(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))
(setq ntRespData
(ntlm-smb-owf-encrypt (cadr password-hashes) challengeData))))
;; get offsets to fields to pack the response struct in a string
(let* ((ll (length lmRespData))
(ln (length ntRespData))
(lu (length user))
(ld (length domain))
(lw (length workstation))
(off-u 64) ;offset to string 'uUser
(off-d (+ off-u (* 2 lu))) ;offset to string 'uDomain
(off-w (+ off-d (* 2 ld))) ;offset to string 'uWks
(off-lm (+ off-w (* 2 lw))) ;offset to string 'lmResponse
(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 ll) ;len field
(md4-pack-int16 ll) ;maxlen field
(md4-pack-int32 (cons 0 off-lm)) ;field offset
;; ntResponse field, 8 bytes
;;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
;;AddUnicodeString(response,uDomain,domain);
;;AddBytes(response, uDomain, udomain, 2*ld);
(md4-pack-int16 (* 2 ld)) ;len field
(md4-pack-int16 (* 2 ld)) ;maxlen field
;; 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);
;;AddBytes(response, uUser, uuser, 2*lu);
(md4-pack-int16 (* 2 lu)) ;len field
(md4-pack-int16 (* 2 lu)) ;maxlen field
(md4-pack-int32 (cons 0 off-u)) ;field offset
;; uWks field, 8 bytes
;;AddUnicodeString(response,uWks,u);
(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, blank, 8 bytes
;;AddString(response,sessionKey,NULL);
(md4-pack-int16 0) ;len field
(md4-pack-int16 0) ;maxlen field
(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, ln bytes
))))