jabber-si-server.el

   1 ;; jabber-si-server.el - handle incoming stream requests, by JEP-0095
   2
   3 ;; Copyright (C) 2002, 2003, 2004 - tom berger - object@intelectronica.net
   4 ;; Copyright (C) 2003, 2004 - 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 this program; if not, write to the Free Software
  20 ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  21
  22 (require 'jabber-iq)
  23 (require 'jabber-disco)
  24 (require 'jabber-feature-neg)
  25
  26 (require 'jabber-si-common)
  27
  28 (add-to-list 'jabber-advertised-features "http://jabber.org/protocol/si")
  29
  30 ;; Now, stream methods push data to profiles.  It could be the other
  31 ;; way around; not sure which is better.
  32 (defvar jabber-si-profiles nil
  33   "Supported SI profiles.
  34
  35 Each entry is a list, containing:
  36  * The namespace URI of the profile
  37  * Accept function, taking entire IQ stanza, and signalling a 'forbidden'
  38    error if request is declined; returning an XML node to return in
  39    response, or nil of none needed
  40  * \"Connection established\" function.  See `jabber-si-stream-methods'.")
  41
  42 (add-to-list 'jabber-iq-set-xmlns-alist
  43              (cons "http://jabber.org/protocol/si" 'jabber-si-process))
  44 (defun jabber-si-process (jc xml-data)
  45
  46   (let* ((to (jabber-xml-get-attribute xml-data 'from))
  47          (id (jabber-xml-get-attribute xml-data 'id))
  48          (query (jabber-iq-query xml-data))
  49          (profile (jabber-xml-get-attribute query 'profile))
  50          (si-id (jabber-xml-get-attribute query 'id))
  51          (feature (car (jabber-xml-get-children query 'feature))))
  52     (message "Receiving SI with profile '%s'" profile)
  53
  54     (let (stream-method
  55           ;; Find profile
  56           (profile-data (assoc profile jabber-si-profiles)))
  57       ;; Now, feature negotiation for stream type (errors
  58       ;; don't match JEP-0095, so convert)
  59       (condition-case err
  60           (setq stream-method (jabber-fn-intersection
  61                                (jabber-fn-parse feature 'request)
  62                                (list (cons "stream-method" (mapcar 'car jabber-si-stream-methods)))))
  63         (jabber-error
  64          (jabber-signal-error "cancel" 'bad-request nil
  65                               '((no-valid-streams ((xmlns . "http://jabber.org/protocol/si")))))))
  66       (unless profile-data
  67         ;; profile not understood
  68         (jabber-signal-error "cancel" 'bad-request nil
  69                              '((bad-profile ((xmlns . "http://jabber.org/protocol/si"))))))
  70       (let* ((profile-accept-function (nth 1 profile-data))
  71              ;; accept-function might throw a "forbidden" error
  72              ;; on user cancel
  73              (profile-response (funcall profile-accept-function jc xml-data))
  74              (profile-connected-function (nth 2 profile-data))
  75              (stream-method-id (nth 1 (assoc "stream-method" stream-method)))
  76              (stream-data (assoc stream-method-id jabber-si-stream-methods))
  77              (stream-accept-function (nth 2 stream-data)))
  78         ;; prepare stream for the transfer
  79         (funcall stream-accept-function jc to si-id profile-connected-function)
  80         ;; return result of feature negotiation of stream type
  81         (jabber-send-iq jc to "result"
  82                         `(si ((xmlns . "http://jabber.org/protocol/si"))
  83                              ,@profile-response
  84                              (feature ((xmlns . "http://jabber.org/protocol/feature-neg"))
  85                                       ,(jabber-fn-encode stream-method 'response)))
  86                         nil nil nil nil
  87                         id)
  88         ))))
  89
  90 (provide 'jabber-si-server)
  91
  92 ;;; arch-tag: d3c75c66-4052-4cf5-8f04-8765adfc8b96