native/tls.c — sigil-tls

1/*

2 * Sigil TLS Library Implementation

3 *

4 * This file implements TLS/SSL connections using mbedTLS.

5 * Provides secure TCP connections for HTTPS and other TLS protocols.

6 *

7 * Currently supports TLS 1.2. TLS 1.3 requires additional PSA Crypto setup.

8 *

9 * Certificate Verification:

10 * - By default, certificates are verified against system CA certificates

11 * - Set SIGIL_TLS_INSECURE=1 to skip verification (for testing only)

12 *

13 * Note: TLS is not available on Emscripten/WebAssembly builds.

14 */

16#include "sigil-internal.h"

18#ifdef __EMSCRIPTEN__

19/*

20 * Stub implementation for Emscripten builds.

21 * TLS requires native sockets which aren't available in the browser.

22 * Note: sigil__tls_get_fd is now in tls-hooks.c (returns -1 when no hooks registered).

23 */

24void sigil__init_sigil_tls_module(SigilVM *vm)

25{

26 (void)vm;

27 /* TLS module not available on web platform - don't register hooks */

28}

30#else /* Native build */

31#include <stdio.h>

32#include <stdlib.h>

33#include <string.h>

34#include <errno.h>

35#include <fcntl.h>

36#ifdef _WIN32

37#include <winsock2.h>

38#else

39#include <unistd.h>

40#include <time.h>

41#include <sys/types.h>

42#include <sys/socket.h>

43#include <sys/select.h>

44#include <netinet/in.h>

45#include <netdb.h>

46#endif

48#include "mbedtls/ssl.h"

49#include "mbedtls/net_sockets.h"

50#include "mbedtls/entropy.h"

51#include "mbedtls/ctr_drbg.h"

52#include "mbedtls/error.h"

53#include "mbedtls/x509_crt.h"

55#ifdef SIGIL_TLS_DEBUG

56#include "mbedtls/debug.h"

58/* Debug callback for mbedTLS - enabled with SIGIL_TLS_DEBUG */

59static void tls_debug_callback(void *ctx, int level, const char *file, int line, const char *str)

60{

61 (void)ctx;

62 (void)level;

63 const char *p = strrchr(file, '/');

64 if (p) file = p + 1;

65 fprintf(stderr, "[mbedTLS] %s:%d: %s", file, line, str);

66}

67#endif

69/* Common CA certificate bundle paths on various Linux distributions */

70static const char *ca_cert_paths[] = {

71 "/etc/ssl/certs/ca-certificates.crt", /* Debian/Ubuntu/Guix */

72 "/etc/pki/tls/certs/ca-bundle.crt", /* Fedora/RHEL */

73 "/etc/ssl/ca-bundle.pem", /* openSUSE */

74 "/etc/pki/ca-trust/extracted/pem/tls-ca-bundle.pem", /* CentOS */

75 "/etc/ssl/cert.pem", /* Alpine/FreeBSD */

76 "/usr/local/share/certs/ca-root-nss.crt", /* FreeBSD */

77 "/etc/certs/ca-certificates.crt", /* Guix alternative */

78 NULL

79};

81/*

82 * TLS Connection data structure

83 *

84 * Wraps mbedTLS context for a single TLS connection.

85 * Each connection has its own SSL context and config.

86 */

87typedef struct {

88 mbedtls_ssl_context ssl;

89 mbedtls_ssl_config conf;

90 mbedtls_net_context server_fd;

91 mbedtls_x509_crt cacert;

92 int closed;

93} TlsConnectionData;

95/* Symbol used as type tag for TLS connection foreign objects */

96static Value tls_connection_type_tag = SIGIL_UNDEFINED;

98/* Global entropy and RNG context (shared across connections for efficiency) */

99static mbedtls_entropy_context global_entropy;

100static mbedtls_ctr_drbg_context global_ctr_drbg;

101static mbedtls_x509_crt global_cacert;

102static int global_tls_initialized = 0;

103static int global_cacert_loaded = 0;

104static int global_insecure_mode = 0;

105

106/*

107 * Check if insecure mode is enabled via environment variable

108 */

109static int is_insecure_mode(void)

110{

111 const char *val = getenv("SIGIL_TLS_INSECURE");

112 return val && (val[0] == '1' || val[0] == 't' || val[0] == 'T');

113}

114

115/*

116 * Try to load CA certificates from common system paths

117 */

118static int load_system_ca_certs(void)

