djavu-asus/elpa/jabber-20230715.456/jabber-time.el

   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