Initial forays in the direction of AMQP support
This commit is contained in:
Tony Garnock-Jones
parent
7c2c6cd893
commit
6175e40a1f
|
|
@ -2,3 +2,4 @@ scratch/
|
|||
_build/
|
||||
*.native
|
||||
message.ml
|
||||
amqp_spec.ml
|
||||
|
|
|
|||
6
Makefile
6
Makefile
|
|
@ -1,13 +1,17 @@
|
|||
APP=ocamlmsg
|
||||
|
||||
all: message.ml $(APP).native
|
||||
all: message.ml amqp_spec.ml $(APP).native
|
||||
|
||||
message.ml: messages.json codegen.py
|
||||
python codegen.py > $@
|
||||
|
||||
amqp_spec.ml: amqp0-9-1.stripped.xml amqp_codegen.py
|
||||
python amqp_codegen.py > $@
|
||||
|
||||
clean:
|
||||
ocamlbuild -clean
|
||||
rm -f message.ml
|
||||
rm -f amqp_spec.ml
|
||||
|
||||
$(APP).native: $(wildcard *.ml)
|
||||
ocamlbuild $@
|
||||
|
|
|
|||
|
|
@ -0,0 +1,459 @@
|
|||
<?xml version="1.0"?>
|
||||
<!--
|
||||
Copyright (c) 2009 AMQP Working Group.
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions
|
||||
are met:
|
||||
1. Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
2. Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in the
|
||||
documentation and/or other materials provided with the distribution.
|
||||
3. The name of the author may not be used to endorse or promote products
|
||||
derived from this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
|
||||
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
|
||||
OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
|
||||
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
|
||||
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
|
||||
NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
|
||||
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
-->
|
||||
<amqp major="0" minor="9" revision="1" port="5672">
|
||||
<constant name="frame-method" value="1"/>
|
||||
<constant name="frame-header" value="2"/>
|
||||
<constant name="frame-body" value="3"/>
|
||||
<constant name="frame-heartbeat" value="8"/>
|
||||
<constant name="frame-min-size" value="4096"/>
|
||||
<constant name="frame-end" value="206"/>
|
||||
<constant name="reply-success" value="200"/>
|
||||
<constant name="content-too-large" value="311" class="soft-error"/>
|
||||
<constant name="no-consumers" value="313" class="soft-error"/>
|
||||
<constant name="connection-forced" value="320" class="hard-error"/>
|
||||
<constant name="invalid-path" value="402" class="hard-error"/>
|
||||
<constant name="access-refused" value="403" class="soft-error"/>
|
||||
<constant name="not-found" value="404" class="soft-error"/>
|
||||
<constant name="resource-locked" value="405" class="soft-error"/>
|
||||
<constant name="precondition-failed" value="406" class="soft-error"/>
|
||||
<constant name="frame-error" value="501" class="hard-error"/>
|
||||
<constant name="syntax-error" value="502" class="hard-error"/>
|
||||
<constant name="command-invalid" value="503" class="hard-error"/>
|
||||
<constant name="channel-error" value="504" class="hard-error"/>
|
||||
<constant name="unexpected-frame" value="505" class="hard-error"/>
|
||||
<constant name="resource-error" value="506" class="hard-error"/>
|
||||
<constant name="not-allowed" value="530" class="hard-error"/>
|
||||
<constant name="not-implemented" value="540" class="hard-error"/>
|
||||
<constant name="internal-error" value="541" class="hard-error"/>
|
||||
<domain name="class-id" type="short"/>
|
||||
<domain name="consumer-tag" type="shortstr"/>
|
||||
<domain name="delivery-tag" type="longlong"/>
|
||||
<domain name="exchange-name" type="shortstr">
|
||||
<assert check="length" value="127"/>
|
||||
<assert check="regexp" value="^[a-zA-Z0-9-_.:]*$"/>
|
||||
</domain>
|
||||
<domain name="method-id" type="short"/>
|
||||
<domain name="no-ack" type="bit"/>
|
||||
<domain name="no-local" type="bit"/>
|
||||
<domain name="no-wait" type="bit"/>
|
||||
<domain name="path" type="shortstr">
|
||||
<assert check="notnull"/>
|
||||
<assert check="length" value="127"/>
|
||||
</domain>
|
||||
<domain name="peer-properties" type="table"/>
|
||||
<domain name="queue-name" type="shortstr">
|
||||
<assert check="length" value="127"/>
|
||||
<assert check="regexp" value="^[a-zA-Z0-9-_.:]*$"/>
|
||||
</domain>
|
||||
<domain name="redelivered" type="bit"/>
|
||||
<domain name="message-count" type="long"/>
|
||||
<domain name="reply-code" type="short">
|
||||
<assert check="notnull"/>
|
||||
</domain>
|
||||
<domain name="reply-text" type="shortstr">
|
||||
<assert check="notnull"/>
|
||||
</domain>
|
||||
<domain name="bit" type="bit"/>
|
||||
<domain name="octet" type="octet"/>
|
||||
<domain name="short" type="short"/>
|
||||
<domain name="long" type="long"/>
|
||||
<domain name="longlong" type="longlong"/>
|
||||
<domain name="shortstr" type="shortstr"/>
|
||||
<domain name="longstr" type="longstr"/>
|
||||
<domain name="timestamp" type="timestamp"/>
|
||||
<domain name="table" type="table"/>
|
||||
<class name="connection" handler="connection" index="10">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<method name="start" synchronous="1" index="10">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<response name="start-ok"/>
|
||||
<field name="version-major" domain="octet"/>
|
||||
<field name="version-minor" domain="octet"/>
|
||||
<field name="server-properties" domain="peer-properties"/>
|
||||
<field name="mechanisms" domain="longstr">
|
||||
<assert check="notnull"/>
|
||||
</field>
|
||||
<field name="locales" domain="longstr">
|
||||
<assert check="notnull"/>
|
||||
</field>
|
||||
</method>
|
||||
<method name="start-ok" synchronous="1" index="11">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<field name="client-properties" domain="peer-properties"/>
|
||||
<field name="mechanism" domain="shortstr">
|
||||
<assert check="notnull"/>
|
||||
</field>
|
||||
<field name="response" domain="longstr">
|
||||
<assert check="notnull"/>
|
||||
</field>
|
||||
<field name="locale" domain="shortstr">
|
||||
<assert check="notnull"/>
|
||||
</field>
|
||||
</method>
|
||||
<method name="secure" synchronous="1" index="20">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<response name="secure-ok"/>
|
||||
<field name="challenge" domain="longstr"/>
|
||||
</method>
|
||||
<method name="secure-ok" synchronous="1" index="21">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<field name="response" domain="longstr">
|
||||
<assert check="notnull"/>
|
||||
</field>
|
||||
</method>
|
||||
<method name="tune" synchronous="1" index="30">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<response name="tune-ok"/>
|
||||
<field name="channel-max" domain="short"/>
|
||||
<field name="frame-max" domain="long"/>
|
||||
<field name="heartbeat" domain="short"/>
|
||||
</method>
|
||||
<method name="tune-ok" synchronous="1" index="31">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<field name="channel-max" domain="short">
|
||||
<assert check="notnull"/>
|
||||
<assert check="le" method="tune" field="channel-max"/>
|
||||
</field>
|
||||
<field name="frame-max" domain="long"/>
|
||||
<field name="heartbeat" domain="short"/>
|
||||
</method>
|
||||
<method name="open" synchronous="1" index="40">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<response name="open-ok"/>
|
||||
<field name="virtual-host" domain="path"/>
|
||||
<field name="reserved-1" type="shortstr" reserved="1"/>
|
||||
<field name="reserved-2" type="bit" reserved="1"/>
|
||||
</method>
|
||||
<method name="open-ok" synchronous="1" index="41">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<field name="reserved-1" type="shortstr" reserved="1"/>
|
||||
</method>
|
||||
<method name="close" synchronous="1" index="50">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<response name="close-ok"/>
|
||||
<field name="reply-code" domain="reply-code"/>
|
||||
<field name="reply-text" domain="reply-text"/>
|
||||
<field name="class-id" domain="class-id"/>
|
||||
<field name="method-id" domain="method-id"/>
|
||||
</method>
|
||||
<method name="close-ok" synchronous="1" index="51">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<chassis name="server" implement="MUST"/>
|
||||
</method>
|
||||
</class>
|
||||
<class name="channel" handler="channel" index="20">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<method name="open" synchronous="1" index="10">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<response name="open-ok"/>
|
||||
<field name="reserved-1" type="shortstr" reserved="1"/>
|
||||
</method>
|
||||
<method name="open-ok" synchronous="1" index="11">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<field name="reserved-1" type="longstr" reserved="1"/>
|
||||
</method>
|
||||
<method name="flow" synchronous="1" index="20">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<response name="flow-ok"/>
|
||||
<field name="active" domain="bit"/>
|
||||
</method>
|
||||
<method name="flow-ok" index="21">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<field name="active" domain="bit"/>
|
||||
</method>
|
||||
<method name="close" synchronous="1" index="40">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<response name="close-ok"/>
|
||||
<field name="reply-code" domain="reply-code"/>
|
||||
<field name="reply-text" domain="reply-text"/>
|
||||
<field name="class-id" domain="class-id"/>
|
||||
<field name="method-id" domain="method-id"/>
|
||||
</method>
|
||||
<method name="close-ok" synchronous="1" index="41">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<chassis name="server" implement="MUST"/>
|
||||
</method>
|
||||
</class>
|
||||
<class name="exchange" handler="channel" index="40">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<method name="declare" synchronous="1" index="10">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<response name="declare-ok"/>
|
||||
<field name="reserved-1" type="short" reserved="1"/>
|
||||
<field name="exchange" domain="exchange-name">
|
||||
<assert check="notnull"/>
|
||||
</field>
|
||||
<field name="type" domain="shortstr"/>
|
||||
<field name="passive" domain="bit"/>
|
||||
<field name="durable" domain="bit"/>
|
||||
<field name="reserved-2" type="bit" reserved="1"/>
|
||||
<field name="reserved-3" type="bit" reserved="1"/>
|
||||
<field name="no-wait" domain="no-wait"/>
|
||||
<field name="arguments" domain="table"/>
|
||||
</method>
|
||||
<method name="declare-ok" synchronous="1" index="11">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
</method>
|
||||
<method name="delete" synchronous="1" index="20">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<response name="delete-ok"/>
|
||||
<field name="reserved-1" type="short" reserved="1"/>
|
||||
<field name="exchange" domain="exchange-name">
|
||||
<assert check="notnull"/>
|
||||
</field>
|
||||
<field name="if-unused" domain="bit"/>
|
||||
<field name="no-wait" domain="no-wait"/>
|
||||
</method>
|
||||
<method name="delete-ok" synchronous="1" index="21">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
</method>
|
||||
</class>
|
||||
<class name="queue" handler="channel" index="50">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<method name="declare" synchronous="1" index="10">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<response name="declare-ok"/>
|
||||
<field name="reserved-1" type="short" reserved="1"/>
|
||||
<field name="queue" domain="queue-name"/>
|
||||
<field name="passive" domain="bit"/>
|
||||
<field name="durable" domain="bit"/>
|
||||
<field name="exclusive" domain="bit"/>
|
||||
<field name="auto-delete" domain="bit"/>
|
||||
<field name="no-wait" domain="no-wait"/>
|
||||
<field name="arguments" domain="table"/>
|
||||
</method>
|
||||
<method name="declare-ok" synchronous="1" index="11">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<field name="queue" domain="queue-name">
|
||||
<assert check="notnull"/>
|
||||
</field>
|
||||
<field name="message-count" domain="message-count"/>
|
||||
<field name="consumer-count" domain="long"/>
|
||||
</method>
|
||||
<method name="bind" synchronous="1" index="20">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<response name="bind-ok"/>
|
||||
<field name="reserved-1" type="short" reserved="1"/>
|
||||
<field name="queue" domain="queue-name"/>
|
||||
<field name="exchange" domain="exchange-name"/>
|
||||
<field name="routing-key" domain="shortstr"/>
|
||||
<field name="no-wait" domain="no-wait"/>
|
||||
<field name="arguments" domain="table"/>
|
||||
</method>
|
||||
<method name="bind-ok" synchronous="1" index="21">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
</method>
|
||||
<method name="unbind" synchronous="1" index="50">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<response name="unbind-ok"/>
|
||||
<field name="reserved-1" type="short" reserved="1"/>
|
||||
<field name="queue" domain="queue-name"/>
|
||||
<field name="exchange" domain="exchange-name"/>
|
||||
<field name="routing-key" domain="shortstr"/>
|
||||
<field name="arguments" domain="table"/>
|
||||
</method>
|
||||
<method name="unbind-ok" synchronous="1" index="51">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
</method>
|
||||
<method name="purge" synchronous="1" index="30">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<response name="purge-ok"/>
|
||||
<field name="reserved-1" type="short" reserved="1"/>
|
||||
<field name="queue" domain="queue-name"/>
|
||||
<field name="no-wait" domain="no-wait"/>
|
||||
</method>
|
||||
<method name="purge-ok" synchronous="1" index="31">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<field name="message-count" domain="message-count"/>
|
||||
</method>
|
||||
<method name="delete" synchronous="1" index="40">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<response name="delete-ok"/>
|
||||
<field name="reserved-1" type="short" reserved="1"/>
|
||||
<field name="queue" domain="queue-name"/>
|
||||
<field name="if-unused" domain="bit"/>
|
||||
<field name="if-empty" domain="bit"/>
|
||||
<field name="no-wait" domain="no-wait"/>
|
||||
</method>
|
||||
<method name="delete-ok" synchronous="1" index="41">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<field name="message-count" domain="message-count"/>
|
||||
</method>
|
||||
</class>
|
||||
<class name="basic" handler="channel" index="60">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<chassis name="client" implement="MAY"/>
|
||||
<field name="content-type" domain="shortstr"/>
|
||||
<field name="content-encoding" domain="shortstr"/>
|
||||
<field name="headers" domain="table"/>
|
||||
<field name="delivery-mode" domain="octet"/>
|
||||
<field name="priority" domain="octet"/>
|
||||
<field name="correlation-id" domain="shortstr"/>
|
||||
<field name="reply-to" domain="shortstr"/>
|
||||
<field name="expiration" domain="shortstr"/>
|
||||
<field name="message-id" domain="shortstr"/>
|
||||
<field name="timestamp" domain="timestamp"/>
|
||||
<field name="type" domain="shortstr"/>
|
||||
<field name="user-id" domain="shortstr"/>
|
||||
<field name="app-id" domain="shortstr"/>
|
||||
<field name="reserved" domain="shortstr"/>
|
||||
<method name="qos" synchronous="1" index="10">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<response name="qos-ok"/>
|
||||
<field name="prefetch-size" domain="long"/>
|
||||
<field name="prefetch-count" domain="short"/>
|
||||
<field name="global" domain="bit"/>
|
||||
</method>
|
||||
<method name="qos-ok" synchronous="1" index="11">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
</method>
|
||||
<method name="consume" synchronous="1" index="20">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<response name="consume-ok"/>
|
||||
<field name="reserved-1" type="short" reserved="1"/>
|
||||
<field name="queue" domain="queue-name"/>
|
||||
<field name="consumer-tag" domain="consumer-tag"/>
|
||||
<field name="no-local" domain="no-local"/>
|
||||
<field name="no-ack" domain="no-ack"/>
|
||||
<field name="exclusive" domain="bit"/>
|
||||
<field name="no-wait" domain="no-wait"/>
|
||||
<field name="arguments" domain="table"/>
|
||||
</method>
|
||||
<method name="consume-ok" synchronous="1" index="21">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<field name="consumer-tag" domain="consumer-tag"/>
|
||||
</method>
|
||||
<method name="cancel" synchronous="1" index="30">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<response name="cancel-ok"/>
|
||||
<field name="consumer-tag" domain="consumer-tag"/>
|
||||
<field name="no-wait" domain="no-wait"/>
|
||||
</method>
|
||||
<method name="cancel-ok" synchronous="1" index="31">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<field name="consumer-tag" domain="consumer-tag"/>
|
||||
</method>
|
||||
<method name="publish" content="1" index="40">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<field name="reserved-1" type="short" reserved="1"/>
|
||||
<field name="exchange" domain="exchange-name"/>
|
||||
<field name="routing-key" domain="shortstr"/>
|
||||
<field name="mandatory" domain="bit"/>
|
||||
<field name="immediate" domain="bit"/>
|
||||
</method>
|
||||
<method name="return" content="1" index="50">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<field name="reply-code" domain="reply-code"/>
|
||||
<field name="reply-text" domain="reply-text"/>
|
||||
<field name="exchange" domain="exchange-name"/>
|
||||
<field name="routing-key" domain="shortstr"/>
|
||||
</method>
|
||||
<method name="deliver" content="1" index="60">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
<field name="consumer-tag" domain="consumer-tag"/>
|
||||
<field name="delivery-tag" domain="delivery-tag"/>
|
||||
<field name="redelivered" domain="redelivered"/>
|
||||
<field name="exchange" domain="exchange-name"/>
|
||||
<field name="routing-key" domain="shortstr"/>
|
||||
</method>
|
||||
<method name="get" synchronous="1" index="70">
|
||||
<response name="get-ok"/>
|
||||
<response name="get-empty"/>
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<field name="reserved-1" type="short" reserved="1"/>
|
||||
<field name="queue" domain="queue-name"/>
|
||||
<field name="no-ack" domain="no-ack"/>
|
||||
</method>
|
||||
<method name="get-ok" synchronous="1" content="1" index="71">
|
||||
<chassis name="client" implement="MAY"/>
|
||||
<field name="delivery-tag" domain="delivery-tag"/>
|
||||
<field name="redelivered" domain="redelivered"/>
|
||||
<field name="exchange" domain="exchange-name"/>
|
||||
<field name="routing-key" domain="shortstr"/>
|
||||
<field name="message-count" domain="message-count"/>
|
||||
</method>
|
||||
<method name="get-empty" synchronous="1" index="72">
|
||||
<chassis name="client" implement="MAY"/>
|
||||
<field name="reserved-1" type="shortstr" reserved="1"/>
|
||||
</method>
|
||||
<method name="ack" index="80">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<field name="delivery-tag" domain="delivery-tag"/>
|
||||
<field name="multiple" domain="bit"/>
|
||||
</method>
|
||||
<method name="reject" index="90">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<field name="delivery-tag" domain="delivery-tag"/>
|
||||
<field name="requeue" domain="bit"/>
|
||||
</method>
|
||||
<method name="recover-async" index="100" deprecated="1">
|
||||
<chassis name="server" implement="MAY"/>
|
||||
<field name="requeue" domain="bit"/>
|
||||
</method>
|
||||
<method name="recover" index="110">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<field name="requeue" domain="bit"/>
|
||||
</method>
|
||||
<method name="recover-ok" synchronous="1" index="111">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
</method>
|
||||
</class>
|
||||
<class name="tx" handler="channel" index="90">
|
||||
<chassis name="server" implement="SHOULD"/>
|
||||
<chassis name="client" implement="MAY"/>
|
||||
<method name="select" synchronous="1" index="10">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<response name="select-ok"/>
|
||||
</method>
|
||||
<method name="select-ok" synchronous="1" index="11">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
</method>
|
||||
<method name="commit" synchronous="1" index="20">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<response name="commit-ok"/>
|
||||
</method>
|
||||
<method name="commit-ok" synchronous="1" index="21">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
</method>
|
||||
<method name="rollback" synchronous="1" index="30">
|
||||
<chassis name="server" implement="MUST"/>
|
||||
<response name="rollback-ok"/>
|
||||
</method>
|
||||
<method name="rollback-ok" synchronous="1" index="31">
|
||||
<chassis name="client" implement="MUST"/>
|
||||
</method>
|
||||
</class>
|
||||
</amqp>
|
||||
|
|
@ -0,0 +1,210 @@
|
|||
from __future__ import with_statement
|
||||
|
||||
# Copyright (C) 2012 Tony Garnock-Jones. All rights reserved.
|
||||
copyright_stmt = '(* Copyright (C) 2012 Tony Garnock-Jones. All rights reserved. *)'
|
||||
|
||||
import sys
|
||||
import xml.dom.minidom
|
||||
from collections import namedtuple
|
||||
|
||||
###########################################################################
|
||||
# XML utils
|
||||
def attr(n,a,d=None): return n.getAttribute(a).strip() if n.hasAttribute(a) else d
|
||||
def kids(e,t): return [k for k in e.getElementsByTagName(t) if k.parentNode is e]
|
||||
|
||||
##########################################################################
|
||||
# Identifier utils
|
||||
|
||||
def mlify(s):
|
||||
s = s.replace('-', '_')
|
||||
s = s.replace(' ', '_')
|
||||
return s
|
||||
|
||||
def ctor(s):
|
||||
return mlify(s).capitalize()
|
||||
|
||||
def tname(s):
|
||||
return mlify(s) + '_t'
|
||||
|
||||
###########################################################################
|
||||
# Load & parse the spec
|
||||
|
||||
with open('amqp0-9-1.stripped.xml') as f:
|
||||
spec_xml = xml.dom.minidom.parse(f)
|
||||
|
||||
amqp_elt = spec_xml.getElementsByTagName('amqp')[0]
|
||||
major = int(attr(amqp_elt, 'major', '0'))
|
||||
minor = int(attr(amqp_elt, 'minor', '0'))
|
||||
port = int(attr(amqp_elt, 'port', '5672'))
|
||||
revision = int(attr(amqp_elt, 'revision', '0'))
|
||||
|
||||
constant_elts = amqp_elt.getElementsByTagName('constant')
|
||||
def constants():
|
||||
for e in constant_elts:
|
||||
yield (attr(e, 'name'), attr(e, 'value'))
|
||||
|
||||
domain_elts = amqp_elt.getElementsByTagName('domain')
|
||||
domains = {}
|
||||
for e in domain_elts:
|
||||
domains[attr(e, 'name')] = attr(e, 'type')
|
||||
def resolve(typename):
|
||||
seen = set()
|
||||
while True:
|
||||
if typename in seen:
|
||||
return typename
|
||||
seen.add(typename)
|
||||
if typename in domains:
|
||||
typename = domains[typename]
|
||||
|
||||
class AccessibleFieldsMixin:
|
||||
@property
|
||||
def accessible_fields(self):
|
||||
return [f for f in self.fields if not f.reserved]
|
||||
|
||||
class Class(AccessibleFieldsMixin,
|
||||
namedtuple('Class', 'index name fields methods'.split())):
|
||||
pass
|
||||
|
||||
class Method(AccessibleFieldsMixin,
|
||||
namedtuple('Method', ['class_name',
|
||||
'class_index',
|
||||
'has_content',
|
||||
'deprecated',
|
||||
'index',
|
||||
'name',
|
||||
'synchronous',
|
||||
'responses',
|
||||
'fields'])):
|
||||
@property
|
||||
def full_name(self):
|
||||
return self.class_name + '-' + self.name
|
||||
|
||||
Field = namedtuple('Field', 'name type reserved'.split())
|
||||
|
||||
def load_fields(e):
|
||||
return [Field(attr(f, 'name'),
|
||||
resolve(attr(f, 'domain', attr(f, 'type'))),
|
||||
int(attr(f, 'reserved', '0'))) \
|
||||
for f in kids(e, 'field')]
|
||||
|
||||
class_elts = amqp_elt.getElementsByTagName('class')
|
||||
classes = []
|
||||
for e in class_elts:
|
||||
classes.append(Class(int(attr(e, 'index')),
|
||||
attr(e, 'name'),
|
||||
load_fields(e),
|
||||
[Method(attr(e, 'name'),
|
||||
int(attr(e, 'index')),
|
||||
int(attr(m, 'content', '0')),
|
||||
int(attr(m, 'deprecated', '0')),
|
||||
int(attr(m, 'index')),
|
||||
attr(m, 'name'),
|
||||
int(attr(m, 'synchronous', '0')),
|
||||
[attr(r, 'name') for r in kids(m, 'response')],
|
||||
load_fields(m)) \
|
||||
for m in kids(e, 'method')]))
|
||||
methods = []
|
||||
for c in classes:
|
||||
for m in c.methods:
|
||||
methods.append(m)
|
||||
|
||||
###########################################################################
|
||||
|
||||
def print_codec():
|
||||
print copyright_stmt
|
||||
print '(* WARNING: Autogenerated code. Do not edit by hand! *)'
|
||||
print
|
||||
print 'open Amqp_wireformat'
|
||||
print 'open Sexp'
|
||||
print
|
||||
print 'let version = (%d, %d, %d)' % (major, minor, revision)
|
||||
print
|
||||
print 'type method_t ='
|
||||
for m in methods:
|
||||
print ' | %s' % (ctor(m.full_name),),
|
||||
if m.accessible_fields:
|
||||
print 'of (' + ', '.join((tname(f.type) for f in m.accessible_fields)) + ')'
|
||||
else:
|
||||
print
|
||||
print
|
||||
print 'let has_content m = match m with '
|
||||
for m in methods:
|
||||
if m.has_content:
|
||||
if m.accessible_fields:
|
||||
print (' | %s (' + ', '.join(('_' for f in m.accessible_fields)) + ') = true') % \
|
||||
(ctor(m.full_name),)
|
||||
else:
|
||||
print ' | %s = true' % (ctor(m.full_name),)
|
||||
print ' | _ = false'
|
||||
print
|
||||
print 'type properties_t ='
|
||||
for c in classes:
|
||||
if c.fields:
|
||||
if c.accessible_fields:
|
||||
print (' | %s_properties of (' + ', '.join((tname(f.type) for f in c.accessible_fields)) + ')') % (ctor(c.name),)
|
||||
else:
|
||||
print ' | %s_properties' % (ctor(c.name),)
|
||||
print
|
||||
print 'let is_synchronous m = match m with '
|
||||
for m in methods:
|
||||
if not m.synchronous:
|
||||
if m.accessible_fields:
|
||||
print (' | %s (' + ', '.join(('_' for f in m.accessible_fields)) + ') = false') % \
|
||||
(ctor(m.full_name),)
|
||||
else:
|
||||
print ' | %s = false' % (ctor(m.full_name),)
|
||||
print ' | _ = true'
|
||||
print
|
||||
print 'let sexp_of_method m = match m with '
|
||||
for m in methods:
|
||||
print ' | %s' % (ctor(m.full_name),),
|
||||
if m.accessible_fields:
|
||||
print 'of (' + ', '.join((mlify(f.name) for f in m.accessible_fields)) + ') ->'
|
||||
print ' Arr ["%s"; "%s"; %s]' % (
|
||||
m.class_name,
|
||||
m.name,
|
||||
'; '.join(('Arr [Str "%s"; sexp_of_%s(%s)]' % \
|
||||
(f.name, mlify(f.type), mlify(f.name)) for f in m.accessible_fields))
|
||||
)
|
||||
else:
|
||||
print '->'
|
||||
print ' Arr ["%s"; "%s"]' % (m.class_name, m.name)
|
||||
print
|
||||
print 'let read_method class_index method_index ch = match (class_index, method_index) with'
|
||||
for m in methods:
|
||||
print ' | (%d, %d) ->' % (m.class_index, m.index)
|
||||
for f in m.fields:
|
||||
if f.reserved:
|
||||
print ' let _ = read_%s ch in' % (mlify(f.type))
|
||||
else:
|
||||
print ' let %s = read_%s ch in' % (mlify(f.name), mlify(f.type))
|
||||
if m.accessible_fields:
|
||||
print ' %s (%s)' % (ctor(m.full_name),
|
||||
', '.join((mlify(f.name) for f in m.accessible_fields)))
|
||||
else:
|
||||
print ' %s' % (ctor(m.full_name),)
|
||||
print
|
||||
print 'let method_index m = match m with'
|
||||
for m in methods:
|
||||
if m.accessible_fields:
|
||||
print (' | %s (' + ', '.join(('_' for f in m.accessible_fields)) + ') = (%d, %d)') % \
|
||||
(ctor(m.full_name), m.class_index, m.index)
|
||||
else:
|
||||
print ' | %s = (%d, %d)' % (ctor(m.full_name), m.class_index, m.index)
|
||||
print
|
||||
print 'let write_method m ch = match m with'
|
||||
for m in methods:
|
||||
print ' | %s' % (ctor(m.full_name),),
|
||||
if m.accessible_fields:
|
||||
print 'of (' + ', '.join((mlify(f.name) for f in m.accessible_fields)) + ') ->'
|
||||
for f in m.fields:
|
||||
if f.reserved:
|
||||
print ' write_%s ch reserved_value_%s;' % (mlify(f.type), mlify(f.type))
|
||||
else:
|
||||
print ' write_%s ch %s;' % (mlify(f.type), mlify(f.name))
|
||||
else:
|
||||
print '->'
|
||||
print ' ()'
|
||||
|
||||
if __name__ == '__main__':
|
||||
print_codec()
|
||||
Loading…
Reference in New Issue