119{

120 if (global_cacert_loaded) return 0;

121

122 mbedtls_x509_crt_init(&global_cacert);

123

124 for (int i = 0; ca_cert_paths[i] != NULL; i++) {

125 int ret = mbedtls_x509_crt_parse_file(&global_cacert, ca_cert_paths[i]);

126 if (ret == 0) {

127 global_cacert_loaded = 1;

128 return 0;

129 }

130 }

131

132 /* Also try loading from SSL_CERT_FILE environment variable */

133 const char *cert_file = getenv("SSL_CERT_FILE");

134 if (cert_file) {

135 int ret = mbedtls_x509_crt_parse_file(&global_cacert, cert_file);

136 if (ret == 0) {

137 global_cacert_loaded = 1;

138 return 0;

139 }

140 }

141

142 /* Couldn't load any CA certificates */

143 return -1;

144}

145

146/*

147 * Initialize global TLS state (entropy, RNG, CA certs)

148 * Called once at module initialization.

149 */

150static int ensure_tls_initialized(void)

151{

152 if (!global_tls_initialized) {

153 mbedtls_entropy_init(&global_entropy);

154 mbedtls_ctr_drbg_init(&global_ctr_drbg);

155

156 const char *pers = "sigil_tls";

157 int ret = mbedtls_ctr_drbg_seed(&global_ctr_drbg, mbedtls_entropy_func,

158 &global_entropy,

159 (const unsigned char *)pers, strlen(pers));

160 if (ret != 0) {

161 return -1;

162 }

163

164 /* Check for insecure mode */

165 global_insecure_mode = is_insecure_mode();

166

167 /* Try to load CA certificates (not fatal if fails, but verify won't work) */

168 if (!global_insecure_mode) {

169 load_system_ca_certs();

170 }

171

172 global_tls_initialized = 1;

173 }

174 return 0;

175}

176

177/*

178 * Finalizer - clean up TLS connection when GC reclaims object

179 */

180static void tls_connection_finalizer(void *data)

181{

182 TlsConnectionData *conn = (TlsConnectionData *)data;

183 if (conn) {

184 if (!conn->closed) {

185 mbedtls_ssl_close_notify(&conn->ssl);

186 mbedtls_net_free(&conn->server_fd);

187 mbedtls_ssl_free(&conn->ssl);

188 mbedtls_ssl_config_free(&conn->conf);

189 mbedtls_x509_crt_free(&conn->cacert);

190 }

191 free(conn);

192 }

193}

194

195/*

196 * Helper: Create a TLS connection object

197 */

198static Value make_tls_connection(SigilVM *vm, TlsConnectionData *data)

199{

200 return sigil_make_foreign(vm, tls_connection_type_tag, data,

201 tls_connection_finalizer, sizeof(TlsConnectionData));

202}

203

204/*

205 * Helper: Check if value is a TLS connection

206 */

207static int is_tls_connection(Value v)

208{

209 if (!sigil_is_foreign(v)) return 0;

210 return sigil_foreign_type(v) == tls_connection_type_tag;

211}

212

213/*

214 * Helper: Get TLS connection data from value

215 */

216static TlsConnectionData *as_tls_connection(Value v)

217{

218 return (TlsConnectionData *)sigil_foreign_data(v);

219}

220

221/*

222 * tls-connection? value -> boolean

223 * Check if value is a TLS connection object.

224 */

225static Value native_tls_connectionp(SigilVM *vm, int argc, Value *args)

226{

227 (void)vm;

228 (void)argc;

229 return sigil_bool(is_tls_connection(args[0]));

230}

231

232#ifndef _WIN32

233/*

234 * Connect to host:port with a bounded total deadline, populating ctx->fd.

235 *

236 * Resolves the host (which may yield several CDN addresses) and tries each

237 * in turn with a NON-BLOCKING connect + select(), so a blackholed address

238 * (SYN dropped) cannot burn the full OS SYN-retransmit timeout (~127s on

239 * Linux). The whole operation is bounded by timeout_ms; on success the

240 * socket is restored to blocking mode (mbedTLS drives it blocking after).

241 *

242 * Returns 0 on success (ctx->fd set), -1 on failure/timeout. This is the

243 * opt-in path: native_tls_connect only calls it when a positive timeout is

244 * supplied; otherwise the original blocking mbedtls_net_connect runs,

245 * leaving the default behavior byte-identical.

246 */

247static long sigil_tls_now_ms(void)

248{

249 struct timespec ts;

250 clock_gettime(CLOCK_MONOTONIC, &ts);

251 return (long)ts.tv_sec * 1000L + ts.tv_nsec / 1000000L;

252}

253

254static int sigil_tls_connect_timeout(mbedtls_net_context *ctx,

255 const char *host, const char *port,

256 long timeout_ms)

