Add TLS handshake diagnostics and pin the TLS 1.3 stack

Changed

 README.md                    |  16 ++++++++++++++--
 RELEASE_NOTES_v0.16.7.md     |  16 ++++++++++++++++
 native/tls.c                 | 161 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-------------------
 package.sgl                  |   6 ++++--
 sigil.lock                   |   5 ++---
 src/sigil/tls.sgl            |  30 +++++++++++++++++++++++++++---
 test/fixtures/README.md      |  29 +++++++++++++++++++++++++++++
 test/fixtures/tls-client.c   |  58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 test/fixtures/tls-matrix.cjs |  93 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 test/test-tls.sgl            |  31 +++++++++++++++++++++++++++++++
 10 files changed, 416 insertions(+), 29 deletions(-)

Diff

README.mdmodified

@@ -2,7 +2,7 @@

TLS/SSL client connections for [Sigil](https://codeberg.org/sigil/sigil).

−5

Secure TCP connections using mbedTLS. Supports TLS 1.2 client connections

Secure TCP connections using mbedTLS. Supports TLS 1.2 and TLS 1.3 client connections

with system CA certificate verification, non-blocking I/O, and STARTTLS

upgrades of existing sockets.

@@ -10,7 +10,7 @@ upgrades of existing sockets.

| Module | Purpose |

|----------------|-----------------------------------------|

−13

| `(sigil tls)` | TLS 1.2 client connections |

+13

| `(sigil tls)` | TLS 1.2 and TLS 1.3 client connections |

## API summary

@@ -26,6 +26,18 @@ upgrades of existing sockets.

| `tls-connection?` | Whether a value is a TLS connection |

| `tls-set-non-blocking!` | Toggle non-blocking mode on the underlying socket |

+29

## Connection diagnostics

+30

+31

`tls-connect/details` and `tls-upgrade/details` accept the same arguments as

+32

their `/status` counterparts and return a dictionary. The existing connection

+33

and `/status` APIs retain their return shapes.

+34

+35

`status:` gives the stable outcome and `connection:` is the connection or

+36

`#f`. `error-code:`, `error-message:`, and `handshake-state:` describe a

+37

failed handshake. `protocol:` and `cipher:` identify a successful negotiation.

+38

Details belong to that attempt and survive later connections. Handshake state

+39

names are diagnostic information; use `status:` for application decisions.

+40

## System prerequisites

None beyond a working C toolchain. mbedTLS is consumed transitively via

RELEASE_NOTES_v0.16.7.mdadded

@@ -0,0 +1,16 @@

# 0.16.7

TLS connections now negotiate TLS 1.3 when the server supports it, while

remaining compatible with TLS 1.2-only servers. This requires sigil-crypto

0.16.6 or later in the 0.16 series, with Mbed TLS 3.6.7 and PSA enabled.

New tls-connect/details and tls-upgrade/details procedures return per-attempt

handshake errors, state, verification flags and negotiated protocol/cipher.

The existing connection and /status APIs retain their argument and return

+10

shapes. Bounded handshakes keep their existing total deadlines.

+11

+12

Validation: 22 TLS tests and 100 crypto tests passed. Native Linux and Android

+13

fixtures each passed forty encrypted roundtrips per TLS version, certificate

+14

rejection, and reconnect after rejection. Production certificate verification

+15

was also exercised with TLS 1.3 clients on both systems. These checks do not

+16

establish a terminal-latency or CPU improvement.

native/tls.cmodified

@@ -4,7 +4,8 @@

* This file implements TLS/SSL connections using mbedTLS.

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

*

−7

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

* Supports TLS 1.2 and TLS 1.3 with the shared sigil-crypto configuration.

* mbedTLS initializes PSA as part of its TLS 1.3 handshake.

*

* Certificate Verification:

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

@@ -102,6 +103,16 @@ typedef struct {

103

long handshake_deadline_ms;

104

} TlsConnectionData;

105

+106

/* Per-attempt diagnostics are copied before connection cleanup. No shared

+107

* last-error slot: another connection cannot overwrite this attempt's result. */

+108

typedef struct {

+109

int error_code;

+110

const char *handshake_state;

+111

const char *protocol;

+112

const char *cipher;

+113

uint32_t verify_flags;

+114

} TlsDiagnostics;

+115

116

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

117

static Value tls_connection_type_tag = SIGIL_UNDEFINED;

118

@@ -450,6 +461,59 @@ static int sigil_tls_bio_send(void *ctx, const unsigned char *buf, size_t len)

461

}

462

#endif /* !_WIN32 */

463

+464

static const char *tls_handshake_state_name(int state)

+465

