rts-socket.c
1 //! @file rts-socket.c
2 //! @author J. Marcel van der Veer
3 //!
4 //! @section Copyright
5 //!
6 //! This file is part of Algol68G - an Algol 68 compiler-interpreter.
7 //! Copyright 2001-2023 J. Marcel van der Veer [algol68g@xs4all.nl].
8 //!
9 //! @section License
10 //!
11 //! This program is free software; you can redistribute it and/or modify it
12 //! under the terms of the GNU General Public License as published by the
13 //! Free Software Foundation; either version 3 of the License, or
14 //! (at your option) any later version.
15 //!
16 //! This program is distributed in the hope that it will be useful, but
17 //! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
18 //! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
19 //! more details. You should have received a copy of the GNU General Public
20 //! License along with this program. If not, see [http://www.gnu.org/licenses/].
21
22 //! @section Synopsis
23 //!
24 //! Low-level socket routines.
25
26 #include "a68g.h"
27 #include "a68g-genie.h"
28 #include "a68g-prelude.h"
29 #include "a68g-transput.h"
30
31 #if defined (BUILD_HTTP)
32
33 #define PROTOCOL "tcp"
34 #define SERVICE "http"
35
36 #define CONTENT_BUFFER_SIZE (64 * KILOBYTE)
37 #define TIMEOUT_INTERVAL 15
38
39 #if defined (BUILD_UNIX)
40
41 //! @brief Send GET request to server and yield answer (TCP/HTTP only).
42
43 void genie_http_content (NODE_T * p)
44 {
45 A68_REF path_string, domain_string, content_string;
46 A68_INT port_number;
47 int socket_id, conn, k;
48 fd_set set;
49 struct timeval a68_timeout;
50 struct servent *service_address;
51 struct hostent *host_address;
52 struct protoent *protocol;
53 struct sockaddr_in socket_address;
54 char buffer[CONTENT_BUFFER_SIZE];
55 errno = 0;
56 // Pop arguments.
57 POP_OBJECT (p, &port_number, A68_INT);
58 CHECK_INIT (p, INITIALISED (&port_number), M_INT);
59 POP_REF (p, &path_string);
60 CHECK_INIT (p, INITIALISED (&path_string), M_STRING);
61 POP_REF (p, &domain_string);
62 CHECK_INIT (p, INITIALISED (&domain_string), M_STRING);
63 POP_REF (p, &content_string);
64 CHECK_REF (p, content_string, M_REF_STRING);
65 *DEREF (A68_REF, &content_string) = empty_string (p);
66 // Reset buffers.
67 reset_transput_buffer (DOMAIN_BUFFER);
68 reset_transput_buffer (PATH_BUFFER);
69 reset_transput_buffer (REQUEST_BUFFER);
70 reset_transput_buffer (CONTENT_BUFFER);
71 add_a_string_transput_buffer (p, DOMAIN_BUFFER, (BYTE_T *) & domain_string);
72 add_a_string_transput_buffer (p, PATH_BUFFER, (BYTE_T *) & path_string);
73 // Make request.
74 add_string_transput_buffer (p, REQUEST_BUFFER, "GET ");
75 add_string_transput_buffer (p, REQUEST_BUFFER, get_transput_buffer (PATH_BUFFER));
76 add_string_transput_buffer (p, REQUEST_BUFFER, " HTTP/1.0\n\n");
77 // Connect to host.
78 FILL (&socket_address, 0, (int) sizeof (socket_address));
79 SIN_FAMILY (&socket_address) = AF_INET;
80 service_address = getservbyname (SERVICE, PROTOCOL);
81 if (service_address == NULL) {
82 PUSH_VALUE (p, 1, A68_INT);
83 return;
84 }
85 if (VALUE (&port_number) == 0) {
86 SIN_PORT (&socket_address) = (uint16_t) (S_PORT (service_address));
87 } else {
88 SIN_PORT (&socket_address) = (uint16_t) (htons ((uint16_t) (VALUE (&port_number))));
89 if (SIN_PORT (&socket_address) == 0) {
90 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
91 return;
92 }
93 }
94 host_address = gethostbyname (get_transput_buffer (DOMAIN_BUFFER));
95 if (host_address == NULL) {
96 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
97 return;
98 }
99 COPY (&SIN_ADDR (&socket_address), H_ADDR (host_address), H_LENGTH (host_address));
100 protocol = getprotobyname (PROTOCOL);
101 if (protocol == NULL) {
102 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
103 return;
104 }
105 socket_id = socket (PF_INET, SOCK_STREAM, P_PROTO (protocol));
106 if (socket_id < 0) {
107 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
108 return;
109 }
110 conn = connect (socket_id, (const struct sockaddr *) &socket_address, (socklen_t) SIZE_ALIGNED (socket_address));
111 if (conn < 0) {
112 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
113 ASSERT (close (socket_id) == 0);
114 return;
115 }
116 // Read from host.
117 WRITE (socket_id, get_transput_buffer (REQUEST_BUFFER));
118 if (errno != 0) {
119 PUSH_VALUE (p, errno, A68_INT);
120 ASSERT (close (socket_id) == 0);
121 return;
122 }
123 // Initialise file descriptor set.
124 FD_ZERO (&set);
125 FD_SET (socket_id, &set);
126 // Initialise the a68_timeout data structure.
127 TV_SEC (&a68_timeout) = TIMEOUT_INTERVAL;
128 TV_USEC (&a68_timeout) = 0;
129 // Block until server replies or a68_timeout blows up.
130 switch (select (FD_SETSIZE, &set, NULL, NULL, &a68_timeout)) {
131 case 0:
132 {
133 errno = ETIMEDOUT;
134 PUSH_VALUE (p, errno, A68_INT);
135 ASSERT (close (socket_id) == 0);
136 return;
137 }
138 case -1:
139 {
140 PUSH_VALUE (p, errno, A68_INT);
141 ASSERT (close (socket_id) == 0);
142 return;
143 }
144 case 1:
145 {
146 break;
147 }
148 default:
149 {
150 ABEND (A68_TRUE, ERROR_ACTION, __func__);
151 }
152 }
153 while ((k = (int) io_read (socket_id, &buffer, (CONTENT_BUFFER_SIZE - 1))) > 0) {
154 add_chars_transput_buffer (p, CONTENT_BUFFER, k, buffer);
155 }
156 if (k < 0 || errno != 0) {
157 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
158 ASSERT (close (socket_id) == 0);
159 return;
160 }
161 // Convert string.
162 *DEREF (A68_REF, &content_string) = c_to_a_string (p, get_transput_buffer (CONTENT_BUFFER), get_transput_buffer_index (CONTENT_BUFFER));
163 ASSERT (close (socket_id) == 0);
164 PUSH_VALUE (p, errno, A68_INT);
165 }
166
167 //! @brief Send request to server and yield answer (TCP only).
168
169 void genie_tcp_request (NODE_T * p)
170 {
171 A68_REF path_string, domain_string, content_string;
172 A68_INT port_number;
173 int socket_id, conn, k;
174 fd_set set;
175 struct timeval a68_timeout;
176 struct servent *service_address;
177 struct hostent *host_address;
178 struct protoent *protocol;
179 struct sockaddr_in socket_address;
180 char buffer[CONTENT_BUFFER_SIZE];
181 errno = 0;
182 // Pop arguments.
183 POP_OBJECT (p, &port_number, A68_INT);
184 CHECK_INIT (p, INITIALISED (&port_number), M_INT);
185 POP_REF (p, &path_string);
186 CHECK_INIT (p, INITIALISED (&path_string), M_STRING);
187 POP_REF (p, &domain_string);
188 CHECK_INIT (p, INITIALISED (&domain_string), M_STRING);
189 POP_REF (p, &content_string);
190 CHECK_REF (p, content_string, M_REF_STRING);
191 *DEREF (A68_REF, &content_string) = empty_string (p);
192 // Reset buffers.
193 reset_transput_buffer (DOMAIN_BUFFER);
194 reset_transput_buffer (PATH_BUFFER);
195 reset_transput_buffer (REQUEST_BUFFER);
196 reset_transput_buffer (CONTENT_BUFFER);
197 add_a_string_transput_buffer (p, DOMAIN_BUFFER, (BYTE_T *) & domain_string);
198 add_a_string_transput_buffer (p, PATH_BUFFER, (BYTE_T *) & path_string);
199 // Make request.
200 add_string_transput_buffer (p, REQUEST_BUFFER, get_transput_buffer (PATH_BUFFER));
201 // Connect to host.
202 FILL (&socket_address, 0, (int) sizeof (socket_address));
203 SIN_FAMILY (&socket_address) = AF_INET;
204 service_address = getservbyname (SERVICE, PROTOCOL);
205 if (service_address == NULL) {
206 PUSH_VALUE (p, 1, A68_INT);
207 return;
208 }
209 if (VALUE (&port_number) == 0) {
210 SIN_PORT (&socket_address) = (uint16_t) (S_PORT (service_address));
211 } else {
212 SIN_PORT (&socket_address) = (uint16_t) (htons ((uint16_t) (VALUE (&port_number))));
213 if (SIN_PORT (&socket_address) == 0) {
214 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
215 return;
216 }
217 }
218 host_address = gethostbyname (get_transput_buffer (DOMAIN_BUFFER));
219 if (host_address == NULL) {
220 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
221 return;
222 }
223 COPY (&SIN_ADDR (&socket_address), H_ADDR (host_address), H_LENGTH (host_address));
224 protocol = getprotobyname (PROTOCOL);
225 if (protocol == NULL) {
226 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
227 return;
228 }
229 socket_id = socket (PF_INET, SOCK_STREAM, P_PROTO (protocol));
230 if (socket_id < 0) {
231 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
232 return;
233 }
234 conn = connect (socket_id, (const struct sockaddr *) &socket_address, (socklen_t) SIZE_ALIGNED (socket_address));
235 if (conn < 0) {
236 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
237 ASSERT (close (socket_id) == 0);
238 return;
239 }
240 // Read from host.
241 WRITE (socket_id, get_transput_buffer (REQUEST_BUFFER));
242 if (errno != 0) {
243 PUSH_VALUE (p, errno, A68_INT);
244 ASSERT (close (socket_id) == 0);
245 return;
246 }
247 // Initialise file descriptor set.
248 FD_ZERO (&set);
249 FD_SET (socket_id, &set);
250 // Initialise the a68_timeout data structure.
251 TV_SEC (&a68_timeout) = TIMEOUT_INTERVAL;
252 TV_USEC (&a68_timeout) = 0;
253 // Block until server replies or a68_timeout blows up.
254 switch (select (FD_SETSIZE, &set, NULL, NULL, &a68_timeout)) {
255 case 0:
256 {
257 errno = ETIMEDOUT;
258 PUSH_VALUE (p, errno, A68_INT);
259 ASSERT (close (socket_id) == 0);
260 return;
261 }
262 case -1:
263 {
264 PUSH_VALUE (p, errno, A68_INT);
265 ASSERT (close (socket_id) == 0);
266 return;
267 }
268 case 1:
269 {
270 break;
271 }
272 default:
273 {
274 ABEND (A68_TRUE, ERROR_ACTION, __func__);
275 }
276 }
277 while ((k = (int) io_read (socket_id, &buffer, (CONTENT_BUFFER_SIZE - 1))) > 0) {
278 add_chars_transput_buffer (p, CONTENT_BUFFER, k, buffer);
279 }
280 if (k < 0 || errno != 0) {
281 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
282 ASSERT (close (socket_id) == 0);
283 return;
284 }
285 // Convert string.
286 *DEREF (A68_REF, &content_string) = c_to_a_string (p, get_transput_buffer (CONTENT_BUFFER), get_transput_buffer_index (CONTENT_BUFFER));
287 ASSERT (close (socket_id) == 0);
288 PUSH_VALUE (p, errno, A68_INT);
289 }
290
291 #endif
292
293 #if defined (BUILD_WIN32)
294
295 #if defined (HAVE_WINSOCK_H)
296 #include <winsock.h>
297 #endif
298 typedef int socklen_t;
299
300 //! @brief Send GET request to server and yield answer (TCP/HTTP only).
301
302 void genie_http_content (NODE_T * p)
303 {
304 WSADATA wsa_data;
305 A68_REF path_string, domain_string, content_string;
306 A68_INT port_number;
307 int socket_id, conn, k, rc, len, sent;
308 struct servent *service_address;
309 struct hostent *host_address;
310 struct protoent *protocol;
311 struct sockaddr_in socket_address;
312 char buffer[CONTENT_BUFFER_SIZE];
313 char *str;
314 errno = 0;
315 // Pop arguments.
316 POP_OBJECT (p, &port_number, A68_INT);
317 CHECK_INIT (p, INITIALISED (&port_number), M_INT);
318 POP_REF (p, &path_string);
319 CHECK_INIT (p, INITIALISED (&path_string), M_STRING);
320 POP_REF (p, &domain_string);
321 CHECK_INIT (p, INITIALISED (&domain_string), M_STRING);
322 POP_REF (p, &content_string);
323 CHECK_REF (p, content_string, M_REF_STRING);
324 *DEREF (A68_REF, &content_string) = empty_string (p);
325 // Reset buffers.
326 reset_transput_buffer (DOMAIN_BUFFER);
327 reset_transput_buffer (PATH_BUFFER);
328 reset_transput_buffer (REQUEST_BUFFER);
329 reset_transput_buffer (CONTENT_BUFFER);
330 add_a_string_transput_buffer (p, DOMAIN_BUFFER, (BYTE_T *) & domain_string);
331 add_a_string_transput_buffer (p, PATH_BUFFER, (BYTE_T *) & path_string);
332 // Make request.
333 add_string_transput_buffer (p, REQUEST_BUFFER, "GET ");
334 add_string_transput_buffer (p, REQUEST_BUFFER, get_transput_buffer (PATH_BUFFER));
335 add_string_transput_buffer (p, REQUEST_BUFFER, " HTTP/1.0\n\n");
336 // Connect to host.
337 if (WSAStartup (MAKEWORD (1, 1), &wsa_data) != NO_ERROR) {
338 PUSH_VALUE (p, 1, A68_INT);
339 return;
340 }
341 FILL (&socket_address, 0, (int) sizeof (socket_address));
342 SIN_FAMILY (&socket_address) = AF_INET;
343 service_address = getservbyname (SERVICE, PROTOCOL);
344 if (service_address == NULL) {
345 PUSH_VALUE (p, 1, A68_INT);
346 WSACleanup ();
347 return;
348 }
349 if (VALUE (&port_number) == 0) {
350 SIN_PORT (&socket_address) = (uint16_t) (S_PORT (service_address));
351 } else {
352 SIN_PORT (&socket_address) = (uint16_t) (htons ((uint16_t) (VALUE (&port_number))));
353 if (SIN_PORT (&socket_address) == 0) {
354 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
355 WSACleanup ();
356 return;
357 }
358 }
359 host_address = gethostbyname (get_transput_buffer (DOMAIN_BUFFER));
360 if (host_address == NULL) {
361 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
362 WSACleanup ();
363 return;
364 }
365 COPY (&SIN_ADDR (&socket_address), H_ADDR (host_address), H_LENGTH (host_address));
366 protocol = getprotobyname (PROTOCOL);
367 if (protocol == NULL) {
368 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
369 WSACleanup ();
370 return;
371 }
372 socket_id = socket (PF_INET, SOCK_STREAM, P_PROTO (protocol));
373 if (socket_id < 0) {
374 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
375 WSACleanup ();
376 return;
377 }
378 conn = connect (socket_id, (const struct sockaddr *) &socket_address, (socklen_t) SIZE_ALIGNED (socket_address));
379 if (conn < 0) {
380 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
381 WSACleanup ();
382 return;
383 }
384 // Send request to host.
385 str = get_transput_buffer (REQUEST_BUFFER);
386 len = (int) strlen (str);
387 sent = 0;
388 while (sent < len) {
389 rc = send (socket_id, &str[sent], len - sent, 0);
390 if (rc == SOCKET_ERROR) {
391 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
392 WSACleanup ();
393 }
394 sent += rc;
395 }
396 // Receive data from host.
397 while ((k = (int) recv (socket_id, (char *) &buffer, (CONTENT_BUFFER_SIZE - 1), 0)) > 0) {
398 add_chars_transput_buffer (p, CONTENT_BUFFER, k, buffer);
399 }
400 if (k < 0 || errno != 0) {
401 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
402 WSACleanup ();
403 return;
404 }
405 // Convert string.
406 *DEREF (A68_REF, &content_string) = c_to_a_string (p, get_transput_buffer (CONTENT_BUFFER), get_transput_buffer_index (CONTENT_BUFFER));
407 if (k != 0) {
408 // Not gracefully closed by recv ().
409 ASSERT (close (socket_id) == 0);
410 }
411 PUSH_VALUE (p, errno, A68_INT);
412 WSACleanup ();
413 }
414
415 //! @brief Send request to server and yield answer (TCP only).
416
417 void genie_tcp_request (NODE_T * p)
418 {
419 WSADATA wsa_data;
420 A68_REF path_string, domain_string, content_string;
421 A68_INT port_number;
422 int socket_id, conn, k, rc, len, sent;
423 struct servent *service_address;
424 struct hostent *host_address;
425 struct protoent *protocol;
426 struct sockaddr_in socket_address;
427 char buffer[CONTENT_BUFFER_SIZE];
428 char *str;
429 errno = 0;
430 // Pop arguments.
431 POP_OBJECT (p, &port_number, A68_INT);
432 CHECK_INIT (p, INITIALISED (&port_number), M_INT);
433 POP_REF (p, &path_string);
434 CHECK_INIT (p, INITIALISED (&path_string), M_STRING);
435 POP_REF (p, &domain_string);
436 CHECK_INIT (p, INITIALISED (&domain_string), M_STRING);
437 POP_REF (p, &content_string);
438 CHECK_REF (p, content_string, M_REF_STRING);
439 *DEREF (A68_REF, &content_string) = empty_string (p);
440 // Reset buffers.
441 reset_transput_buffer (DOMAIN_BUFFER);
442 reset_transput_buffer (PATH_BUFFER);
443 reset_transput_buffer (REQUEST_BUFFER);
444 reset_transput_buffer (CONTENT_BUFFER);
445 add_a_string_transput_buffer (p, DOMAIN_BUFFER, (BYTE_T *) & domain_string);
446 add_a_string_transput_buffer (p, PATH_BUFFER, (BYTE_T *) & path_string);
447 // Make request.
448 add_string_transput_buffer (p, REQUEST_BUFFER, get_transput_buffer (PATH_BUFFER));
449 // Connect to host.
450 if (WSAStartup (MAKEWORD (1, 1), &wsa_data) != NO_ERROR) {
451 PUSH_VALUE (p, 1, A68_INT);
452 return;
453 }
454 FILL (&socket_address, 0, (int) sizeof (socket_address));
455 SIN_FAMILY (&socket_address) = AF_INET;
456 service_address = getservbyname (SERVICE, PROTOCOL);
457 if (service_address == NULL) {
458 PUSH_VALUE (p, 1, A68_INT);
459 WSACleanup ();
460 return;
461 }
462 if (VALUE (&port_number) == 0) {
463 SIN_PORT (&socket_address) = (uint16_t) (S_PORT (service_address));
464 } else {
465 SIN_PORT (&socket_address) = (uint16_t) (htons ((uint16_t) (VALUE (&port_number))));
466 if (SIN_PORT (&socket_address) == 0) {
467 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
468 WSACleanup ();
469 return;
470 }
471 }
472 host_address = gethostbyname (get_transput_buffer (DOMAIN_BUFFER));
473 if (host_address == NULL) {
474 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
475 WSACleanup ();
476 return;
477 }
478 COPY (&SIN_ADDR (&socket_address), H_ADDR (host_address), H_LENGTH (host_address));
479 protocol = getprotobyname (PROTOCOL);
480 if (protocol == NULL) {
481 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
482 WSACleanup ();
483 return;
484 }
485 socket_id = socket (PF_INET, SOCK_STREAM, P_PROTO (protocol));
486 if (socket_id < 0) {
487 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
488 WSACleanup ();
489 return;
490 }
491 conn = connect (socket_id, (const struct sockaddr *) &socket_address, (socklen_t) SIZE_ALIGNED (socket_address));
492 if (conn < 0) {
493 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
494 WSACleanup ();
495 return;
496 }
497 // Send request to host.
498 str = get_transput_buffer (REQUEST_BUFFER);
499 len = (int) strlen (str);
500 sent = 0;
501 while (sent < len) {
502 rc = send (socket_id, &str[sent], len - sent, 0);
503 if (rc == SOCKET_ERROR) {
504 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
505 WSACleanup ();
506 }
507 sent += rc;
508 }
509 // Receive data from host.
510 while ((k = (int) recv (socket_id, (char *) &buffer, (CONTENT_BUFFER_SIZE - 1), 0)) > 0) {
511 add_chars_transput_buffer (p, CONTENT_BUFFER, k, buffer);
512 }
513 if (k < 0 || errno != 0) {
514 PUSH_VALUE (p, (errno == 0 ? 1 : errno), A68_INT);
515 WSACleanup ();
516 return;
517 }
518 // Convert string.
519 *DEREF (A68_REF, &content_string) = c_to_a_string (p, get_transput_buffer (CONTENT_BUFFER), get_transput_buffer_index (CONTENT_BUFFER));
520 if (k != 0) {
521 // Not gracefully closed by recv ().
522 ASSERT (close (socket_id) == 0);
523 }
524 PUSH_VALUE (p, errno, A68_INT);
525 WSACleanup ();
526 }
527
528 #endif
529
530 #endif