257{

258 struct addrinfo hints, *res = NULL, *cur;

259 memset(&hints, 0, sizeof(hints));

260 hints.ai_family = AF_UNSPEC;

261 hints.ai_socktype = SOCK_STREAM;

262 hints.ai_protocol = IPPROTO_TCP;

263

264 if (getaddrinfo(host, port, &hints, &res) != 0) {

265 return -1;

266 }

267

268 long deadline = sigil_tls_now_ms() + timeout_ms;

269 int sockfd = -1;

270 int connected = 0;

271

272 /* Count addresses so each gets a fair slice of the total deadline: a

273 * blackholed first address can't consume the whole budget, leaving a

274 * working address (e.g. IPv4 after a dead IPv6, or another CDN node)

275 * still reachable within the same call (Happy-Eyeballs-lite). */

276 int addrs_remaining = 0;

277 for (cur = res; cur != NULL; cur = cur->ai_next) addrs_remaining++;

278

279 for (cur = res; cur != NULL; cur = cur->ai_next, addrs_remaining--) {

280 long remaining = deadline - sigil_tls_now_ms();

281 if (remaining <= 0) break;

282 long per_addr = remaining / (addrs_remaining > 0 ? addrs_remaining : 1);

283 if (per_addr < 1) per_addr = 1;

284

285 sockfd = socket(cur->ai_family, cur->ai_socktype, cur->ai_protocol);

286 if (sockfd < 0) continue;

287

288 int flags = fcntl(sockfd, F_GETFL, 0);

289 if (flags == -1 || fcntl(sockfd, F_SETFL, flags | O_NONBLOCK) == -1) {

290 close(sockfd);

291 sockfd = -1;

292 continue;

293 }

294

295 int rc = connect(sockfd, cur->ai_addr, cur->ai_addrlen);

296 if (rc == 0) {

297 connected = 1;

298 } else if (errno == EINPROGRESS) {

299 fd_set wset;

300 FD_ZERO(&wset);

301 FD_SET(sockfd, &wset);

302 struct timeval tv;

303 tv.tv_sec = per_addr / 1000L;

304 tv.tv_usec = (per_addr % 1000L) * 1000L;

305 int sel = select(sockfd + 1, NULL, &wset, NULL, &tv);

306 if (sel > 0 && FD_ISSET(sockfd, &wset)) {

307 int so_err = 0;

308 socklen_t len = sizeof(so_err);

309 if (getsockopt(sockfd, SOL_SOCKET, SO_ERROR, &so_err, &len) == 0

310 && so_err == 0) {

311 connected = 1;

312 }

313 }

314 /* sel == 0 -> this address timed out; sel < 0 -> select error */

315 }

316

317 if (connected) {

318 /* Restore blocking mode for mbedTLS's blocking I/O. */

319 fcntl(sockfd, F_SETFL, flags);

320 break;

321 }

322

323 close(sockfd);

324 sockfd = -1;

325 }

326

327 freeaddrinfo(res);

328

329 if (!connected || sockfd < 0) {

330 return -1;

331 }

332 ctx->fd = sockfd;

333 return 0;

334}

335#endif /* !_WIN32 */

336

337/*

338 * tls-connect hostname port [connect-timeout-ms] -> tls-connection | #f

339 * Establish a TLS connection to the specified host and port.

340 * Returns a TLS connection object on success, #f on failure.

341 *

342 * The optional connect-timeout-ms (a positive integer) bounds the TCP

343 * connect phase via a non-blocking connect + select with try-next-address,

344 * so a blackholed address can't hang on the OS SYN timeout. Omitted or <= 0

345 * keeps the original blocking mbedtls_net_connect (default behavior

346 * unchanged). On Windows the timeout is ignored (blocking connect).

347 */

348static Value native_tls_connect(SigilVM *vm, int argc, Value *args)