{

+466

switch (state) {

+467

case MBEDTLS_SSL_HELLO_REQUEST: return "hello-request";

+468

case MBEDTLS_SSL_CLIENT_HELLO: return "client-hello";

+469

case MBEDTLS_SSL_SERVER_HELLO: return "server-hello";

+470

case MBEDTLS_SSL_SERVER_CERTIFICATE: return "server-certificate";

+471

case MBEDTLS_SSL_SERVER_KEY_EXCHANGE: return "server-key-exchange";

+472

case MBEDTLS_SSL_CERTIFICATE_REQUEST: return "certificate-request";

+473

case MBEDTLS_SSL_SERVER_HELLO_DONE: return "server-hello-done";

+474

case MBEDTLS_SSL_CLIENT_CERTIFICATE: return "client-certificate";

+475

case MBEDTLS_SSL_CLIENT_KEY_EXCHANGE: return "client-key-exchange";

+476

case MBEDTLS_SSL_CERTIFICATE_VERIFY: return "certificate-verify";

+477

case MBEDTLS_SSL_CLIENT_CHANGE_CIPHER_SPEC: return "client-change-cipher-spec";

+478

case MBEDTLS_SSL_CLIENT_FINISHED: return "client-finished";

+479

case MBEDTLS_SSL_SERVER_CHANGE_CIPHER_SPEC: return "server-change-cipher-spec";

+480

case MBEDTLS_SSL_SERVER_FINISHED: return "server-finished";

+481

case MBEDTLS_SSL_FLUSH_BUFFERS: return "flush-buffers";

+482

case MBEDTLS_SSL_HANDSHAKE_WRAPUP: return "handshake-wrapup";

+483

case MBEDTLS_SSL_NEW_SESSION_TICKET: return "new-session-ticket";

+484

case MBEDTLS_SSL_SERVER_HELLO_VERIFY_REQUEST_SENT: return "server-hello-verify-request-sent";

+485

case MBEDTLS_SSL_HELLO_RETRY_REQUEST: return "hello-retry-request";

+486

case MBEDTLS_SSL_ENCRYPTED_EXTENSIONS: return "encrypted-extensions";

+487

case MBEDTLS_SSL_END_OF_EARLY_DATA: return "end-of-early-data";

+488

case MBEDTLS_SSL_CLIENT_CERTIFICATE_VERIFY: return "client-certificate-verify";

+489

case MBEDTLS_SSL_CLIENT_CCS_AFTER_SERVER_FINISHED: return "client-ccs-after-server-finished";

+490

case MBEDTLS_SSL_CLIENT_CCS_BEFORE_2ND_CLIENT_HELLO: return "client-ccs-before-2nd-client-hello";

+491

case MBEDTLS_SSL_SERVER_CCS_AFTER_SERVER_HELLO: return "server-ccs-after-server-hello";

+492

case MBEDTLS_SSL_CLIENT_CCS_AFTER_CLIENT_HELLO: return "client-ccs-after-client-hello";

+493

case MBEDTLS_SSL_SERVER_CCS_AFTER_HELLO_RETRY_REQUEST: return "server-ccs-after-hello-retry-request";

+494

case MBEDTLS_SSL_HANDSHAKE_OVER: return "handshake-over";

+495

case MBEDTLS_SSL_TLS1_3_NEW_SESSION_TICKET: return "tls1-3-new-session-ticket";

+496

case MBEDTLS_SSL_TLS1_3_NEW_SESSION_TICKET_FLUSH: return "tls1-3-new-session-ticket-flush";

+497

default: return "unknown";

+498

}

+499

}

+500

+501

static int tls_handshake_result(TlsConnectionData *conn, int error,

+502

TlsDiagnostics *details)

+503

{

+504

if (details) {

+505

details->error_code = error;

+506

details->handshake_state = tls_handshake_state_name(conn->ssl.MBEDTLS_PRIVATE(state));

+507

details->verify_flags = mbedtls_ssl_get_verify_result(&conn->ssl);

+508

if (error == 0) {

+509

details->protocol = mbedtls_ssl_get_version(&conn->ssl);

+510

details->cipher = mbedtls_ssl_get_ciphersuite(&conn->ssl);

+511

}

+512

}

+513

if (error == 0) return SIGIL_TLS_HS_OK;

+514

return error == MBEDTLS_ERR_SSL_TIMEOUT ? SIGIL_TLS_HS_TIMEOUT : SIGIL_TLS_HS_FAILED;

+515

}

+516

517

/*

518

* Run the TLS handshake on an already-connected conn->server_fd.

519

*

@@ -474,14 +538,13 @@ static int sigil_tls_bio_send(void *ctx, const unsigned char *buf, size_t len)

538

* subsequent tls-read and tls-write behave exactly as before. Only the

539

* handshake is bounded here.

540

*/

