Mercurial > emacs
annotate lisp/net/sasl-digest.el @ 108002:c609e6e60b3d
* vc-dispatcher (vc-finish-logentry): Don't mess with the windows/frames.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Tue, 20 Apr 2010 12:52:43 -0400 |
parents | 1d1d5d9bd884 |
children | 280c8ae2476d 376148b31b5e |
rev | line source |
---|---|
86995 | 1 ;;; sasl-digest.el --- DIGEST-MD5 module for the SASL client framework |
2 | |
106815 | 3 ;; Copyright (C) 2000, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
86995 | 4 |
5 ;; Author: Daiki Ueno <ueno@unixuser.org> | |
6 ;; Kenichi OKADA <okada@opaopa.org> | |
7 ;; Keywords: SASL, DIGEST-MD5 | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
94677
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
86995 | 12 ;; it under the terms of the GNU General Public License as published by |
94677
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; (at your option) any later version. |
86995 | 15 |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
94677
91e5880a36c1
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
86995 | 23 |
24 ;;; Commentary: | |
25 | |
26 ;; This program is implemented from draft-leach-digest-sasl-05.txt. | |
27 ;; | |
28 ;; It is caller's responsibility to base64-decode challenges and | |
29 ;; base64-encode responses in IMAP4 AUTHENTICATE command. | |
30 ;; | |
31 ;; Passphrase should be longer than 16 bytes. (See RFC 2195) | |
32 | |
33 ;;; Commentary: | |
34 | |
35 (require 'sasl) | |
36 (require 'hmac-md5) | |
37 | |
38 (defvar sasl-digest-md5-nonce-count 1) | |
39 (defvar sasl-digest-md5-unique-id-function | |
40 sasl-unique-id-function) | |
41 | |
42 (defvar sasl-digest-md5-syntax-table | |
43 (let ((table (make-syntax-table))) | |
44 (modify-syntax-entry ?= "." table) | |
45 (modify-syntax-entry ?, "." table) | |
46 table) | |
47 "A syntax table for parsing digest-challenge attributes.") | |
48 | |
49 (defconst sasl-digest-md5-steps | |
50 '(ignore ;no initial response | |
51 sasl-digest-md5-response | |
52 ignore)) ;"" | |
53 | |
54 (defun sasl-digest-md5-parse-string (string) | |
55 "Parse STRING and return a property list. | |
56 The value is a cons cell of the form \(realm nonce qop-options stale maxbuf | |
57 charset algorithm cipher-opts auth-param)." | |
58 (with-temp-buffer | |
59 (set-syntax-table sasl-digest-md5-syntax-table) | |
60 (save-excursion | |
61 (insert string) | |
62 (goto-char (point-min)) | |
63 (insert "(") | |
64 (while (progn (forward-sexp) (not (eobp))) | |
65 (delete-char 1) | |
66 (insert " ")) | |
67 (insert ")") | |
68 (read (point-min-marker))))) | |
69 | |
70 (defun sasl-digest-md5-digest-uri (serv-type host &optional serv-name) | |
71 (concat serv-type "/" host | |
72 (if (and serv-name | |
73 (not (string= host serv-name))) | |
74 (concat "/" serv-name)))) | |
75 | |
76 (defun sasl-digest-md5-cnonce () | |
77 (let ((sasl-unique-id-function sasl-digest-md5-unique-id-function)) | |
78 (sasl-unique-id))) | |
79 | |
80 (defun sasl-digest-md5-response-value (username | |
81 realm | |
82 nonce | |
83 cnonce | |
84 nonce-count | |
85 qop | |
86 digest-uri | |
87 authzid) | |
88 (let ((passphrase | |
89 (sasl-read-passphrase | |
90 (format "DIGEST-MD5 passphrase for %s: " | |
91 username)))) | |
92 (unwind-protect | |
93 (encode-hex-string | |
94 (md5-binary | |
95 (concat | |
96 (encode-hex-string | |
97 (md5-binary (concat (md5-binary | |
98 (concat username ":" realm ":" passphrase)) | |
99 ":" nonce ":" cnonce | |
100 (if authzid | |
101 (concat ":" authzid))))) | |
102 ":" nonce | |
103 ":" (format "%08x" nonce-count) ":" cnonce ":" qop ":" | |
104 (encode-hex-string | |
105 (md5-binary | |
106 (concat "AUTHENTICATE:" digest-uri | |
107 (if (member qop '("auth-int" "auth-conf")) | |
108 ":00000000000000000000000000000000"))))))) | |
109 (fillarray passphrase 0)))) | |
110 | |
111 (defun sasl-digest-md5-response (client step) | |
112 (let* ((plist | |
113 (sasl-digest-md5-parse-string (sasl-step-data step))) | |
114 (realm | |
115 (or (sasl-client-property client 'realm) | |
116 (plist-get plist 'realm))) ;need to check | |
117 (nonce-count | |
118 (or (sasl-client-property client 'nonce-count) | |
119 sasl-digest-md5-nonce-count)) | |
120 (qop | |
121 (or (sasl-client-property client 'qop) | |
122 "auth")) | |
123 (digest-uri | |
124 (sasl-digest-md5-digest-uri | |
125 (sasl-client-service client)(sasl-client-server client))) | |
126 (cnonce | |
127 (or (sasl-client-property client 'cnonce) | |
128 (sasl-digest-md5-cnonce)))) | |
129 (sasl-client-set-property client 'nonce-count (1+ nonce-count)) | |
130 (unless (string= qop "auth") | |
131 (sasl-error (format "Unsupported \"qop-value\": %s" qop))) | |
132 (concat | |
133 "username=\"" (sasl-client-name client) "\"," | |
134 "realm=\"" realm "\"," | |
135 "nonce=\"" (plist-get plist 'nonce) "\"," | |
136 "cnonce=\"" cnonce "\"," | |
137 (format "nc=%08x," nonce-count) | |
138 "digest-uri=\"" digest-uri "\"," | |
139 "qop=" qop "," | |
140 "response=" | |
141 (sasl-digest-md5-response-value | |
142 (sasl-client-name client) | |
143 realm | |
144 (plist-get plist 'nonce) | |
145 cnonce | |
146 nonce-count | |
147 qop | |
148 digest-uri | |
149 (plist-get plist 'authzid))))) | |
150 | |
151 (put 'sasl-digest 'sasl-mechanism | |
152 (sasl-make-mechanism "DIGEST-MD5" sasl-digest-md5-steps)) | |
153 | |
154 (provide 'sasl-digest) | |
155 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
87665
diff
changeset
|
156 ;; arch-tag: 786e02ed-1bc4-4b3c-bf34-96c27e31084d |
86995 | 157 ;;; sasl-digest.el ends here |