349{

350 (void)argc;

351

352 if (!sigil_is_string(args[0])) {

353 sigil__vm_error(vm, SIGIL_ERR_TYPE, "tls-connect: expected string for hostname");

354 return SIGIL_UNDEFINED;

355 }

356 if (!sigil_is_fixnum(args[1])) {

357 sigil__vm_error(vm, SIGIL_ERR_TYPE, "tls-connect: expected integer for port");

358 return SIGIL_UNDEFINED;

359 }

360

361 if (ensure_tls_initialized() < 0) {

362 return SIGIL_FALSE;

363 }

364

365 SigilString *host_str = (SigilString *)sigil_as_ptr(args[0]);

366 int port = (int)sigil_as_fixnum(args[1]);

367

368 /* Optional connect timeout (milliseconds); <= 0 or absent = blocking. */

369 long connect_timeout_ms = 0;

370 if (argc >= 3 && sigil_is_fixnum(args[2])) {

371 connect_timeout_ms = (long)sigil_as_fixnum(args[2]);

372 }

373

374 /* Null-terminate hostname */

375 char *hostname = malloc(host_str->byte_length + 1);

376 if (!hostname) return SIGIL_FALSE;

377 memcpy(hostname, host_str->data, host_str->byte_length);

378 hostname[host_str->byte_length] = '\0';

379

380 char port_str[16];

381 snprintf(port_str, sizeof(port_str), "%d", port);

382

383 /* Allocate connection structure */

384 TlsConnectionData *conn = calloc(1, sizeof(TlsConnectionData));

385 if (!conn) {

386 free(hostname);

387 return SIGIL_FALSE;

388 }

389

390 conn->closed = 0;

391 int ret;

392 const char *error_stage = NULL;

393

394 /* Initialize mbedTLS structures */

395 mbedtls_net_init(&conn->server_fd);

396 mbedtls_ssl_init(&conn->ssl);

397 mbedtls_ssl_config_init(&conn->conf);

398 mbedtls_x509_crt_init(&conn->cacert);

399

400 /* Connect to server. With a positive connect timeout, use the bounded

401 * non-blocking path; otherwise the original blocking connect (default

402 * behavior unchanged). */

403#ifndef _WIN32

404 if (connect_timeout_ms > 0) {

405 ret = sigil_tls_connect_timeout(&conn->server_fd, hostname, port_str,

406 connect_timeout_ms);

407 } else {

408 ret = mbedtls_net_connect(&conn->server_fd, hostname, port_str,

409 MBEDTLS_NET_PROTO_TCP);

410 }

411#else

412 (void)connect_timeout_ms;

413 ret = mbedtls_net_connect(&conn->server_fd, hostname, port_str,

414 MBEDTLS_NET_PROTO_TCP);

415#endif

416 if (ret != 0) {

417 error_stage = "TCP connect";

418 goto cleanup_error;

419 }

420

421 /* Set up SSL configuration */

422 ret = mbedtls_ssl_config_defaults(&conn->conf,

423 MBEDTLS_SSL_IS_CLIENT,

424 MBEDTLS_SSL_TRANSPORT_STREAM,

425 MBEDTLS_SSL_PRESET_DEFAULT);

426 if (ret != 0) {

427 error_stage = "SSL config defaults";

428 goto cleanup_error;

429 }

430

431 /* Configure certificate verification */

432 if (global_insecure_mode) {

433 /* SIGIL_TLS_INSECURE=1 - skip verification (for testing only) */

434 mbedtls_ssl_conf_authmode(&conn->conf, MBEDTLS_SSL_VERIFY_NONE);

435 } else if (global_cacert_loaded) {

436 /* Verify certificates against system CA bundle */

437 mbedtls_ssl_conf_authmode(&conn->conf, MBEDTLS_SSL_VERIFY_REQUIRED);

438 mbedtls_ssl_conf_ca_chain(&conn->conf, &global_cacert, NULL);

439 } else {

440 /* No CA certs available - fall back to no verification with warning */

441 mbedtls_ssl_conf_authmode(&conn->conf, MBEDTLS_SSL_VERIFY_NONE);

442 }

443 mbedtls_ssl_conf_rng(&conn->conf, mbedtls_ctr_drbg_random, &global_ctr_drbg);

444

445#ifdef SIGIL_TLS_DEBUG

446 mbedtls_ssl_conf_dbg(&conn->conf, tls_debug_callback, NULL);

447 mbedtls_debug_set_threshold(4);

448#endif

449

450 /* Set up SSL context */

451 ret = mbedtls_ssl_setup(&conn->ssl, &conn->conf);

452 if (ret != 0) {

453 error_stage = "SSL setup";

454 goto cleanup_error;

455 }

456

457 /* Set hostname for SNI (Server Name Indication) */

458 ret = mbedtls_ssl_set_hostname(&conn->ssl, hostname);

459 if (ret != 0) {

460 error_stage = "SSL set hostname";

461 goto cleanup_error;

462 }

463

464 /* Set I/O functions */

465 mbedtls_ssl_set_bio(&conn->ssl, &conn->server_fd,

466 mbedtls_net_send, mbedtls_net_recv, NULL);

467

468 /* Perform TLS handshake */

469 while ((ret = mbedtls_ssl_handshake(&conn->ssl)) != 0) {

470 if (ret != MBEDTLS_ERR_SSL_WANT_READ && ret != MBEDTLS_ERR_SSL_WANT_WRITE) {

471 error_stage = "TLS handshake";

472 goto cleanup_error;

473 }

474 }

475

476 free(hostname);

477 return make_tls_connection(vm, conn);

478

479cleanup_error:

480 mbedtls_net_free(&conn->server_fd);

481 mbedtls_ssl_free(&conn->ssl);

482 mbedtls_ssl_config_free(&conn->conf);

483 mbedtls_x509_crt_free(&conn->cacert);

484 free(conn);

485 free(hostname);

486 return SIGIL_FALSE;

487}