−477

static int sigil_tls_run_handshake(TlsConnectionData *conn, long handshake_timeout_ms)

+541

static int sigil_tls_run_handshake(TlsConnectionData *conn, long handshake_timeout_ms,

+542

TlsDiagnostics *details)

543

{

544

int ret;

545

546

#ifndef _WIN32

547

if (handshake_timeout_ms > 0) {

−483

int outcome = SIGIL_TLS_HS_OK;

−484

548

conn->handshake_deadline_ms = sigil_tls_now_ms() + handshake_timeout_ms;

549

mbedtls_ssl_conf_read_timeout(&conn->conf, (uint32_t)handshake_timeout_ms);

550

mbedtls_ssl_set_bio(&conn->ssl, conn,

@@ -494,18 +557,16 @@ static int sigil_tls_run_handshake(TlsConnectionData *conn, long handshake_timeo

557

break;

558

}

559

if (ret == MBEDTLS_ERR_SSL_TIMEOUT) {

−497

outcome = SIGIL_TLS_HS_TIMEOUT;

560

break;

561

}

562

if (ret != MBEDTLS_ERR_SSL_WANT_READ &&

563

ret != MBEDTLS_ERR_SSL_WANT_WRITE) {

−502

outcome = SIGIL_TLS_HS_FAILED;

564

break;

565

}

566

/* WANT_* on a blocking BIO means the deadline is the only thing

567

* that can end this; check it so the retry cannot spin. */

568

if (conn->handshake_deadline_ms - sigil_tls_now_ms() <= 0) {

−508

outcome = SIGIL_TLS_HS_TIMEOUT;

+569

ret = MBEDTLS_ERR_SSL_TIMEOUT;

570

break;

571

}

572

}

@@ -515,7 +576,7 @@ static int sigil_tls_run_handshake(TlsConnectionData *conn, long handshake_timeo

576

mbedtls_ssl_conf_read_timeout(&conn->conf, 0);

577

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

578

mbedtls_net_send, mbedtls_net_recv, NULL);

−518

return outcome;

+579

return tls_handshake_result(conn, ret, details);

580

}

581

#else

582

(void)handshake_timeout_ms;

@@ -526,10 +587,10 @@ static int sigil_tls_run_handshake(TlsConnectionData *conn, long handshake_timeo

587

588

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

589

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

−529

return SIGIL_TLS_HS_FAILED;

+590

return tls_handshake_result(conn, ret, details);

591

}

592

}

−532

return SIGIL_TLS_HS_OK;

+593

return tls_handshake_result(conn, 0, details);

594

}

595

596

/*

@@ -539,9 +600,9 @@ static int sigil_tls_run_handshake(TlsConnectionData *conn, long handshake_timeo

600

*/

601

static Value make_tls_status(SigilVM *vm, const char *status, Value conn)

602

{

+603

sigil__gc_push_temp_root(vm, conn);

604

Value status_val = sigil_make_string(vm, status, strlen(status));

605

sigil__gc_push_temp_root(vm, status_val);

−544

sigil__gc_push_temp_root(vm, conn);

606

Value result = sigil_cons(vm, status_val, conn);

607

sigil__gc_pop_temp_root(vm);

608

sigil__gc_pop_temp_root(vm);

@@ -557,7 +618,7 @@ static Value make_tls_status(SigilVM *vm, const char *status, Value conn)

618

* (which surfaces it) run this, so the two can never drift apart.

619

*/

620

static Value tls_connect_core(SigilVM *vm, int argc, Value *args,

−560

const char **status_out)

+621

const char **status_out, TlsDiagnostics *details)

622

