<commit_before>open Lwt

let src =
  let src = Logs.Src.create "9P" ~doc:"/port filesystem" in
  Logs.Src.set_level src (Some Logs.Info);
  src

module Log9P = (val Logs.src_log src : Logs.LOG)

let src =
  let src = Logs.Src.create "usernet" ~doc:"Mirage TCP/IP <-> socket proxy" in
  Logs.Src.set_level src (Some Logs.Info);
  src

module Log = (val Logs.src_log src : Logs.LOG)

let _ =
  Printexc.register_printer (function
    | Unix.Unix_error(e, _, _) -> Some (Unix.error_message e)
    | _ -> None
    )

let log_exception_continue description f =
  Lwt.catch
    (fun () -> f ())
    (fun e ->
       Log.err (fun f -> f "%s: failed with %a" description Fmt.exn e);
       Lwt.return ()
    )

let ethernet_serviceid = "30D48B34-7D27-4B0B-AAAF-BBBED334DD59"
let ports_serviceid = "0B95756A-9985-48AD-9470-78E060895BE7"

let hvsock_addr_of_uri ~default_serviceid uri =
  (* hyperv://vmid/serviceid *)
  let vmid = match Uri.host uri with
  | None   -> Hvsock.Loopback
  | Some x -> Hvsock.Id x
  in
  let serviceid =
    let p = Uri.path uri in
    if p = ""
    then default_serviceid
    (* trim leading / *)
    else if String.length p > 0 then String.sub p 1 (String.length p - 1) else p
  in
  { Hvsock.vmid; serviceid }

  module Vnet = Basic_backend.Make
  module Connect_unix = Connect.Unix
  module Connect_hvsock = Connect.Hvsock
  module Bind = Bind.Make(Host.Sockets)
  module Dns_policy = Hostnet_dns.Policy(Host.Files)
  module Config = Active_config.Make(Host.Time)(Host.Sockets.Stream.Unix)
  module Forward_unix = Forward.Make(Mclock)(Connect_unix)(Bind)
  module Forward_hvsock = Forward.Make(Mclock)(Connect_hvsock)(Bind)
  module HV = Flow_lwt_hvsock.Make(Host.Time)(Host.Fn)
  module HostsFile = Hosts.Make(Host.Files)

  let file_descr_of_int (x: int) : Unix.file_descr =
    if Sys.os_type <> "Unix"
    then
      failwith "Cannot convert from an int to Unix.file_descr on platforms \
                other than Unix";
    Obj.magic x

  let unix_listen path =
    let startswith prefix x =
      let prefix' = String.length prefix in
      let x' = String.length x in
      prefix' <= x' && (String.sub x 0 prefix' = prefix) in
    if startswith "fd:" path then begin
      let i = String.sub path 3 (String.length path - 3) in
      (try Lwt.return (int_of_string i) with
      | _ ->
        Fmt.kstrf Lwt.fail_with "Failed to parse command-line argument [%s]" path
      ) >|= fun x ->
      let fd = file_descr_of_int x in
      Host.Sockets.Stream.Unix.of_bound_fd fd
    end else
      Host.Sockets.Stream.Unix.bind path

  let hvsock_connect_forever url sockaddr callback =
    Log.info (fun f ->
        f "connecting to %s:%s" (Hvsock.string_of_vmid sockaddr.Hvsock.vmid)
          sockaddr.Hvsock.serviceid);
    let rec aux () =
      let socket = HV.Hvsock.create () in
      Lwt.catch (fun () ->
          HV.Hvsock.connect ~timeout_ms:300 socket sockaddr >>= fun () ->
          Log.info (fun f -> f "hvsock connected successfully");
          callback socket
        ) (function
        | Unix.Unix_error(Unix.ETIMEDOUT, _, _) ->
          HV.Hvsock.close socket
          (* no need to add more delay *)
        | Unix.Unix_error(_, _, _) ->
          HV.Hvsock.close socket >>= fun () ->
          Host.Time.sleep_ns (Duration.of_sec 1)
        | _ ->
          HV.Hvsock.close socket >>= fun () ->
          Host.Time.sleep_ns (Duration.of_sec 1)
        )
      >>= fun () ->
      aux ()
    in
    Log.debug (fun f -> f "Waiting for connections on socket %s" url);
    aux ()

  let start_introspection introspection_url root =
    if introspection_url = ""
    then Log.info (fun f ->
        f "no introspection server requested. See the --introspection argument")
    else Lwt.async (fun () ->
        log_exception_continue
          ("starting introspection server on: " ^ introspection_url)
          (fun () ->
             Log.info (fun f ->
                 f "starting introspection server on: %s" introspection_url);
             let module Server = Fs9p.Make(Host.Sockets.Stream.Unix) in
             unix_listen introspection_url >>= fun s ->
             Host.Sockets.Stream.Unix.disable_connection_tracking s;
             Host.Sockets.Stream.Unix.listen s (fun flow ->
                 Server.accept ~root ~msg:introspection_url flow >>= function
                 | Error (`Msg m) ->
                   Log.err (fun f ->
                       f "failed to establish 9P connection: %s" m);
                   Lwt.return ()
                 | Ok () ->
                   Lwt.return_unit
               );<commit_msg>Be more robust to Hyper-V socket failures<commit_after>open Lwt

let src =
  let src = Logs.Src.create "9P" ~doc:"/port filesystem" in
  Logs.Src.set_level src (Some Logs.Info);
  src

module Log9P = (val Logs.src_log src : Logs.LOG)

let src =
  let src = Logs.Src.create "usernet" ~doc:"Mirage TCP/IP <-> socket proxy" in
  Logs.Src.set_level src (Some Logs.Info);
  src

module Log = (val Logs.src_log src : Logs.LOG)

let _ =
  Printexc.register_printer (function
    | Unix.Unix_error(e, _, _) -> Some (Unix.error_message e)
    | _ -> None
    )

let log_exception_continue description f =
  Lwt.catch
    (fun () -> f ())
    (fun e ->
       Log.err (fun f -> f "%s: failed with %a" description Fmt.exn e);
       Lwt.return ()
    )

let ethernet_serviceid = "30D48B34-7D27-4B0B-AAAF-BBBED334DD59"
let ports_serviceid = "0B95756A-9985-48AD-9470-78E060895BE7"

let hvsock_addr_of_uri ~default_serviceid uri =
  (* hyperv://vmid/serviceid *)
  let vmid = match Uri.host uri with
  | None   -> Hvsock.Loopback
  | Some x -> Hvsock.Id x
  in
  let serviceid =
    let p = Uri.path uri in
    if p = ""
    then default_serviceid
    (* trim leading / *)
    else if String.length p > 0 then String.sub p 1 (String.length p - 1) else p
  in
  { Hvsock.vmid; serviceid }

  module Vnet = Basic_backend.Make
  module Connect_unix = Connect.Unix
  module Connect_hvsock = Connect.Hvsock
  module Bind = Bind.Make(Host.Sockets)
  module Dns_policy = Hostnet_dns.Policy(Host.Files)
  module Config = Active_config.Make(Host.Time)(Host.Sockets.Stream.Unix)
  module Forward_unix = Forward.Make(Mclock)(Connect_unix)(Bind)
  module Forward_hvsock = Forward.Make(Mclock)(Connect_hvsock)(Bind)
  module HV = Flow_lwt_hvsock.Make(Host.Time)(Host.Fn)
  module HostsFile = Hosts.Make(Host.Files)

  let file_descr_of_int (x: int) : Unix.file_descr =
    if Sys.os_type <> "Unix"
    then
      failwith "Cannot convert from an int to Unix.file_descr on platforms \
                other than Unix";
    Obj.magic x

  let unix_listen path =
    let startswith prefix x =
      let prefix' = String.length prefix in
      let x' = String.length x in
      prefix' <= x' && (String.sub x 0 prefix' = prefix) in
    if startswith "fd:" path then begin
      let i = String.sub path 3 (String.length path - 3) in
      (try Lwt.return (int_of_string i) with
      | _ ->
        Fmt.kstrf Lwt.fail_with "Failed to parse command-line argument [%s]" path
      ) >|= fun x ->
      let fd = file_descr_of_int x in
      Host.Sockets.Stream.Unix.of_bound_fd fd
    end else
      Host.Sockets.Stream.Unix.bind path

  let hvsock_connect_forever url sockaddr callback =
    Log.info (fun f ->
        f "connecting to %s:%s" (Hvsock.string_of_vmid sockaddr.Hvsock.vmid)
          sockaddr.Hvsock.serviceid);
    let rec aux () =
      let rec create () =
        match HV.Hvsock.create () with
        | x -> Lwt.return x
        | exception e ->
          Log.err (fun f -> f "caught %s while creating Hyper-V socket" (Printexc.to_string e));
          Host.Time.sleep_ns (Duration.of_sec 1)
          >>= fun () ->
          create () in
      create ()
      >>= fun socket ->
      Lwt.catch (fun () ->
          HV.Hvsock.connect ~timeout_ms:300 socket sockaddr >>= fun () ->
          Log.info (fun f -> f "hvsock connected successfully");
          callback socket
        ) (function
        | Unix.Unix_error(Unix.ETIMEDOUT, _, _) ->
          log_exception_continue "HV.Hvsock.close" (fun () -> HV.Hvsock.close socket)
          (* no need to add more delay *)
        | Unix.Unix_error(_, _, _) ->
          log_exception_continue "HV.Hvsock.close" (fun () -> HV.Hvsock.close socket)
          >>= fun () ->
          Host.Time.sleep_ns (Duration.of_sec 1)
        | _ ->
          log_exception_continue "HV.Hvsock.close" (fun () -> HV.Hvsock.close socket)
          >>= fun () ->
          Host.Time.sleep_ns (Duration.of_sec 1)
        )
      >>= fun () ->
      aux ()
    in
    Log.debug (fun f -> f "Waiting for connections on socket %s" url);
    Lwt.catch
      aux
      (fun e ->
        Log.err (fun f -> f "Caught %s while accepting connections on socket %s" (Printexc.to_string e) url);
        Lwt.return_unit
      )

  let start_introspection introspection_url root =
    if introspection_url = ""
    then Log.info (fun f ->
        f "no introspection server requested. See the --introspection argument")
    else Lwt.async (fun () ->
        log_exception_continue
          ("starting introspection server on: " ^ introspection_url)
          (fun () ->
             Log.info (fun f ->
                 f "starting introspection server on: %s" introspection_url);
             let module Server = Fs9p.Make(Host.Sockets.Stream.Unix) in
             unix_listen introspection_url >>= fun s ->
             Host.Sockets.Stream.Unix.disable_connection_tracking s;
             Host.Sockets.Stream.Unix.listen s (fun flow ->
                 Server.accept ~root ~msg:introspection_url flow >>= function
                 | Error (`Msg m) ->
                   Log.err (fun f ->
                       f "failed to establish 9P connection: %s" m);
                   Lwt.return ()
                 | Ok () ->
                   Lwt.return_unit
               );
{'fraction_non_alphanumeric': 0.11332048290554936, 'fraction_numerical': 0.01146393425991681, 'mean_word_length': 2.1964980544747084, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 107, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1725411', 'n_tokens_mistral': 3458, 'n_tokens_neox': 3313, 'n_words': 864}