488

489/*

490 * tls-read connection [max-bytes] -> string | #f | eof-object

491 * Read data from TLS connection.

492 * Returns string with data, #f on error, or eof-object if connection closed.

493 */

494static Value native_tls_read(SigilVM *vm, int argc, Value *args)

495{

496 if (!is_tls_connection(args[0])) {

497 sigil__vm_error(vm, SIGIL_ERR_TYPE, "tls-read: expected tls-connection");

498 return SIGIL_UNDEFINED;

499 }

500

501 TlsConnectionData *conn = as_tls_connection(args[0]);

502 if (conn->closed) {

503 sigil__vm_error(vm, SIGIL_ERR_IO, "tls-read: connection is closed");

504 return SIGIL_UNDEFINED;

505 }

506

507 int max_bytes = 4096;

508 if (argc >= 2 && sigil_is_fixnum(args[1])) {

509 max_bytes = (int)sigil_as_fixnum(args[1]);

510 if (max_bytes <= 0) max_bytes = 4096;

511 }

512

513 char *buf = malloc(max_bytes);

514 if (!buf) return SIGIL_FALSE;

515

516 int ret = mbedtls_ssl_read(&conn->ssl, (unsigned char *)buf, max_bytes);

517

518 if (ret == MBEDTLS_ERR_SSL_WANT_READ || ret == MBEDTLS_ERR_SSL_WANT_WRITE) {

519 free(buf);

520 return sigil_make_string(vm, "", 0); /* Non-blocking, no data available */

521 }

522

523 if (ret == MBEDTLS_ERR_SSL_PEER_CLOSE_NOTIFY || ret == 0) {

524 free(buf);

525 return SIGIL_EOF; /* Connection closed */

526 }

527

528 if (ret < 0) {

529 free(buf);

530 return SIGIL_FALSE; /* Error */

531 }

532

533 Value result = sigil_make_string(vm, buf, ret);

534 free(buf);

535 return result;

536}

537

538/*

539 * tls-read-bytevector connection [max-bytes] -> bytevector | #f | eof-object

540 * Read raw bytes from TLS connection into a bytevector.

541 * Unlike tls-read (which returns a UTF-8 string), this preserves raw bytes

542 * without any encoding interpretation. Essential for binary protocols.

543 */

544static Value native_tls_read_bytevector(SigilVM *vm, int argc, Value *args)

545{

546 if (!is_tls_connection(args[0])) {

547 sigil__vm_error(vm, SIGIL_ERR_TYPE, "tls-read-bytevector: expected tls-connection");

548 return SIGIL_UNDEFINED;

549 }

550

551 TlsConnectionData *conn = as_tls_connection(args[0]);

552 if (conn->closed) {

553 sigil__vm_error(vm, SIGIL_ERR_IO, "tls-read-bytevector: connection is closed");

554 return SIGIL_UNDEFINED;

555 }

556

557 int max_bytes = 4096;

558 if (argc >= 2 && sigil_is_fixnum(args[1])) {

559 max_bytes = (int)sigil_as_fixnum(args[1]);

560 if (max_bytes <= 0) max_bytes = 4096;

561 }

562

563 char *buf = malloc(max_bytes);

564 if (!buf) return SIGIL_FALSE;

565

566 int ret = mbedtls_ssl_read(&conn->ssl, (unsigned char *)buf, max_bytes);

567

568 if (ret == MBEDTLS_ERR_SSL_WANT_READ || ret == MBEDTLS_ERR_SSL_WANT_WRITE) {

569 free(buf);

570 return sigil_make_bytevector(vm, 0); /* Non-blocking, no data available */

571 }

572

573 if (ret == MBEDTLS_ERR_SSL_PEER_CLOSE_NOTIFY || ret == 0) {

574 free(buf);

575 return SIGIL_EOF; /* Connection closed */

576 }

577

578 if (ret < 0) {

579 free(buf);

580 return SIGIL_FALSE; /* Error */

581 }

582

583 Value result = sigil_make_bytevector(vm, (size_t)ret);

584 SigilBytevector *bv = (SigilBytevector *)sigil_as_ptr(result);

585 memcpy(bv->data, buf, ret);

586 free(buf);

587 return result;

588}

589

590/*

591 * tls-write connection data -> integer | #f

592 * Write data to TLS connection.

593 * Returns number of bytes written, or #f on error.

594 */

