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