;;; Code:
+(require 'poem)
(require 'md4)
;;;
(request-flags (concat (make-string 1 7) (make-string 1 178)
(make-string 2 0)))
;0x07 0xb2 0x00 0x00
- (request-bufIndex 0)
lu ld off-d off-u)
(when (string-match "@" user)
(unless domain
(concat request-ident ;8 bytes
request-msgType ;4 bytes
request-flags ;4 bytes
- (pack-int16 lu) ;user field, count field
- (pack-int16 lu) ;user field, max count field
- (pack-int32 (cons 0 off-u)) ;user field, offset field
- (pack-int16 ld) ;domain field, count field
- (pack-int16 ld) ;domain field, max count field
- (pack-int32 (cons 0 off-d)) ;domain field, offset field
+ (md4-pack-int16 lu) ;user field, count field
+ (md4-pack-int16 lu) ;user field, max count field
+ (md4-pack-int32 (cons 0 off-u)) ;user field, offset field
+ (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
)))
PASSWORD-HASHES. NTLM uses two hash values which are represented
by PASSWORD-HASHES. PASSWORD-HASHES should be a return value of
(list (smb-passwd-hash password) (ntlm-md4hash password))"
- (let* ((rchallenge (if (functionp 'string-as-unibyte)
- (string-as-unibyte challenge)
- challenge))
+ (let* ((rchallenge (string-as-unibyte challenge))
;; get fields within challenge struct
- (ident (substring rchallenge 0 8)) ;ident, 8 bytes
- (msgType (substring rchallenge 8 12)) ;msgType, 4 bytes
+ ;;(ident (substring rchallenge 0 8)) ;ident, 8 bytes
+ ;;(msgType (substring rchallenge 8 12)) ;msgType, 4 bytes
(uDomain (substring rchallenge 12 20)) ;uDomain, 8 bytes
(flags (substring rchallenge 20 24)) ;flags, 4 bytes
(challengeData (substring rchallenge 24 32)) ;challengeData, 8 bytes
uDomain-len uDomain-offs
;; response struct and its fields
- response
lmRespData ;lmRespData, 24 bytes
ntRespData ;ntRespData, 24 bytes
domain ;ascii domain string
lu ld off-lm off-nt off-d off-u off-w off-s)
;; extract domain string from challenge string
- (setq uDomain-len (unpack-int16 (substring uDomain 0 2)))
- (setq uDomain-offs (unpack-int32 (substring uDomain 4 8)))
+ (setq uDomain-len (md4-unpack-int16 (substring uDomain 0 2)))
+ (setq uDomain-offs (md4-unpack-int32 (substring uDomain 4 8)))
(setq domain
(ntlm-unicode2ascii (substring challenge
(cdr uDomain-offs)
(setq off-s (+ 64 48 (* 2 (+ ld lu lu)))) ;offset to string 'sessionKey
;; pack the response struct in a string
(concat "NTLMSSP\0" ;response ident field, 8 bytes
- (pack-int32 '(0 . 3)) ;response msgType field, 4 bytes
+ (md4-pack-int32 '(0 . 3)) ;response msgType field, 4 bytes
;; lmResponse field, 8 bytes
;;AddBytes(response,lmResponse,lmRespData,24);
- (pack-int16 24) ;len field
- (pack-int16 24) ;maxlen field
- (pack-int32 (cons 0 off-lm)) ;field offset
+ (md4-pack-int16 24) ;len field
+ (md4-pack-int16 24) ;maxlen field
+ (md4-pack-int32 (cons 0 off-lm)) ;field offset
;; ntResponse field, 8 bytes
;;AddBytes(response,ntResponse,ntRespData,24);
- (pack-int16 24) ;len field
- (pack-int16 24) ;maxlen field
- (pack-int32 (cons 0 off-nt)) ;field offset
+ (md4-pack-int16 24) ;len field
+ (md4-pack-int16 24) ;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);
- (pack-int16 (* 2 ld)) ;len field
- (pack-int16 (* 2 ld)) ;maxlen field
- (pack-int32 (cons 0 off-d)) ;field offset
+ (md4-pack-int16 (* 2 ld)) ;len field
+ (md4-pack-int16 (* 2 ld)) ;maxlen field
+ (md4-pack-int32 (cons 0 off-d)) ;field offset
;; uUser field, 8 bytes
;;AddUnicodeString(response,uUser,u);
;;AddBytes(response, uUser, uuser, 2*lu);
- (pack-int16 (* 2 lu)) ;len field
- (pack-int16 (* 2 lu)) ;maxlen field
- (pack-int32 (cons 0 off-u)) ;field offset
+ (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);
- (pack-int16 (* 2 lu)) ;len field
- (pack-int16 (* 2 lu)) ;maxlen field
- (pack-int32 (cons 0 off-w)) ;field offset
+ (md4-pack-int16 (* 2 lu)) ;len field
+ (md4-pack-int16 (* 2 lu)) ;maxlen field
+ (md4-pack-int32 (cons 0 off-w)) ;field offset
;; sessionKey field, 8 bytes
;;AddString(response,sessionKey,NULL);
- (pack-int16 0) ;len field
- (pack-int16 0) ;maxlen field
- (pack-int32 (cons 0 (- off-s off-lm))) ;field offset
+ (md4-pack-int16 0) ;len field
+ (md4-pack-int16 0) ;maxlen field
+ (md4-pack-int32 (cons 0 (- off-s off-lm))) ;field offset
;; flags field, 4 bytes
flags ;
(list (smb-passwd-hash password)
(ntlm-md4hash password)))
-;;;
-;;; sub functions
-
-(defun pack-int16 (int16)
- "Pack 16 bits integer in 2 bytes string as little endian."
- (let ((str (make-string 2 0)))
- (aset str 0 (logand int16 255))
- (aset str 1 (lsh int16 -8))
- str))
-
-(defun pack-int32 (int32)
- "Pack 32 bits integer in a 4 bytes string as little endian. A 32 bits
-integer is represented as a pair of two 16 bits integers (cons high low)."
- (let ((str (make-string 4 0))
- (h (car int32)) (l (cdr int32)))
- (aset str 0 (logand l 255))
- (aset str 1 (lsh l -8))
- (aset str 2 (logand h 255))
- (aset str 3 (lsh h -8))
- str))
-
-(defun unpack-int16 (str)
- (if (eq 2 (length str))
- (+ (lsh (aref str 1) 8) (aref str 0))
- (error "%s is not 2 bytes long" str)))
-
-(defun unpack-int32 (str)
- (if (eq 4 (length str))
- (cons (+ (lsh (aref str 3) 8) (aref str 2))
- (+ (lsh (aref str 1) 8) (aref str 0)))
- (error "%s is not 4 bytes long" str)))
-
(defun ntlm-ascii2unicode (str len)
"Convert an ASCII string into a NT Unicode string, which is
little-endian utf16."
utf))
(defun ntlm-unicode2ascii (str len)
- "Extract 7 bits ASCII part of a little endian utf16 string STR of length
-LEN."
+ "Extract 7 bits ASCII part of a little endian utf16 string STR of length LEN."
(let ((buf (make-string len 0)) (i 0) (j 0))
(while (< i len)
(aset buf i (logand (aref str j) 127)) ;(string-to-number "7f" 16)
(defun smb-passwd-hash (passwd)
"Return the SMB password hash string of 16 bytes long for the given password
string PASSWD. PASSWD is truncated to 14 bytes if longer."
- (let* ((len (min (length passwd) 14))
- p15)
- (setq p15 (concat (substring passwd 0 len) ;fill top 14 bytes with passwd
- (make-string (- 15 len) 0)))
- (smbdes-e-p16 (upcase p15))))
+ (let ((len (min (length passwd) 14)))
+ (smbdes-e-p16
+ (concat (substring (upcase passwd) 0 len) ;fill top 14 bytes with passwd
+ (make-string (- 15 len) 0)))))
(defun smb-owf-encrypt (passwd c8)
"Return the response string of 24 bytes long for the given password
projects / elisp / flim.git / blobdiff