595static Value native_tls_write(SigilVM *vm, int argc, Value *args)

596{

597 (void)argc;

598

599 if (!is_tls_connection(args[0])) {

600 sigil__vm_error(vm, SIGIL_ERR_TYPE, "tls-write: expected tls-connection");

601 return SIGIL_UNDEFINED;

602 }

603

604 TlsConnectionData *conn = as_tls_connection(args[0]);

605 if (conn->closed) {

606 sigil__vm_error(vm, SIGIL_ERR_IO, "tls-write: connection is closed");

607 return SIGIL_UNDEFINED;

608 }

609

610 const char *data;

611 size_t len;

612

613 if (sigil_is_string(args[1])) {

614 SigilString *s = (SigilString *)sigil_as_ptr(args[1]);

615 data = s->data;

616 len = s->byte_length;

617 } else if (sigil_is_bytevector(args[1])) {

618 SigilBytevector *bv = (SigilBytevector *)sigil_as_ptr(args[1]);

619 data = (const char *)bv->data;

620 len = bv->length;

621 } else {

622 sigil__vm_error(vm, SIGIL_ERR_TYPE, "tls-write: expected string or bytevector");

623 return SIGIL_UNDEFINED;

624 }

625

626 int ret;

627 size_t total_written = 0;

628

629 while (total_written < len) {

630 ret = mbedtls_ssl_write(&conn->ssl,

631 (const unsigned char *)data + total_written,

632 len - total_written);

633

634 if (ret == MBEDTLS_ERR_SSL_WANT_READ || ret == MBEDTLS_ERR_SSL_WANT_WRITE) {

635 continue; /* Retry */

636 }

637

638 if (ret < 0) {

639 return SIGIL_FALSE; /* Error */

640 }

641

642 total_written += ret;

643 }

644

645 return sigil_fixnum(total_written);

646}

647

648/*

649 * tls-close connection -> boolean

650 * Close a TLS connection. Returns #t on success.

651 */

652static Value native_tls_close(SigilVM *vm, int argc, Value *args)

653{

654 (void)argc;

655

656 if (!is_tls_connection(args[0])) {

657 sigil__vm_error(vm, SIGIL_ERR_TYPE, "tls-close: expected tls-connection");

658 return SIGIL_UNDEFINED;

659 }

660

661 TlsConnectionData *conn = as_tls_connection(args[0]);

662 if (conn->closed) {

663 return SIGIL_TRUE; /* Already closed */

664 }

665

666 mbedtls_ssl_close_notify(&conn->ssl);

667 mbedtls_net_free(&conn->server_fd);

668 mbedtls_ssl_free(&conn->ssl);

669 mbedtls_ssl_config_free(&conn->conf);

670 mbedtls_x509_crt_free(&conn->cacert);

671

672 conn->closed = 1;

673

674 return SIGIL_TRUE;

675}

676

677/*

678 * tls-closed? connection -> boolean

679 * Check if TLS connection is closed.

680 */

681static Value native_tls_closedp(SigilVM *vm, int argc, Value *args)

682{

683 (void)argc;

684

685 if (!is_tls_connection(args[0])) {

686 sigil__vm_error(vm, SIGIL_ERR_TYPE, "tls-closed?: expected tls-connection");

687 return SIGIL_UNDEFINED;

688 }

689

690 TlsConnectionData *conn = as_tls_connection(args[0]);

691 return sigil_bool(conn->closed);

692}

693

694/*

695 * tls-set-non-blocking! tls-connection [enable] -> boolean

696 * Set the underlying socket to non-blocking mode.

697 * enable defaults to #t if not provided.

698 */

699static Value native_tls_set_non_blocking(SigilVM *vm, int argc, Value *args)

700{

701 if (!is_tls_connection(args[0])) {

702 sigil__vm_error(vm, SIGIL_ERR_TYPE, "tls-set-non-blocking!: expected tls-connection");

703 return SIGIL_UNDEFINED;

704 }

705

706 TlsConnectionData *conn = as_tls_connection(args[0]);

707 if (conn->closed) {

708 return SIGIL_FALSE;

709 }

710

711 int enable = (argc < 2) ? 1 : sigil_is_truthy(args[1]);

712 int fd = conn->server_fd.fd;

713

714#ifdef _WIN32

715 u_long mode = enable ? 1 : 0;

716 return sigil_bool(ioctlsocket(fd, FIONBIO, &mode) == 0);

717#else

718 int flags = fcntl(fd, F_GETFL, 0);

719 if (flags == -1) return SIGIL_FALSE;

720

721 if (enable) {

722 flags |= O_NONBLOCK;

723 } else {

724 flags &= ~O_NONBLOCK;

725 }

726

727 return sigil_bool(fcntl(fd, F_SETFL, flags) != -1);

728#endif

729}

