2017-03-02 14:52:55 +00:00
|
|
|
(* Copyright (C) 2015, Thomas Leonard <thomas.leonard@unikernel.com>
|
|
|
|
See the README file for details. *)
|
|
|
|
|
|
|
|
open Lwt.Infix
|
|
|
|
|
|
|
|
let src = Logs.Src.create "my-nat" ~doc:"NAT shim"
|
|
|
|
module Log = (val Logs.src_log src : Logs.LOG)
|
|
|
|
|
|
|
|
type action = [
|
2017-03-10 16:09:36 +00:00
|
|
|
| `NAT
|
|
|
|
| `Redirect of Mirage_nat.endpoint
|
2017-03-02 14:52:55 +00:00
|
|
|
]
|
|
|
|
|
2017-10-15 13:35:03 +00:00
|
|
|
module Nat = Mirage_nat_lru
|
2017-03-02 14:52:55 +00:00
|
|
|
|
2017-03-10 16:09:36 +00:00
|
|
|
type t = {
|
|
|
|
table : Nat.t;
|
2022-10-07 18:54:49 +00:00
|
|
|
mutable udp_dns : int list;
|
2017-03-10 16:09:36 +00:00
|
|
|
}
|
2017-03-02 14:52:55 +00:00
|
|
|
|
2020-01-11 14:36:02 +00:00
|
|
|
let create ~max_entries =
|
2017-03-15 08:56:24 +00:00
|
|
|
let tcp_size = 7 * max_entries / 8 in
|
|
|
|
let udp_size = max_entries - tcp_size in
|
2022-10-07 16:49:03 +00:00
|
|
|
let table = Nat.empty ~tcp_size ~udp_size ~icmp_size:100 in
|
2022-10-07 18:54:49 +00:00
|
|
|
{ table ; udp_dns = [] }
|
|
|
|
|
|
|
|
let pick_free_port t proto =
|
|
|
|
let rec go () =
|
|
|
|
let p = 1024 + Random.int (0xffff - 1024) in
|
|
|
|
match proto with
|
|
|
|
| `Udp when List.mem p t.udp_dns -> go ()
|
|
|
|
| _ -> p
|
|
|
|
in
|
|
|
|
go ()
|
|
|
|
|
|
|
|
let free_udp_port t ~src ~dst ~dst_port =
|
|
|
|
let rec go () =
|
|
|
|
let src_port = pick_free_port t `Udp in
|
|
|
|
if Nat.is_port_free t.table `Udp ~src ~dst ~src_port ~dst_port then begin
|
|
|
|
t.udp_dns <- src_port :: t.udp_dns;
|
|
|
|
src_port
|
|
|
|
end else
|
|
|
|
go ()
|
|
|
|
in
|
|
|
|
go ()
|
2017-03-10 16:09:36 +00:00
|
|
|
|
|
|
|
let translate t packet =
|
2022-10-07 16:49:03 +00:00
|
|
|
match Nat.translate t.table packet with
|
2017-03-10 16:09:36 +00:00
|
|
|
| Error (`Untranslated | `TTL_exceeded as e) ->
|
|
|
|
Log.debug (fun f -> f "Failed to NAT %a: %a"
|
|
|
|
Nat_packet.pp packet
|
|
|
|
Mirage_nat.pp_error e
|
|
|
|
);
|
|
|
|
None
|
2017-03-07 10:02:54 +00:00
|
|
|
| Ok packet -> Some packet
|
2017-03-02 14:52:55 +00:00
|
|
|
|
2022-10-07 18:54:49 +00:00
|
|
|
let remove_connections t ip =
|
|
|
|
ignore (Nat.remove_connections t.table ip)
|
2020-04-29 13:58:01 +00:00
|
|
|
|
2022-10-07 18:54:49 +00:00
|
|
|
let add_nat_rule_and_translate t ~xl_host action packet =
|
|
|
|
let proto = match packet with
|
|
|
|
| `IPv4 (_, `TCP _) -> `Tcp
|
|
|
|
| `IPv4 (_, `UDP _) -> `Udp
|
|
|
|
| `IPv4 (_, `ICMP _) -> `Icmp
|
2017-03-02 14:52:55 +00:00
|
|
|
in
|
2022-10-07 18:54:49 +00:00
|
|
|
match Nat.add t.table packet xl_host (fun () -> pick_free_port t proto) action with
|
|
|
|
| Error `Overlap -> Error "Too many retries"
|
|
|
|
| Error `Cannot_NAT -> Error "Cannot NAT this packet"
|
|
|
|
| Ok () ->
|
|
|
|
Log.debug (fun f -> f "Updated NAT table: %a" Nat.pp_summary t.table);
|
|
|
|
Option.to_result ~none:"No NAT entry, even after adding one!"
|
|
|
|
(translate t packet)
|