X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fntlm.el;h=6d49426fa60086738f6cc7e43c72eb25ddd4ae50;hp=3479851732cf7493db5f0cd9c60f72722eee1baf;hb=b83f8075b710368442538ef872ed3f6b5400698a;hpb=6d3039252bb175eba53a2028cbf3c0e90112388d diff --git a/lisp/ntlm.el b/lisp/ntlm.el index 347985173..6d49426fa 100644 --- a/lisp/ntlm.el +++ b/lisp/ntlm.el @@ -1,18 +1,19 @@ ;;; ntlm.el --- NTLM (NT LanManager) authentication support -;; Copyright (C) 2001, 2007, 2008 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2007-2016 Free Software Foundation, Inc. ;; Author: Taro Kawagishi -;; Keywords: NTLM, SASL -;; Version: 1.00 +;; Maintainer: Thomas Fitzsimmons +;; Keywords: NTLM, SASL, comm +;; Version: 2.0.0 ;; Created: February 2001 ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -20,18 +21,16 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: ;; This library is a direct translation of the Samba release 2.2.0 ;; implementation of Windows NT and LanManager compatible password ;; encryption. -;; +;; ;; Interface functions: -;; +;; ;; ntlm-build-auth-request ;; This will return a binary string, which should be used in the ;; base64 encoded form and it is the caller's responsibility to encode @@ -42,7 +41,7 @@ ;; (which will be a binary string) as the first argument and to ;; encode the returned string with base64. The second argument user ;; should be given in user@domain format. -;; +;; ;; ntlm-get-password-hashes ;; ;; @@ -67,6 +66,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 @@ -82,8 +102,8 @@ is not given." (request-msgType (concat (make-string 1 1) (make-string 3 0))) ;0x01 0x00 0x00 0x00 (request-flags (concat (make-string 1 7) (make-string 1 178) - (make-string 2 0))) - ;0x07 0xb2 0x00 0x00 + (make-string 1 8) (make-string 1 0))) + ;0x07 0xb2 0x08 0x00 lu ld off-d off-u) (when (string-match "@" user) (unless domain @@ -104,15 +124,90 @@ is not given." (md4-pack-int16 ld) ;domain field, count field (md4-pack-int16 ld) ;domain field, max count field (md4-pack-int32 (cons 0 off-d)) ;domain field, offset field - user ;bufer field - domain ;bufer field + user ;buffer field + domain ;buffer field ))) (eval-when-compile (defmacro ntlm-string-as-unibyte (string) (if (fboundp 'string-as-unibyte) `(string-as-unibyte ,string) - string))) + string)) + (defmacro ntlm-string-make-unibyte (string) + (if (fboundp 'string-make-unibyte) + `(string-make-unibyte ,string) + string)) + (defmacro ntlm-unibyte-string (&rest bytes) + (if (fboundp 'unibyte-string) + `(unibyte-string ,@bytes) + `(concat (vector ,@bytes))))) + +(eval-and-compile + (autoload 'sha1 "sha1") + (if (fboundp 'secure-hash) + (defalias 'ntlm-secure-hash 'secure-hash) + (defun ntlm-secure-hash (algorithm object &optional start end binary) + "Return the secure hash of OBJECT, a buffer or string. +ALGORITHM is a symbol specifying the hash to use: md5, sha1. + +The two optional arguments START and END are positions specifying for +which part of OBJECT to compute the hash. If nil or omitted, uses the +whole OBJECT. + +If BINARY is non-nil, returns a string in binary form." + (cond ((eq algorithm 'md5) + (if binary + (let* ((hex (md5 object start end)) + (len (length hex)) + (beg 0) + rest) + (while (< beg len) + (push (ntlm-string-make-unibyte + (char-to-string + (string-to-number + (substring hex beg (setq beg (+ beg 2))) + 16))) + rest)) + (apply #'concat (nreverse rest))) + (md5 object start end))) + ((eq algorithm 'sha1) + (sha1 object start end binary)) + (t + (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 @@ -130,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))) @@ -146,21 +241,79 @@ 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)))) - ;; generate response data - (setq lmRespData - (ntlm-smb-owf-encrypt (car password-hashes) challengeData)) - (setq ntRespData - (ntlm-smb-owf-encrypt (cadr password-hashes) challengeData)) + (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 (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))) + ;; 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 (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 @@ -172,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 @@ -209,16 +362,16 @@ by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of ;; buffer field lmRespData ;lmResponse, 24 bytes ntRespData ;ntResponse, 24 bytes - (ntlm-ascii2unicode domain ;unicode domain string, 2*ld bytes + (ntlm-ascii2unicode domain ;Unicode domain string, 2*ld bytes (length domain)) ; - (ntlm-ascii2unicode user ;unicode user string, 2*lu bytes + (ntlm-ascii2unicode user ;Unicode user string, 2*lu bytes (length user)) ; - (ntlm-ascii2unicode user ;unicode user string, 2*lu bytes + (ntlm-ascii2unicode user ;Unicode user string, 2*lu bytes (length user)) ; ))) (defun ntlm-get-password-hashes (password) - "Return a pair of SMB hash and NT MD4 hash of the given password PASSWORD" + "Return a pair of SMB hash and NT MD4 hash of the given password PASSWORD." (list (ntlm-smb-passwd-hash password) (ntlm-md4hash password))) @@ -442,7 +595,7 @@ length of STR is LEN." (defun ntlm-smb-dohash (in key forw) "Return the hash value for a string IN and a string KEY. -Length of IN and KEY are 64. FORW non nill means forward, nil means +Length of IN and KEY are 64. FORW non-nil means forward, nil means backward." (let (pk1 ;string of length 56 c ;string of length 28 @@ -528,7 +681,7 @@ into a Unicode string. PASSWD is truncated to 128 bytes if longer." (setq len (length passwd)) (if (> len 128) (setq len 128)) - ;; Password must be converted to NT unicode + ;; Password must be converted to NT Unicode (setq wpwd (ntlm-ascii2unicode passwd len)) ;; Calculate length in bytes (setq len (* len 2)) @@ -536,5 +689,4 @@ into a Unicode string. PASSWD is truncated to 128 bytes if longer." (provide 'ntlm) -;; arch-tag: 348ace18-f8e2-4176-8fe9-d9ab4e96f296 ;;; ntlm.el ends here