730

731/*

732 * tls-upgrade socket hostname -> tls-connection | #f

733 * Upgrade an existing TCP socket to a TLS connection via STARTTLS.

734 * Takes ownership of the socket's file descriptor. The original socket

735 * object should not be used after this call.

736 */

737static Value native_tls_upgrade(SigilVM *vm, int argc, Value *args)

738{

739 (void)argc;

740

741 /* Validate socket argument - must be a foreign object with "socket" type tag */

742 if (!sigil_is_foreign(args[0])) {

743 sigil__vm_error(vm, SIGIL_ERR_TYPE, "tls-upgrade: expected socket");

744 return SIGIL_UNDEFINED;

745 }

746

747 Value socket_tag = sigil_intern_symbol(vm, "socket", 6);

748 if (sigil_foreign_type(args[0]) != socket_tag) {

749 sigil__vm_error(vm, SIGIL_ERR_TYPE, "tls-upgrade: expected socket");

750 return SIGIL_UNDEFINED;

751 }

752

753 if (!sigil_is_string(args[1])) {

754 sigil__vm_error(vm, SIGIL_ERR_TYPE, "tls-upgrade: expected string for hostname");

755 return SIGIL_UNDEFINED;

756 }

757

758 if (ensure_tls_initialized() < 0) {

759 return SIGIL_FALSE;

760 }

761

762 /* Extract fd from socket foreign data (fd is first int field of SocketData) */

763 int *socket_data = (int *)sigil_foreign_data(args[0]);

764 int existing_fd = socket_data[0];

765 int closed = socket_data[2]; /* closed is third int field */

766

767 if (closed || existing_fd < 0) {

768 sigil__vm_error(vm, SIGIL_ERR_IO, "tls-upgrade: socket is closed");

769 return SIGIL_UNDEFINED;

770 }

771

772 /* Mark the original socket as closed so it won't close the fd on GC */

773 socket_data[2] = 1; /* closed = 1 */

774

775 SigilString *host_str = (SigilString *)sigil_as_ptr(args[1]);

776

777 /* Null-terminate hostname */

778 char *hostname = malloc(host_str->byte_length + 1);

779 if (!hostname) return SIGIL_FALSE;

780 memcpy(hostname, host_str->data, host_str->byte_length);

781 hostname[host_str->byte_length] = '\0';

782

783 /* Allocate connection structure */

784 TlsConnectionData *conn = calloc(1, sizeof(TlsConnectionData));

785 if (!conn) {

786 free(hostname);

787 return SIGIL_FALSE;

788 }

789

790 conn->closed = 0;

791 int ret;

792

793 /* Initialize mbedTLS structures */

794 mbedtls_net_init(&conn->server_fd);

795 mbedtls_ssl_init(&conn->ssl);

796 mbedtls_ssl_config_init(&conn->conf);

797 mbedtls_x509_crt_init(&conn->cacert);

798

799 /* Use the existing fd instead of creating a new connection */

800 conn->server_fd.fd = existing_fd;

801

802 /* Set up SSL configuration */

803 ret = mbedtls_ssl_config_defaults(&conn->conf,

804 MBEDTLS_SSL_IS_CLIENT,

805 MBEDTLS_SSL_TRANSPORT_STREAM,

806 MBEDTLS_SSL_PRESET_DEFAULT);

807 if (ret != 0) {

808 goto cleanup_error;

809 }

810

811 /* Configure certificate verification */

812 if (global_insecure_mode) {

813 mbedtls_ssl_conf_authmode(&conn->conf, MBEDTLS_SSL_VERIFY_NONE);

814 } else if (global_cacert_loaded) {

815 mbedtls_ssl_conf_authmode(&conn->conf, MBEDTLS_SSL_VERIFY_REQUIRED);

816 mbedtls_ssl_conf_ca_chain(&conn->conf, &global_cacert, NULL);

817 } else {

818 mbedtls_ssl_conf_authmode(&conn->conf, MBEDTLS_SSL_VERIFY_NONE);

819 }

820 mbedtls_ssl_conf_rng(&conn->conf, mbedtls_ctr_drbg_random, &global_ctr_drbg);

821

822#ifdef SIGIL_TLS_DEBUG

823 mbedtls_ssl_conf_dbg(&conn->conf, tls_debug_callback, NULL);

824 mbedtls_debug_set_threshold(4);

825#endif

826

827 /* Set up SSL context */

828 ret = mbedtls_ssl_setup(&conn->ssl, &conn->conf);

829 if (ret != 0) {

830 goto cleanup_error;

831 }

832

833 /* Set hostname for SNI */

834 ret = mbedtls_ssl_set_hostname(&conn->ssl, hostname);

835 if (ret != 0) {

836 goto cleanup_error;

837 }

838

839 /* Set I/O functions */

840 mbedtls_ssl_set_bio(&conn->ssl, &conn->server_fd,

841 mbedtls_net_send, mbedtls_net_recv, NULL);

842

843 /* Perform TLS handshake on existing connection */

844 while ((ret = mbedtls_ssl_handshake(&conn->ssl)) != 0) {

845 if (ret != MBEDTLS_ERR_SSL_WANT_READ && ret != MBEDTLS_ERR_SSL_WANT_WRITE) {

846 goto cleanup_error;

847 }

848 }

849

850 free(hostname);

851 return make_tls_connection(vm, conn);

852

853cleanup_error:

854 /* Don't call mbedtls_net_free - it would close the fd which we took ownership of */

855 conn->server_fd.fd = -1; /* Prevent double-close */

856 mbedtls_net_free(&conn->server_fd);

857 mbedtls_ssl_free(&conn->ssl);

858 mbedtls_ssl_config_free(&conn->conf);

859 mbedtls_x509_crt_free(&conn->cacert);

860 free(conn);

861 free(hostname);

862 return SIGIL_FALSE;

863}