{

623

*status_out = "tls-init-failed";

624

@@ -670,7 +731,7 @@ static Value tls_connect_core(SigilVM *vm, int argc, Value *args,

731

}

732

733

/* Perform TLS handshake (bounded when handshake_timeout_ms > 0). */

−673

ret = sigil_tls_run_handshake(conn, handshake_timeout_ms);

+734

ret = sigil_tls_run_handshake(conn, handshake_timeout_ms, details);

735

if (ret == SIGIL_TLS_HS_TIMEOUT) {

736

*status_out = "handshake-timeout";

737

goto cleanup_error;

@@ -740,7 +801,7 @@ static Value native_tls_connect(SigilVM *vm, int argc, Value *args)

801

if (tls_connect_check_args(vm, args, "tls-connect") < 0) {

802

return SIGIL_UNDEFINED;

803

}

−743

return tls_connect_core(vm, argc, args, &status);

+804

return tls_connect_core(vm, argc, args, &status, NULL);

805

}

806

807

/*

@@ -766,10 +827,58 @@ static Value native_tls_connect_status(SigilVM *vm, int argc, Value *args)

827

return SIGIL_UNDEFINED;

828

}

829

−769

Value conn = tls_connect_core(vm, argc, args, &status);

+830

Value conn = tls_connect_core(vm, argc, args, &status, NULL);

831

return make_tls_status(vm, status, conn);

832

}

833

+834

/* Values are rooted while subsequent strings/keywords allocate. */

+835

static Value tls_detail_string(SigilVM *vm, const char *text)

+836

{

+837

return text ? sigil_make_string(vm, text, strlen(text)) : SIGIL_FALSE;

+838

}

+839

+840

static Value make_tls_details(SigilVM *vm, const char *status, Value conn,

+841

const TlsDiagnostics *details)

+842

{

+843

char message[256];

+844

if (details->error_code != 0)

+845

mbedtls_strerror(details->error_code, message, sizeof(message));

+846

const char *names[] = { "status", "connection", "error-code", "error-message",

+847

"handshake-state", "protocol", "cipher", "verify-flags" };

+848

Value pairs[16];

+849

sigil__gc_push_temp_root(vm, conn);

+850

for (int i = 0; i < 8; i++) {

+851

pairs[i * 2] = sigil_intern_keyword(vm, names[i], strlen(names[i]));

+852

sigil__gc_push_temp_root(vm, pairs[i * 2]);

+853

Value value;

+854

switch (i) {

+855

case 0: value = tls_detail_string(vm, status); break;

+856

case 1: value = conn; break;

+857

case 2: value = sigil_fixnum(details->error_code); break;

+858

case 3: value = tls_detail_string(vm, details->error_code ? message : NULL); break;

+859

case 4: value = tls_detail_string(vm, details->handshake_state); break;

+860

case 5: value = tls_detail_string(vm, details->protocol); break;

+861

case 6: value = tls_detail_string(vm, details->cipher); break;

+862

default: value = sigil_fixnum(details->verify_flags); break;

+863

}

+864

pairs[i * 2 + 1] = value;

+865

sigil__gc_push_temp_root(vm, value);

+866

}

+867

Value result = sigil_dict_create(vm, 8, pairs);

+868

for (int i = 0; i < 17; i++) sigil__gc_pop_temp_root(vm);

+869

return result;

+870

}

+871

+872

static Value native_tls_connect_details(SigilVM *vm, int argc, Value *args)

+873

{

+874

const char *status = "tls-init-failed";

+875

TlsDiagnostics details = {0};

+876

if (tls_connect_check_args(vm, args, "tls-connect/details") < 0)

+877

return SIGIL_UNDEFINED;

+878

Value conn = tls_connect_core(vm, argc, args, &status, &details);

+879

return make_tls_details(vm, status, conn, &details);

+880

}

+881

882

/*

883

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

884

* Read data from TLS connection.

@@ -1066,7 +1175,7 @@ static Value native_tls_set_non_blocking(SigilVM *vm, int argc, Value *args)

1175

* arguments have already been validated.

1176

*/

1177

static Value tls_upgrade_core(SigilVM *vm, int argc, Value *args,

−1069

const char **status_out)

+1178

const char **status_out, TlsDiagnostics *details)

1179

