1(*
2 * Copyright (C) 2006-2007 XenSource Ltd.
3 * Copyright (C) 2008      Citrix Ltd.
4 * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
5 *
6 * This program is free software; you can redistribute it and/or modify
7 * it under the terms of the GNU Lesser General Public License as published
8 * by the Free Software Foundation; version 2.1 only. with the special
9 * exception on linking described in file LICENSE.
10 *
11 * This program is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 * GNU Lesser General Public License for more details.
15 *)
16
17type t =
18{
19	tid: int;
20	rid: int;
21	ty: Op.operation;
22	data: string;
23}
24
25exception Error of string
26exception DataError of string
27
28external string_of_header: int -> int -> int -> int -> string = "stub_string_of_header"
29
30let create tid rid ty data = { tid = tid; rid = rid; ty = ty; data = data; }
31
32let of_partialpkt ppkt =
33	create ppkt.Partial.tid ppkt.Partial.rid ppkt.Partial.ty (Buffer.contents ppkt.Partial.buf)
34
35let to_string pkt =
36	let header = string_of_header pkt.tid pkt.rid (Op.to_cval pkt.ty) (String.length pkt.data) in
37	header ^ pkt.data
38
39let unpack pkt =
40	pkt.tid, pkt.rid, pkt.ty, pkt.data
41
42let get_tid pkt = pkt.tid
43let get_ty pkt = pkt.ty
44let get_data pkt =
45	let l = String.length pkt.data in
46	if l > 0 && pkt.data.[l - 1] = '\000' then
47		String.sub pkt.data 0 (l - 1)
48	else
49		pkt.data
50let get_rid pkt = pkt.rid