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 *) 16open Xenbus 17 18let data_concat ls = (String.concat "\000" ls) ^ "\000" 19let queue con pkt = let r = Xb.queue con pkt in assert (r <> None) 20let queue_path ty (tid: int) (path: string) con = 21 let data = data_concat [ path; ] in 22 queue con (Xb.Packet.create tid 0 ty data) 23 24(* operations *) 25let directory tid path con = queue_path Xb.Op.Directory tid path con 26let read tid path con = queue_path Xb.Op.Read tid path con 27 28let getperms tid path con = queue_path Xb.Op.Getperms tid path con 29 30let debug commands con = 31 queue con (Xb.Packet.create 0 0 Xb.Op.Debug (data_concat commands)) 32 33let watch path data con = 34 let data = data_concat [ path; data; ] in 35 queue con (Xb.Packet.create 0 0 Xb.Op.Watch data) 36 37let unwatch path data con = 38 let data = data_concat [ path; data; ] in 39 queue con (Xb.Packet.create 0 0 Xb.Op.Unwatch data) 40 41let transaction_start con = 42 queue con (Xb.Packet.create 0 0 Xb.Op.Transaction_start (data_concat [])) 43 44let transaction_end tid commit con = 45 let data = data_concat [ (if commit then "T" else "F"); ] in 46 queue con (Xb.Packet.create tid 0 Xb.Op.Transaction_end data) 47 48let introduce domid mfn port con = 49 let data = data_concat [ Printf.sprintf "%u" domid; 50 Printf.sprintf "%nu" mfn; 51 string_of_int port; ] in 52 queue con (Xb.Packet.create 0 0 Xb.Op.Introduce data) 53 54let release domid con = 55 let data = data_concat [ Printf.sprintf "%u" domid; ] in 56 queue con (Xb.Packet.create 0 0 Xb.Op.Release data) 57 58let resume domid con = 59 let data = data_concat [ Printf.sprintf "%u" domid; ] in 60 queue con (Xb.Packet.create 0 0 Xb.Op.Resume data) 61 62let getdomainpath domid con = 63 let data = data_concat [ Printf.sprintf "%u" domid; ] in 64 queue con (Xb.Packet.create 0 0 Xb.Op.Getdomainpath data) 65 66let write tid path value con = 67 let data = path ^ "\000" ^ value (* no NULL at the end *) in 68 queue con (Xb.Packet.create tid 0 Xb.Op.Write data) 69 70let mkdir tid path con = queue_path Xb.Op.Mkdir tid path con 71let rm tid path con = queue_path Xb.Op.Rm tid path con 72 73let setperms tid path perms con = 74 let data = data_concat [ path; perms ] in 75 queue con (Xb.Packet.create tid 0 Xb.Op.Setperms data) 76