{

1180

*status_out = "tls-init-failed";

1181

@@ -1164,7 +1273,7 @@ static Value tls_upgrade_core(SigilVM *vm, int argc, Value *args,

1273

* handshake_timeout_ms > 0). An upgraded socket is ALREADY connected,

1274

* so every byte of its handshake sits past the connect phase — the

1275

* unbounded window here is strictly wider than tls-connect's. */

−1167

ret = sigil_tls_run_handshake(conn, handshake_timeout_ms);

+1276

ret = sigil_tls_run_handshake(conn, handshake_timeout_ms, details);

1277

if (ret == SIGIL_TLS_HS_TIMEOUT) {

1278

*status_out = "handshake-timeout";

1279

goto cleanup_error;

@@ -1243,7 +1352,7 @@ static Value native_tls_upgrade(SigilVM *vm, int argc, Value *args)

1352

if (tls_upgrade_check_args(vm, args, "tls-upgrade") < 0) {

1353

return SIGIL_UNDEFINED;

1354

}

−1246

return tls_upgrade_core(vm, argc, args, &status);

+1355

return tls_upgrade_core(vm, argc, args, &status, NULL);

1356

}

1357

1358

/*

@@ -1261,10 +1370,20 @@ static Value native_tls_upgrade_status(SigilVM *vm, int argc, Value *args)

1370

return SIGIL_UNDEFINED;

1371

}

1372

−1264

Value conn = tls_upgrade_core(vm, argc, args, &status);

+1373

Value conn = tls_upgrade_core(vm, argc, args, &status, NULL);

1374

return make_tls_status(vm, status, conn);

1375

}

1376

+1377

static Value native_tls_upgrade_details(SigilVM *vm, int argc, Value *args)

+1378

{

+1379

const char *status = "tls-init-failed";

+1380

TlsDiagnostics details = {0};

+1381

if (tls_upgrade_check_args(vm, args, "tls-upgrade/details") < 0)

+1382

return SIGIL_UNDEFINED;

+1383

Value conn = tls_upgrade_core(vm, argc, args, &status, &details);

+1384

return make_tls_details(vm, status, conn, &details);

+1385

}

+1386

1387

/*

1388

* Hook implementations for TLS integration with socket layer.

1389

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

@@ -1312,6 +1431,8 @@ void sigil__init_sigil_tls_module(SigilVM *vm)

1431

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

1432

1433

/* Connection operations */

+1434

REGISTER_AND_EXPORT("tls-connect/details", native_tls_connect_details,

+1435

SIGIL_ARITY_RANGE(2, 4), "Connect to TLS with per-attempt diagnostics");

1436

REGISTER_AND_EXPORT("tls-connect", native_tls_connect,

1437

SIGIL_ARITY_RANGE(2, 4), "Connect to TLS server");

1438

REGISTER_AND_EXPORT("tls-connect/status", native_tls_connect_status,

@@ -1331,6 +1452,8 @@ void sigil__init_sigil_tls_module(SigilVM *vm)

1452

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

1453

1454

/* STARTTLS support */

+1455

REGISTER_AND_EXPORT("tls-upgrade/details", native_tls_upgrade_details,

+1456

SIGIL_ARITY_RANGE(2, 3), "Upgrade to TLS with per-attempt diagnostics");

1457

REGISTER_AND_EXPORT("tls-upgrade", native_tls_upgrade,

1458

SIGIL_ARITY_RANGE(2, 3), "Upgrade existing TCP socket to TLS connection");

1459

REGISTER_AND_EXPORT("tls-upgrade/status", native_tls_upgrade_status,

package.sglmodified

@@ -9,7 +9,7 @@

(package

name: "sigil-tls"

−12

version: "0.16.6"

+12

version: "0.16.7"

sigil: "0.20"

description: "TLS/SSL connections for Sigil"

url: "https://codeberg.org/sigil/sigil-tls"

@@ -29,7 +29,9 @@

;; topics/sigil-crypto-017-pin-does-not-protect-native-codegen.

(from-git url: "codeberg:sigil/sigil"

package: "sigil-lib" version: ">=0.21")

−32

(from-git url: "codeberg:sigil/sigil-crypto" version: "^0.16"))

+32

;; Pin the tested TLS 1.3 stack for the upcoming Sigil release.

+33

(from-git url: "codeberg:sigil/sigil-crypto"

+34

commit: "71362137db0596e0695791b32c4f6e8faf11b39e"))

;; These must track the host runtime. At ^0.17 they resolved to

;; sigil-test-runner 0.17.17, whose core.sgb is bytecode v10, and a 0.19

sigil.lockmodified

@@ -26,9 +26,8 @@

version: "0.21.0")

(package name: "sigil-crypto"

url: "codeberg:sigil/sigil-crypto"

−29

ref: "^0.16"

−30

sha: "debba4462b7ff4de143db9e0792b8606fdc455bc"

−31

version: "0.16.5")

+29

sha: "71362137db0596e0695791b32c4f6e8faf11b39e"

+30

version: "0.16.6")

