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
17 #include <sys/types.h>
18 #include <sys/stat.h>
19 #include <fcntl.h>
20 #include <unistd.h>
21 #include <errno.h>
22 #include <string.h>
23 #include <stdint.h>
24
25 #include <xenctrl.h>
26 #include <xen/io/xs_wire.h>
27
28 #include <caml/mlvalues.h>
29 #include <caml/memory.h>
30 #include <caml/alloc.h>
31 #include <caml/custom.h>
32 #include <caml/fail.h>
33 #include <caml/callback.h>
34
35 #include "mmap_stubs.h"
36
37 #define GET_C_STRUCT(a) ((struct mmap_interface *) a)
38
ml_interface_read(value ml_interface,value ml_buffer,value ml_len)39 CAMLprim value ml_interface_read(value ml_interface,
40 value ml_buffer,
41 value ml_len)
42 {
43 CAMLparam3(ml_interface, ml_buffer, ml_len);
44 CAMLlocal1(ml_result);
45
46 struct mmap_interface *interface = GET_C_STRUCT(ml_interface);
47 char *buffer = String_val(ml_buffer);
48 int len = Int_val(ml_len);
49 int result;
50
51 struct xenstore_domain_interface *intf = interface->addr;
52 XENSTORE_RING_IDX cons, prod; /* offsets only */
53 int total_data, data;
54 uint32_t connection;
55
56 cons = *(volatile uint32_t*)&intf->req_cons;
57 prod = *(volatile uint32_t*)&intf->req_prod;
58 connection = *(volatile uint32_t*)&intf->connection;
59
60 if (connection != XENSTORE_CONNECTED)
61 caml_raise_constant(*caml_named_value("Xb.Reconnect"));
62
63 xen_mb();
64
65 if ((prod - cons) > XENSTORE_RING_SIZE)
66 caml_failwith("bad connection");
67
68 /* Check for any pending data at all. */
69 total_data = prod - cons;
70 if (total_data == 0) {
71 /* No pending data at all. */
72 result = 0;
73 goto exit;
74 }
75 else if (total_data < len)
76 /* Some data - make a partial read. */
77 len = total_data;
78
79 /* Check whether data crosses the end of the ring. */
80 data = XENSTORE_RING_SIZE - MASK_XENSTORE_IDX(cons);
81 if (len < data)
82 /* Data within the remaining part of the ring. */
83 memcpy(buffer, intf->req + MASK_XENSTORE_IDX(cons), len);
84 else {
85 /* Data crosses the ring boundary. Read both halves. */
86 memcpy(buffer, intf->req + MASK_XENSTORE_IDX(cons), data);
87 memcpy(buffer + data, intf->req, len - data);
88 }
89
90 xen_mb();
91 intf->req_cons += len;
92 result = len;
93 exit:
94 ml_result = Val_int(result);
95 CAMLreturn(ml_result);
96 }
97
ml_interface_write(value ml_interface,value ml_buffer,value ml_len)98 CAMLprim value ml_interface_write(value ml_interface,
99 value ml_buffer,
100 value ml_len)
101 {
102 CAMLparam3(ml_interface, ml_buffer, ml_len);
103 CAMLlocal1(ml_result);
104
105 struct mmap_interface *interface = GET_C_STRUCT(ml_interface);
106 char *buffer = String_val(ml_buffer);
107 int len = Int_val(ml_len);
108 int result;
109
110 struct xenstore_domain_interface *intf = interface->addr;
111 XENSTORE_RING_IDX cons, prod;
112 int total_space, space;
113 uint32_t connection;
114
115 cons = *(volatile uint32_t*)&intf->rsp_cons;
116 prod = *(volatile uint32_t*)&intf->rsp_prod;
117 connection = *(volatile uint32_t*)&intf->connection;
118
119 if (connection != XENSTORE_CONNECTED)
120 caml_raise_constant(*caml_named_value("Xb.Reconnect"));
121
122 xen_mb();
123
124 if ((prod - cons) > XENSTORE_RING_SIZE)
125 caml_failwith("bad connection");
126
127 /* Check for space to write the full message. */
128 total_space = XENSTORE_RING_SIZE - (prod - cons);
129 if (total_space == 0) {
130 /* No space at all - exit having done nothing. */
131 result = 0;
132 goto exit;
133 }
134 else if (total_space < len)
135 /* Some space - make a partial write. */
136 len = total_space;
137
138 /* Check for space until the ring wraps. */
139 space = XENSTORE_RING_SIZE - MASK_XENSTORE_IDX(prod);
140 if (len < space)
141 /* Message fits inside the remaining part of the ring. */
142 memcpy(intf->rsp + MASK_XENSTORE_IDX(prod), buffer, len);
143 else {
144 /* Message wraps around the end of the ring. Write both halves. */
145 memcpy(intf->rsp + MASK_XENSTORE_IDX(prod), buffer, space);
146 memcpy(intf->rsp, buffer + space, len - space);
147 }
148
149 xen_mb();
150 intf->rsp_prod += len;
151 result = len;
152 exit:
153 ml_result = Val_int(result);
154 CAMLreturn(ml_result);
155 }
156
ml_interface_set_server_features(value interface,value v)157 CAMLprim value ml_interface_set_server_features(value interface, value v)
158 {
159 CAMLparam2(interface, v);
160 struct xenstore_domain_interface *intf = GET_C_STRUCT(interface)->addr;
161
162 intf->server_features = Int_val(v);
163
164 CAMLreturn(Val_unit);
165 }
166
ml_interface_get_server_features(value interface)167 CAMLprim value ml_interface_get_server_features(value interface)
168 {
169 CAMLparam1(interface);
170 struct xenstore_domain_interface *intf = GET_C_STRUCT(interface)->addr;
171
172 CAMLreturn(Val_int (intf->server_features));
173 }
174
ml_interface_close(value interface)175 CAMLprim value ml_interface_close(value interface)
176 {
177 CAMLparam1(interface);
178 struct xenstore_domain_interface *intf = GET_C_STRUCT(interface)->addr;
179 int i;
180
181 intf->req_cons = intf->req_prod = intf->rsp_cons = intf->rsp_prod = 0;
182 /* Ensure the unused space is full of invalid xenstore packets. */
183 for (i = 0; i < XENSTORE_RING_SIZE; i++) {
184 intf->req[i] = 0xff; /* XS_INVALID = 0xffff */
185 intf->rsp[i] = 0xff;
186 }
187 xen_mb ();
188 intf->connection = XENSTORE_CONNECTED;
189 CAMLreturn(Val_unit);
190 }
191