From: Magnus H. <leg...@us...> - 2008-10-16 21:55:06
|
Update of /cvsroot/emacs-jabber/tox In directory 23jxhf1.ch3.sourceforge.com:/tmp/cvs-serv31719 Modified Files: jabber-tox.el Log Message: Refactor: remove :allocate state Index: jabber-tox.el =================================================================== RCS file: /cvsroot/emacs-jabber/tox/jabber-tox.el,v retrieving revision 1.16 retrieving revision 1.17 diff -u -d -r1.16 -r1.17 --- jabber-tox.el 16 Oct 2008 18:35:31 -0000 1.16 +++ jabber-tox.el 16 Oct 2008 21:54:51 -0000 1.17 @@ -57,13 +57,20 @@ SID is a string, the session ID. ROLE is either :initiator or :target. JID is the full JID of the partner." - (list :allocate - (list :jc jc :jid jid :sid sid :role role)))) + (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)))) -(define-enter-state jingle :allocate - (fsm state-data) - (condition-case e - ;; Allocate a ToxSession object. +(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" @@ -105,24 +112,7 @@ fsm (cons :new-native-candidate components))))) (fsm-debug-output "Waiting") - (list state-data nil)) - (error - ;; So, we couldn't initiate our Jingle tool. - (setq state-data (plist-put state-data :we-deserve-to-die (error-message-string e))) - ;; Make sure we exit gracefully. - (ecase (plist-get state-data :role) - (:initiator - ;; If we're the initiator, make sure that the user gets to know - ;; what happened. - (message "Couldn't initiate Jingle session: %s" - (error-message-string e)) - ;; This seems to be the smoothest way to get rid of the FSM... - (list state-data 0.1)) - (:target - ;; If we're the target, make sure that our contact gets to know - ;; what happened. We don't know yet how, but we will soon get - ;; an :iq-set that we need to answer. - (list state-data)))))) + state-data)) (define-enter-state jingle nil (fsm state-data) @@ -137,48 +127,6 @@ jingle-acct-sid-map) (list nil nil)) -(define-state jingle :allocate - (fsm state-data event callback) - (case (or (car-safe event) event) - (:new-native-candidate - (setq state-data (plist-put state-data :native-candidates (list (cdr event)))) - (list (ecase (plist-get state-data :role) - (:initiator - :initiate) - (:target - :wait-for-initiate)) - state-data)) - - (:native-candidates-prepared - ;; this code is currently unnecessary, as we never get the - ;; native-candidates-prepared signal - (let ((components (cdr event))) - (fsm-debug-output "The native candidates are %S" components) - (setq state-data (plist-put state-data :native-candidates components)) - (list (ecase (plist-get state-data :role) - (:initiator - :initiate) - (:target - :wait-for-initiate)) - state-data))) - - (:iq-set - (if (plist-get state-data :we-deserve-to-die) - (let ((iq (cdr event))) - (jabber-xml-let-attributes (from id) iq - (jabber-send-iq-error - (plist-get state-data :jc) - from id (jabber-iq-query iq) - "wait" 'internal-server-error - (plist-get state-data :we-deserve-to-die))) - (list nil state-data)) - :defer)) - - (:timeout - ;; fatal error during initialization, but we couldn't garbage - ;; collect ourselves until now. - (list nil state-data)))) - (define-enter-state jingle :initiate (fsm state-data) (let ((jc (plist-get state-data :jc)) @@ -237,7 +185,13 @@ (:iq-error (message "Couldn't initiate Jingle audio session: %s" (jabber-parse-error (jabber-iq-error (cdr event)))) - (list nil state-data)))) + (list nil state-data)) + (:new-native-candidate + (let ((components (cdr event))) + ;; XXX: keep them all + (setq state-data (plist-put state-data :native-candidates (list (cdr event)))) + (jingle-send-native-candidate state-data components) + (list :initiate state-data))))) (define-state jingle :wait-for-initiate (fsm state-data event callback) @@ -280,9 +234,27 @@ (list nil state-data)) (t - ;; Allocate a new ToxSession object. - (dbus-call-method nil tox-name tox-path tox-interface - "CreateSession" + ;; Tell tox what codecs the remote side supports + (dbus-call-method nil tox-name tox-session tox-session-interface + "SetRemoteCodecs" + 'ignore + '((array (struct int32 string byte uint32 uint32 (array (dict-entry string string))))) + (mapcar + (lambda (pt) + (jabber-xml-let-attributes + (id name clockrate channels) pt + (list id name 0 clockrate channels + (mapcar + (lambda (param) + (jabber-xml-let-attributes + (name value) param + (list name value))) + (jabber-xml-get-children pt 'parameter))))) + (plist-get state-data :payload-types))) + + ;; Check if we have any codecs in common + (dbus-call-method nil tox-name tox-session tox-session-interface + "GetCodecIntersection" (lexical-let ((jingle-fsm fsm)) (lambda (dbus-fsm msg) (ecase (dbus-message-type msg) @@ -293,65 +265,14 @@ (:method-return (fsm-send jingle-fsm (cons :ok - (first (dbus-message-body-values msg)))))))) - 'byte 3) - - (list :tox-wait (plist-put - (plist-put state-data :iq-id id) - :payload-types payload-types)))))))) - -(define-state jingle :tox-wait - (fsm state-data event callback) - ;; Wait for our ToxSession to be allocated - (case (car-safe event) - (:error - ;; Some error occurred. Bail out. - (let ((jc (plist-get state-data :jc)) - (jid (plist-get state-data :jid)) - (id (plist-get state-data :iq-id))) - (jabber-send-iq-error jc jid id nil "wait" 'internal-server-error (cdr event)) - - (list nil state-data))) - - (:ok - ;; ToxSession created. - (let ((tox-session (cdr event))) - (setq state-data (plist-put state-data :tox-session tox-session)) - - ;; Tell tox what codecs the remote side supports - (dbus-call-method nil tox-name tox-session tox-session-interface - "SetRemoteCodecs" - 'ignore - '((array (struct int32 string byte uint32 uint32 (array (dict-entry string string))))) - (mapcar - (lambda (pt) - (jabber-xml-let-attributes - (id name clockrate channels) pt - (list id name 0 clockrate channels - (mapcar - (lambda (param) - (jabber-xml-let-attributes - (name value) param - (list name value))) - (jabber-xml-get-children pt 'parameter))))) - (plist-get state-data :payload-types))) - - ;; Check if we have any codecs in common - (dbus-call-method nil tox-name tox-session tox-session-interface - "GetCodecIntersection" - (lexical-let ((jingle-fsm fsm)) - (lambda (dbus-fsm msg) - (ecase (dbus-message-type msg) - (:error - (fsm-send jingle-fsm - (cons :error - (dbus-error-to-string msg)))) - (:method-return - (fsm-send jingle-fsm - (cons :ok (first (dbus-message-body-values msg))))))))) - (list :wait-for-codec-intersection state-data))))) + ;; So, now we know that we stand a basic chance of fulfilling + ;; the request. Let's move on to PENDING. + ;; XXX: should we check codec intersection first? + (list :pending + (plist-put state-data :payload-types payload-types)) + )))))) (define-state jingle :wait-for-codec-intersection (fsm state-data event callback) @@ -391,6 +312,31 @@ ;; 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." + (jingle-send-iq state-data "transport-info" + `(content + ((creator . "initiator") + (name . "foo")) + (transport + ((xmlns . ,jingle-ice-udp-ns)) + ,@(mapcar + (lambda (c) + `(candidate + ((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)) + (priority . ,(nth 7 c)) + ;; how to translate type? + ))) + components))))) + (add-to-list 'jabber-iq-set-xmlns-alist (cons jingle-ns 'jabber-jingle-incoming-iq)) (defun jabber-jingle-incoming-iq (jc iq) |