(package name: "sigil-json"

url: "codeberg:sigil/sigil-json"

ref: "^0.16.0"

src/sigil/tls.sglmodified

@@ -1,6 +1,6 @@

;;; (sigil tls) - TLS/SSL Connections

;;;

−3

;;; Secure TCP connections using mbedTLS. Supports TLS 1.2 client

;;; Secure TCP connections using mbedTLS. Supports TLS 1.2 and TLS 1.3 client

;;; connections with system CA certificate verification.

;;;

;;; ```scheme

@@ -17,6 +17,7 @@

tls-connection?

tls-connect

tls-connect/status

+20

tls-connect/details

tls-read

tls-read-bytevector

tls-write

@@ -24,7 +25,8 @@

tls-closed?

tls-set-non-blocking!

tls-upgrade

−27

tls-upgrade/status)

+28

tls-upgrade/status

+29

tls-upgrade/details)

(begin

@@ -89,6 +91,22 @@

(define-native (tls-connect/status hostname port . timeouts-ms)

(: string? integer? -> pair?))

+94

;;; Connect with per-attempt handshake diagnostics.

+95

;;;

+96

;;; Takes the same arguments and deadlines as tls-connect/status.

+97

;;; Returns a dictionary with status:, connection:, error-code:,

+98

;;; error-message:, handshake-state:, protocol:, cipher:, verify-flags:.

+99

;;; The connection is #f on failure; close a successful one with tls-close.

+100

;;; Error codes/messages are mbedTLS handshake errors, with 0/#f when no

+101

;;; handshake error is available. Consult status: for pre-handshake failures.

+102

;;; Handshake state is #f before a handshake, otherwise a diagnostic state

+103

;;; name (not a stable application error category). Protocol and cipher are

+104

;;; populated only after success. Verify flags are mbedTLS X.509 flags;

+105

;;; they do not establish verification when insecure mode was requested.

+106

;;; Each result owns its details; later attempts cannot overwrite it.

+107

(define-native (tls-connect/details hostname port . timeouts-ms)

+108

(: string? integer? -> dict?))

+109

110

;;; Read data from a TLS connection.

111

;;;

112

;;; Returns a string with data, #f on error, or eof-object if the

@@ -184,4 +202,10 @@

202

;;; Like `tls-upgrade`, but returns `(status . connection-or-#f)`.

203

;;; Statuses match `tls-connect/status` minus the connect-phase ones.

204

(define-native (tls-upgrade/status socket hostname . handshake-timeout-ms)

−187

(: any? string? -> pair?))))

+205

(: any? string? -> pair?))

+206

+207

;;; Upgrade an existing socket, returning the same diagnostic dictionary

+208

;;; as tls-connect/details. Takes the same arguments as tls-upgrade/status

+209

;;; and owns the socket even when the handshake fails.

+210

(define-native (tls-upgrade/details socket hostname . handshake-timeout-ms)

+211

(: any? string? -> dict?))))

test/fixtures/README.mdadded

@@ -0,0 +1,29 @@

# Native TLS integration matrix

The driver includes the production TLS implementation and invokes its public

native entry points in a real Sigil VM. It installs only the test CA in that

process, keeping certificate and hostname verification enabled. This is

necessary because the current library searches system CA files before the

SSL_CERT_FILE override. It does not set SIGIL_TLS_INSECURE.

Compile tls-client.c against the same sigil-lib and sigil-crypto headers and

+10

archives as the build under test, with MBEDTLS_CONFIG_FILE defined as

+11

"sigil_mbedtls_config.h". For example, with a configured C compiler:

+12

+13

```sh

+14

cc -O2 -DMBEDTLS_CONFIG_FILE='"sigil_mbedtls_config.h"' \

+15

-I"$SIGIL_LIB_DIR/include" -I"$SIGIL_LIB_DIR/src" \

+16

-I"$SIGIL_CRYPTO_DIR/vendor/mbedtls/include" \

+17

-I"$SIGIL_CRYPTO_DIR/vendor/mbedtls" \

+18

test/fixtures/tls-client.c "$SIGIL_LIB_ARCHIVE" "$SIGIL_CRYPTO_ARCHIVE" \

+19

-lm -lpthread -o /tmp/sigil-tls-client

+20

node test/fixtures/tls-matrix.cjs /tmp/sigil-tls-client

+21

```

+22

+23

Node and OpenSSL are fixture dependencies; OPENSSL may select an explicit

+24

OpenSSL executable. Each child has a 15-second watchdog. The matrix generates

+25

a private test certificate and checks both TLS 1.2 and TLS 1.3: forty verified

+26

connections with encrypted roundtrips, wrong-host and untrusted certificates,

+27

and a successful reconnect after certificate rejection. A failure exits

+28

nonzero. The ordinary Sigil suite separately covers handshake deadlines and

+29

socket ownership for both connect and upgrade.

test/fixtures/tls-client.cadded

@@ -0,0 +1,58 @@

/* Exercise public native entry points and per-attempt result ownership. */

#include "../../native/tls.c"

static Value field(SigilVM *vm, Value result, const char *name) {

return sigil_dict_ref(vm, result, sigil_intern_keyword(vm, name, strlen(name)));

}

static const char *text_value(Value value) {

return sigil_is_string(value) ? ((SigilString *)sigil_as_ptr(value))->data : "none";

}

int main(int argc, char **argv)

+10

