jabber-tox.el

   1 ;; jabber-tox.el - Jingle support using TOX
   2
   3 ;; Copyright (C) 2008 - Magnus Henoch - mange@freemail.hu
   4
   5 ;; This file is (soon) a part of jabber.el.
   6
   7 ;; This program is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation; either version 2 of the License, or
  10 ;; (at your option) any later version.
  11
  12 ;; This program is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with this program; if not, write to the Free Software
  19 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  20
  21 (require 'dbus)
  22 (require 'fsm)
  23 (require 'cl)
  24
  25 (require 'jabber-xml)
  26
  27 (defconst jingle-ns "urn:xmpp:jingle:0"
  28   "Jingle namespace (XEP-0166)")
  29
  30 (defconst jingle-error-ns "urn:xmpp:jingle:errors:0"
  31   "Jingle error namespace (XEP-0166)")
  32
  33 (defconst jingle-rtp-ns "urn:xmpp:jingle:apps:rtp:0"
  34   "Jingle RTP Sessions namespace (XEP-0167)")
  35
  36 (defconst jingle-ice-udp-ns "urn:xmpp:jingle:transports:ice-udp:0"
  37   "Jingle ICE namespace (XEP-0176)")
  38
  39 (defvar jingle-acct-sid-map (make-hash-table :test 'equal)
  40   "Mapping from pairs of JIDs and Jingle SIDs to FSMs.
  41 The JID is the full JID of the account using the session.")
  42
  43 (defconst tox-name "net.sourceforge.emacs-jabber.Tox"
  44   "Well-known D-BUS name of the tox service.")
  45
  46 (defconst tox-path "/net/sourceforge/emacs_jabber/Tox"
  47   "Well-known path of the main Tox object.")
  48
  49 (defconst tox-interface "net.sourceforge.emacs_jabber.Tox"
  50   "Interface of main Tox object.")
  51
  52 (defconst tox-session-interface "net.sourceforge.emacs_jabber.ToxSession"
  53   "Interface of ToxSession object.")
  54
  55 (defvar tox-my-ogg-answering-machine
  56   (replace-regexp-in-string
  57    "\n" ""
  58    (shell-command-to-string "locate '*.ogg' | head -1"))
  59   "The Ogg file to play to anyone who calls to us.
  60 This should go away once we have hooked up everything properly,
  61 with microphone and so on.  (Or maybe not...)")
  62
  63 (define-fsm jingle
  64   :start ((jc sid role jid) "Start a Jingle FSM.
  65 \(Specifically, for Jingle Audio, as that's all we support for now.)
  66 JC is the account we're using.
  67 SID is a string, the session ID.
  68 ROLE is either :initiator or :target.
  69 JID is the full JID of the partner."
  70           (let ((state-data (list :jc jc :jid jid :sid sid :role role)))
  71             (setq state-data (jingle-create-tox-session fsm state-data))
  72             (list
  73              (ecase (plist-get state-data :role)
  74                (:initiator
  75                 :initiate)
  76                (:target
  77                 :wait-for-initiate))
  78              state-data))))
  79
  80 (defun jingle-create-tox-session (fsm state-data)
  81   "Helper function to create a Tox session.
  82 Accepts, modifies, and returns STATE-DATA."
  83   ;; XXX: should this always be bidirectional?
  84   (let* ((tox-session
  85           (dbus-call-method :session tox-name tox-path tox-interface
  86                             "CreateSession"
  87                             :byte 3))   ;3=bidirectional stream
  88          ;; Find the codecs that we support
  89          (our-codecs
  90           (dbus-call-method :session tox-name tox-session tox-session-interface
  91                             "GetLocalCodecs")))
  92     (setq state-data (plist-put state-data :tox-session tox-session))
  93     (setq state-data (plist-put state-data :our-codecs our-codecs))
  94
  95     (fsm-debug-output "tox-session: %S, our-codecs: %S" tox-session our-codecs)
  96     ;; Set up the pipeline, so we can search for transport candidates.
  97     (fsm-debug-output "About to call SetDefaultAudioSink")
  98     (dbus-call-method :session tox-name tox-session tox-session-interface
  99                       "SetDefaultAudioSink")
 100     (fsm-debug-output "About to call SetOggVorbisAudioSource")
 101     (dbus-call-method :session tox-name tox-session tox-session-interface
 102                       "SetOggVorbisAudioSource"
 103                       tox-my-ogg-answering-machine)
 104     ;; There, now we just wait for the NativeCandidatesPrepared signal...
 105     ;; NO!  Don't do like those dead people do!  That signal will never
 106     ;; come.  I don't know why, though...
 107     (fsm-debug-output "About to register signal")
 108     (dbus-register-signal :session tox-name tox-session tox-session-interface
 109                           "NativeCandidatesPrepared"
 110                           (lexical-let ((fsm fsm))
 111                             (lambda (components)
 112                               (fsm-send-sync
 113                                fsm
 114                                (cons :native-candidates-prepared components)))))
 115     ;; This is more like it.  At least it will provide us with some
 116     ;; debugging information.
 117     (dbus-register-signal :session tox-name tox-session tox-session-interface
 118                           "NewNativeCandidate"
 119                           (lexical-let ((fsm fsm))
 120                             (lambda (components)
 121                               (fsm-send-sync
 122                                fsm
 123                                (cons :new-native-candidate components)))))
 124     ;; And we also want to know about state changes.
 125     (dbus-register-signal :session tox-name tox-session tox-session-interface
 126                           "StateChanged"
 127                           (lexical-let ((fsm fsm))
 128                             (lambda (state direction)
 129                               (fsm-send-sync
 130                                fsm
 131                                (list :state-changed state direction)))))
 132     ;; And about active candidate pairs.
 133     (dbus-register-signal :session tox-name tox-session tox-session-interface
 134                           "NewActiveCandidatePair"
 135                           (lexical-let ((fsm fsm))
 136                             (lambda (native-candidate remote-candidate)
 137                               (fsm-send-sync
 138                                fsm
 139                                (list :new-active-candidate-pair
 140                                      native-candidate remote-candidate)))))
 141     (fsm-debug-output "Waiting")
 142     state-data))
 143
 144 (define-enter-state jingle nil
 145   (fsm state-data)
 146   ;; clean up
 147   (let ((tox-session (plist-get state-data :tox-session)))
 148     (when tox-session
 149       (ignore-errors
 150         (dbus-call-method :session tox-name tox-session tox-session-interface
 151                           "Destroy"))))
 152   (remhash (cons (jabber-connection-jid (plist-get state-data :jc))
 153                  (plist-get state-data :sid))
 154            jingle-acct-sid-map)
 155   (list nil nil))
 156
 157 (define-enter-state jingle :initiate
 158   (fsm state-data)
 159   (let ((jc (plist-get state-data :jc))
 160         (jid (plist-get state-data :jid))
 161         (sid (plist-get state-data :sid))
 162         (payload-types (mapcar
 163                         (lambda (codec)
 164                           `(payload-type
 165                             ((id . ,(number-to-string (nth 0 codec)))
 166                              (name . ,(nth 1 codec))
 167                              ;; (nth 2 codec) is media type;
 168                              ;; should we filter out
 169                              ;; non-audio codecs?  then
 170                              ;; again, the value seems to be
 171                              ;; bogus...
 172                              (clockrate . ,(number-to-string (nth 3 codec)))
 173                              ,@(let ((channels (nth 4 codec)))
 174                                  (unless (= channels 0)
 175                                    `((channels . ,(number-to-string channels))))))
 176                             ,@(mapcar
 177                                (lambda (param)
 178                                  `(parameter
 179                                    ((name . ,(nth 0 param))
 180                                     (value . ,(nth 1 param)))))
 181                                (nth 5 codec))))
 182                         (plist-get state-data :our-codecs))))
 183     (jabber-send-iq jc jid "set"
 184                     `(jingle ((xmlns . ,jingle-ns)
 185                               (action . "session-initiate")
 186                               (initiator . ,(jabber-connection-jid jc))
 187                               (sid . ,sid))
 188                              (content
 189                               ((creator . "initiator")
 190                                (name . "foo")
 191                                (senders . "initiator"))
 192                               (description
 193                                ((xmlns . ,jingle-rtp-ns)
 194                                 (media . "audio"))
 195                                ,@payload-types)
 196                               (transport ((xmlns . ,jingle-ice-udp-ns)))))
 197                     (lambda (jc iq fsm)
 198                       (fsm-send-sync fsm (cons :iq-result iq)))
 199                     fsm
 200                     (lambda (jc iq fsm)
 201                       (fsm-send-sync fsm (cons :iq-error iq)))
 202                     fsm)
 203     (list state-data nil)))
 204
 205 (define-state jingle :initiate
 206   (fsm state-data event callback)
 207   (case (car-safe event)
 208     (:iq-result
 209      ;; Receiver provisionally accepted the session request.  Move on
 210      ;; to PENDING.
 211      (list :pending state-data))
 212     (:iq-error
 213      (message "Couldn't initiate Jingle audio session: %s"
 214               (jabber-parse-error (jabber-iq-error (cdr event))))
 215      (list nil state-data))
 216     (:new-native-candidate
 217      (let ((components (cdr event)))
 218        ;; XXX: keep them all
 219        (setq state-data (plist-put state-data :native-candidates (list (cdr event))))
 220        (jingle-send-native-candidate state-data components)
 221        (list :initiate state-data)))))
 222
 223 (define-state jingle :wait-for-initiate
 224   (fsm state-data event callback)
 225   (case (car-safe event)
 226     (:iq-set
 227      (let* ((jc (plist-get state-data :jc))
 228             (iq (cdr event))
 229             (from (jabber-xml-get-attribute iq 'from))
 230             (id (jabber-xml-get-attribute iq 'id))
 231             (jingle (jabber-iq-query iq))
 232             ;; XXX: could be more than one...
 233             (content (car (jabber-xml-get-children jingle 'content)))
 234             ;; XXX: is it really audio?
 235             (audio-content (find jingle-rtp-ns (jabber-xml-node-children content)
 236                                  :test 'string=
 237                                  :key 'jabber-xml-get-xmlns))
 238             (payload-types (jabber-xml-get-children audio-content 'payload-type)))
 239        ;; There are very few reasons for which we should not send an
 240        ;; acknowledgement here; see section 6.3.2 of XEP-0166.
 241        ;; Notably, we might want to check that there is a presence
 242        ;; subscription.
 243        (jabber-send-iq jc from "result" ()
 244                        nil nil nil nil id)
 245
 246        (cond
 247         ;; Make sure audio is in the list of contents.  We can
 248         ;; negotiate away other content types later.
 249         ((null audio-content)
 250          (jingle-send-iq state-data "session-terminate"
 251                          '((reason () (unsupported-applications))))
 252          (list nil state-data))
 253
 254         ;; Make sure ICE is in the list of transports.
 255         ((not (member* jingle-ice-udp-ns
 256                        (jabber-xml-get-children content 'transport)
 257                        :test 'string=
 258                        :key 'jabber-xml-get-xmlns))
 259          (jingle-send-iq state-data "session-terminate"
 260                          '((reason () (unsupported-transports))))
 261          (list nil state-data))
 262
 263         (t
 264          (let ((tox-session (plist-get state-data :tox-session))
 265                (their-codecs (mapcar
 266                               (lambda (pt)
 267                                 (jabber-xml-let-attributes
 268                                     (id name clockrate channels) pt
 269                                   (list :struct
 270                                         :int32 (string-to-number id)
 271                                         :string name
 272                                         :byte 0
 273                                         :uint32 (string-to-number clockrate)
 274                                         :uint32 (if channels
 275                                                     (string-to-number channels)
 276                                                   1)
 277                                         (cons
 278                                          :array
 279                                          (or
 280                                           (mapcar
 281                                            (lambda (param)
 282                                              (jabber-xml-let-attributes
 283                                                  (name value) param
 284                                                (list :dict-entry :string name :string value)))
 285                                            (jabber-xml-get-children pt 'parameter))
 286                                           (list :signature "{ss}"))))))
 287                               payload-types)))
 288            (fsm-debug-output "Their codecs are %S" their-codecs)
 289            ;; Tell tox what codecs the remote side supports
 290            (dbus-call-method
 291             :session tox-name tox-session tox-session-interface
 292             "SetRemoteCodecs"
 293             ;;'((array (struct int32 string byte uint32 uint32 (array (dict-entry string string)))))
 294             their-codecs)
 295
 296            ;; Check if we have any codecs in common
 297            (let ((codec-intersection
 298                   (dbus-call-method
 299                    :session tox-name tox-session tox-session-interface
 300                    "GetCodecIntersection")))
 301              (fsm-debug-output "The codec intersection is %S" codec-intersection)
 302              (setq state-data
 303                    (plist-put
 304                     state-data
 305                     :codec-intersection codec-intersection))
 306
 307              (if codec-intersection
 308                  ;; So, now we know that we stand a basic chance of fulfilling
 309                  ;; the request.  Let's move on to PENDING.
 310                  (list :pending state-data)
 311
 312                ;; Or, it might turn out that we don't have any codecs
 313                ;; in common with our partner.
 314                (jingle-send-iq state-data "session-terminate"
 315                                '((reason () (media-error))))
 316                (list nil state-data))))))))))
 317
 318 (define-state jingle :pending
 319   (fsm state-data event callback)
 320
 321   (case (car-safe event)
 322     (:state-changed
 323      (let ((state (car (assq (second event)
 324                              '((0 . :disconnected)
 325                                (1 . :connecting)
 326                                (2 . :connected)))))
 327            (direction (car (assq (third event)
 328                                  '((1 . :send-only)
 329                                    (2 . :receive-only)
 330                                    (3 . :send-and-receive))))))
 331        (fsm-debug-output "Got :state-changed; new state %s, new direction %s"
 332                          state direction)
 333        ;; Still, not sure what we should do here...
 334        ))))
 335
 336 (defun jingle-send-iq (state-data action payload)
 337   "Send a Jingle IQ stanza from within a Jingle FSM.
 338 STATE-DATA is the state data plist of the FSM.
 339 ACTION is the value of the action attribute of the <jingle/>
 340 element.
 341 PAYLOAD is a list of XML elements to include as children
 342 of the <jingle/> element.
 343 The recipient and the SID are determined from STATE-DATA."
 344   (let ((jc (plist-get state-data :jc))
 345         (jid (plist-get state-data :jid))
 346         (role (plist-get state-data :role))
 347         (sid (plist-get state-data :sid)))
 348     (jabber-send-iq
 349      jc jid "set"
 350      `(jingle ((xmlns . ,jingle-ns)
 351                (action . ,action)
 352                (initiator
 353                 . ,(ecase role
 354                      (:initiator
 355                       (jabber-connection-jid jc))
 356                      (:target
 357                       jid)))
 358                (sid . ,sid))
 359               ,@payload)
 360      ;; XXX: we probably want error checking, to see if our partner
 361      ;; went offline.
 362      nil nil nil nil)))
 363
 364 (defun jingle-send-native-candidate (state-data candidate)
 365   "Send a native candidate for ICE-UDP.
 366 The CANDIDATE is a list of components, as provided by the
 367 NewNativeCandidate signal of Tox."
 368   (jingle-send-iq state-data "transport-info"
 369                   `((content
 370                      ((creator . "initiator")
 371                       (name . "foo"))
 372                      (transport
 373                       ((xmlns . ,jingle-ice-udp-ns))
 374                       ,@(mapcar
 375                          (lambda (c)
 376                            `(candidate
 377                              ((component . ,(number-to-string (nth 1 c)))
 378                               ;; foundation?
 379                               ;; generation?
 380                               (ip . ,(nth 2 c))
 381                               ;; network?
 382                               (port . ,(number-to-string (nth 3 c)))
 383                               (protocol . ,(nth 4 c))
 384                               (priority . ,(nth 7 c))
 385                               ;; how to translate type?
 386                               )))
 387                          candidate))))))
 388
 389 (add-to-list 'jabber-iq-set-xmlns-alist
 390              (cons jingle-ns 'jabber-jingle-incoming-iq))
 391 (defun jabber-jingle-incoming-iq (jc iq)
 392   (jabber-xml-let-attributes
 393    (sid action) (jabber-iq-query iq)
 394    (unless (and sid action)
 395      (jabber-signal-error "modify" 'bad-request))
 396    (let ((fsm (gethash (cons (jabber-connection-jid jc) sid) jingle-acct-sid-map)))
 397      (cond
 398       (fsm
 399        (fsm-send-sync fsm (cons :iq-set iq)))
 400       ((string= action "session-initiate")
 401        (condition-case e
 402            (setq fsm (start-jingle jc sid :target (jabber-xml-get-attribute iq 'from)))
 403          (error
 404           (jabber-signal-error "wait" 'internal-server-error
 405                                (concat "Couldn't accept Jingle session: "
 406                                        (error-message-string e)))))
 407        (puthash (cons (jabber-connection-jid jc) sid) fsm jingle-acct-sid-map)
 408        (fsm-send-sync fsm (cons :iq-set iq)))
 409       (t
 410        (jabber-signal-error "modify" 'bad-request
 411                             (format "Session \"%s\" unknown" sid)
 412                             `((unknown-session ((xmlns . ,jingle-error-ns))))))))))
 413
 414 (defun jabber-jingle-start-audio-session (jc jid)
 415   (interactive
 416    (list (jabber-read-account)
 417          (jabber-read-jid-completing "Voice call to: " nil nil nil 'full)))
 418   (let* ((sid (apply 'format "emacs-sid-%d.%d.%d" (current-time)))
 419          (fsm (start-jingle jc sid :initiator jid)))
 420     (puthash (cons (jabber-connection-jid jc) sid) fsm jingle-acct-sid-map)))
 421
 422
 423 (provide 'jabber-tox)