1 :(before "End Types")
  2 struct socket_t {
  3   int fd;
  4   sockaddr_in addr;
  5   bool polled;
  6   socket_t() {
  7     fd = 0;
  8     polled = false;
  9     bzero(&addr, sizeof(addr));
 10   }
 11 };
 12 
 13 :(before "End Primitive Recipe Declarations")
 14 _OPEN_CLIENT_SOCKET,
 15 :(before "End Primitive Recipe Numbers")
 16 put(Recipe_ordinal, "$open-client-socket", _OPEN_CLIENT_SOCKET);
 17 :(before "End Primitive Recipe Checks")
 18 case _OPEN_CLIENT_SOCKET: {
 19   if (SIZE(inst.ingredients) != 2) {
 20     raise << maybe(get(Recipe, r).name) << "'$open-client-socket' requires exactly two ingredients, but got '" << to_original_string(inst) << "'\n" << end();
 21     break;
 22   }
 23   if (!is_mu_text(inst.ingredients.at(0))) {
 24     raise << maybe(get(Recipe, r).name) << "first ingredient of '$open-client-socket' should be text (the hostname), but got '" << to_string(inst.ingredients.at(0)) << "'\n" << end();
 25     break;
 26   }
 27   if (!is_mu_number(inst.ingredients.at(1))) {
 28     raise << maybe(get(Recipe, r).name) << "second ingredient of '$open-client-socket' should be a number (the port of the hostname to connect to), but got '" << to_string(inst.ingredients.at(1)) << "'\n" << end();
 29     break;
 30   }
 31   if (SIZE(inst.products) != 1) {
 32     raise << maybe(get(Recipe, r).name) << "'$open-client-socket' requires exactly one product, but got '" << to_original_string(inst) << "'\n" << end();
 33     break;
 34   }
 35   if (!is_mu_number(inst.products.at(0))) {
 36     raise << maybe(get(Recipe, r).name) << "first product of '$open-client-socket' should be a number (socket handle), but got '" << to_string(inst.products.at(0)) << "'\n" << end();
 37     break;
 38   }
 39   break;
 40 }
 41 :(before "End Primitive Recipe Implementations")
 42 case _OPEN_CLIENT_SOCKET: {
 43   string host = read_mu_text(ingredients.at(0).at(/*skip alloc id*/1));
 44   int port = ingredients.at(1).at(0);
 45   socket_t* client = client_socket(host, port);
 46   products.resize(1);
 47   if (client->fd < 0) {  // error
 48     delete client;
 49     products.at(0).push_back(0);
 50     break;
 51   }
 52   long long int result = reinterpret_cast<long long int>(client);
 53   products.at(0).push_back(static_cast<double>(result));
 54   break;
 55 }
 56 :(code)
 57 socket_t* client_socket(const string& host, int port) {
 58   socket_t* result = new socket_t;
 59   result->fd = socket(AF_INET, SOCK_STREAM, 0);
 60   if (result->fd < 0) {
 61     raise << "Failed to create socket.\n" << end();
 62     return result;
 63   }
 64   result->addr.sin_family = AF_INET;
 65   hostent* tmp = gethostbyname(host.c_str());
 66   bcopy(tmp->h_addr, reinterpret_cast<char*>(&result->addr.sin_addr.s_addr), tmp->h_length);
 67   result->addr.sin_port = htons(port);
 68   if (connect(result->fd, reinterpret_cast<sockaddr*>(&result->addr), sizeof(result->addr)) < 0) {
 69     close(result->fd);
 70     result->fd = -1;
 71     raise << "Failed to connect to " << host << ':' << port << '\n' << end();
 72   }
 73   return result;
 74 }
 75 
 76 :(before "End Primitive Recipe Declarations")
 77 _OPEN_SERVER_SOCKET,
 78 :(before "End Primitive Recipe Numbers")
 79 put(Recipe_ordinal, "$open-server-socket", _OPEN_SERVER_SOCKET);
 80 :(before "End Primitive Recipe Checks")
 81 case _OPEN_SERVER_SOCKET: {
 82   if (SIZE(inst.ingredients) != 1) {
 83     raise << maybe(get(Recipe, r).name) << "'$open-server-socket' requires exactly one ingredient (the port to listen for requests on), but got '" << to_original_string(inst) << "'\n" << end();
 84     break;
 85   }
 86   if (!is_mu_number(inst.ingredients.at(0))) {
 87     raise << maybe(get(Recipe, r).name) << "first ingredient of '$open-server-socket' should be a number, but got '" << to_string(inst.ingredients.at(0)) << "'\n" << end();
 88     break;
 89   }
 90   if (SIZE(inst.products) != 1) {
 91     raise << maybe(get(Recipe, r).name) << "'$open-server-socket' requires exactly one product, but got '" << to_original_string(inst) << "'\n" << end();
 92     break;
 93   }
 94   if (!is_mu_number(inst.products.at(0))) {
 95     raise << maybe(get(Recipe, r).name) << "first product of '$open-server-socket' should be a number (file handle), but got '" << to_string(inst.products.at(0)) << "'\n" << end();
 96     break;
 97   }
 98   break;
 99 }
