diff options
author | Gnus developers <ding@gnus.org> | 2011-03-15 22:38:41 +0000 |
---|---|---|
committer | Katsumi Yamaoka <yamaoka@jpl.org> | 2011-03-15 22:38:41 +0000 |
commit | a123622dc48a5f0e0eb32c07ce05c85e16e09c1d (patch) | |
tree | 1d2116fe692367da3625b744e980a6a8c909dd1e /lisp/gnus/gssapi.el | |
parent | 2dab465b9edbb62db03cd5d2d9741415ba1014f6 (diff) | |
download | emacs-a123622dc48a5f0e0eb32c07ce05c85e16e09c1d.tar.gz emacs-a123622dc48a5f0e0eb32c07ce05c85e16e09c1d.tar.bz2 emacs-a123622dc48a5f0e0eb32c07ce05c85e16e09c1d.zip |
Merge changes made in Gnus trunk.
message.texi (Insertion Variables): Document message-cite-style.
nnimap.el (nnimap-open-connection-1): Allow `network-only', too.
gssapi.el: New file separated out from imap.el to provide a general Kerberos 5 connection facility for Emacs.
message.el (message-elide-ellipsis): Document the format spec ellipsis.
message.el (message-elide-region): Allow the ellipsis to say how many lines were removed.
gnus-win.el (gnus-configure-frame): Protect against trying to restore window configurations containing buffers that are now dead.
nnimap.el (nnimap-parse-flags): Remove all MODSEQ entries before parsing to avoid integer overflows.
(nnimap-parse-flags): Simplify the last change.
(nnimap-parse-flags): Store HIGHESTMODSEQ as a string, since it may be too large for 32-bit Emacsen.
gnus-art.el (gnus-article-treat-body-boundary): Fix boundary width on XEmacs, which was one character too wide.
gnus-sum.el (gnus-articles-to-read): Use gnus-large-newsgroup as default number of articles to display.
(gnus-articles-to-read): Use pretty names for prompt.
gnus-int.el (gnus-open-server): Ditto.
gnus-start.el (gnus-activate-group): Give a backtrace if debug-on-quit is set and the user hits `C-g'.
(gnus-read-active-file): Ditto.
gnus-group.el (gnus-group-read-ephemeral-group): Ditto.
Diffstat (limited to 'lisp/gnus/gssapi.el')
-rw-r--r-- | lisp/gnus/gssapi.el | 105 |
1 files changed, 105 insertions, 0 deletions
diff --git a/lisp/gnus/gssapi.el b/lisp/gnus/gssapi.el new file mode 100644 index 00000000000..3765fb84ee8 --- /dev/null +++ b/lisp/gnus/gssapi.el @@ -0,0 +1,105 @@ +;;; gssapi.el --- GSSAPI/Kerberos 5 interface for Emacs + +;; Copyright (C) 2011 Free Software Foundation, Inc. + +;; Author: Simon Josefsson <simon@josefsson.org> +;; Lars Magne Ingebrigtsen <larsi@gnus.org> +;; Keywords: network + +;; This file is part of GNU Emacs. + +;; 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 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 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'format-spec) + +(defcustom gssapi-program (list + (concat "gsasl %s %p " + "--mechanism GSSAPI " + "--authentication-id %l") + "imtest -m gssapi -u %l -p %p %s") + "List of strings containing commands for GSSAPI (krb5) authentication. +%s is replaced with server hostname, %p with port to connect to, and +%l with the value of `imap-default-user'. The program should accept +IMAP commands on stdin and return responses to stdout. Each entry in +the list is tried until a successful connection is made." + :group 'network + :type '(repeat string)) + +(defun open-gssapi-stream (name buffer server port) + (let ((cmds gssapi-program) + cmd done) + (with-current-buffer buffer + (while (and (not done) + (setq cmd (pop cmds))) + (message "Opening GSSAPI connection with `%s'..." cmd) + (erase-buffer) + (let* ((coding-system-for-read 'binary) + (coding-system-for-write 'binary) + (process (start-process + name buffer shell-file-name shell-command-switch + (format-spec + cmd + (format-spec-make + ?s server + ?p (number-to-string port) + ?l imap-default-user)))) + response) + (when process + (while (and (memq (process-status process) '(open run)) + (goto-char (point-min)) + ;; Athena IMTEST can output SSL verify errors + (or (while (looking-at "^verify error:num=") + (forward-line)) + t) + (or (while (looking-at "^TLS connection established") + (forward-line)) + t) + ;; cyrus 1.6.x (13? < x <= 22) queries capabilities + (or (while (looking-at "^C:") + (forward-line)) + t) + ;; cyrus 1.6 imtest print "S: " before server greeting + (or (not (looking-at "S: ")) + (forward-char 3) + t) + ;; GNU SASL may print 'Trying ...' first. + (or (not (looking-at "Trying ")) + (forward-line) + t) + (not (and (looking-at "\\* \\(OK\\|PREAUTH\\|BYE\\) ") + ;; success in imtest 1.6: + (re-search-forward + (concat "^\\(\\(Authenticat.*\\)\\|\\(" + "Client authentication " + "finished.*\\)\\)") + nil t) + (setq response (match-string 1))))) + (accept-process-output process 1) + (sit-for 1)) + (erase-buffer) + (message "GSSAPI IMAP connection: %s" (or response "failed")) + (if (and response (let ((case-fold-search nil)) + (not (string-match "failed" response)))) + (setq done process) + (delete-process process) + nil)))) + done))) + +(provide 'gssapi) + +;;; gssapi.el ends here |