]> crepu.dev Git - config.git/blame_incremental - djavu-asus/elpa/jabber-20230715.456/jabber-logon.el
Actualizado el Readme
[config.git] / djavu-asus / elpa / jabber-20230715.456 / jabber-logon.el
... / ...
CommitLineData
1;; jabber-logon.el - logon functions -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2003, 2004, 2007, 2008 - Magnus Henoch - mange@freemail.hu
4;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net
5
6;; This file is a part of jabber.el.
7
8;; This program is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation; either version 2 of the License, or
11;; (at your option) any later version.
12
13;; This program is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with this program; if not, write to the Free Software
20;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21
22(require 'jabber-xml)
23(require 'jabber-util)
24;; In Emacs 24, sha1 is built in, so this require is only needed for
25;; earlier versions. It's supposed to be a noop in Emacs 24, but
26;; sometimes, for some people, it isn't, and fails with
27;; (file-error "Cannot open load file" "sha1").
28(unless (fboundp 'sha1)
29 (require 'sha1))
30
31(defun jabber-get-auth (jc to session-id)
32 "Send IQ get request in namespace \"jabber:iq:auth\".
33JC is the Jabber connection."
34 (jabber-send-iq jc to
35 "get"
36 `(query ((xmlns . "jabber:iq:auth"))
37 (username () ,(plist-get (fsm-get-state-data jc) :username)))
38 #'jabber-do-logon session-id
39 #'jabber-report-success "Impossible error - auth field request"))
40
41(defun jabber-do-logon (jc xml-data session-id)
42 "Send username and password in logon attempt.
43
44JC is the Jabber connection.
45XML-DATA is the parsed tree data from the stream (stanzas)
46obtained from `xml-parse-region'."
47 (let* ((digest-allowed (jabber-xml-get-children (jabber-iq-query xml-data) 'digest))
48 (passwd (when
49 (or digest-allowed
50 (plist-get (fsm-get-state-data jc) :encrypted)
51 (yes-or-no-p "Jabber server only allows cleartext password transmission! Continue? "))
52 (or (plist-get (fsm-get-state-data jc) :password)
53 (jabber-read-password (jabber-connection-bare-jid jc)))))
54 auth)
55 (if (null passwd)
56 (fsm-send jc :authentication-failure)
57 (if digest-allowed
58 (setq auth `(digest () ,(sha1 (concat session-id passwd))))
59 (setq auth `(password () ,passwd)))
60 ;; For legacy authentication we must specify a resource.
61 (unless (plist-get (fsm-get-state-data jc) :resource)
62 ;; Yes, this is ugly. Where is my encapsulation?
63 (plist-put (fsm-get-state-data jc) :resource "emacs-jabber"))
64 (jabber-send-iq jc (plist-get (fsm-get-state-data jc) :server)
65 "set"
66 `(query ((xmlns . "jabber:iq:auth"))
67 (username () ,(plist-get (fsm-get-state-data jc) :username))
68 ,auth
69 (resource () ,(plist-get (fsm-get-state-data jc) :resource)))
70 #'jabber-process-logon passwd
71 #'jabber-process-logon nil))))
72
73(defun jabber-process-logon (jc xml-data closure-data)
74 "Receive login success or failure, and request roster.
75CLOSURE-DATA should be the password on success and nil on failure.
76
77JC is the Jabber connection.
78XML-DATA is the parsed tree data from the stream (stanzas)
79obtained from `xml-parse-region'."
80 (if closure-data
81 ;; Logon success
82 (fsm-send jc (cons :authentication-success closure-data))
83
84 ;; Logon failure
85 (jabber-report-success jc xml-data "Logon")
86 (fsm-send jc :authentication-failure)))
87
88(provide 'jabber-logon)
89
90;;; arch-tag: f24ebe5e-3420-44bb-af81-d4de21f378b0