cgit.sxemacs.org Git - gnus/blob - lisp/ntlm.el

   1 ;;; ntlm.el --- NTLM (NT LanManager) authentication support
   2
   3 ;; Copyright (C) 2001, 2007, 2008, 2009, 2010  Free Software Foundation, Inc.
   4
   5 ;; Author: Taro Kawagishi <tarok@transpulse.org>
   6 ;; Keywords: NTLM, SASL
   7 ;; Version: 1.00
   8 ;; Created: February 2001
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26
  27 ;; This library is a direct translation of the Samba release 2.2.0
  28 ;; implementation of Windows NT and LanManager compatible password
  29 ;; encryption.
  30 ;;
  31 ;; Interface functions:
  32 ;;
  33 ;; ntlm-build-auth-request
  34 ;;   This will return a binary string, which should be used in the
  35 ;;   base64 encoded form and it is the caller's responsibility to encode
  36 ;;   the returned string with base64.
  37 ;;
  38 ;; ntlm-build-auth-response
  39 ;;   It is the caller's responsibility to pass a base64 decoded string
  40 ;;   (which will be a binary string) as the first argument and to
  41 ;;   encode the returned string with base64.  The second argument user
  42 ;;   should be given in user@domain format.
  43 ;;
  44 ;; ntlm-get-password-hashes
  45 ;;
  46 ;;
  47 ;; NTLM authentication procedure example:
  48 ;;
  49 ;;  1. Open a network connection to the Exchange server at the IMAP port (143)
  50 ;;  2. Receive an opening message such as:
  51 ;;     "* OK Microsoft Exchange IMAP4rev1 server version 5.5.2653.7 (XXXX) ready"
  52 ;;  3. Ask for IMAP server capability by sending "NNN capability"
  53 ;;  4. Receive a capability message such as:
  54 ;;     "* CAPABILITY IMAP4 IMAP4rev1 IDLE LITERAL+ LOGIN-REFERRALS MAILBOX-REFERRALS NAMESPACE AUTH=NTLM"
  55 ;;  5. Ask for NTLM authentication by sending a string
  56 ;;     "NNN authenticate ntlm"
  57 ;;  6. Receive continuation acknowledgment "+"
  58 ;;  7. Send NTLM authentication request generated by 'ntlm-build-auth-request
  59 ;;  8. Receive NTLM challenge string following acknowledgment "+"
  60 ;;  9. Generate response to challenge by 'ntlm-build-auth-response
  61 ;;     (here two hash function values of the user password are encrypted)
  62 ;; 10. Receive authentication completion message such as
  63 ;;     "NNN OK AUTHENTICATE NTLM completed."
  64
  65 ;;; Code:
  66
  67 (require 'md4)
  68
  69 ;;;
  70 ;;; NTLM authentication interface functions
  71
  72 (defun ntlm-build-auth-request (user &optional domain)
  73   "Return the NTLM authentication request string for USER and DOMAIN.
  74 USER is a string representing a user name to be authenticated and
  75 DOMAIN is a NT domain.  USER can include a NT domain part as in
  76 user@domain where the string after @ is used as the domain if DOMAIN
  77 is not given."
  78   (interactive)
  79   (let ((request-ident (concat "NTLMSSP" (make-string 1 0)))
  80         (request-msgType (concat (make-string 1 1) (make-string 3 0)))
  81                                         ;0x01 0x00 0x00 0x00
  82         (request-flags (concat (make-string 1 7) (make-string 1 178)
  83                                (make-string 2 0)))
  84                                         ;0x07 0xb2 0x00 0x00
  85         lu ld off-d off-u)
  86     (when (string-match "@" user)
  87       (unless domain
  88         (setq domain (substring user (1+ (match-beginning 0)))))
  89       (setq user (substring user 0 (match-beginning 0))))
  90     ;; set fields offsets within the request struct
  91     (setq lu (length user))
  92     (setq ld (length domain))
  93     (setq off-u 32)                     ;offset to the string 'user
  94     (setq off-d (+ 32 lu))              ;offset to the string 'domain
  95     ;; pack the request struct in a string
  96     (concat request-ident               ;8 bytes
  97             request-msgType     ;4 bytes
  98             request-flags               ;4 bytes
  99             (md4-pack-int16 lu) ;user field, count field
 100             (md4-pack-int16 lu) ;user field, max count field
 101             (md4-pack-int32 (cons 0 off-u)) ;user field, offset field
 102             (md4-pack-int16 ld) ;domain field, count field
 103             (md4-pack-int16 ld) ;domain field, max count field
 104             (md4-pack-int32 (cons 0 off-d)) ;domain field, offset field
 105             user                        ;bufer field
 106             domain              ;bufer field
 107             )))
 108
 109 (eval-when-compile
 110   (defmacro ntlm-string-as-unibyte (string)
 111     (if (fboundp 'string-as-unibyte)
 112         `(string-as-unibyte ,string)
 113       string)))
 114
 115 (defun ntlm-build-auth-response (challenge user password-hashes)
 116   "Return the response string to a challenge string CHALLENGE given by
 117 the NTLM based server for the user USER and the password hash list
 118 PASSWORD-HASHES.  NTLM uses two hash values which are represented
 119 by PASSWORD-HASHES.  PASSWORD-HASHES should be a return value of
 120  (list (ntlm-smb-passwd-hash password) (ntlm-md4hash password))"
 121   (let* ((rchallenge (ntlm-string-as-unibyte challenge))
 122          ;; get fields within challenge struct
 123          ;;(ident (substring rchallenge 0 8))   ;ident, 8 bytes
 124          ;;(msgType (substring rchallenge 8 12))        ;msgType, 4 bytes
 125          (uDomain (substring rchallenge 12 20)) ;uDomain, 8 bytes
 126          (flags (substring rchallenge 20 24))   ;flags, 4 bytes
 127          (challengeData (substring rchallenge 24 32)) ;challengeData, 8 bytes
 128          uDomain-len uDomain-offs
 129          ;; response struct and its fields
 130          lmRespData                     ;lmRespData, 24 bytes
 131          ntRespData                     ;ntRespData, 24 bytes
 132          domain                         ;ascii domain string
 133          lu ld off-lm off-nt off-d off-u off-w off-s)
 134     ;; extract domain string from challenge string
 135     (setq uDomain-len (md4-unpack-int16 (substring uDomain 0 2)))
 136     (setq uDomain-offs (md4-unpack-int32 (substring uDomain 4 8)))
 137     (setq domain
 138           (ntlm-unicode2ascii (substring challenge
 139                                          (cdr uDomain-offs)
 140                                          (+ (cdr uDomain-offs) uDomain-len))
 141                               (/ uDomain-len 2)))
 142     ;; overwrite domain in case user is given in <user>@<domain> format
 143     (when (string-match "@" user)
 144       (setq domain (substring user (1+ (match-beginning 0))))
 145       (setq user (substring user 0 (match-beginning 0))))
 146
 147     ;; generate response data
 148     (setq lmRespData
 149           (ntlm-smb-owf-encrypt (car password-hashes) challengeData))
 150     (setq ntRespData
 151           (ntlm-smb-owf-encrypt (cadr password-hashes) challengeData))
 152
 153     ;; get offsets to fields to pack the response struct in a string
 154     (setq lu (length user))
 155     (setq ld (length domain))
 156     (setq off-lm 64)                    ;offset to string 'lmResponse
 157     (setq off-nt (+ 64 24))             ;offset to string 'ntResponse
 158     (setq off-d (+ 64 48))              ;offset to string 'uDomain
 159     (setq off-u (+ 64 48 (* 2 ld)))     ;offset to string 'uUser
 160     (setq off-w (+ 64 48 (* 2 (+ ld lu)))) ;offset to string 'uWks
 161     (setq off-s (+ 64 48 (* 2 (+ ld lu lu)))) ;offset to string 'sessionKey
 162     ;; pack the response struct in a string
 163     (concat "NTLMSSP\0"                 ;response ident field, 8 bytes
 164             (md4-pack-int32 '(0 . 3))   ;response msgType field, 4 bytes