1 /*
2 * R : A Computer Language for Statistical Data Analysis
3 * Copyright (C) 2009-2021 The R Core Team.
4 *
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation; either version 2 of the License, or
8 * (at your option) any later version.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, a copy is available at
17 * https://www.R-project.org/Licenses/
18 */
19
20 /* This is a small HTTP server that serves requests by evaluating
21 * the httpd() function and passing the result to the browser. */
22
23 /* Example:
24 httpd <- function(path,query=NULL,...) {
25 cat("Request for:", path,"\n"); print(query);
26 list(paste("Hello, <b>world</b>!<p>You asked for \"",path,"\".",sep=''))
27 }
28 .Internal(startHTTPD("127.0.0.1",8080))
29 */
30
31 /* size of the line buffer for each worker (request and header only)
32 * requests that have longer headers will be rejected with 413 */
33 #define LINE_BUF_SIZE 1024
34
35 /* maximum number of active workers (parallel connections)
36 * when exceeded the server closes new connections */
37 #define MAX_WORKERS 32
38
39
40 /* --- Rhttpd implementation --- */
41
42 #ifdef HAVE_CONFIG_H
43 #include <config.h>
44 #endif
45
46 #include <Defn.h>
47 #include <Fileio.h>
48 #include <Rconnections.h>
49
50 #include <stdlib.h>
51 #include <stdio.h>
52 #include <string.h>
53
54 #include <Rmodules/Rinternet.h>
55
56 #define HttpdServerActivity 8
57 #define HttpdWorkerActivity 9
58
59 /* this is orignally from sisock.h - system independent sockets */
60
61 #ifndef _WIN32
62 # include <R_ext/eventloop.h>
63 # include <sys/types.h>
64 # ifdef HAVE_UNISTD_H
65 # include <unistd.h>
66 # endif
67 # include <netdb.h>
68 # include <sys/socket.h>
69 # include <netinet/in.h>
70 # include <arpa/inet.h>
71 # include <errno.h>
72
73 # define sockerrno errno
74 # define SOCKET int
75 # define INVALID_SOCKET (-1)
76 # define closesocket(A) close(A)
77 # define initsocks()
78 # define donesocks()
79 #else
80 /* --- Windows-only --- */
81 # include <windows.h>
82 # include <winsock.h>
83 # include <string.h>
84
85 # define sockerrno WSAGetLastError()
86
87
initsocks(void)88 static int initsocks(void)
89 {
90 WSADATA dt;
91 /* initialize WinSock 1.1 */
92 return (WSAStartup(0x0101, &dt)) ? -1 : 0;
93 }
94
95 # define donesocks() WSACleanup()
96 typedef int socklen_t;
97
98 #endif /* _WIN32 */
99
100 /* --- system-independent part --- */
101
102 #define SA struct sockaddr
103 #define SAIN struct sockaddr_in
104
build_sin(struct sockaddr_in * sa,const char * ip,int port)105 static struct sockaddr *build_sin(struct sockaddr_in *sa, const char *ip, int port) {
106 memset(sa, 0, sizeof(struct sockaddr_in));
107 sa->sin_family = AF_INET;
108 sa->sin_port = htons(port);
109 sa->sin_addr.s_addr = (ip) ? inet_addr(ip) : htonl(INADDR_ANY);
110 return (struct sockaddr*)sa;
111 }
112
113 /* --- END of sisock.h --- */
114
115 /* debug output - change the DBG(X) X to enable debugging output */
116 #define DBG(X)
117
118 /* --- httpd --- */
119
120 #define PART_REQUEST 0
121 #define PART_HEADER 1
122 #define PART_BODY 2
123
124 #define METHOD_POST 1
125 #define METHOD_GET 2
126 #define METHOD_HEAD 3
127 #define METHOD_OTHER 8 /* for custom requests only */
128
129 /* attributes of a connection/worker */
130 #define CONNECTION_CLOSE 0x01 /* Connection: close response behavior is requested */
131 #define HOST_HEADER 0x02 /* headers contained Host: header (required for HTTP/1.1) */
132 #define HTTP_1_0 0x04 /* the client requested HTTP/1.0 */
133 #define CONTENT_LENGTH 0x08 /* Content-length: was specified in the headers */
134 #define THREAD_OWNED 0x10 /* the worker is owned by a thread and cannot removed */
135 #define THREAD_DISPOSE 0x20 /* the thread should dispose of the worker */
136 #define CONTENT_TYPE 0x40 /* message has a specific content type set */
137 #define CONTENT_FORM_UENC 0x80 /* message content type is application/x-www-form-urlencoded */
138
139 struct buffer {
140 struct buffer *next, *prev;
141 size_t size, length;
142 char data[1];
143 };
144
145 /*
146 All processing inside R is executed on the main R thread via
147 R_ProcessEvents (on Unix via event handlers, on Windows via a message
148 window).
149
150 We still have to protect re-entrance and not continue processing if there
151 is a worker inside R already. If we did not then another client connection
152 would trigger handler and pile up eval on top of the stack, leading to
153 exhaustion very quickly and a big mess.
154 */
155 #ifdef _WIN32
156 static HANDLE process_request_mutex;
157 #else
158 static int in_process;
159 #endif
160
161 /* --- connection/worker structure holding all data for an active connection --- */
162 typedef struct httpd_conn {
163 SOCKET sock; /* client socket */
164 struct in_addr peer; /* IP address of the peer */
165 #ifdef _WIN32
166 HANDLE thread; /* worker thread */
167 #else
168 InputHandler *ih; /* worker input handler */
169 #endif
170 char line_buf[LINE_BUF_SIZE]; /* line buffer (used for request and headers) */
171 char *url, *body; /* URL and request body */
172 char *content_type; /* content type (if set) */
173 size_t line_pos, body_pos; /* positions in the buffers */
174 long content_length; /* desired content length */
175 char part, method, attr; /* request part, method and connection attributes */
176 struct buffer *headers; /* buffer holding header lines */
177 } httpd_conn_t;
178
179 #define IS_HTTP_1_1(C) (((C)->attr & HTTP_1_0) == 0)
180
181 /* returns the HTTP/x.x string for a given connection - we support 1.0 and 1.1 only */
182 #define HTTP_SIG(C) (IS_HTTP_1_1(C) ? "HTTP/1.1" : "HTTP/1.0")
183
184 /* --- static list of currently active workers --- */
185 static httpd_conn_t *workers[MAX_WORKERS];
186
187 /* --- flag determining whether one-time initialization is yet to be performed --- */
188 static int needs_init = 1;
189
190 #ifdef _WIN32
191 #define WM_RHTTP_CALLBACK ( WM_USER + 1 )
192 static HWND message_window;
193 static LRESULT CALLBACK
194 RhttpdWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam);
195 #ifndef HWND_MESSAGE
196 #define HWND_MESSAGE ((HWND)-3) /* NOTE: this is supported by W2k/XP and up only! */
197 #endif
198 #endif
199
first_init()200 static void first_init()
201 {
202 initsocks();
203 #ifdef _WIN32
204 /* create a dummy message-only window for synchronization with the
205 * main event loop */
206 HINSTANCE instance = GetModuleHandle(NULL);
207 LPCTSTR class = "Rhttpd";
208 WNDCLASS wndclass = { 0, RhttpdWindowProc, 0, 0, instance, NULL, 0, 0,
209 NULL, class };
210 RegisterClass(&wndclass);
211 message_window = CreateWindow(class, "Rhttpd", 0, 1, 1, 1, 1,
212 HWND_MESSAGE, NULL, instance, NULL);
213
214 process_request_mutex = CreateMutex(NULL, FALSE, NULL);
215 if (!process_request_mutex)
216 DBG(printf("Mutex creation failed\n"));
217 #endif
218 needs_init = 0;
219 }
220
221 /* free buffers starting from the tail(!!) */
free_buffer(struct buffer * buf)222 static void free_buffer(struct buffer *buf) {
223 if (!buf) return;
224 if (buf->prev) free_buffer(buf->prev);
225 free(buf);
226 }
227
228 /* allocate a new buffer */
alloc_buffer(int size,struct buffer * parent)229 static struct buffer *alloc_buffer(int size, struct buffer *parent) {
230 struct buffer *buf = (struct buffer*) malloc(sizeof(struct buffer) + size);
231 if (!buf) return buf;
232 buf->next = 0;
233 buf->prev = parent;
234 if (parent) parent->next = buf;
235 buf->size = size;
236 buf->length = 0;
237 return buf;
238 }
239
240 /* convert doubly-linked buffers into one big raw vector */
collect_buffers(struct buffer * buf)241 static SEXP collect_buffers(struct buffer *buf) {
242 SEXP res;
243 char *dst;
244 int len = 0;
245 if (!buf) return allocVector(RAWSXP, 0);
246 while (buf->prev) { /* count the total length and find the root */
247 len += buf->length;
248 buf = buf->prev;
249 }
250 res = allocVector(RAWSXP, len + buf->length);
251 dst = (char*) RAW(res);
252 while (buf) {
253 memcpy(dst, buf->data, buf->length);
254 dst += buf->length;
255 buf = buf->next;
256 }
257 return res;
258 }
259
finalize_worker(httpd_conn_t * c)260 static void finalize_worker(httpd_conn_t *c)
261 {
262 DBG(printf("finalizing worker %p\n", (void*) c));
263 #ifndef _WIN32
264 if (c->ih) {
265 removeInputHandler(&R_InputHandlers, c->ih);
266 c->ih = NULL;
267 }
268 #endif
269 if (c->url) {
270 free(c->url);
271 c->url = NULL;
272 }
273
274 if (c->body) {
275 free(c->body);
276 c->body = NULL;
277 }
278
279 if (c->content_type) {
280 free(c->content_type);
281 c->content_type = NULL;
282 }
283 if (c->headers) {
284 free_buffer(c->headers);
285 c->headers = NULL;
286 }
287 if (c->sock != INVALID_SOCKET) {
288 closesocket(c->sock);
289 c->sock = INVALID_SOCKET;
290 }
291 }
292
293 /* adds a worker to the worker list and returns 0. If the list is
294 * full, the worker is finalized and returns -1.
295 * Note that we don't need locking, because add_worker is guaranteed
296 * to be called by the same thread (server thread).
297 */
add_worker(httpd_conn_t * c)298 static int add_worker(httpd_conn_t *c) {
299 unsigned int i = 0;
300 for (; i < MAX_WORKERS; i++)
301 if (!workers[i]) {
302 #ifdef _WIN32
303 DBG(printf("registering worker %p as %d (thread=0x%x)\n", (void*) c, i, (int) c->thread));
304 #else
305 DBG(printf("registering worker %p as %d (handler=%p)\n", (void*) c, i, (void*) c->ih));
306 #endif
307 workers[i] = c;
308 return 0;
309 }
310 /* FIXME: ok no more space for a new worker - what do we do now?
311 * for now we just drop it on the floor .. */
312 finalize_worker(c);
313 free(c);
314 return -1;
315 }
316
317 /* finalize worker, remove it from the list and free the memory. If
318 * the worker is owned by a thread, it is not finalized and the
319 * THREAD_DISPOSE flag is set instead. */
remove_worker(httpd_conn_t * c)320 static void remove_worker(httpd_conn_t *c)
321 {
322 unsigned int i = 0;
323 if (!c) return;
324 if (c->attr & THREAD_OWNED) { /* if the worker is used by a
325 * thread, we can only signal for
326 * its removal */
327 c->attr |= THREAD_DISPOSE;
328 return;
329 }
330 finalize_worker(c);
331 for (; i < MAX_WORKERS; i++)
332 if (workers[i] == c)
333 workers[i] = NULL;
334 DBG(printf("removing worker %p\n", (void*) c));
335 free(c);
336 }
337
338 #ifndef Win32
339 extern int R_ignore_SIGPIPE; /* defined in src/main/main.c on unix */
340 #else
341 static int R_ignore_SIGPIPE; /* for simplicity of the code below */
342 #endif
343
send_response(SOCKET s,const char * buf,size_t len)344 static int send_response(SOCKET s, const char *buf, size_t len)
345 {
346 unsigned int i = 0;
347 /* we have to tell R to ignore SIGPIPE otherwise it can raise an error
348 and get us into deep trouble */
349 R_ignore_SIGPIPE = 1;
350 while (i < len) {
351 ssize_t n = send(s, buf + i, len - i, 0);
352 if (n < 1) {
353 R_ignore_SIGPIPE = 0;
354 return -1;
355 }
356 i += n;
357 }
358 R_ignore_SIGPIPE = 0;
359 return 0;
360 }
361
362 /* sends HTTP/x.x plus the text (which should be of the form " XXX ...") */
send_http_response(httpd_conn_t * c,const char * text)363 static int send_http_response(httpd_conn_t *c, const char *text) {
364 char buf[96];
365 const char *s = HTTP_SIG(c);
366 size_t l = strlen(text);
367 ssize_t res;
368 /* reduce the number of packets by sending the payload en-block from buf */
369 if (l < sizeof(buf) - 10) {
370 strcpy(buf, s);
371 strcpy(buf + 8, text);
372 return send_response(c->sock, buf, l + 8);
373 }
374 R_ignore_SIGPIPE = 1;
375 res = send(c->sock, s, 8, 0);
376 R_ignore_SIGPIPE = 0;
377 if (res < 8) return -1;
378 return send_response(c->sock, text, strlen(text));
379 }
380
381 /* decode URI in place (decoding never expands) */
uri_decode(char * s)382 static void uri_decode(char *s)
383 {
384 char *t = s;
385 while (*s) {
386 if (*s == '+') { /* + -> SPC */
387 *(t++) = ' '; s++;
388 } else if (*s == '%') {
389 unsigned char ec = 0;
390 s++;
391 if (*s >= '0' && *s <= '9') ec |= ((unsigned char)(*s - '0')) << 4;
392 else if (*s >= 'a' && *s <= 'f') ec |= ((unsigned char)(*s - 'a' + 10)) << 4;
393 else if (*s >= 'A' && *s <= 'F') ec |= ((unsigned char)(*s - 'A' + 10)) << 4;
394 if (*s) s++;
395 if (*s >= '0' && *s <= '9') ec |= (unsigned char)(*s - '0');
396 else if (*s >= 'a' && *s <= 'f') ec |= (unsigned char)(*s - 'a' + 10);
397 else if (*s >= 'A' && *s <= 'F') ec |= (unsigned char)(*s - 'A' + 10);
398 if (*s) s++;
399 *(t++) = (char) ec;
400 } else *(t++) = *(s++);
401 }
402 *t = 0;
403 }
404
405 /* parse a query string into a named character vector - must NOT be
406 * URI decoded */
parse_query(char * query)407 static SEXP parse_query(char *query)
408 {
409 int parts = 0;
410 SEXP res, names;
411 char *s = query, *key = 0, *value = query, *t = query;
412 while (*s) {
413 if (*s == '&') parts++;
414 s++;
415 }
416 parts++;
417 res = PROTECT(allocVector(STRSXP, parts));
418 names = PROTECT(allocVector(STRSXP, parts));
419 s = query;
420 parts = 0;
421 while (1) {
422 if (*s == '=' && !key) { /* first '=' in a part */
423 key = value;
424 *(t++) = 0;
425 value = t;
426 s++;
427 } else if (*s == '&' || !*s) { /* next part */
428 int last_entry = !*s;
429 *(t++) = 0;
430 if (!key) key = "";
431 SET_STRING_ELT(names, parts, mkChar(key));
432 SET_STRING_ELT(res, parts, mkChar(value));
433 parts++;
434 if (last_entry) break;
435 key = 0;
436 value = t;
437 s++;
438 } else if (*s == '+') { /* + -> SPC */
439 *(t++) = ' '; s++;
440 } else if (*s == '%') { /* we cannot use uri_decode becasue we need &/= *before* decoding */
441 unsigned char ec = 0;
442 s++;
443 if (*s >= '0' && *s <= '9') ec |= ((unsigned char)(*s - '0')) << 4;
444 else if (*s >= 'a' && *s <= 'f') ec |= ((unsigned char)(*s - 'a' + 10)) << 4;
445 else if (*s >= 'A' && *s <= 'F') ec |= ((unsigned char)(*s - 'A' + 10)) << 4;
446 if (*s) s++;
447 if (*s >= '0' && *s <= '9') ec |= (unsigned char)(*s - '0');
448 else if (*s >= 'a' && *s <= 'f') ec |= (unsigned char)(*s - 'a' + 10);
449 else if (*s >= 'A' && *s <= 'F') ec |= (unsigned char)(*s - 'A' + 10);
450 if (*s) s++;
451 *(t++) = (char) ec;
452 } else *(t++) = *(s++);
453 }
454 setAttrib(res, R_NamesSymbol, names);
455 UNPROTECT(2);
456 return res;
457 }
458
459 static SEXP R_ContentTypeName, R_HandlersName;
460
461 /* create an object representing the request body. It is NULL if the body is empty (or zero length).
462 * In the case of a URL encoded form it will have the same shape as the query string (named string vector).
463 * In all other cases it will be a raw vector with a "content-type" attribute (if specified in the headers) */
parse_request_body(httpd_conn_t * c)464 static SEXP parse_request_body(httpd_conn_t *c) {
465 if (!c || !c->body) return R_NilValue;
466
467 if (c->attr & CONTENT_FORM_UENC) { /* URL encoded form - return parsed form */
468 c->body[c->content_length] = 0; /* the body is guaranteed to have an extra byte for the termination */
469 return parse_query(c->body);
470 } else { /* something else - pass it as a raw vector */
471 SEXP res = PROTECT(Rf_allocVector(RAWSXP, c->content_length));
472 if (c->content_length)
473 memcpy(RAW(res), c->body, c->content_length);
474 if (c->content_type) { /* attach the content type so it can be interpreted */
475 if (!R_ContentTypeName) R_ContentTypeName = install("content-type");
476 setAttrib(res, R_ContentTypeName, mkString(c->content_type));
477 }
478 UNPROTECT(1);
479 return res;
480 }
481 }
482
483 #ifdef _WIN32
484 /* on Windows we have to guarantee that process_request is performed
485 * on the main thread, so we have to dispatch it through a message */
486 static void process_request_main_thread(httpd_conn_t *c);
487
process_request(httpd_conn_t * c)488 static void process_request(httpd_conn_t *c)
489 {
490 if (WaitForSingleObject(process_request_mutex, INFINITE) != 0) {
491 DBG(printf("Acquiring mutex failed\n"));
492 /* (very) unexpected error, maybe we're shutting down? */
493 return;
494 }
495
496 /* SendMessage is synchronous, so it will wait until the message
497 * is processed */
498 DBG(Rprintf("enqueuing process_request_main_thread\n"));
499 SendMessage(message_window, WM_RHTTP_CALLBACK, 0, (LPARAM) c);
500 DBG(Rprintf("process_request_main_thread returned\n"));
501
502 ReleaseMutex(process_request_mutex);
503 }
504 #define process_request process_request_main_thread
505 #endif
506
507 /* finalize a request - essentially for HTTP/1.0 it means that
508 * we have to close the connection */
fin_request(httpd_conn_t * c)509 static void fin_request(httpd_conn_t *c) {
510 if (!IS_HTTP_1_1(c))
511 c->attr |= CONNECTION_CLOSE;
512 }
513
514 static SEXP custom_handlers_env;
515
516 /* returns a httpd handler (closure) for a given path. As a special case
517 * it can return a symbol that will be resolved in the "tools" namespace.
518 * currently it allows custom handlers for paths of the form
519 * /custom/<name>[/.*] where <name> must less than 64 characters long
520 * and is matched against closures in tools:::.httpd.handlers.env */
handler_for_path(const char * path)521 static SEXP handler_for_path(const char *path) {
522 if (path && !strncmp(path, "/custom/", 8)) { /* starts with /custom/ ? */
523 const char *c = path + 8, *e = c;
524 while (*c && *c != '/') c++; /* find out the name */
525 if (c - e > 0 && c - e < 64) { /* if it's 1..63 chars long, proceed */
526 char fn[64];
527 memcpy(fn, e, c - e); /* create a local C string with the name for the install() call */
528 fn[c - e] = 0;
529 DBG(Rprintf("handler_for_path('%s'): looking up custom handler '%s'\n", path, fn));
530 /* we cache custom_handlers_env so in case it has not been loaded yet, fetch it */
531 if (!custom_handlers_env) {
532 if (!R_HandlersName) R_HandlersName = install(".httpd.handlers.env");
533 SEXP toolsNS = PROTECT(R_FindNamespace(mkString("tools")));
534 custom_handlers_env = eval(R_HandlersName, toolsNS);
535 UNPROTECT(1); /* toolsNS */
536 }
537 /* we only proceed if .httpd.handlers.env really exists */
538 if (TYPEOF(custom_handlers_env) == ENVSXP) {
539 SEXP cl = findVarInFrame3(custom_handlers_env, install(fn), TRUE);
540 if (cl != R_UnboundValue && TYPEOF(cl) == CLOSXP) /* we need a closure */
541 return cl;
542 }
543 }
544 }
545 DBG(Rprintf(" - falling back to default httpd\n"));
546 return install("httpd");
547 }
548
549 /* process a request by calling the httpd() function in R */
process_request_(void * ptr)550 static void process_request_(void *ptr)
551 {
552 httpd_conn_t *c = (httpd_conn_t*) ptr;
553 const char *ct = "text/html";
554 char *query = 0, *s;
555 SEXP sHeaders = R_NilValue;
556 int code = 200;
557 DBG(Rprintf("process request for %p\n", (void*) c));
558 if (!c || !c->url) return; /* if there is not enough to process, bail out */
559 s = c->url;
560 while (*s && *s != '?') s++; /* find the query part */
561 if (*s) {
562 *(s++) = 0;
563 query = s;
564 }
565 uri_decode(c->url); /* decode the path part */
566 { /* construct "try(httpd(url, query, body), silent=TRUE)" */
567 SEXP sTrue = PROTECT(ScalarLogical(TRUE));
568 SEXP sBody = PROTECT(parse_request_body(c));
569 SEXP sQuery = PROTECT(query ? parse_query(query) : R_NilValue);
570 SEXP sReqHeaders = PROTECT(c->headers ? collect_buffers(c->headers) : R_NilValue);
571 SEXP sArgs = PROTECT(list4(mkString(c->url), sQuery, sBody, sReqHeaders));
572 SEXP sTry = install("try");
573 SEXP y, x = PROTECT(lang3(sTry,
574 LCONS(handler_for_path(c->url), sArgs),
575 sTrue));
576 SET_TAG(CDR(CDR(x)), install("silent"));
577 DBG(Rprintf("eval(try(httpd('%s'),silent=TRUE))\n", c->url));
578
579 /* evaluate the above in the tools namespace */
580 SEXP toolsNS = PROTECT(R_FindNamespace(mkString("tools")));
581 x = eval(x, toolsNS);
582 UNPROTECT(1); /* toolsNS */
583 PROTECT(x);
584
585 /* the result is expected to have one of the following forms:
586
587 a) character vector of length 1 => error (possibly from try),
588 will create 500 response
589
590 b) list(payload[, content-type[, headers[, status code]]])
591
592 payload: can be a character vector of length one or a
593 raw vector. if the character vector is named "file" then
594 the content of a file of that name is the payload
595
596 content-type: must be a character vector of length one
597 or NULL (if present, else default is "text/html")
598
599 headers: must be a character vector - the elements will
600 have CRLF appended and neither Content-type nor
601 Content-length may be used
602
603 status code: must be an integer if present (default is 200)
604 */
605
606 if (TYPEOF(x) == STRSXP && LENGTH(x) > 0) { /* string means there was an error */
607 const char *s = CHAR(STRING_ELT(x, 0));
608 send_http_response(c, " 500 Evaluation error\r\nConnection: close\r\nContent-type: text/plain\r\n\r\n");
609 DBG(Rprintf("respond with 500 and content: %s\n", s));
610 if (c->method != METHOD_HEAD)
611 send_response(c->sock, s, strlen(s));
612 c->attr |= CONNECTION_CLOSE; /* force close */
613 UNPROTECT(7);
614 return;
615 }
616
617 if (TYPEOF(x) == VECSXP && LENGTH(x) > 0) { /* a list (generic vector) can be a real payload */
618 SEXP xNames = getAttrib(x, R_NamesSymbol);
619 if (LENGTH(x) > 1) {
620 SEXP sCT = VECTOR_ELT(x, 1); /* second element is content type if present */
621 if (TYPEOF(sCT) == STRSXP && LENGTH(sCT) > 0)
622 ct = CHAR(STRING_ELT(sCT, 0));
623 if (LENGTH(x) > 2) { /* third element is headers vector */
624 sHeaders = VECTOR_ELT(x, 2);
625 if (TYPEOF(sHeaders) != STRSXP)
626 sHeaders = R_NilValue;
627 if (LENGTH(x) > 3) /* fourth element is HTTP code */
628 code = asInteger(VECTOR_ELT(x, 3));
629 }
630 }
631 y = VECTOR_ELT(x, 0);
632 if (TYPEOF(y) == STRSXP && LENGTH(y) > 0) {
633 char buf[64];
634 const char *cs = CHAR(STRING_ELT(y, 0)), *fn = 0;
635 if (code == 200)
636 send_http_response(c, " 200 OK\r\nContent-type: ");
637 else {
638 sprintf(buf, "%s %d Code %d\r\nContent-type: ", HTTP_SIG(c), code, code);
639 send_response(c->sock, buf, strlen(buf));
640 }
641 send_response(c->sock, ct, strlen(ct));
642 if (sHeaders != R_NilValue) {
643 unsigned int i = 0, n = LENGTH(sHeaders);
644 for (; i < n; i++) {
645 const char *hs = CHAR(STRING_ELT(sHeaders, i));
646 send_response(c->sock, "\r\n", 2);
647 send_response(c->sock, hs, strlen(hs));
648 }
649 }
650 /* special content - a file: either list(file="") or list(c("*FILE*", "")) - the latter will go away */
651 if (TYPEOF(xNames) == STRSXP && LENGTH(xNames) > 0 &&
652 !strcmp(CHAR(STRING_ELT(xNames, 0)), "file"))
653 fn = cs;
654 if (LENGTH(y) > 1 && !strcmp(cs, "*FILE*"))
655 fn = CHAR(STRING_ELT(y, 1));
656 if (fn) {
657 char *fbuf;
658 FILE *f = fopen(fn, "rb");
659 long fsz = 0;
660 if (!f) {
661 send_response(c->sock, "\r\nContent-length: 0\r\n\r\n", 23);
662 UNPROTECT(7);
663 fin_request(c);
664 return;
665 }
666 fseek(f, 0, SEEK_END);
667 fsz = ftell(f);
668 fseek(f, 0, SEEK_SET);
669 sprintf(buf, "\r\nContent-length: %ld\r\n\r\n", fsz);
670 send_response(c->sock, buf, strlen(buf));
671 if (c->method != METHOD_HEAD) {
672 fbuf = (char*) malloc(32768);
673 if (fbuf) {
674 while (fsz > 0 && !feof(f)) {
675 size_t rd = (fsz > 32768) ? 32768 : fsz;
676 if (fread(fbuf, 1, rd, f) != rd) {
677 free(fbuf);
678 UNPROTECT(7);
679 c->attr |= CONNECTION_CLOSE;
680 fclose(f);
681 return;
682 }
683 send_response(c->sock, fbuf, rd);
684 fsz -= rd;
685 }
686 free(fbuf);
687 } else { /* allocation error - get out */
688 UNPROTECT(7);
689 c->attr |= CONNECTION_CLOSE;
690 fclose(f);
691 return;
692 }
693 }
694 fclose(f);
695 UNPROTECT(7);
696 fin_request(c);
697 return;
698 }
699 sprintf(buf, "\r\nContent-length: %u\r\n\r\n", (unsigned int) strlen(cs));
700 send_response(c->sock, buf, strlen(buf));
701 if (c->method != METHOD_HEAD)
702 send_response(c->sock, cs, strlen(cs));
703 UNPROTECT(7);
704 fin_request(c);
705 return;
706 }
707 if (TYPEOF(y) == RAWSXP) {
708 char buf[64];
709 Rbyte *cs = RAW(y);
710 if (code == 200)
711 send_http_response(c, " 200 OK\r\nContent-type: ");
712 else {
713 sprintf(buf, "%s %d Code %d\r\nContent-type: ", HTTP_SIG(c), code, code);
714 send_response(c->sock, buf, strlen(buf));
715 }
716 send_response(c->sock, ct, strlen(ct));
717 if (sHeaders != R_NilValue) {
718 unsigned int i = 0, n = LENGTH(sHeaders);
719 for (; i < n; i++) {
720 const char *hs = CHAR(STRING_ELT(sHeaders, i));
721 send_response(c->sock, "\r\n", 2);
722 send_response(c->sock, hs, strlen(hs));
723 }
724 }
725 sprintf(buf, "\r\nContent-length: %u\r\n\r\n", LENGTH(y));
726 send_response(c->sock, buf, strlen(buf));
727 if (c->method != METHOD_HEAD)
728 send_response(c->sock, (char*) cs, LENGTH(y));
729 UNPROTECT(7);
730 fin_request(c);
731 return;
732 }
733 }
734 UNPROTECT(7);
735 }
736 send_http_response(c, " 500 Invalid response from R\r\nConnection: close\r\nContent-type: text/plain\r\n\r\nServer error: invalid response from R\r\n");
737 c->attr |= CONNECTION_CLOSE; /* force close */
738 }
739
740 /* wrap the actual call with ToplevelExec since we need to have a guaranteed
741 return so we can track the presence of a worker code inside R to prevent
742 re-entrance from other clients
743
744 on Windows, this function is named process_request_main_thread via
745 C preprocessor; on all platforms it is executed on the main R thread
746 */
process_request(httpd_conn_t * c)747 static void process_request(httpd_conn_t *c)
748 {
749 #ifndef _WIN32
750 in_process = 1;
751 #endif
752 R_ToplevelExec(process_request_, c);
753 #ifndef _WIN32
754 in_process = 0;
755 #endif
756 }
757
758 #ifdef _WIN32
759 #undef process_request
760 #endif
761
762 /* Remove . and (most) .. from "p" following RFC 3986, 5.2.4.*/
remove_dot_segments(char * p)763 static char *remove_dot_segments(char *p) {
764
765 char *inbuf = Rstrdup(p);
766 char *in = inbuf; /* first byte of input buffer */
767
768 char *outbuf = malloc(strlen(inbuf) + 1);
769 if (!outbuf)
770 error("allocation error in remove_dot_segments");
771 char *out = outbuf; /* last byte (terminator) of output buffer */
772 *out = '\0';
773
774 while(*in) {
775 /*
776 A. If the input buffer begins with a prefix of "../" or "./",
777 then remove that prefix from the input buffer; otherwise,
778 */
779 if (in[0] == '.' && in[1] == '.' && in[2] == '/') {
780 /* remove "../" */
781 in += 3;
782 continue;
783 }
784 if (in[0] == '.' && in[1] == '/') {
785 /* remove "./" */
786 in += 2;
787 continue;
788 }
789 /*
790 B. if the input buffer begins with a prefix of "/./" or "/.",
791 where "." is a complete path segment, then replace that
792 prefix with "/" in the input buffer; otherwise,
793 */
794 if (in[0] == '/' && in[1] == '.' && in[2] == '/') {
795 /* replace "/./" by "/" */
796 in += 2;
797 continue;
798 }
799 if (in[0] == '/' && in[1] == '.' && in[2] == '\0') {
800 /* replace trailing "/." by "/" */
801 in[1] = '\0';
802 continue;
803 }
804 /*
805 C. if the input buffer begins with a prefix of "/../" or "/..",
806 where ".." is a complete path segment, then replace that
807 prefix with "/" in the input buffer and remove the last
808 segment and its preceding "/" (if any) from the output
809 buffer; otherwise,
810 */
811 if (in[0] == '/' && in[1] == '.' && in[2] == '.' && in[3] == '/') {
812 /* replace "/../" by "/" */
813 in += 3;
814 /* remove trailing "/segment" from output */
815 while(out > outbuf && *out != '/') out--;
816 *out = '\0';
817 continue;
818 }
819 if (in[0] == '/' && in[1] == '.' && in[2] == '.' && in[3] == '\0') {
820 /* replace trailing "/.." by "/" */
821 in[1] = '\0';
822 /* remove trailing "/segment" from output */
823 while(out > outbuf && *out != '/') out--;
824 *out = '\0';
825 continue;
826 }
827 /*
828 D. if the input buffer consists only of "." or "..", then remove
829 that from the input buffer; otherwise,
830 */
831 if ( (in[0] == '.' && in[1] == '\0') ||
832 (in[0] == '.' && in[1] == '.' && in[2] == '\0') ) {
833 /* remove input */
834 in[0] = '\0';
835 continue;
836 }
837 /*
838 E. move the first path segment in the input buffer to the end of
839 the output buffer, including the initial "/" character (if
840 any) and any subsequent characters up to, but not including,
841 the next "/" character or the end of the input buffer.
842 */
843 if (in[0] == '/') {
844 *out++ = '/';
845 in++;
846 }
847 for(; *in && *in != '/'; in++) *out++ = *in;
848 *out = '\0';
849 }
850
851 free(inbuf);
852 return outbuf;
853 }
854
855 /* this function is called to fetch new data from the client
856 * connection socket and process it */
worker_input_handler(void * data)857 static void worker_input_handler(void *data) {
858 httpd_conn_t *c = (httpd_conn_t*) data;
859
860 DBG(printf("worker_input_handler, data=%p\n", data));
861 if (!c) return;
862
863 #ifndef _WIN32
864 if (in_process) return; /* we don't allow recursive entrance */
865 #endif
866
867 DBG(printf("input handler for worker %p (sock=%d, part=%d, method=%d, line_pos=%d)\n", (void*) c, (int)c->sock, (int)c->part, (int)c->method, (int)c->line_pos));
868
869 /* FIXME: there is one edge case that is not caught on unix: if
870 * recv reads two or more full requests into the line buffer then
871 * this function exits after the first one, but input handlers may
872 * not trigger, because there may be no further data. It is not
873 * trivial to fix, because just checking for a full line at the
874 * beginning and not calling recv won't trigger a new input
875 * handler. However, under normal circumstance this should not
876 * happen, because clients should wait for the response and even
877 * if they don't it's unlikely that both requests get combined
878 * into one packet. */
879 if (c->part < PART_BODY) {
880 char *s = c->line_buf;
881 ssize_t n = recv(c->sock, c->line_buf + c->line_pos,
882 LINE_BUF_SIZE - c->line_pos - 1, 0);
883 DBG(printf("[recv n=%d, line_pos=%d, part=%d]\n", n, c->line_pos, (int)c->part));
884 if (n < 0) { /* error, scrape this worker */
885 remove_worker(c);
886 return;
887 }
888 if (n == 0) { /* connection closed -> try to process and then remove */
889 process_request(c);
890 remove_worker(c);
891 return;
892 }
893 c->line_pos += n;
894 c->line_buf[c->line_pos] = 0;
895 DBG(printf("in buffer: {%s}\n", c->line_buf));
896 while (*s) {
897 /* ok, we have genuine data in the line buffer */
898 if (s[0] == '\n' || (s[0] == '\r' && s[1] == '\n')) { /* single, empty line - end of headers */
899 /* --- check request validity --- */
900 DBG(printf(" end of request, moving to body\n"));
901 if (!(c->attr & HTTP_1_0) && !(c->attr & HOST_HEADER)) { /* HTTP/1.1 mandates Host: header */
902 send_http_response(c, " 400 Bad Request (Host: missing)\r\nConnection: close\r\n\r\n");
903 remove_worker(c);
904 return;
905 }
906 if (c->attr & CONTENT_LENGTH && c->content_length) {
907 if (c->content_length < 0 || /* we are parsing signed so negative numbers are bad */
908 c->content_length > 2147483640 || /* R will currently have issues with body around 2Gb or more, so better to not go there */
909 !(c->body = (char*) malloc(c->content_length + 1 /* allocate an extra termination byte */ ))) {
910 send_http_response(c, " 413 Request Entity Too Large (request body too big)\r\nConnection: close\r\n\r\n");
911 remove_worker(c);
912 return;
913 }
914 }
915 c->body_pos = 0;
916 c->part = PART_BODY;
917 if (s[0] == '\r') s++;
918 s++;
919 /* move the body part to the beginning of the buffer */
920 c->line_pos -= s - c->line_buf;
921 memmove(c->line_buf, s, c->line_pos);
922 /* GET/HEAD or no content length mean no body */
923 if (c->method == METHOD_GET || c->method == METHOD_HEAD ||
924 !(c->attr & CONTENT_LENGTH) || c->content_length == 0) {
925 if ((c->attr & CONTENT_LENGTH) && c->content_length > 0) {
926 send_http_response(c, " 400 Bad Request (GET/HEAD with body)\r\n\r\n");
927 remove_worker(c);
928 return;
929 }
930 process_request(c);
931 if (c->attr & CONNECTION_CLOSE) {
932 remove_worker(c);
933 return;
934 }
935 /* keep-alive - reset the worker so it can process a new request */
936 if (c->url) { free(c->url); c->url = NULL; }
937 if (c->body) { free(c->body); c->body = NULL; }
938 if (c->content_type) { free(c->content_type); c->content_type = NULL; }
939 if (c->headers) { free_buffer(c->headers); c->headers = NULL; }
940 c->body_pos = 0;
941 c->method = 0;
942 c->part = PART_REQUEST;
943 c->attr = 0;
944 c->content_length = 0;
945 return;
946 }
947 /* copy body content (as far as available) */
948 c->body_pos = (c->content_length < c->line_pos) ? c->content_length : c->line_pos;
949 if (c->body_pos) {
950 memcpy(c->body, c->line_buf, c->body_pos);
951 c->line_pos -= c->body_pos; /* NOTE: we are NOT moving the buffer since non-zero left-over causes connection close */
952 }
953 /* POST will continue into the BODY part */
954 break;
955 }
956 {
957 char *bol = s;
958 while (*s && *s != '\r' && *s != '\n') s++;
959 if (!*s) { /* incomplete line */
960 if (bol == c->line_buf) {
961 if (c->line_pos < LINE_BUF_SIZE) /* one, incomplete line, but the buffer is not full yet, just return */
962 return;
963 /* the buffer is full yet the line is incomplete - we're in trouble */
964 send_http_response(c, " 413 Request entity too large\r\nConnection: close\r\n\r\n");
965 remove_worker(c);
966 return;
967 }
968 /* move the line to the begining of the buffer for later requests */
969 c->line_pos -= bol - c->line_buf;
970 memmove(c->line_buf, bol, c->line_pos);
971 return;
972 } else { /* complete line, great! */
973 if (*s == '\r') *(s++) = 0;
974 if (*s == '\n') *(s++) = 0;
975 DBG(printf("complete line: {%s}\n", bol));
976 if (c->part == PART_REQUEST) {
977 /* --- process request line --- */
978 size_t rll = strlen(bol); /* request line length */
979 char *url = strchr(bol, ' ');
980 if (!url || rll < 14 || strncmp(bol + rll - 9, " HTTP/1.", 8)) { /* each request must have at least 14 characters [GET / HTTP/1.0] and have HTTP/1.x */
981 send_response(c->sock, "HTTP/1.0 400 Bad Request\r\n\r\n", 28);
982 remove_worker(c);
983 return;
984 }
985 url++;
986 bol[strlen(bol) - 9] = 0; /* cut off " HTTP/1.x" */
987 c->url = remove_dot_segments(url);
988 if (!strncmp(bol + rll - 3, "1.0", 3)) c->attr |= HTTP_1_0;
989 if (!strncmp(bol, "GET ", 4)) c->method = METHOD_GET;
990 if (!strncmp(bol, "POST ", 5)) c->method = METHOD_POST;
991 if (!strncmp(bol, "HEAD ", 5)) c->method = METHOD_HEAD;
992 /* only custom handlers can use other methods */
993 if (!strncmp(c->url, "/custom/", 8)) {
994 char *mend = url - 1;
995 /* we generate a header with the method so it can be passed to the handler */
996 if (!c->headers)
997 c->headers = alloc_buffer(1024, NULL);
998 /* make sure it fits */
999 if (c->headers->size - c->headers->length >= 18 + (mend - bol)) {
1000 if (!c->method) c->method = METHOD_OTHER;
1001 /* add "Request-Method: xxx" */
1002 memcpy(c->headers->data + c->headers->length, "Request-Method: ", 16);
1003 c->headers->length += 16;
1004 memcpy(c->headers->data + c->headers->length, bol, mend - bol);
1005 c->headers->length += mend - bol;
1006 c->headers->data[c->headers->length++] = '\n';
1007 }
1008 }
1009 if (!c->method) {
1010 send_http_response(c, " 501 Invalid or unimplemented method\r\n\r\n");
1011 remove_worker(c);
1012 return;
1013 }
1014 c->part = PART_HEADER;
1015 DBG(printf("parsed request, method=%d, URL='%s'\n", (int)c->method, c->url));
1016 } else if (c->part == PART_HEADER) {
1017 /* --- process headers --- */
1018 char *k = bol;
1019 if (!c->headers)
1020 c->headers = alloc_buffer(1024, NULL);
1021 if (c->headers) { /* record the header line in the buffer */
1022 size_t l = strlen(bol);
1023 if (l) { /* this should be really always true */
1024 if (c->headers->length + l + 1 > c->headers->size) { /* not enough space? */
1025 size_t fits = c->headers->size - c->headers->length;
1026 if (fits) memcpy(c->headers->data + c->headers->length, bol, fits);
1027 if (alloc_buffer(2048, c->headers)) {
1028 c->headers = c->headers->next;
1029 memcpy(c->headers->data, bol + fits, l - fits);
1030 c->headers->length = l - fits;
1031 c->headers->data[c->headers->length++] = '\n';
1032 }
1033 } else {
1034 memcpy(c->headers->data + c->headers->length, bol, l);
1035 c->headers->length += l;
1036 c->headers->data[c->headers->length++] = '\n';
1037 }
1038 }
1039 }
1040 while (*k && *k != ':') {
1041 if (*k >= 'A' && *k <= 'Z')
1042 *k |= 0x20;
1043 k++;
1044 }
1045 if (*k == ':') {
1046 *(k++) = 0;
1047 while (*k == ' ' || *k == '\t') k++;
1048 DBG(printf("header '%s' => '%s'\n", bol, k));
1049 if (!strcmp(bol, "content-length")) {
1050 c->attr |= CONTENT_LENGTH;
1051 c->content_length = atol(k);
1052 }
1053 if (!strcmp(bol, "content-type")) {
1054 char *l = k;
1055 /* convert content-type to lowercase to facilitate comparison
1056 since MIME types are case-insensitive.
1057 However, we have to stop at ; since parameters
1058 may be case-sensitive (see PR 16541) */
1059 while (*l && *l != ';') { if (*l >= 'A' && *l <= 'Z') *l |= 0x20; l++; }
1060 c->attr |= CONTENT_TYPE;
1061 if (c->content_type) free(c->content_type);
1062 c->content_type = Rstrdup(k);
1063 if (!strncmp(k, "application/x-www-form-urlencoded", 33))
1064 c->attr |= CONTENT_FORM_UENC;
1065 }
1066 if (!strcmp(bol, "host"))
1067 c->attr |= HOST_HEADER;
1068 if (!strcmp(bol, "connection")) {
1069 char *l = k;
1070 while (*l) { if (*l >= 'A' && *l <= 'Z') *l |= 0x20; l++; }
1071 if (!strncmp(k, "close", 5))
1072 c->attr |= CONNECTION_CLOSE;
1073 }
1074 }
1075 }
1076 }
1077 }
1078 }
1079 if (c->part < PART_BODY) {
1080 /* we end here if we processed a buffer of exactly one line */
1081 c->line_pos = 0;
1082 return;
1083 }
1084 }
1085 if (c->part == PART_BODY && c->body) { /* BODY - this branch always returns */
1086 if (c->body_pos < c->content_length) { /* need to receive more ? */
1087 DBG(printf("BODY: body_pos=%d, content_length=%ld\n", c->body_pos, c->content_length));
1088 ssize_t n = recv(c->sock, c->body + c->body_pos,
1089 c->content_length - c->body_pos, 0);
1090 DBG(printf(" [recv n=%d - had %u of %lu]\n", n, c->body_pos, c->content_length));
1091 c->line_pos = 0;
1092 if (n < 0) { /* error, scrap this worker */
1093 remove_worker(c);
1094 return;
1095 }
1096 if (n == 0) { /* connection closed -> try to process and then remove */
1097 process_request(c);
1098 remove_worker(c);
1099 return;
1100 }
1101 c->body_pos += n;
1102 }
1103 if (c->body_pos == c->content_length) { /* yay! we got the whole body */
1104 process_request(c);
1105 if (c->attr & CONNECTION_CLOSE || c->line_pos) { /* we have to close the connection if there was a double-hit */
1106 remove_worker(c);
1107 return;
1108 }
1109 /* keep-alive - reset the worker so it can process a new request */
1110 if (c->url) { free(c->url); c->url = NULL; }
1111 if (c->body) { free(c->body); c->body = NULL; }
1112 if (c->content_type) { free(c->content_type); c->content_type = NULL; }
1113 if (c->headers) { free_buffer(c->headers); c->headers = NULL; }
1114 c->line_pos = 0; c->body_pos = 0;
1115 c->method = 0;
1116 c->part = PART_REQUEST;
1117 c->attr = 0;
1118 c->content_length = 0;
1119 return;
1120 }
1121 }
1122
1123 /* we enter here only if recv was used to leave the headers with no body */
1124 if (c->part == PART_BODY && !c->body) {
1125 char *s = c->line_buf;
1126 if (c->line_pos > 0) {
1127 if ((s[0] != '\r' || s[1] != '\n') && (s[0] != '\n')) {
1128 send_http_response(c, " 411 length is required for non-empty body\r\nConnection: close\r\n\r\n");
1129 remove_worker(c);
1130 return;
1131 }
1132 /* empty body, good */
1133 process_request(c);
1134 if (c->attr & CONNECTION_CLOSE) {
1135 remove_worker(c);
1136 return;
1137 } else { /* keep-alive */
1138 int sh = 1;
1139 if (s[0] == '\r') sh++;
1140 if (c->line_pos <= sh)
1141 c->line_pos = 0;
1142 else { /* shift the remaining buffer */
1143 memmove(c->line_buf, c->line_buf + sh, c->line_pos - sh);
1144 c->line_pos -= sh;
1145 }
1146 /* keep-alive - reset the worker so it can process a new request */
1147 if (c->url) { free(c->url); c->url = NULL; }
1148 if (c->body) { free(c->body); c->body = NULL; }
1149 if (c->content_type) { free(c->content_type); c->content_type = NULL; }
1150 if (c->headers) { free_buffer(c->headers); c->headers = NULL; }
1151 c->body_pos = 0;
1152 c->method = 0;
1153 c->part = PART_REQUEST;
1154 c->attr = 0;
1155 c->content_length = 0;
1156 return;
1157 }
1158 }
1159 ssize_t n = recv(c->sock, c->line_buf + c->line_pos,
1160 LINE_BUF_SIZE - c->line_pos - 1, 0);
1161 if (n < 0) { /* error, scrap this worker */
1162 remove_worker(c);
1163 return;
1164 }
1165 if (n == 0) { /* connection closed -> try to process and then remove */
1166 process_request(c);
1167 remove_worker(c);
1168 return;
1169 }
1170 if ((s[0] != '\r' || s[1] != '\n') && (s[0] != '\n')) {
1171 send_http_response(c, " 411 length is required for non-empty body\r\nConnection: close\r\n\r\n");
1172 remove_worker(c);
1173 return;
1174 }
1175 }
1176 }
1177
1178 static void srv_input_handler(void *data);
1179
1180 static SOCKET srv_sock = INVALID_SOCKET;
1181
1182 #ifdef _WIN32
1183 /* Windows implementation uses threads to accept and serve
1184 connections, using the main event loop to synchronize with R
1185 through a message-only window which is created on the R thread
1186 */
RhttpdWindowProc(HWND hwnd,UINT uMsg,WPARAM wParam,LPARAM lParam)1187 static LRESULT CALLBACK RhttpdWindowProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam)
1188 {
1189 DBG(Rprintf("RhttpdWindowProc(%x, %x, %x, %x)\n", (int) hwnd, (int) uMsg, (int) wParam, (int) lParam));
1190 if (hwnd == message_window && uMsg == WM_RHTTP_CALLBACK) {
1191 httpd_conn_t *c = (httpd_conn_t*) lParam;
1192 process_request_main_thread(c);
1193 return 0;
1194 }
1195 return DefWindowProc(hwnd, uMsg, wParam, lParam);
1196 }
1197
1198 /* server thread - accepts connections on the server socket and
1199 creates worker threads
1200 */
ServerThreadProc(LPVOID lpParameter)1201 static DWORD WINAPI ServerThreadProc(LPVOID lpParameter) {
1202 while (srv_sock != INVALID_SOCKET) {
1203 srv_input_handler(lpParameter);
1204 }
1205 return 0;
1206 }
1207
1208 /* worker thread - processes one client connection socket */
WorkerThreadProc(LPVOID lpParameter)1209 static DWORD WINAPI WorkerThreadProc(LPVOID lpParameter) {
1210 httpd_conn_t *c = (httpd_conn_t*) lpParameter;
1211 if (!c) return 0;
1212 while ((c->attr & THREAD_DISPOSE) == 0) {
1213 c->attr |= THREAD_OWNED; /* make sure the worker is not removed by the handler since we need it */
1214 worker_input_handler(c);
1215 }
1216 /* the handler signalled a desire to remove the worker, do it */
1217 c->attr = 0; /* reset the flags */
1218 remove_worker(c); /* free the worker */
1219 return 0;
1220 }
1221
1222 /* global server thread - currently we support only one server at a time */
1223 HANDLE server_thread;
1224 #else
1225 /* on unix we register all used sockets (server and workers) as input
1226 * handlers such that we can avoid polling */
1227
1228 /* global input handler for the server socket */
1229 static InputHandler *srv_handler;
1230 #endif
1231
srv_input_handler(void * data)1232 static void srv_input_handler(void *data)
1233 {
1234 httpd_conn_t *c;
1235 SAIN peer_sa;
1236 socklen_t peer_sal = sizeof(peer_sa);
1237 SOCKET cl_sock = accept(srv_sock, (SA*) &peer_sa, &peer_sal);
1238 if (cl_sock == INVALID_SOCKET) /* accept failed, don't bother */
1239 return;
1240 c = (httpd_conn_t*) calloc(1, sizeof(httpd_conn_t));
1241 if (c == NULL) error("allocation error in srv_input_handler");
1242 c->sock = cl_sock;
1243 c->peer = peer_sa.sin_addr;
1244 #ifndef _WIN32
1245 c->ih = addInputHandler(R_InputHandlers, cl_sock, &worker_input_handler,
1246 HttpdWorkerActivity);
1247 if (c->ih) c->ih->userData = c;
1248 add_worker(c);
1249 #else
1250 if (!add_worker(c)) { /* create worker thread only if the worker
1251 * was accepted */
1252 if (!(c->thread = CreateThread(NULL, 0, WorkerThreadProc,
1253 (LPVOID) c, 0, 0)))
1254 remove_worker(c);
1255 }
1256 #endif
1257 }
1258
in_R_HTTPDCreate(const char * ip,int port)1259 int in_R_HTTPDCreate(const char *ip, int port)
1260 {
1261 #ifndef _WIN32
1262 int reuse = 1;
1263 #endif
1264 SAIN srv_sa;
1265
1266 if (needs_init) /* initialization may need to be performed on first use */
1267 first_init();
1268
1269 /* is already in use, close the current socket */
1270 if (srv_sock != INVALID_SOCKET)
1271 closesocket(srv_sock);
1272
1273 #ifdef _WIN32
1274 /* on Windows stop the server thread if it exists */
1275 if (server_thread) {
1276 DWORD ts = 0;
1277 if (GetExitCodeThread(server_thread, &ts) && ts == STILL_ACTIVE)
1278 TerminateThread(server_thread, 0);
1279 server_thread = 0;
1280 }
1281 #endif
1282
1283 /* create a new socket */
1284 srv_sock = socket(AF_INET, SOCK_STREAM, 0);
1285 if (srv_sock == INVALID_SOCKET)
1286 Rf_error("unable to create socket");
1287
1288 #ifndef _WIN32
1289 /* set socket for reuse so we can re-init if we die */
1290 /* But on Windows, this lets us stomp on any port already in use, so don't do it. */
1291 setsockopt(srv_sock, SOL_SOCKET, SO_REUSEADDR,
1292 (const char*)&reuse, sizeof(reuse));
1293 #endif
1294
1295 /* bind to the desired port */
1296 if (bind(srv_sock, build_sin(&srv_sa, ip, port), sizeof(srv_sa))) {
1297 #ifndef _WIN32
1298 if (sockerrno == EADDRINUSE) {
1299 #else
1300 if (sockerrno == WSAEADDRINUSE) {
1301 #endif
1302 closesocket(srv_sock);
1303 srv_sock = INVALID_SOCKET;
1304 return -2;
1305 } else {
1306 closesocket(srv_sock);
1307 srv_sock = INVALID_SOCKET;
1308 Rf_error("unable to bind socket to TCP port %d", port);
1309 }
1310 }
1311
1312 /* setup listen */
1313 if (listen(srv_sock, 8))
1314 Rf_error("cannot listen to TCP port %d", port);
1315
1316 #ifndef _WIN32
1317 /* all went well, register the socket as a handler */
1318 if (srv_handler) removeInputHandler(&R_InputHandlers, srv_handler);
1319 srv_handler = addInputHandler(R_InputHandlers, srv_sock,
1320 &srv_input_handler, HttpdServerActivity);
1321 #else
1322 /* do the desired Windows synchronization */
1323 server_thread = CreateThread(NULL, 0, ServerThreadProc, 0, 0, 0);
1324 #endif
1325 return 0;
1326 }
1327
1328 void in_R_HTTPDStop(void)
1329 {
1330 if (srv_sock != INVALID_SOCKET) closesocket(srv_sock);
1331 srv_sock = INVALID_SOCKET;
1332
1333 #ifdef _WIN32
1334 /* on Windows stop the server thread if it exists */
1335 if (server_thread) {
1336 DWORD ts = 0;
1337 if (GetExitCodeThread(server_thread, &ts) && ts == STILL_ACTIVE)
1338 TerminateThread(server_thread, 0);
1339 server_thread = 0;
1340 }
1341 #else
1342 if (srv_handler) removeInputHandler(&R_InputHandlers, srv_handler);
1343 #endif
1344 }
1345
1346 /* Create an internal http server in R. Note that currently there can
1347 only be at most one http server running at any given time so the
1348 behavior is undefined if a server already exists (currently any
1349 previous servers will be shut down by this call but the shutdown
1350 may not be clean).
1351
1352 @param sIP is the IP to bind to (or NULL for any)
1353 @param sPort is the TCP port number to bin to
1354 @return returns an integer value -- 0L on success, other values
1355 denote failures: -2L means that the address/port combination is
1356 already in use
1357 */
1358 SEXP R_init_httpd(SEXP sIP, SEXP sPort)
1359 {
1360 const char *ip = 0;
1361 if (sIP != R_NilValue && (TYPEOF(sIP) != STRSXP || LENGTH(sIP) != 1))
1362 Rf_error("invalid bind address specification");
1363 if (sIP != R_NilValue)
1364 ip = CHAR(STRING_ELT(sIP, 0));
1365 return ScalarInteger(in_R_HTTPDCreate(ip, asInteger(sPort)));
1366 }
1367