]>
Commit | Line | Data |
---|---|---|
53e6db90 DC |
1 | ;; jabber-time.el - time reporting by XEP-0012, XEP-0090, XEP-0202 -*- lexical-binding: t; -*- |
2 | ||
3 | ;; Copyright (C) 2006, 2010 - Kirill A. Kroinskiy - catap@catap.ru | |
4 | ;; Copyright (C) 2006 - Magnus Henoch - mange@freemail.hu | |
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 GNU Emacs; see the file COPYING. If not, write to | |
20 | ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | |
21 | ;; Boston, MA 02110-1301, USA. | |
22 | ||
23 | (require 'jabber-iq) | |
24 | (require 'jabber-util) | |
25 | (require 'jabber-autoaway) | |
26 | ||
27 | (require 'time-date) | |
28 | ||
29 | (add-to-list 'jabber-jid-info-menu (cons "Request time" 'jabber-get-time)) | |
30 | ||
31 | (defun jabber-get-time (jc to) | |
32 | "Request time. | |
33 | ||
34 | JC is the Jabber connection." | |
35 | (interactive (list (jabber-read-account) | |
36 | (jabber-read-jid-completing "Request time of: " | |
37 | nil nil nil 'full t))) | |
38 | ||
39 | (jabber-send-iq jc to "get" | |
40 | '(time ((xmlns . "urn:xmpp:time"))) | |
41 | 'jabber-silent-process-data 'jabber-process-time | |
42 | 'jabber-silent-process-data | |
43 | (lambda (jc xml-data) | |
44 | (let ((from (jabber-xml-get-attribute xml-data 'from))) | |
45 | (jabber-get-legacy-time jc from))))) | |
46 | ||
47 | (defun jabber-get-legacy-time (jc to) | |
48 | "Request legacy time. | |
49 | ||
50 | JC is the Jabber connection. | |
51 | XML-DATA is the parsed tree data from the stream (stanzas) | |
52 | obtained from `xml-parse-region'." | |
53 | (interactive (list (jabber-read-account) | |
54 | (jabber-read-jid-completing "Request time of: " | |
55 | nil nil nil 'full t))) | |
56 | ||
57 | (jabber-send-iq jc to | |
58 | "get" | |
59 | '(query ((xmlns . "jabber:iq:time"))) | |
60 | 'jabber-silent-process-data 'jabber-process-legacy-time | |
61 | 'jabber-silent-process-data "Time request failed")) | |
62 | ||
63 | ;; called by jabber-process-data | |
64 | (defun jabber-process-time (jc xml-data) | |
65 | "Handle results from urn:xmpp:time requests. | |
66 | ||
67 | JC is the Jabber Connection. | |
68 | XML-DATA is the parsed tree data from the stream (stanzas) | |
69 | obtained from `xml-parse-region'." | |
70 | (let* ((from (jabber-xml-get-attribute xml-data 'from)) | |
71 | (time (or (car (jabber-xml-get-children xml-data 'time)) | |
72 | ;; adium response of qeury | |
73 | (car (jabber-xml-get-children xml-data 'query)))) | |
74 | (tzo (car (jabber-xml-node-children | |
75 | (car (jabber-xml-get-children time 'tzo))))) | |
76 | (utc (car (jabber-xml-node-children | |
77 | (car (jabber-xml-get-children time 'utc)))))) | |
78 | (when (and utc tzo) | |
79 | (format "%s has time: %s %s" | |
80 | from (format-time-string "%Y-%m-%d %T" (jabber-parse-time utc)) tzo)))) | |
81 | ||
82 | (defun jabber-process-legacy-time (jc xml-data) | |
83 | "Handle results from jabber:iq:time requests. | |
84 | ||
85 | JC is the Jabber connection. | |
86 | XML-DATA is the parsed tree data from the stream (stanzas) | |
87 | obtained from `xml-parse-region'." | |
88 | (let* ((from (jabber-xml-get-attribute xml-data 'from)) | |
89 | (query (jabber-iq-query xml-data)) | |
90 | (display | |
91 | (car (jabber-xml-node-children | |
92 | (car (jabber-xml-get-children | |
93 | query 'display))))) | |
94 | (utc | |
95 | (car (jabber-xml-node-children | |
96 | (car (jabber-xml-get-children | |
97 | query 'utc))))) | |
98 | (tz | |
99 | (car (jabber-xml-node-children | |
100 | (car (jabber-xml-get-children | |
101 | query 'tz)))))) | |
102 | (format "%s has time: %s" from | |
103 | (cond | |
104 | (display display) | |
105 | (utc | |
106 | (concat | |
107 | (format-time-string "%Y-%m-%d %T" (jabber-parse-legacy-time utc)) | |
108 | (when tz | |
109 | (concat " " tz)))))))) | |
110 | ||
111 | ;; the only difference between these two functions is the | |
112 | ;; `jabber-read-jid-completing' call. | |
113 | (defun jabber-get-last-online (jc to) | |
114 | "Request time since a user was last online, or uptime of a component. | |
115 | ||
116 | JC is the Jabber connection." | |
117 | (interactive (list (jabber-read-account) | |
118 | (jabber-read-jid-completing "Get last online for: " | |
119 | nil nil nil 'bare-or-muc))) | |
120 | (jabber-send-iq jc to | |
121 | "get" | |
122 | '(query ((xmlns . "jabber:iq:last"))) | |
123 | #'jabber-silent-process-data #'jabber-process-last | |
124 | #'jabber-silent-process-data "Last online request failed")) | |
125 | ||
126 | (defun jabber-get-idle-time (jc to) | |
127 | "Request idle time of user. | |
128 | ||
129 | JC is the Jabber connection." | |
130 | (interactive (list (jabber-read-account) | |
131 | (jabber-read-jid-completing "Get idle time for: " | |
132 | nil nil nil 'full t))) | |
133 | (jabber-send-iq jc to | |
134 | "get" | |
135 | '(query ((xmlns . "jabber:iq:last"))) | |
136 | #'jabber-silent-process-data #'jabber-process-last | |
137 | #'jabber-silent-process-data "Idle time request failed")) | |
138 | ||
139 | (defun jabber-process-last (jc xml-data) | |
140 | "Handle results from jabber:iq:last requests. | |
141 | ||
142 | JC is the Jabber connection. | |
143 | XML-DATA is the parsed tree data from the stream (stanzas) | |
144 | obtained from `xml-parse-region'." | |
145 | (let* ((from (jabber-xml-get-attribute xml-data 'from)) | |
146 | (query (jabber-iq-query xml-data)) | |
147 | (seconds (jabber-xml-get-attribute query 'seconds)) | |
148 | (message (car (jabber-xml-node-children query)))) | |
149 | (cond | |
150 | ((jabber-jid-resource from) | |
151 | ;; Full JID: idle time | |
152 | (format "%s idle for %s seconds" from seconds)) | |
153 | ((jabber-jid-username from) | |
154 | ;; Bare JID with username: time since online | |
155 | (concat | |
156 | (format "%s last online %s seconds ago" from seconds) | |
157 | (let ((seconds (condition-case nil | |
158 | (string-to-number seconds) | |
159 | (error nil)))) | |
160 | (when (numberp seconds) | |
161 | (concat | |
162 | " - that is, at " | |
163 | (format-time-string "%Y-%m-%d %T" | |
164 | (time-subtract (current-time) | |
165 | (seconds-to-time seconds))) | |
166 | "\n"))))) | |
167 | (t | |
168 | ;; Only hostname: uptime | |
169 | (format "%s uptime: %s seconds" from seconds))))) | |
170 | ||
171 | (add-to-list 'jabber-iq-get-xmlns-alist (cons "jabber:iq:time" 'jabber-return-legacy-time)) | |
172 | (jabber-disco-advertise-feature "jabber:iq:time") | |
173 | ||
174 | (defun jabber-return-legacy-time (jc xml-data) | |
175 | "Return client time as defined in XEP-0090. | |
176 | Sender and ID are determined from the incoming packet passed in XML-DATA. | |
177 | ||
178 | JC is the Jabber connection. | |
179 | XML-DATA is the parsed tree data from the stream (stanzas) | |
180 | obtained from `xml-parse-region'." | |
181 | (let ((to (jabber-xml-get-attribute xml-data 'from)) | |
182 | (id (jabber-xml-get-attribute xml-data 'id))) | |
183 | (jabber-send-iq jc to "result" | |
184 | `(query ((xmlns . "jabber:iq:time")) | |
185 | ;; what is ``human-readable'' format? | |
186 | ;; the same way as formating using by tkabber | |
187 | (display () ,(format-time-string "%a %b %d %H:%M:%S %Z %Y")) | |
188 | (tz () ,(format-time-string "%Z")) | |
189 | (utc () ,(jabber-encode-legacy-time nil))) | |
190 | nil nil nil nil | |
191 | id))) | |
192 | ||
193 | (add-to-list 'jabber-iq-get-xmlns-alist (cons "urn:xmpp:time" 'jabber-return-time)) | |
194 | (jabber-disco-advertise-feature "urn:xmpp:time") | |
195 | ||
196 | (defun jabber-return-time (jc xml-data) | |
197 | "Return client time as defined in XEP-0202. | |
198 | Sender and ID are determined from the incoming packet passed in XML-DATA. | |
199 | ||
200 | JC is the Jabber connection. | |
201 | XML-DATA is the parsed tree data from the stream (stanzas) | |
202 | obtained from `xml-parse-region'." | |
203 | (let ((to (jabber-xml-get-attribute xml-data 'from)) | |
204 | (id (jabber-xml-get-attribute xml-data 'id))) | |
205 | (jabber-send-iq jc to "result" | |
206 | `(time ((xmlns . "urn:xmpp:time")) | |
207 | (utc () ,(jabber-encode-time nil)) | |
208 | (tzo () ,(jabber-encode-timezone))) | |
209 | nil nil nil nil | |
210 | id))) | |
211 | ||
212 | (add-to-list 'jabber-iq-get-xmlns-alist (cons "jabber:iq:last" 'jabber-return-last)) | |
213 | (jabber-disco-advertise-feature "jabber:iq:last") | |
214 | ||
215 | (defun jabber-return-last (jc xml-data) | |
216 | (let ((to (jabber-xml-get-attribute xml-data 'from)) | |
217 | (id (jabber-xml-get-attribute xml-data 'id))) | |
218 | (jabber-send-iq jc to "result" | |
219 | `(time ((xmlns . "jabber:iq:last") | |
220 | ;; XEP-0012 specifies that this is an integer. | |
221 | (seconds . ,(number-to-string | |
222 | (floor (jabber-autoaway-get-idle-time)))))) | |
223 | nil nil nil nil | |
224 | id))) | |
225 | ||
226 | ||
227 | (provide 'jabber-time) | |
228 | ||
229 | ;; arch-tag: 5396bfda-323a-11db-ac8d-000a95c2fcd0 |