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   ;; XXX: send termination stanza, if appropriate
 147   ;; clean up
 148   (let ((tox-session (plist-get state-data :tox-session)))
 149     (when tox-session
 150       (ignore-errors
 151         (dbus-call-method :session tox-name tox-session tox-session-interface
 152                           "Destroy"))))
 153   (remhash (cons (jabber-connection-jid (plist-get state-data :jc))
 154                  (plist-get state-data :sid))
 155            jingle-acct-sid-map)
 156   (list nil nil))
 157
 158 (define-enter-state jingle :initiate
 159   (fsm state-data)
 160   (let ((jc (plist-get state-data :jc))
 161         (jid (plist-get state-data :jid))
 162         (sid (plist-get state-data :sid))
 163         (payload-types (mapcar
 164                         (lambda (codec)
 165                           `(payload-type
 166                             ((id . ,(number-to-string (nth 0 codec)))
 167                              (name . ,(nth 1 codec))
 168                              ;; (nth 2 codec) is media type;
 169                              ;; should we filter out
 170                              ;; non-audio codecs?  then
 171                              ;; again, the value seems to be
 172                              ;; bogus...
 173                              (clockrate . ,(number-to-string (nth 3 codec)))
 174                              ,@(let ((channels (nth 4 codec)))
 175                                  (unless (= channels 0)
 176                                    `((channels . ,(number-to-string channels))))))
 177                             ,@(mapcar
 178                                (lambda (param)
 179                                  `(parameter
 180                                    ((name . ,(nth 0 param))
 181                                     (value . ,(nth 1 param)))))
 182                                (nth 5 codec))))
 183                         (plist-get state-data :our-codecs))))
 184     (jabber-send-iq jc jid "set"
 185                     `(jingle ((xmlns . ,jingle-ns)
 186                               (action . "session-initiate")
 187                               (initiator . ,(jabber-connection-jid jc))
 188                               (sid . ,sid))
 189                              (content
 190                               ((creator . "initiator")
 191                                (name . "foo")
 192                                (senders . "initiator"))
 193                               (description
 194                                ((xmlns . ,jingle-rtp-ns)
 195                                 (media . "audio"))
 196                                ,@payload-types)
 197                               (transport ((xmlns . ,jingle-ice-udp-ns)))))
 198                     (lambda (jc iq fsm)
 199                       (fsm-send-sync fsm (cons :iq-result iq)))
 200                     fsm
 201                     (lambda (jc iq fsm)
 202                       (fsm-send-sync fsm (cons :iq-error iq)))
 203                     fsm)
 204     (list state-data nil)))
 205
 206 (define-state jingle :initiate
 207   (fsm state-data event callback)
 208   (case (car-safe event)
 209     (:iq-result
 210      ;; Receiver provisionally accepted the session request.  Move on
 211      ;; to PENDING.
 212      (list :pending state-data))
 213     (:iq-error
 214      (message "Couldn't initiate Jingle audio session: %s"
 215               (jabber-parse-error (jabber-iq-error (cdr event))))
 216      (list nil state-data))
 217     (:new-native-candidate
 218      (let ((components (cdr event)))
 219        (jingle-send-native-candidate state-data components)
 220        (list :initiate state-data)))))
 221
 222 (define-state jingle :wait-for-initiate
 223   (fsm state-data event callback)
 224   (case (car-safe event)
 225     (:iq-set
 226      (let* ((jc (plist-get state-data :jc))
 227             (iq (cdr event))
 228             (from (jabber-xml-get-attribute iq 'from))
 229             (id (jabber-xml-get-attribute iq 'id))
 230             (jingle (jabber-iq-query iq))
 231             (action (jabber-xml-get-attribute jingle 'action))
 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        (unless (string= action "session-initiate")
 247          (fsm-debug-output "Action is %S.  Why is it not \"session-initiate\"?" action))
 248
 249        (cond
 250         ;; Make sure audio is in the list of contents.  We can
 251         ;; negotiate away other content types later.
 252         ((null audio-content)
 253          (jingle-send-iq state-data "session-terminate"
 254                          '((reason () (unsupported-applications))))
 255          (list nil state-data))
 256
 257         ;; Make sure ICE is in the list of transports.
 258         ((not (member* jingle-ice-udp-ns
 259                        (jabber-xml-get-children content 'transport)
 260                        :test 'string=
 261                        :key 'jabber-xml-get-xmlns))
 262          (jingle-send-iq state-data "session-terminate"
 263                          '((reason () (unsupported-transports))))
 264          (list nil state-data))
 265
 266         (t
 267          (let ((tox-session (plist-get state-data :tox-session))
 268                (their-codecs (mapcar
 269                               (lambda (pt)
 270                                 (jabber-xml-let-attributes
 271                                     (id name clockrate channels) pt
 272                                   (list :struct
 273                                         :int32 (string-to-number id)
 274                                         :string name
 275                                         :byte 0
 276                                         :uint32 (string-to-number clockrate)
 277                                         :uint32 (if channels
 278                                                     (string-to-number channels)
 279                                                   1)
 280                                         (cons
 281                                          :array
 282                                          (or
 283                                           (mapcar
 284                                            (lambda (param)
 285                                              (jabber-xml-let-attributes
 286                                                  (name value) param
 287                                                (list :dict-entry :string name :string value)))
 288                                            (jabber-xml-get-children pt 'parameter))
 289                                           (list :signature "{ss}"))))))
 290                               payload-types)))
 291            (fsm-debug-output "Their codecs are %S" their-codecs)
 292            ;; Tell tox what codecs the remote side supports
 293            (dbus-call-method
 294             :session tox-name tox-session tox-session-interface
 295             "SetRemoteCodecs"
 296             ;;'((array (struct int32 string byte uint32 uint32 (array (dict-entry string string)))))
 297             their-codecs)
 298
 299            ;; Check if we have any codecs in common
 300            (let ((codec-intersection
 301                   (dbus-call-method
 302                    :session tox-name tox-session tox-session-interface
 303                    "GetCodecIntersection")))
 304              (fsm-debug-output "The codec intersection is %S" codec-intersection)
 305              (setq state-data
 306                    (plist-put
 307                     state-data
 308                     :codec-intersection codec-intersection))
 309
 310              (if codec-intersection
 311                  ;; So, now we know that we stand a basic chance of fulfilling
 312                  ;; the request.  Let's move on to PENDING.
 313                  (list :pending state-data)
 314
 315                ;; Or, it might turn out that we don't have any codecs
 316                ;; in common with our partner.
 317                (jingle-send-iq state-data "session-terminate"
 318                                '((reason () (media-error))))
 319                (list nil state-data))))))))))
 320
 321 ;; Thu Jan  1 16:49:23 2009: Warning: event (:new-native-candidate ("L1" 1 "127.0.0.1" 33582 "udp" "RTP" "AVP" 100 0 "Pmc4YPYhJyGPWKIv" "GKQ5/XFIE0pp8+6y")) ignored in state jingle/:pending
 322 ;; Thu Jan  1 16:49:23 2009: Warning: event (:iq-set iq ((from . "legoscia@jabber.cd.chalmers.se/2868723341230824321901526") (to . "magnus.henoch@jabber.se/2635526438123082419775630") (type . "set") (id . "emacs-iq-18780.58883.21969")) (jingle ((xmlns . "urn:xmpp:jingle:0") (action . "transport-info") (initiator . "legoscia@jabber.cd.chalmers.se/2868723341230824321901526") (sid . "emacs-sid-18780.58881.712027")) (content ((creator . "initiator") (name . "foo")) (transport ((xmlns . "urn:xmpp:jingle:transports:ice-udp:0")) (candidate ((component . "1") (ip . "127.0.0.1") (port . "44319") (protocol . "udp") (priority . "100"))))))) ignored in state jingle/:pending
 323 ;; Thu Jan  1 16:50:07 2009: Warning: event (:state-changed 0 0) ignored in state jingle/:pending
 324
 325 (define-state jingle :pending
 326   (fsm state-data event callback)
 327
 328   (case (car-safe event)
 329     (:state-changed
 330      (let ((state (car (assq (second event)
 331                              '((0 . :disconnected)
 332                                (1 . :connecting)
 333                                (2 . :connected)))))
 334            (direction (car (assq (third event)
 335                                  '((0 . nil)
 336                                    (1 . :send-only)
 337                                    (2 . :receive-only)
 338                                    (3 . :send-and-receive))))))
 339        (fsm-debug-output "Got :state-changed; new state %s, new direction %s"
 340                          state direction)
 341
 342        (case state
 343          (0
 344           ;; Do we have enough information to send the termination stanza?
 345           (list nil state-data)))
 346        ;; Still, not sure what we should do here...
 347        ))
 348
 349     (:new-native-candidate
 350      (let ((components (cdr event)))
 351        (jingle-send-native-candidate state-data components)
 352        (list :pending state-data)))
 353
 354     (:iq-set
 355      (fsm-debug-output "iq-set event is %S" event)
 356      (let* ((jc (plist-get state-data :jc))
 357             (iq (cdr event)))
 358        (jabber-xml-let-attributes (action) (jabber-iq-query iq)
 359          (fsm-debug-output "action is %S" action)
 360          (cond
 361           ((string= action "transport-info")
 362            (fsm-debug-output "transport-info is %S" iq)
 363            (let ((tox-session (plist-get state-data :tox-session))
 364                  (candidates
 365                   (jabber-xml-get-children
 366                    (jabber-xml-path
 367                     iq
 368                     `(jingle content (,jingle-ice-udp-ns . "transport")))
 369                    'candidate)))
 370              ;; XXX: send iq error for no candidates
 371              (when candidates
 372                (fsm-debug-output "Adding remote candidate...")
 373                (dbus-call-method :session tox-name tox-session tox-session-interface
 374                                  "AddRemoteCandidate"
 375                                  (mapcar
 376                                   'jingle-parse-candidate
 377                                   candidates))
 378                ;; XXX: iq result
 379                (list :pending state-data)
 380                )))
 381           (t
 382            ;; XXX: send "bad-request" or something
 383             )))))))
 384
 385 (defun jingle-send-iq (state-data action payload)
 386   "Send a Jingle IQ stanza from within a Jingle FSM.
 387 STATE-DATA is the state data plist of the FSM.
 388 ACTION is the value of the action attribute of the <jingle/>
 389 element.
 390 PAYLOAD is a list of XML elements to include as children
 391 of the <jingle/> element.
 392 The recipient and the SID are determined from STATE-DATA."
 393   (let ((jc (plist-get state-data :jc))
 394         (jid (plist-get state-data :jid))
 395         (role (plist-get state-data :role))
 396         (sid (plist-get state-data :sid)))
 397     (jabber-send-iq
 398      jc jid "set"
 399      `(jingle ((xmlns . ,jingle-ns)
 400                (action . ,action)
 401                (initiator
 402                 . ,(ecase role
 403                      (:initiator
 404                       (jabber-connection-jid jc))
 405                      (:target
 406                       jid)))
 407                (sid . ,sid))
 408               ,@payload)
 409      ;; XXX: we probably want error checking, to see if our partner
 410      ;; went offline.
 411      nil nil nil nil)))
 412
 413 (defun jingle-send-native-candidate (state-data candidate)
 414   "Send a native candidate for ICE-UDP.
 415 The CANDIDATE is a list of components, as provided by the
 416 NewNativeCandidate signal of Tox."
 417   ;; XXX: check against XEP-0176
 418   (jingle-send-iq state-data "transport-info"
 419                   `((content
 420                      ((creator . "initiator")
 421                       (name . "foo"))
 422                      (transport
 423                       ((xmlns . ,jingle-ice-udp-ns))
 424                       ,@(mapcar
 425                          (lambda (c)
 426                            `(candidate
 427                              ((id . ,(nth 0 c))
 428                               (component . ,(number-to-string (nth 1 c)))
 429                               ;; foundation?
 430                               ;; generation?
 431                               (ip . ,(nth 2 c))
 432                               ;; network?
 433                               (port . ,(number-to-string (nth 3 c)))
 434                               (protocol . ,(nth 4 c))
 435                               ;; (nth 5 c) is always "RTP"
 436                               ;; (nth 6 c) is always "AVP"
 437                               (priority . ,(nth 7 c))
 438                               ;; (nth 8 c) is type.  how to translate it?
 439                               (username . ,(nth 9 c))
 440                               (password . ,(nth 10 c))
 441                               )))
 442                          candidate))))))
 443
 444 (defun jingle-parse-candidate (candidate)
 445   "Parse an XEP-0176 <candidate/> element into DBus format.
 446 Specifically, the signature is \"(susqsssyyss)\"."
 447   ;; XXX: check against XEP-0176 again
 448   (jabber-xml-let-attributes
 449       (id component foundation generation
 450           ip port protocol priority type
 451           username password)
 452       candidate
 453       (list :string id
 454             :uint32 (string-to-number component)
 455             :string ip
 456             :uint16 (string-to-number port)
 457             "udp" "RTP" "AVP"
 458             :byte (string-to-number priority) ;XXX: priority is preference?
 459             :byte 0                           ;XXX: fix type
 460             :string (or username "")
 461             :string (or password ""))))
 462
 463 (add-to-list 'jabber-iq-set-xmlns-alist
 464              (cons jingle-ns 'jabber-jingle-incoming-iq))
 465 (defun jabber-jingle-incoming-iq (jc iq)
 466   (jabber-xml-let-attributes
 467    (sid action) (jabber-iq-query iq)
 468    (unless (and sid action)
 469      (jabber-signal-error "modify" 'bad-request))
 470    (let ((fsm (gethash (cons (jabber-connection-jid jc) sid) jingle-acct-sid-map)))
 471      (cond
 472       (fsm
 473        (fsm-send-sync fsm (cons :iq-set iq)))
 474       ((string= action "session-initiate")
 475        (condition-case e
 476            (setq fsm (start-jingle jc sid :target (jabber-xml-get-attribute iq 'from)))
 477          (error
 478           (jabber-signal-error "wait" 'internal-server-error
 479                                (concat "Couldn't accept Jingle session: "
 480                                        (error-message-string e)))))
 481        (puthash (cons (jabber-connection-jid jc) sid) fsm jingle-acct-sid-map)
 482        (fsm-send-sync fsm (cons :iq-set iq)))
 483       (t
 484        (jabber-signal-error "modify" 'bad-request
 485                             (format "Session \"%s\" unknown" sid)
 486                             `((unknown-session ((xmlns . ,jingle-error-ns))))))))))
 487
 488 (defun jabber-jingle-start-audio-session (jc jid)
 489   (interactive
 490    (list (jabber-read-account)
 491          (jabber-read-jid-completing "Voice call to: " nil nil nil 'full)))
 492   (let* ((sid (apply 'format "emacs-sid-%d.%d.%d" (current-time)))
 493          (fsm (start-jingle jc sid :initiator jid)))
 494     (puthash (cons (jabber-connection-jid jc) sid) fsm jingle-acct-sid-map)))
 495
 496
 497 (provide 'jabber-tox)