{

+11

if (argc < 3) return 64;

+12

SigilVM *vm = sigil_vm_create();

+13

if (!vm) return 70;

+14

sigil__init_sigil_tls_module(vm);

+15

if (argc > 3) {

+16

ensure_tls_initialized();

+17

mbedtls_x509_crt_free(&global_cacert);

+18

mbedtls_x509_crt_init(&global_cacert);

+19

if (mbedtls_x509_crt_parse_file(&global_cacert, argv[3]) != 0) return 65;

+20

global_cacert_loaded = 1;

+21

}

+22

int repeat = getenv("PROBE_REPEAT") ? atoi(getenv("PROBE_REPEAT")) : 1;

+23

int exit_code = 0;

+24

for (int i = 0; i < repeat; i++) {

+25

const char *host = i == 0 && getenv("PROBE_FIRST_BAD_HOST") ? "127.0.0.1" : argv[1];

+26

Value args[] = {sigil_make_string(vm, host, strlen(host)),

+27

sigil_fixnum(atoi(argv[2])), sigil_fixnum(3000), sigil_fixnum(1500)};

+28

sigil__gc_push_temp_root(vm, args[0]);

+29

long start = sigil_tls_now_ms();

+30

Value result = native_tls_connect_details(vm, 4, args);

+31

sigil__gc_push_temp_root(vm, result);

+32

Value conn = field(vm, result, "connection");

+33

printf("attempt=%d status=%s error=%ld state=%s protocol=%s verify=%ld elapsed=%ld\n",

+34

i, text_value(field(vm, result, "status")), (long)sigil_as_fixnum(field(vm, result, "error-code")),

+35

text_value(field(vm, result, "handshake-state")), text_value(field(vm, result, "protocol")),

+36

(long)sigil_as_fixnum(field(vm, result, "verify-flags")), sigil_tls_now_ms() - start);

+37

if (is_tls_connection(conn)) {

+38

if (getenv("PROBE_ECHO")) {

+39

const char *payload = "sigil-tls-roundtrip-0123456789";

+40

Value write_args[] = {conn, sigil_make_string(vm, payload, strlen(payload))};

+41

sigil__gc_push_temp_root(vm, write_args[1]);

+42

Value n = native_tls_write(vm, 2, write_args);

+43

if (!sigil_is_fixnum(n) || sigil_as_fixnum(n) != (int)strlen(payload)) return 71;

+44

sigil__gc_pop_temp_root(vm);

+45

Value read_args[] = {conn};

+46

Value reply = native_tls_read(vm, 1, read_args);

+47

if (!sigil_is_string(reply) || strcmp(text_value(reply), payload)) return 72;

+48

puts("echo=ok");

+49

}

+50

Value close_args[] = {conn};

+51

native_tls_close(vm, 1, close_args);

+52

} else if (!(i == 0 && getenv("PROBE_FIRST_BAD_HOST"))) exit_code = 1;

+53

sigil__gc_pop_temp_root(vm);

+54

sigil__gc_pop_temp_root(vm);

+55

}

+56

sigil_vm_destroy(vm);

+57

return exit_code;

+58

}

test/fixtures/tls-matrix.cjsadded

@@ -0,0 +1,93 @@

const fs = require('fs');

const tls = require('tls');

const cp = require('child_process');

const path = require('path');

const os = require('os');

const binary = process.argv[2];

if (!binary) {

throw new Error('Usage: node test/fixtures/tls-matrix.cjs /path/to/tls-client');

+10

}

+11

const root = fs.mkdtempSync(path.join(os.tmpdir(), 'sigil-tls-matrix-'));

+12

let failures = 0;

+13

process.on('exit', () => fs.rmSync(root, { recursive: true, force: true }));

+14

cp.execFileSync(process.env.OPENSSL || 'openssl', [

+15

'req', '-x509', '-newkey', 'rsa:2048', '-nodes',

+16

'-keyout', root + '/key.pem', '-out', root + '/cert.pem',

+17

'-days', '1', '-subj', '/CN=localhost', '-addext', 'subjectAltName=DNS:localhost',

+18

], { stdio: 'ignore' });

+19

+20

function probe(port, version, label, host, trust, extra, expect) {

+21

return new Promise((resolve, reject) => {

+22

const args = [host, String(port), ...(trust ? [root + '/cert.pem'] : [])];

+23

const env = { ...process.env, ...extra };

+24

delete env.SIGIL_TLS_INSECURE;

+25

const child = cp.spawn(binary, args, { env });

+26

let output = '';

+27

const timer = setTimeout(() => child.kill('SIGKILL'), 15000);

+28

child.stdout.on('data', data => { output += data; });

+29

child.stderr.on('data', data => { output += data; });

+30

child.on('error', error => {

+31

clearTimeout(timer);

+32

reject(error);

+33

});

+34

child.on('exit', (code, signal) => {

+35

clearTimeout(timer);

+36

const pass = !signal && expect(code, output);

+37

console.log(JSON.stringify({ version, label, code, signal, pass, output }));

+38

if (!pass) failures++;

+39

resolve();

+40

});

+41

});

+42

}

