Git-Mirrors/qubes-mirage-firewall
1
0
Fork 0
mirror of https://github.com/mirage/qubes-mirage-firewall.git synced 2024-10-01 01:05:39 -04:00
Code Issues Packages Projects Releases Wiki Activity

drop astring dependency

Browse Source
This commit is contained in:
Hannes Mehnert 2024-04-24 17:31:12 +01:00
parent e36ffdb0a5
commit 1cf2722954
2 changed files with 4 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
config.ml
View File

@ -18,7 +18,6 @@ let main =
~packages:[ ~packages:[
package "vchan" ~min:"4.0.2"; package "vchan" ~min:"4.0.2";
package "cstruct"; package "cstruct";
package "astring";
package "tcpip" ~min:"3.7.0"; package "tcpip" ~min:"3.7.0";
package ~min:"2.3.0" ~sublibs:["mirage"] "arp"; package ~min:"2.3.0" ~sublibs:["mirage"] "arp";
package ~min:"3.0.0" "ethernet"; package ~min:"3.0.0" "ethernet";

9
dao.ml
View File

@ -3,7 +3,6 @@
open Lwt.Infix open Lwt.Infix
open Qubes open Qubes
open Astring
let src = Logs.Src.create "dao" ~doc:"QubesDB data access" let src = Logs.Src.create "dao" ~doc:"QubesDB data access"
module Log = (val Logs.src_log src : Logs.LOG) module Log = (val Logs.src_log src : Logs.LOG)
@ -66,26 +65,26 @@ let read_rules rules client_ip =
number = 0;})] number = 0;})]
let vifs client domid = let vifs client domid =
match String.to_int domid with match int_of_string_opt domid with
| None -> Log.err (fun f -> f "Invalid domid %S" domid); Lwt.return [] | None -> Log.err (fun f -> f "Invalid domid %S" domid); Lwt.return []
| Some domid -> | Some domid ->
let path = Printf.sprintf "backend/vif/%d" domid in let path = Printf.sprintf "backend/vif/%d" domid in
Xen_os.Xs.immediate client (fun handle -> Xen_os.Xs.immediate client (fun handle ->
directory ~handle path >>= directory ~handle path >>=
Lwt_list.filter_map_p (fun device_id -> Lwt_list.filter_map_p (fun device_id ->
match String.to_int device_id with match int_of_string_opt device_id with
| None -> Log.err (fun f -> f "Invalid device ID %S for domid %d" device_id domid); Lwt.return_none | None -> Log.err (fun f -> f "Invalid device ID %S for domid %d" device_id domid); Lwt.return_none
| Some device_id -> | Some device_id ->
let vif = { ClientVif.domid; device_id } in let vif = { ClientVif.domid; device_id } in
Lwt.try_bind Lwt.try_bind
(fun () -> Xen_os.Xs.read handle (Printf.sprintf "%s/%d/ip" path device_id)) (fun () -> Xen_os.Xs.read handle (Printf.sprintf "%s/%d/ip" path device_id))
(fun client_ip -> (fun client_ip ->
let client_ip' = match String.cuts ~sep:" " client_ip with let client_ip' = match String.split_on_char ' ' client_ip with
| [] -> Log.err (fun m -> m "unexpected empty list"); "" | [] -> Log.err (fun m -> m "unexpected empty list"); ""
| [ ip ] -> ip | [ ip ] -> ip
| ip::rest -> | ip::rest ->
Log.warn (fun m -> m "ignoring IPs %s from %a, we support one IP per client" Log.warn (fun m -> m "ignoring IPs %s from %a, we support one IP per client"
(String.concat ~sep:" " rest) ClientVif.pp vif); (String.concat " " rest) ClientVif.pp vif);
ip ip
in in
match Ipaddr.V4.of_string client_ip' with match Ipaddr.V4.of_string client_ip' with