[gnus git] branch master updated: m0-13-65-ga4cb99d =1= ntlm.el: Add support for NTLMv2 authentication
Katsumi Yamaoka <[email protected]> Mon, 07 Sep 2015 01:24:35 +0200
| Newsgroups | gmane.emacs.gnus.cvs |
|---|---|
| Message-ID | <[email protected]> |
via a4cb99d02cb4022fb250f71b631464857447c874 (commit)
from ea3902284b96bfc95c9eeec1f63b6028b4e12871 (commit)
- Log -----------------------------------------------------------------
commit a4cb99d02cb4022fb250f71b631464857447c874
Author: Thomas Fitzsimmons <[email protected]>
Date: Sun Sep 6 23:24:14 2015 +0000
ntlm.el: Add support for NTLMv2 authentication
* 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.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7250d37..ad9c59f 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,12 @@
+2015-09-06 Thomas Fitzsimmons <[email protected]>
+
+ Add support for NTLMv2 authentication.
+ * 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.
+
2015-09-05 Eric Abrahamsen <[email protected]>
* nnimap.el (nnimap-request-group): Handle nil "info" arg. This arg
diff --git a/lisp/ntlm.el b/lisp/ntlm.el
index 9ab83da..f31257e 100644
--- a/lisp/ntlm.el
+++ b/lisp/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
@@ -114,7 +135,12 @@ is not given."
(defmacro ntlm-string-make-unibyte (string)
(if (fboundp 'string-make-unibyte)
`(string-make-unibyte ,string)
- string)))
+ string))
+ (defalias 'ntlm-unibyte-string
+ (if (fboundp 'unibyte-string)
+ 'unibyte-string
+ (lambda (&rest bytes)
+ (concat (apply #'vector bytes))))))
(eval-and-compile
(autoload 'sha1 "sha1")
@@ -150,6 +176,39 @@ If BINARY is non-nil, returns a string in binary form."
(error "(ntlm-secure-hash) Unsupported algorithm: %s"
algorithm))))))
+(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 'ntlm-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."
+ (ntlm-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
@@ -166,9 +225,9 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of
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)))
@@ -182,30 +241,63 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of
(setq domain (substring user (1+ (match-beginning 0))))
(setq user (substring user 0 (match-beginning 0))))
+ (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-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 randomString (ntlm-generate-nonce))
(setq sessionHash (ntlm-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
;; generate response data
(setq lmRespData
(ntlm-smb-owf-encrypt (car password-hashes) challengeData))
@@ -215,12 +307,13 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of
;; 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
@@ -232,9 +325,9 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of
(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
-----------------------------------------------------------------------
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we listed those
revisions in full, above.
Summary of changes:
lisp/ChangeLog | 9 ++++
lisp/ntlm.el | 161 ++++++++++++++++++++++++++++++++++++++++++++------------
2 files changed, 136 insertions(+), 34 deletions(-)
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Gnus Project".
The branch, master has been updated
hooks/post-receive
--
Gnus Project