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
17module Op = struct include Op end
18module Packet = struct include Packet end
19
20exception End_of_file
21exception Eagain
22exception Noent
23exception Invalid
24exception Reconnect
25
26let _ =
27  Callback.register_exception "Xb.Reconnect" Reconnect
28
29type backend_mmap =
30{
31	mmap: Xenmmap.mmap_interface;     (* mmaped interface = xs_ring *)
32	eventchn_notify: unit -> unit; (* function to notify through eventchn *)
33	mutable work_again: bool;
34}
35
36type backend_fd =
37{
38	fd: Unix.file_descr;
39}
40
41type backend = Fd of backend_fd | Xenmmap of backend_mmap
42
43type partial_buf = HaveHdr of Partial.pkt | NoHdr of int * string
44
45type t =
46{
47	backend: backend;
48	pkt_in: Packet.t Queue.t;
49	pkt_out: Packet.t Queue.t;
50	mutable partial_in: partial_buf;
51	mutable partial_out: string;
52}
53
54let init_partial_in () = NoHdr
55	(Partial.header_size (), String.make (Partial.header_size()) '\000')
56
57let reconnect t = match t.backend with
58	| Fd _ ->
59		(* should never happen, so close the connection *)
60		raise End_of_file
61	| Xenmmap backend ->
62		Xs_ring.close backend.mmap;
63		backend.eventchn_notify ();
64		(* Clear our old connection state *)
65		Queue.clear t.pkt_in;
66		Queue.clear t.pkt_out;
67		t.partial_in <- init_partial_in ();
68		t.partial_out <- ""
69
70let queue con pkt = Queue.push pkt con.pkt_out
71
72let read_fd back con s len =
73	let rd = Unix.read back.fd s 0 len in
74	if rd = 0 then
75		raise End_of_file;
76	rd
77
78let read_mmap back con s len =
79	let rd = Xs_ring.read back.mmap s len in
80	back.work_again <- (rd > 0);
81	if rd > 0 then
82		back.eventchn_notify ();
83	rd
84
85let read con s len =
86	match con.backend with
87	| Fd backfd     -> read_fd backfd con s len
88	| Xenmmap backmmap -> read_mmap backmmap con s len
89
90let write_fd back con s len =
91	Unix.write back.fd s 0 len
92
93let write_mmap back con s len =
94	let ws = Xs_ring.write back.mmap s len in
95	if ws > 0 then
96		back.eventchn_notify ();
97	ws
98
99let write con s len =
100	match con.backend with
101	| Fd backfd     -> write_fd backfd con s len
102	| Xenmmap backmmap -> write_mmap backmmap con s len
103
104(* NB: can throw Reconnect *)
105let output con =
106	(* get the output string from a string_of(packet) or partial_out *)
107	let s = if String.length con.partial_out > 0 then
108			con.partial_out
109		else if Queue.length con.pkt_out > 0 then
110			Packet.to_string (Queue.pop con.pkt_out)
111		else
112			"" in
113	(* send data from s, and save the unsent data to partial_out *)
114	if s <> "" then (
115		let len = String.length s in
116		let sz = write con s len in
117		let left = String.sub s sz (len - sz) in
118		con.partial_out <- left
119	);
120	(* after sending one packet, partial is empty *)
121	con.partial_out = ""
122
123(* NB: can throw Reconnect *)
124let input con =
125	let newpacket = ref false in
126	let to_read =
127		match con.partial_in with
128		| HaveHdr partial_pkt -> Partial.to_complete partial_pkt
129		| NoHdr   (i, buf)    -> i in
130
131	(* try to get more data from input stream *)
132	let s = String.make to_read '\000' in
133	let sz = if to_read > 0 then read con s to_read else 0 in
134
135	(
136	match con.partial_in with
137	| HaveHdr partial_pkt ->
138		(* we complete the data *)
139		if sz > 0 then
140			Partial.append partial_pkt s sz;
141		if Partial.to_complete partial_pkt = 0 then (
142			let pkt = Packet.of_partialpkt partial_pkt in
143			con.partial_in <- init_partial_in ();
144			Queue.push pkt con.pkt_in;
145			newpacket := true
146		)
147	| NoHdr (i, buf)      ->
148		(* we complete the partial header *)
149		if sz > 0 then
150			String.blit s 0 buf (Partial.header_size () - i) sz;
151		con.partial_in <- if sz = i then
152			HaveHdr (Partial.of_string buf) else NoHdr (i - sz, buf)
153	);
154	!newpacket
155
156let newcon backend = {
157	backend = backend;
158	pkt_in = Queue.create ();
159	pkt_out = Queue.create ();
160	partial_in = init_partial_in ();
161	partial_out = "";
162	}
163
164let open_fd fd = newcon (Fd { fd = fd; })
165
166let open_mmap mmap notifyfct =
167	(* Advertise XENSTORE_SERVER_FEATURE_RECONNECTION *)
168	Xs_ring.set_server_features mmap (Xs_ring.Server_features.singleton Xs_ring.Server_feature.Reconnection);
169	newcon (Xenmmap {
170		mmap = mmap;
171		eventchn_notify = notifyfct;
172		work_again = false; })
173
174let close con =
175	match con.backend with
176	| Fd backend   -> Unix.close backend.fd
177	| Xenmmap backend -> Xenmmap.unmap backend.mmap
178
179let is_fd con =
180	match con.backend with
181	| Fd _   -> true
182	| Xenmmap _ -> false
183
184let is_mmap con = not (is_fd con)
185
186let output_len con = Queue.length con.pkt_out
187let has_new_output con = Queue.length con.pkt_out > 0
188let has_old_output con = String.length con.partial_out > 0
189
190let has_output con = has_new_output con || has_old_output con
191
192let peek_output con = Queue.peek con.pkt_out
193
194let input_len con = Queue.length con.pkt_in
195let has_in_packet con = Queue.length con.pkt_in > 0
196let get_in_packet con = Queue.pop con.pkt_in
197let has_more_input con =
198	match con.backend with
199	| Fd _         -> false
200	| Xenmmap backend -> backend.work_again
201
202let is_selectable con =
203	match con.backend with
204	| Fd _   -> true
205	| Xenmmap _ -> false
206
207let get_fd con =
208	match con.backend with
209	| Fd backend -> backend.fd
210	| Xenmmap _     -> raise (Failure "get_fd")
211