498 lines
18 KiB
EmacsLisp
498 lines
18 KiB
EmacsLisp
;; jabber-tox.el - Jingle support using TOX
|
|
|
|
;; Copyright (C) 2008 - Magnus Henoch - mange@freemail.hu
|
|
|
|
;; This file is (soon) a part of jabber.el.
|
|
|
|
;; This program is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation; either version 2 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program; if not, write to the Free Software
|
|
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
|
|
|
(require 'dbus)
|
|
(require 'fsm)
|
|
(require 'cl)
|
|
|
|
(require 'jabber-xml)
|
|
|
|
(defconst jingle-ns "urn:xmpp:jingle:0"
|
|
"Jingle namespace (XEP-0166)")
|
|
|
|
(defconst jingle-error-ns "urn:xmpp:jingle:errors:0"
|
|
"Jingle error namespace (XEP-0166)")
|
|
|
|
(defconst jingle-rtp-ns "urn:xmpp:jingle:apps:rtp:0"
|
|
"Jingle RTP Sessions namespace (XEP-0167)")
|
|
|
|
(defconst jingle-ice-udp-ns "urn:xmpp:jingle:transports:ice-udp:0"
|
|
"Jingle ICE namespace (XEP-0176)")
|
|
|
|
(defvar jingle-acct-sid-map (make-hash-table :test 'equal)
|
|
"Mapping from pairs of JIDs and Jingle SIDs to FSMs.
|
|
The JID is the full JID of the account using the session.")
|
|
|
|
(defconst tox-name "net.sourceforge.emacs-jabber.Tox"
|
|
"Well-known D-BUS name of the tox service.")
|
|
|
|
(defconst tox-path "/net/sourceforge/emacs_jabber/Tox"
|
|
"Well-known path of the main Tox object.")
|
|
|
|
(defconst tox-interface "net.sourceforge.emacs_jabber.Tox"
|
|
"Interface of main Tox object.")
|
|
|
|
(defconst tox-session-interface "net.sourceforge.emacs_jabber.ToxSession"
|
|
"Interface of ToxSession object.")
|
|
|
|
(defvar tox-my-ogg-answering-machine
|
|
(replace-regexp-in-string
|
|
"\n" ""
|
|
(shell-command-to-string "locate '*.ogg' | head -1"))
|
|
"The Ogg file to play to anyone who calls to us.
|
|
This should go away once we have hooked up everything properly,
|
|
with microphone and so on. (Or maybe not...)")
|
|
|
|
(define-fsm jingle
|
|
:start ((jc sid role jid) "Start a Jingle FSM.
|
|
\(Specifically, for Jingle Audio, as that's all we support for now.)
|
|
JC is the account we're using.
|
|
SID is a string, the session ID.
|
|
ROLE is either :initiator or :target.
|
|
JID is the full JID of the partner."
|
|
(let ((state-data (list :jc jc :jid jid :sid sid :role role)))
|
|
(setq state-data (jingle-create-tox-session fsm state-data))
|
|
(list
|
|
(ecase (plist-get state-data :role)
|
|
(:initiator
|
|
:initiate)
|
|
(:target
|
|
:wait-for-initiate))
|
|
state-data))))
|
|
|
|
(defun jingle-create-tox-session (fsm state-data)
|
|
"Helper function to create a Tox session.
|
|
Accepts, modifies, and returns STATE-DATA."
|
|
;; XXX: should this always be bidirectional?
|
|
(let* ((tox-session
|
|
(dbus-call-method :session tox-name tox-path tox-interface
|
|
"CreateSession"
|
|
:byte 3)) ;3=bidirectional stream
|
|
;; Find the codecs that we support
|
|
(our-codecs
|
|
(dbus-call-method :session tox-name tox-session tox-session-interface
|
|
"GetLocalCodecs")))
|
|
(setq state-data (plist-put state-data :tox-session tox-session))
|
|
(setq state-data (plist-put state-data :our-codecs our-codecs))
|
|
|
|
(fsm-debug-output "tox-session: %S, our-codecs: %S" tox-session our-codecs)
|
|
;; Set up the pipeline, so we can search for transport candidates.
|
|
(fsm-debug-output "About to call SetDefaultAudioSink")
|
|
(dbus-call-method :session tox-name tox-session tox-session-interface
|
|
"SetDefaultAudioSink")
|
|
(fsm-debug-output "About to call SetOggVorbisAudioSource")
|
|
(dbus-call-method :session tox-name tox-session tox-session-interface
|
|
"SetOggVorbisAudioSource"
|
|
tox-my-ogg-answering-machine)
|
|
;; There, now we just wait for the NativeCandidatesPrepared signal...
|
|
;; NO! Don't do like those dead people do! That signal will never
|
|
;; come. I don't know why, though...
|
|
(fsm-debug-output "About to register signal")
|
|
(dbus-register-signal :session tox-name tox-session tox-session-interface
|
|
"NativeCandidatesPrepared"
|
|
(lexical-let ((fsm fsm))
|
|
(lambda (components)
|
|
(fsm-send-sync
|
|
fsm
|
|
(cons :native-candidates-prepared components)))))
|
|
;; This is more like it. At least it will provide us with some
|
|
;; debugging information.
|
|
(dbus-register-signal :session tox-name tox-session tox-session-interface
|
|
"NewNativeCandidate"
|
|
(lexical-let ((fsm fsm))
|
|
(lambda (components)
|
|
(fsm-send-sync
|
|
fsm
|
|
(cons :new-native-candidate components)))))
|
|
;; And we also want to know about state changes.
|
|
(dbus-register-signal :session tox-name tox-session tox-session-interface
|
|
"StateChanged"
|
|
(lexical-let ((fsm fsm))
|
|
(lambda (state direction)
|
|
(fsm-send-sync
|
|
fsm
|
|
(list :state-changed state direction)))))
|
|
;; And about active candidate pairs.
|
|
(dbus-register-signal :session tox-name tox-session tox-session-interface
|
|
"NewActiveCandidatePair"
|
|
(lexical-let ((fsm fsm))
|
|
(lambda (native-candidate remote-candidate)
|
|
(fsm-send-sync
|
|
fsm
|
|
(list :new-active-candidate-pair
|
|
native-candidate remote-candidate)))))
|
|
(fsm-debug-output "Waiting")
|
|
state-data))
|
|
|
|
(define-enter-state jingle nil
|
|
(fsm state-data)
|
|
;; XXX: send termination stanza, if appropriate
|
|
;; clean up
|
|
(let ((tox-session (plist-get state-data :tox-session)))
|
|
(when tox-session
|
|
(ignore-errors
|
|
(dbus-call-method :session tox-name tox-session tox-session-interface
|
|
"Destroy"))))
|
|
(remhash (cons (jabber-connection-jid (plist-get state-data :jc))
|
|
(plist-get state-data :sid))
|
|
jingle-acct-sid-map)
|
|
(list nil nil))
|
|
|
|
(define-enter-state jingle :initiate
|
|
(fsm state-data)
|
|
(let ((jc (plist-get state-data :jc))
|
|
(jid (plist-get state-data :jid))
|
|
(sid (plist-get state-data :sid))
|
|
(payload-types (mapcar
|
|
(lambda (codec)
|
|
`(payload-type
|
|
((id . ,(number-to-string (nth 0 codec)))
|
|
(name . ,(nth 1 codec))
|
|
;; (nth 2 codec) is media type;
|
|
;; should we filter out
|
|
;; non-audio codecs? then
|
|
;; again, the value seems to be
|
|
;; bogus...
|
|
(clockrate . ,(number-to-string (nth 3 codec)))
|
|
,@(let ((channels (nth 4 codec)))
|
|
(unless (= channels 0)
|
|
`((channels . ,(number-to-string channels))))))
|
|
,@(mapcar
|
|
(lambda (param)
|
|
`(parameter
|
|
((name . ,(nth 0 param))
|
|
(value . ,(nth 1 param)))))
|
|
(nth 5 codec))))
|
|
(plist-get state-data :our-codecs))))
|
|
(jabber-send-iq jc jid "set"
|
|
`(jingle ((xmlns . ,jingle-ns)
|
|
(action . "session-initiate")
|
|
(initiator . ,(jabber-connection-jid jc))
|
|
(sid . ,sid))
|
|
(content
|
|
((creator . "initiator")
|
|
(name . "foo")
|
|
(senders . "initiator"))
|
|
(description
|
|
((xmlns . ,jingle-rtp-ns)
|
|
(media . "audio"))
|
|
,@payload-types)
|
|
(transport ((xmlns . ,jingle-ice-udp-ns)))))
|
|
(lambda (jc iq fsm)
|
|
(fsm-send-sync fsm (cons :iq-result iq)))
|
|
fsm
|
|
(lambda (jc iq fsm)
|
|
(fsm-send-sync fsm (cons :iq-error iq)))
|
|
fsm)
|
|
(list state-data nil)))
|
|
|
|
(define-state jingle :initiate
|
|
(fsm state-data event callback)
|
|
(case (car-safe event)
|
|
(:iq-result
|
|
;; Receiver provisionally accepted the session request. Move on
|
|
;; to PENDING.
|
|
(list :pending state-data))
|
|
(:iq-error
|
|
(message "Couldn't initiate Jingle audio session: %s"
|
|
(jabber-parse-error (jabber-iq-error (cdr event))))
|
|
(list nil state-data))
|
|
(:new-native-candidate
|
|
(let ((components (cdr event)))
|
|
(jingle-send-native-candidate state-data components)
|
|
(list :initiate state-data)))))
|
|
|
|
(define-state jingle :wait-for-initiate
|
|
(fsm state-data event callback)
|
|
(case (car-safe event)
|
|
(:iq-set
|
|
(let* ((jc (plist-get state-data :jc))
|
|
(iq (cdr event))
|
|
(from (jabber-xml-get-attribute iq 'from))
|
|
(id (jabber-xml-get-attribute iq 'id))
|
|
(jingle (jabber-iq-query iq))
|
|
(action (jabber-xml-get-attribute jingle 'action))
|
|
;; XXX: could be more than one...
|
|
(content (car (jabber-xml-get-children jingle 'content)))
|
|
;; XXX: is it really audio?
|
|
(audio-content (find jingle-rtp-ns (jabber-xml-node-children content)
|
|
:test 'string=
|
|
:key 'jabber-xml-get-xmlns))
|
|
(payload-types (jabber-xml-get-children audio-content 'payload-type)))
|
|
;; There are very few reasons for which we should not send an
|
|
;; acknowledgement here; see section 6.3.2 of XEP-0166.
|
|
;; Notably, we might want to check that there is a presence
|
|
;; subscription.
|
|
(jabber-send-iq jc from "result" ()
|
|
nil nil nil nil id)
|
|
|
|
(unless (string= action "session-initiate")
|
|
(fsm-debug-output "Action is %S. Why is it not \"session-initiate\"?" action))
|
|
|
|
(cond
|
|
;; Make sure audio is in the list of contents. We can
|
|
;; negotiate away other content types later.
|
|
((null audio-content)
|
|
(jingle-send-iq state-data "session-terminate"
|
|
'((reason () (unsupported-applications))))
|
|
(list nil state-data))
|
|
|
|
;; Make sure ICE is in the list of transports.
|
|
((not (member* jingle-ice-udp-ns
|
|
(jabber-xml-get-children content 'transport)
|
|
:test 'string=
|
|
:key 'jabber-xml-get-xmlns))
|
|
(jingle-send-iq state-data "session-terminate"
|
|
'((reason () (unsupported-transports))))
|
|
(list nil state-data))
|
|
|
|
(t
|
|
(let ((tox-session (plist-get state-data :tox-session))
|
|
(their-codecs (mapcar
|
|
(lambda (pt)
|
|
(jabber-xml-let-attributes
|
|
(id name clockrate channels) pt
|
|
(list :struct
|
|
:int32 (string-to-number id)
|
|
:string name
|
|
:byte 0
|
|
:uint32 (string-to-number clockrate)
|
|
:uint32 (if channels
|
|
(string-to-number channels)
|
|
1)
|
|
(cons
|
|
:array
|
|
(or
|
|
(mapcar
|
|
(lambda (param)
|
|
(jabber-xml-let-attributes
|
|
(name value) param
|
|
(list :dict-entry :string name :string value)))
|
|
(jabber-xml-get-children pt 'parameter))
|
|
(list :signature "{ss}"))))))
|
|
payload-types)))
|
|
(fsm-debug-output "Their codecs are %S" their-codecs)
|
|
;; Tell tox what codecs the remote side supports
|
|
(dbus-call-method
|
|
:session tox-name tox-session tox-session-interface
|
|
"SetRemoteCodecs"
|
|
;;'((array (struct int32 string byte uint32 uint32 (array (dict-entry string string)))))
|
|
their-codecs)
|
|
|
|
;; Check if we have any codecs in common
|
|
(let ((codec-intersection
|
|
(dbus-call-method
|
|
:session tox-name tox-session tox-session-interface
|
|
"GetCodecIntersection")))
|
|
(fsm-debug-output "The codec intersection is %S" codec-intersection)
|
|
(setq state-data
|
|
(plist-put
|
|
state-data
|
|
:codec-intersection codec-intersection))
|
|
|
|
(if codec-intersection
|
|
;; So, now we know that we stand a basic chance of fulfilling
|
|
;; the request. Let's move on to PENDING.
|
|
(list :pending state-data)
|
|
|
|
;; Or, it might turn out that we don't have any codecs
|
|
;; in common with our partner.
|
|
(jingle-send-iq state-data "session-terminate"
|
|
'((reason () (media-error))))
|
|
(list nil state-data))))))))))
|
|
|
|
;; 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
|
|
;; 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
|
|
;; Thu Jan 1 16:50:07 2009: Warning: event (:state-changed 0 0) ignored in state jingle/:pending
|
|
|
|
(define-state jingle :pending
|
|
(fsm state-data event callback)
|
|
|
|
(case (car-safe event)
|
|
(:state-changed
|
|
(let ((state (car (assq (second event)
|
|
'((0 . :disconnected)
|
|
(1 . :connecting)
|
|
(2 . :connected)))))
|
|
(direction (car (assq (third event)
|
|
'((0 . nil)
|
|
(1 . :send-only)
|
|
(2 . :receive-only)
|
|
(3 . :send-and-receive))))))
|
|
(fsm-debug-output "Got :state-changed; new state %s, new direction %s"
|
|
state direction)
|
|
|
|
(case state
|
|
(0
|
|
;; Do we have enough information to send the termination stanza?
|
|
(list nil state-data)))
|
|
;; Still, not sure what we should do here...
|
|
))
|
|
|
|
(:new-native-candidate
|
|
(let ((components (cdr event)))
|
|
(jingle-send-native-candidate state-data components)
|
|
(list :pending state-data)))
|
|
|
|
(:iq-set
|
|
(fsm-debug-output "iq-set event is %S" event)
|
|
(let* ((jc (plist-get state-data :jc))
|
|
(iq (cdr event)))
|
|
(jabber-xml-let-attributes (action) (jabber-iq-query iq)
|
|
(fsm-debug-output "action is %S" action)
|
|
(cond
|
|
((string= action "transport-info")
|
|
(fsm-debug-output "transport-info is %S" iq)
|
|
(let ((tox-session (plist-get state-data :tox-session))
|
|
(candidates
|
|
(jabber-xml-get-children
|
|
(jabber-xml-path
|
|
iq
|
|
`(jingle content (,jingle-ice-udp-ns . "transport")))
|
|
'candidate)))
|
|
;; XXX: send iq error for no candidates
|
|
(when candidates
|
|
(fsm-debug-output "Adding remote candidate...")
|
|
(dbus-call-method :session tox-name tox-session tox-session-interface
|
|
"AddRemoteCandidate"
|
|
(mapcar
|
|
'jingle-parse-candidate
|
|
candidates))
|
|
;; XXX: iq result
|
|
(list :pending state-data)
|
|
)))
|
|
(t
|
|
;; XXX: send "bad-request" or something
|
|
)))))))
|
|
|
|
(defun jingle-send-iq (state-data action payload)
|
|
"Send a Jingle IQ stanza from within a Jingle FSM.
|
|
STATE-DATA is the state data plist of the FSM.
|
|
ACTION is the value of the action attribute of the <jingle/>
|
|
element.
|
|
PAYLOAD is a list of XML elements to include as children
|
|
of the <jingle/> element.
|
|
The recipient and the SID are determined from STATE-DATA."
|
|
(let ((jc (plist-get state-data :jc))
|
|
(jid (plist-get state-data :jid))
|
|
(role (plist-get state-data :role))
|
|
(sid (plist-get state-data :sid)))
|
|
(jabber-send-iq
|
|
jc jid "set"
|
|
`(jingle ((xmlns . ,jingle-ns)
|
|
(action . ,action)
|
|
(initiator
|
|
. ,(ecase role
|
|
(:initiator
|
|
(jabber-connection-jid jc))
|
|
(:target
|
|
jid)))
|
|
(sid . ,sid))
|
|
,@payload)
|
|
;; XXX: we probably want error checking, to see if our partner
|
|
;; went offline.
|
|
nil nil nil nil)))
|
|
|
|
(defun jingle-send-native-candidate (state-data candidate)
|
|
"Send a native candidate for ICE-UDP.
|
|
The CANDIDATE is a list of components, as provided by the
|
|
NewNativeCandidate signal of Tox."
|
|
;; XXX: check against XEP-0176
|
|
(jingle-send-iq state-data "transport-info"
|
|
`((content
|
|
((creator . "initiator")
|
|
(name . "foo"))
|
|
(transport
|
|
((xmlns . ,jingle-ice-udp-ns))
|
|
,@(mapcar
|
|
(lambda (c)
|
|
`(candidate
|
|
((id . ,(nth 0 c))
|
|
(component . ,(number-to-string (nth 1 c)))
|
|
;; foundation?
|
|
;; generation?
|
|
(ip . ,(nth 2 c))
|
|
;; network?
|
|
(port . ,(number-to-string (nth 3 c)))
|
|
(protocol . ,(nth 4 c))
|
|
;; (nth 5 c) is always "RTP"
|
|
;; (nth 6 c) is always "AVP"
|
|
(priority . ,(nth 7 c))
|
|
;; (nth 8 c) is type. how to translate it?
|
|
(username . ,(nth 9 c))
|
|
(password . ,(nth 10 c))
|
|
)))
|
|
candidate))))))
|
|
|
|
(defun jingle-parse-candidate (candidate)
|
|
"Parse an XEP-0176 <candidate/> element into DBus format.
|
|
Specifically, the signature is \"(susqsssyyss)\"."
|
|
;; XXX: check against XEP-0176 again
|
|
(jabber-xml-let-attributes
|
|
(id component foundation generation
|
|
ip port protocol priority type
|
|
username password)
|
|
candidate
|
|
(list :string id
|
|
:uint32 (string-to-number component)
|
|
:string ip
|
|
:uint16 (string-to-number port)
|
|
"udp" "RTP" "AVP"
|
|
:byte (string-to-number priority) ;XXX: priority is preference?
|
|
:byte 0 ;XXX: fix type
|
|
:string (or username "")
|
|
:string (or password ""))))
|
|
|
|
(add-to-list 'jabber-iq-set-xmlns-alist
|
|
(cons jingle-ns 'jabber-jingle-incoming-iq))
|
|
(defun jabber-jingle-incoming-iq (jc iq)
|
|
(jabber-xml-let-attributes
|
|
(sid action) (jabber-iq-query iq)
|
|
(unless (and sid action)
|
|
(jabber-signal-error "modify" 'bad-request))
|
|
(let ((fsm (gethash (cons (jabber-connection-jid jc) sid) jingle-acct-sid-map)))
|
|
(cond
|
|
(fsm
|
|
(fsm-send-sync fsm (cons :iq-set iq)))
|
|
((string= action "session-initiate")
|
|
(condition-case e
|
|
(setq fsm (start-jingle jc sid :target (jabber-xml-get-attribute iq 'from)))
|
|
(error
|
|
(jabber-signal-error "wait" 'internal-server-error
|
|
(concat "Couldn't accept Jingle session: "
|
|
(error-message-string e)))))
|
|
(puthash (cons (jabber-connection-jid jc) sid) fsm jingle-acct-sid-map)
|
|
(fsm-send-sync fsm (cons :iq-set iq)))
|
|
(t
|
|
(jabber-signal-error "modify" 'bad-request
|
|
(format "Session \"%s\" unknown" sid)
|
|
`((unknown-session ((xmlns . ,jingle-error-ns))))))))))
|
|
|
|
(defun jabber-jingle-start-audio-session (jc jid)
|
|
(interactive
|
|
(list (jabber-read-account)
|
|
(jabber-read-jid-completing "Voice call to: " nil nil nil 'full)))
|
|
(let* ((sid (apply 'format "emacs-sid-%d.%d.%d" (current-time)))
|
|
(fsm (start-jingle jc sid :initiator jid)))
|
|
(puthash (cons (jabber-connection-jid jc) sid) fsm jingle-acct-sid-map)))
|
|
|
|
|
|
(provide 'jabber-tox)
|