diff options
| author | Clombrong <cromblong@egregore.fun> | 2025-06-18 13:31:40 +0200 |
|---|---|---|
| committer | Clombrong <cromblong@egregore.fun> | 2025-06-18 13:37:39 +0200 |
| commit | 8d709f897ccba1d42af4e90fae0d741a6b835a03 (patch) | |
| tree | b90aece55521839d6cd2b2ae49bbec09dc5f87fd /portal | |
| parent | f6bf68a86908f1967bda9573b6d1ae7c2f8c7078 (diff) | |
feat(portal): add XML namespace to interface
Diffstat (limited to 'portal')
| -rw-r--r-- | portal/lib/portal.mli | 8 | ||||
| -rw-r--r-- | portal/lib/ws/portal.ml | 8 |
2 files changed, 13 insertions, 3 deletions
diff --git a/portal/lib/portal.mli b/portal/lib/portal.mli index 5da97ad..a560f5e 100644 --- a/portal/lib/portal.mli +++ b/portal/lib/portal.mli @@ -2,6 +2,14 @@ open Markup type t = (signal, async) stream * ((signal, sync) stream option -> unit) +(** This is the XML namespace of the underlying element stream. + + You can rely on it on your code, as an escape hatch, but you should probably not, + since the Portal interface is supposed to be agnostic. + + Still, bad implementations exist -- Use with care. *) +val xmlns : string + val stanza_open : ?from:string -> string -> (signal, sync) stream val stanza_close : (signal, sync) stream diff --git a/portal/lib/ws/portal.ml b/portal/lib/ws/portal.ml index d5362c1..620a238 100644 --- a/portal/lib/ws/portal.ml +++ b/portal/lib/ws/portal.ml @@ -7,6 +7,8 @@ let sjs = Js.to_string type t = (signal, async) stream * ((signal, sync) stream option -> unit) +let xmlns = "urn:ietf:params:xml:ns:xmpp-framing" + (* sic. XEP-0156: "host-meta files MUST be fetched only over HTTPS". I don't make the rules. *) let well_known_of (domain : string) = "https://" ^ domain ^ "/.well-known/host-meta" @@ -19,18 +21,18 @@ let stanza_open ?from domain : (signal, sync) stream = let stanza = let attributes = let open Option in - [(("", "xmlns"), "urn:ietf:params:xml:ns:xmpp-framing"); + [(("", "xmlns"), xmlns); (("", "to"), domain)] @ (map (fun jid -> (("", "from"), jid)) from |> to_list) @ [(("", "version"), "1.0")] in [`Start_element - (("urn:ietf:params:xml:ns:xmpp-framing", "open"), + ((xmlns, "open"), attributes); `End_element] in stanza |> of_list -let stanza_close = string {|<close xmlns="urn:ietf:params:xml:ns:xmpp-framing" />|} |> parse_xml |> signals +let stanza_close = {|<close xmlns="|} ^ xmlns ^ {|" />|} |> string |> parse_xml |> signals exception MalformedStanza of Markup.location * Markup.Error.t |