864

865/*

866 * Hook implementations for TLS integration with socket layer.

867 * These are registered with sigil-lib during module init.

868 */

869

870/* Get the underlying file descriptor from a TLS connection. */

871static int tls_get_fd_impl(Value v)

872{

873 if (!is_tls_connection(v)) return -1;

874 TlsConnectionData *conn = as_tls_connection(v);

875 if (conn->closed) return -1;

876 return conn->server_fd.fd;

877}

878

879/* Check if a value is a TLS connection. */

880static int tls_is_connection_impl(Value v)

881{

882 return is_tls_connection(v);

883}

884

885/*

886 * Helper macro for module-scoped registration with export

887 */

888#define REGISTER_AND_EXPORT(name, func, arity, doc) \

889 sigil_module_register_native(vm, name, func, arity, doc); \

890 sigil_module_export(vm, name)

891

892/*

893 * Initialize the (sigil tls) module.

894 * This is called at VM startup.

895 */

896void sigil__init_sigil_tls_module(SigilVM *vm)

897{

898 /* Initialize TLS connection type tag */

899 tls_connection_type_tag = sigil_intern_symbol(vm, "tls-connection", 14);

900

901 /* Register hooks so socket-select can work with TLS connections */

902 sigil__register_tls_hooks(tls_get_fd_impl, tls_is_connection_impl);

903

904 SigilModule *module = sigil_begin_module(vm, "(sigil tls)");

905 if (!module) return;

906

907 /* Type predicate */

908 REGISTER_AND_EXPORT("tls-connection?", native_tls_connectionp,

909 SIGIL_ARITY_EXACT(1), "Check if value is a TLS connection");

910

911 /* Connection operations */

912 REGISTER_AND_EXPORT("tls-connect", native_tls_connect,

913 SIGIL_ARITY_RANGE(2, 3), "Connect to TLS server");

914 REGISTER_AND_EXPORT("tls-read", native_tls_read,

915 SIGIL_ARITY_RANGE(1, 2), "Read from TLS connection");

916 REGISTER_AND_EXPORT("tls-read-bytevector", native_tls_read_bytevector,

917 SIGIL_ARITY_RANGE(1, 2), "Read raw bytes from TLS connection");

918 REGISTER_AND_EXPORT("tls-write", native_tls_write,

919 SIGIL_ARITY_EXACT(2), "Write to TLS connection");

920 REGISTER_AND_EXPORT("tls-close", native_tls_close,

921 SIGIL_ARITY_EXACT(1), "Close TLS connection");

922 REGISTER_AND_EXPORT("tls-closed?", native_tls_closedp,

923 SIGIL_ARITY_EXACT(1), "Check if TLS connection is closed");

924 REGISTER_AND_EXPORT("tls-set-non-blocking!", native_tls_set_non_blocking,

925 SIGIL_ARITY_RANGE(1, 2), "Set TLS connection to non-blocking mode");

926

927 /* STARTTLS support */

928 REGISTER_AND_EXPORT("tls-upgrade", native_tls_upgrade,

929 SIGIL_ARITY_EXACT(2), "Upgrade existing TCP socket to TLS connection");

930

931 sigil_end_module(vm);

932}

933

934#undef REGISTER_AND_EXPORT

935

936#endif /* !__EMSCRIPTEN__ */