100 :(before "End Primitive Recipe Implementations")
101 case _OPEN_SERVER_SOCKET: {
102   int port = ingredients.at(0).at(0);
103   socket_t* server = server_socket(port);
104   products.resize(1);
105   if (server->fd < 0) {
106     delete server;
107     products.at(0).push_back(0);
108     break;
109   }
110   long long int result = reinterpret_cast<long long int>(server);
111   products.at(0).push_back(static_cast<double>(result));
112   break;
113 }
114 :(code)
115 socket_t* server_socket(int port) {
116   socket_t* result = new socket_t;
117   result->fd = socket(AF_INET, SOCK_STREAM, 0);
118   if (result->fd < 0) {
119     raise << "Failed to create server socket.\n" << end();
120     return result;
121   }
122   int dummy = 0;
123   setsockopt(result->fd, SOL_SOCKET, SO_REUSEADDR, &dummy, sizeof(dummy));
124   result->addr.sin_family = AF_INET;
125   result->addr.sin_addr.s_addr = Current_scenario ? htonl(INADDR_LOOPBACK) : INADDR_ANY;  // run tests without running afoul of any firewall
126   result->addr.sin_port = htons(port);
127   if (bind(result->fd, reinterpret_cast<sockaddr*>(&result->addr), sizeof(result->addr)) >= 0) {
128     listen(result->fd, /*queue length*/5);
129   }
130   else {
131     close(result->fd);
132     result->fd = -1;
133     raise << "Failed to bind result socket to port " << port << ". Something's already using that port.\n" << end();
134   }
135   return result;
136 }
137 
138 :(before "End Primitive Recipe Declarations")
139 _ACCEPT,
140 :(before "End Primitive Recipe Numbers")
141 put(Recipe_ordinal, "$accept", _ACCEPT);
142 :(before "End Primitive Recipe Checks")
143 case _ACCEPT: {
144   if (SIZE(inst.ingredients) != 1) {
145     raise << maybe(get(Recipe, r).name) << "'$accept' requires exactly one ingredient, but got '" << to_original_string(inst) << "'\n" << end();
146     break;
147   }
148   if (!is_mu_number(inst.ingredients.at(0))) {
149     raise << maybe(get(Recipe, r).name) << "first ingredient of '$accept' should be a number, but got '" << to_string(inst.ingredients.at(0)) << "'\n" << end();
150     break;
151   }
152   if (SIZE(inst.products) != 1) {
153     raise << maybe(get(Recipe, r).name) << "'$accept' requires exactly one product, but got '" << to_original_string(inst) << "'\n" << end();
154     break;
155   }
156   if (!is_mu_number(inst.products.at(0))) {
157     raise << maybe(get(Recipe, r).name) << "first product of '$accept' should be a number (file handle), but got '" << to_string(inst.products.at(0)) << "'\n" << end();
158     break;
159   }
160   break;
161 }
162 :(before "End Primitive Recipe Implementations")
163 case _ACCEPT: {
164   products.resize(2);
165   products.at(1).push_back(ingredients.at(0).at(0));  // indicate it modifies its ingredient
166   long long int x = static_cast<long long int>(ingredients.at(0).at(0));
167   socket_t* server = reinterpret_cast<socket_t*>(x);
168   if (server) {
169     socket_t* session = accept_session(server);
170     long long int result = reinterpret_cast<long long int>(session);
171     products.at(0).push_back(static_cast<double>(result));
172   }
173   else {
174     products.at(0).push_back(0);
175   }
176   break;
177 }
178 :(code)
179 socket_t* accept_session(socket_t* server) {
180   if (server->fd == 0) return NULL;
181   socket_t* result = new socket_t;
182   socklen_t dummy = sizeof(result->addr);
183   result->fd = accept(server->fd, reinterpret_cast<sockaddr*>(&result->addr), &dummy);
184   return result;
185 }
186 
187 :(before "End Primitive Recipe Declarations")
188 _READ_FROM_SOCKET,
189 :(before "End Primitive Recipe Numbers")
190 put(Recipe_ordinal, "$read-from-socket", _READ_FROM_SOCKET);
191 :(before "End Primitive Recipe Checks")
192 case _READ_FROM_SOCKET: {
193   if (SIZE(inst.ingredients) != 1) {
194     raise << maybe(get(Recipe, r).name) << "'$read-from-socket' requires exactly one ingredient, but got '" << to_original_string(inst) << "'\n" << end();
195     break;
196   }
197   if (!is_mu_number(inst.ingredients.at(0))) {
198     raise << maybe(get(Recipe, r).name) << "first ingredient of '$read-from-socket' should be a number (socket), but got '" << to_string(inst.ingredients.at(0)) << "'\n" << end();
199     break;
200   }
201   int nprod = SIZE(inst.products);
202   if (nprod == 0 || nprod > 4) {
203     raise << maybe(get(Recipe, r).name) << "'$read-from-socket' requires 1-4 products, but got '" << to_original_string(inst) << "'\n" << end();
204     break;
205   }
206   if (!is_mu_character(inst.products.at(0))) {
207     raise << maybe(get(Recipe, r).name) << "first product of '$read-from-socket' should be a character, but got '" << to_string(inst.products.at(0)) << "'\n" << end();
208     break;
209   }
210   if (nprod > 1 && !is_mu_boolean(inst.products.at(1))) {
211     raise << maybe(get(Recipe, r).name) << "second product of '$read-from-socket' should be a boolean (data received?), but got '" << to_string(inst.products.at(1)) << "'\n" << end();
212     break;
213   }
214   if (nprod > 2 && !is_mu_boolean(inst.products.at(2))) {
215     raise << maybe(get(Recipe, r).name) << "third product of '$read-from-socket' should be a boolean (eof?), but got '" << to_string(inst.products.at(2)) << "'\n" << end();
216     break;
217   }
218   if (nprod > 3 && !is_mu_number(inst.products.at(3))) {
219     raise << maybe(get(Recipe, r).name) << "fourth product of '$read-from-socket' should be a number (error code), but got '" << to_string(inst.products.at(3)) << "'\n" << end();
220     break;
221   }
222   break;
223 }
224 :(before "End Primitive Recipe Implementations")
225 case _READ_FROM_SOCKET: {
226   products.resize(4);
227   long long int x = static_cast<long long int>(ingredients.at(0).at(0));
228   socket_t* socket = reinterpret_cast<socket_t*>(x);
229   // 1. we'd like to simply read() from the socket
230   // however read() on a socket never returns EOF, so we wouldn't know when to stop
231   // 2. recv() can signal EOF, but it also signals "no data yet" in the beginning
232   // so use poll() in the beginning to wait for data before calling recv()
233   // 3. but poll() will block on EOF, so only use poll() on the very first
234   // $read-from-socket on a socket
235   //
236   // Also, there was an unresolved issue where attempts to read() a small
237   // number of bytes (less than 447 on Linux and Mac) would cause browsers to
238   // prematurely close the connection. See commit 3403. That seems to be gone
239   // after moving to recv()+poll(). It was never observed on OpenBSD.
240   if (!socket->polled) {
241     pollfd p;
242     bzero(&p, sizeof(p));
243     p.fd = socket->fd;
244     p.events = POLLIN | POLLHUP;
245     int poll_result = poll(&p, /*num pollfds*/1, /*timeout*/100/*ms*/);
246     if (poll_result == 0) {
247       products.at(0).push_back(/*no data*/0);
248       products.at(1).push_back(/*found*/false);
249       products.at(2).push_back(/*eof*/false);
250       products.at(3).push_back(/*error*/0);
251       break;
252     }
253     else if (poll_result < 0) {
254       int error_code = errno;
255       raise << maybe(current_recipe_name()) << "error in $read-from-socket\n" << end();
256       products.at(0).push_back(/*no data*/0);
257       products.at(1).push_back(/*found*/false);
258       products.at(2).push_back(/*eof*/false);
259       products.at(3).push_back(error_code);
260       break;
261     }
262     socket->polled = true;
263   }
264   char c = '\0';
265   int error_code = 0;
266   int bytes_read = recv(socket->fd, &c, /*single byte*/1, MSG_DONTWAIT);
267   if (bytes_read < 0) error_code = errno;
268 //?   if (error_code) {
269 //?     ostringstream out;
270 //?     out << "error in $read-from-socket " << socket->fd;
271 //?     perror(out.str().c_str());
272 //?   }
273   products.at(0).push_back(c);
274   products.at(1).push_back(/*found*/true);
275   products.at(2).push_back(/*eof*/bytes_read <= 0);
276   products.at(3).push_back(error_code);
277   break;
278 }
279 
280 :(before "End Primitive Recipe Declarations")
281 _WRITE_TO_SOCKET,
282 :(before "End Primitive Recipe Numbers")
283 put(Recipe_ordinal, "$write-to-socket", _WRITE_TO_SOCKET);
284 :(before "End Primitive Recipe Checks")
285 case _WRITE_TO_SOCKET: {
286   if (SIZE(inst.ingredients) != 2) {
287     raise << maybe(get(Recipe, r).name) << "'$write-to-socket' requires exactly two ingredient, but got '" << to_original_string(inst) << "'\n" << end();
288     break;
289   }
290   break;
291 }
292 :(before "End Primitive Recipe Implementations")
293 case _WRITE_TO_SOCKET: {
294   long long int x = static_cast<long long int>(ingredients.at(0).at(0));
295   socket_t* socket = reinterpret_cast<socket_t*>(x);
296   // write just one character at a time to the socket
297   long long int y = static_cast<long long int>(ingredients.at(1).at(0));
298   char c = static_cast<char>(y);
299   if (write(socket->fd, &c, 1) != 1) {
300     raise << maybe(current_recipe_name()) << "failed to write to socket\n" << end();
301     exit(0);
302   }
303   products.resize(1);
304   products.at(0).push_back(ingredients.at(0).at(0));
305   break;
306 }
307 
308 :(before "End Primitive Recipe Declarations")
309 _CLOSE_SOCKET,
310 :(before "End Primitive Recipe Numbers")
311 put(Recipe_ordinal, "$close-socket", _CLOSE_SOCKET);
312 :(before "End Primitive Recipe Checks")
313 case _CLOSE_SOCKET: {
314   if (SIZE(inst.ingredients) != 1) {
315     raise << maybe(get(Recipe, r).name) << "'$close-socket' requires exactly two ingredient, but got '" << to_original_string(inst) << "'\n" << end();
316     break;
317   }
318   if (!is_mu_number(inst.ingredients.at(0))) {
319     raise << maybe(get(Recipe, r).name) << "first ingredient of '$close-socket' should be a number, but got '" << to_string(inst.ingredients.at(0)) << "'\n" << end();
320     break;
321   }
322   if (SIZE(inst.products) != 1) {
323     raise << maybe(get(Recipe, r).name) << "'$close-socket' requires exactly one product, but got '" << to_original_string(inst) << "'\n" << end();
324     break;
325   }
326   if (inst.products.at(0).name != inst.ingredients.at(0).name) {
327     raise << maybe(get(Recipe, r).name) << "product of '$close-socket' must be first ingredient '" << inst.ingredients.at(0).original_string << "', but got '" << inst.products.at(0).original_string << "'\n" << end();
328     break;
329   }
330   break;
331 }
332 :(before "End Primitive Recipe Implementations")
333 case _CLOSE_SOCKET: {
334   long long int x = static_cast<long long int>(ingredients.at(0).at(0));
335   socket_t* socket = reinterpret_cast<socket_t*>(x);
336   close(socket->fd);
337   delete socket;
338   products.resize(1);
339   products.at(0).push_back(0);  // make sure we can't reuse the socket
340   break;
341 }
342 
343 :(before "End Includes")
344 #include <netinet/in.h>
345 #include <netdb.h>
346 #include <poll.h>
347 #include <sys/socket.h>
348 #include <unistd.h>