|
| 1 | +#!/usr/bin/env escript |
| 2 | +%% -*- erlang -*- |
| 3 | +%% |
| 4 | +%% This file is part of AtomVM. |
| 5 | +%% |
| 6 | +%% Copyright 2026 Paul Guyot <pguyot@kallisys.net> |
| 7 | +%% |
| 8 | +%% Licensed under the Apache License, Version 2.0 (the "License"); |
| 9 | +%% you may not use this file except in compliance with the License. |
| 10 | +%% You may obtain a copy of the License at |
| 11 | +%% |
| 12 | +%% http://www.apache.org/licenses/LICENSE-2.0 |
| 13 | +%% |
| 14 | +%% Unless required by applicable law or agreed to in writing, software |
| 15 | +%% distributed under the License is distributed on an "AS IS" BASIS, |
| 16 | +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. |
| 17 | +%% See the License for the specific language governing permissions and |
| 18 | +%% limitations under the License. |
| 19 | +%% |
| 20 | +%% SPDX-License-Identifier: Apache-2.0 OR LGPL-2.1-or-later |
| 21 | +%% |
| 22 | + |
| 23 | +%% Local endpoints for the qemu network tests (test_socket, test_ssl). |
| 24 | +%% |
| 25 | +%% The qemu guest reaches this host at 10.0.2.2 (SLIRP user networking), so |
| 26 | +%% test_socket and test_ssl talk to these servers instead of an external site: |
| 27 | +%% CI runner egress is slow and lossy enough that external connections pile up |
| 28 | +%% in lwIP until the board runs out of memory. |
| 29 | +%% |
| 30 | +%% - port 80: answers any request with an HTTP/1.1 301, like http://github.com |
| 31 | +%% - port 443: TLS (self-signed, clients don't verify), answers HTTP/1.1 200 |
| 32 | +%% - port 53: minimal UDP DNS responder, so the UDP test needs no real resolver |
| 33 | +%% |
| 34 | +%% Usage: escript local_test_servers.escript [--certdir DIR] |
| 35 | + |
| 36 | +main(Args) -> |
| 37 | + CertDir = cert_dir(Args), |
| 38 | + {ok, _} = application:ensure_all_started(ssl), |
| 39 | + {ok, HTTPListen} = gen_tcp:listen(80, [binary, {active, false}, {reuseaddr, true}]), |
| 40 | + {ok, TLSListen} = ssl:listen(443, [binary, {active, false}, {reuseaddr, true} | tls_opts(CertDir)]), |
| 41 | + {ok, DNSSocket} = gen_udp:open(53, [binary, {active, false}, {reuseaddr, true}]), |
| 42 | + spawn_link(fun() -> http_loop(HTTPListen) end), |
| 43 | + spawn_link(fun() -> tls_loop(TLSListen) end), |
| 44 | + io:format("listening on 0.0.0.0:80 (http), 0.0.0.0:443 (tls) and 0.0.0.0:53 (dns)~n"), |
| 45 | + dns_loop(DNSSocket). |
| 46 | + |
| 47 | +cert_dir(["--certdir", Dir | _]) -> Dir; |
| 48 | +cert_dir([_ | Rest]) -> cert_dir(Rest); |
| 49 | +cert_dir([]) -> "/tmp". |
| 50 | + |
| 51 | +%% A self-signed RSA server certificate the client accepts without validation |
| 52 | +%% (authmode none). Generated with openssl, like the retired python server. |
| 53 | +tls_opts(CertDir) -> |
| 54 | + Cert = filename:join(CertDir, "cert.pem"), |
| 55 | + Key = filename:join(CertDir, "key.pem"), |
| 56 | + case filelib:is_file(Cert) andalso filelib:is_file(Key) of |
| 57 | + true -> |
| 58 | + ok; |
| 59 | + false -> |
| 60 | + Command = lists:flatten(io_lib:format( |
| 61 | + "openssl req -x509 -newkey rsa:2048 -nodes -keyout ~ts -out ~ts" |
| 62 | + " -days 30 -subj /CN=10.0.2.2 2>&1", |
| 63 | + [Key, Cert] |
| 64 | + )), |
| 65 | + Output = os:cmd(Command), |
| 66 | + filelib:is_file(Cert) andalso filelib:is_file(Key) orelse |
| 67 | + fail("openssl could not generate a certificate: ~ts", [Output]) |
| 68 | + end, |
| 69 | + [{certfile, Cert}, {keyfile, Key}]. |
| 70 | + |
| 71 | +http_loop(Listen) -> |
| 72 | + {ok, Socket} = gen_tcp:accept(Listen), |
| 73 | + try |
| 74 | + handle_http(Socket) |
| 75 | + catch |
| 76 | + _:_ -> ok |
| 77 | + end, |
| 78 | + http_loop(Listen). |
| 79 | + |
| 80 | +handle_http(Socket) -> |
| 81 | + _ = gen_tcp:recv(Socket, 0, 10000), |
| 82 | + ok = gen_tcp:send(Socket, [ |
| 83 | + <<"HTTP/1.1 301 Moved Permanently\r\n">>, |
| 84 | + <<"Content-Length: 0\r\n">>, |
| 85 | + <<"Location: https://10.0.2.2/\r\n">>, |
| 86 | + <<"Connection: close\r\n\r\n">> |
| 87 | + ]), |
| 88 | + gen_tcp:close(Socket). |
| 89 | + |
| 90 | +tls_loop(Listen) -> |
| 91 | + case ssl:transport_accept(Listen, 30000) of |
| 92 | + {ok, Transport} -> |
| 93 | + try |
| 94 | + {ok, Socket} = ssl:handshake(Transport, 10000), |
| 95 | + handle_tls(Socket) |
| 96 | + catch |
| 97 | + _:_ -> ok |
| 98 | + end; |
| 99 | + _ -> |
| 100 | + ok |
| 101 | + end, |
| 102 | + tls_loop(Listen). |
| 103 | + |
| 104 | +handle_tls(Socket) -> |
| 105 | + Body = <<"ok">>, |
| 106 | + _ = ssl:recv(Socket, 0, 10000), |
| 107 | + ok = ssl:send(Socket, [ |
| 108 | + <<"HTTP/1.1 200 OK\r\n">>, |
| 109 | + <<"Content-Type: text/plain\r\n">>, |
| 110 | + [<<"Content-Length: ">>, integer_to_binary(byte_size(Body)), <<"\r\n">>], |
| 111 | + <<"Connection: close\r\n\r\n">>, |
| 112 | + Body |
| 113 | + ]), |
| 114 | + %% Let the client send its close_notify first: closing right after the |
| 115 | + %% reply can turn into an RST that races the client's shutdown. |
| 116 | + drain_tls(Socket), |
| 117 | + ssl:close(Socket). |
| 118 | + |
| 119 | +drain_tls(Socket) -> |
| 120 | + case ssl:recv(Socket, 0, 5000) of |
| 121 | + {ok, _} -> drain_tls(Socket); |
| 122 | + _ -> ok |
| 123 | + end. |
| 124 | + |
| 125 | +dns_loop(Socket) -> |
| 126 | + case gen_udp:recv(Socket, 0) of |
| 127 | + {ok, {Address, Port, <<Id:2/binary, _Flags:2/binary, Rest/binary>>}} -> |
| 128 | + %% The guest only checks the transaction id and the QR bit, so echo |
| 129 | + %% the id and rewrite the header flags to a response (QR=1, RD=1, |
| 130 | + %% RA=1) without synthesizing answer records. |
| 131 | + ok = gen_udp:send(Socket, Address, Port, <<Id/binary, 16#81, 16#80, Rest/binary>>); |
| 132 | + _ -> |
| 133 | + ok |
| 134 | + end, |
| 135 | + dns_loop(Socket). |
| 136 | + |
| 137 | +fail(Format, Args) -> |
| 138 | + io:format(standard_error, Format ++ "~n", Args), |
| 139 | + halt(1). |
0 commit comments