+43

+44

async function checkVersion(version) {

+45

const sockets = new Set();

+46

const server = tls.createServer({

+47

key: fs.readFileSync(root + '/key.pem'),

+48

cert: fs.readFileSync(root + '/cert.pem'),

+49

minVersion: version,

+50

maxVersion: version,

+51

}, socket => {

+52

socket.on('data', data => socket.write(data));

+53

});

+54

server.on('connection', socket => {

+55

sockets.add(socket);

+56

socket.on('error', () => {});

+57

socket.on('close', () => sockets.delete(socket));

+58

});

+59

// Certificate-negative arms deliberately terminate their TLS handshakes.

+60

server.on('tlsClientError', () => {});

+61

await new Promise(resolve => server.listen(0, '127.0.0.1', resolve));

+62

const port = server.address().port;

+63

try {

+64

await probe(port, version, 'verified-repeat-40', 'localhost', true,

+65

{ PROBE_ECHO: '1', PROBE_REPEAT: '40' }, (code, output) => {

+66

const attempts = output.split('\n').filter(line => line.startsWith('attempt='));

+67

return code === 0 && attempts.length === 40 &&

+68

attempts.every(line => line.includes('protocol=' + version)) &&

+69

(output.match(/echo=ok/g) || []).length === 40;

+70

});

+71

await probe(port, version, 'wrong-host', '127.0.0.1', true, {},

+72

(code, output) => code === 1 && output.includes('error=-9984') &&

+73

output.includes('verify=4'));

+74

await probe(port, version, 'untrusted', 'localhost', false, {},

+75

(code, output) => code === 1 && output.includes('error=-9984'));

+76

await probe(port, version, 'recover-after-rejection', 'localhost', true,

+77

{ PROBE_ECHO: '1', PROBE_REPEAT: '2', PROBE_FIRST_BAD_HOST: '1' },

+78

(code, output) => code === 0 && output.includes('error=-9984') &&

+79

output.includes('attempt=1 status=connected') && output.includes('echo=ok'));

+80

} finally {

+81

for (const socket of sockets) socket.destroy();

+82

await new Promise(resolve => server.close(resolve));

+83

}

+84

}

+85

+86

(async () => {

+87

await checkVersion('TLSv1.2');

+88

await checkVersion('TLSv1.3');

+89

process.exitCode = failures ? 1 : 0;

+90

})().catch(error => {

+91

console.error(error);

+92

process.exitCode = 1;

+93

});

test/test-tls.sglmodified

@@ -195,3 +195,34 @@

195

(assert-false (cdr r)))))

196

197

(run-tests)

+198

+199

+200

(test-group "per-attempt handshake diagnostics"

+201

(test "details distinguish a failed TCP connect from a handshake"

+202

(let ((result (tls-connect/details "127.0.0.1" 1 1000 1000)))

+203

(assert-equal "tcp-connect-failed" (dict-ref result status:))

+204

(assert-false (dict-ref result connection:))

+205

(assert-false (dict-ref result handshake-state:))

+206

(assert-false (dict-ref result protocol:))))

+207

+208

(test "stalled handshake preserves its raw timeout and phase"

+209

(let* ((listener (tcp-listen 0))

+210

(result (tls-connect/details "127.0.0.1" (stall-port listener) 1000 100)))

+211

(socket-close listener)

+212

(assert-equal "handshake-timeout" (dict-ref result status:))

+213

(assert-false (dict-ref result connection:))

+214

(assert-equal -26624 (dict-ref result error-code:))

+215

(assert-true (string? (dict-ref result error-message:)))

+216

(assert-equal "server-hello" (dict-ref result handshake-state:))

+217

(tls-connect/details "127.0.0.1" 1 1000 1000)

+218

(assert-equal -26624 (dict-ref result error-code:))))

+219

+220

(test "upgrade details preserve the handshake deadline and own the socket"

+221

(let* ((listener (tcp-listen 0))

+222

(socket (tcp-connect "127.0.0.1" (stall-port listener)))

+223

(result (tls-upgrade/details socket "localhost" 100)))

+224

(socket-close listener)

+225

(assert-equal "handshake-timeout" (dict-ref result status:))

+226

(assert-equal -26624 (dict-ref result error-code:))

+227

(assert-false (dict-ref result connection:))

+228

(assert-error (tls-upgrade/details socket "localhost" 100)))))