Add Async support

bin/dune

@@ -3,6 +3,12 @@
  (modules rawcap)
  (libraries rawlink))
 
+(executable
+ (name rawcap_async)
+ (modules rawcap_async)
+ (preprocess (pps ppx_jane))
+ (libraries core_unix.command_unix async_rawlink))
+
 (executable
  (name rawcap_lwt)
  (modules rawcap_lwt)

bin/rawcap_async.ml

@@ -0,0 +1,20 @@
+open! Core
+open Async
+open Deferred.Let_syntax
+
+let command =
+  Command.async ~summary:""
+    (let%map_open.Command () = Log.Global.set_level_via_param ()
+     and ifname = anon ("ifname" %: string) in
+     fun () ->
+       let link = Async_rawlink.open_link ~promisc:true ifname in
+       let rec loop () =
+         let%bind.Deferred () =
+           Async_rawlink.read_packet link >>| fun pkt ->
+           printf "got packet with %d bytes\n%!" (Cstruct.length pkt)
+         in
+         loop ()
+       in
+       loop ())
+
+let () = Command_unix.run command

lib/async_rawlink.ml

@@ -0,0 +1,38 @@
+open! Core
+open Async
+open Deferred.Let_syntax
+module Lowlevel = Rawlink_lowlevel
+
+type t = { fd : Async.Fd.t; packets : Cstruct.t list ref; buffer : Cstruct.t }
+
+let dhcp_server_filter = Lowlevel.dhcp_server_filter
+let dhcp_client_filter = Lowlevel.dhcp_client_filter
+
+let open_link ?filter ?(promisc = false) ifname =
+  let socket = Lowlevel.opensock ?filter ~promisc ifname in
+  let () = Core_unix.set_nonblock socket in
+  let fd = Fd.create (Fd.Kind.Socket `Active) socket (Info.of_string "link") in
+  { fd; packets = ref []; buffer = Cstruct.create 65536 }
+
+let close_link t = Fd.close t.fd
+
+let rec read_packet t =
+  match !(t.packets) with
+  | hd :: tl ->
+      t.packets := tl;
+      Deferred.return hd
+  | [] ->
+      let reader = Reader.create t.fd in
+      let%bind read_result = Async_cstruct.read reader t.buffer in
+      let (_ : unit Reader.Read_result.t) =
+        Reader.Read_result.map read_result ~f:(fun n ->
+            if n = 0 then failwith "Link socket closed";
+            t.packets := Lowlevel.process_input t.buffer n)
+      in
+      read_packet t
+
+let send_packet t buf =
+  let len = Cstruct.length buf in
+  let writer = Writer.create t.fd in
+  Writer.write_bytes ~pos:0 ~len writer (Cstruct.to_bytes ~len buf);
+  Writer.flushed writer

lib/async_rawlink.mli

@@ -0,0 +1,29 @@
+open! Base
+open! Async
+
+type t
+
+val open_link : ?filter:string -> ?promisc:bool -> string ->  t
+(** [open_link ~filter ~promisc interface sw]. Creates a rawlink on the
+   specified [interface], a BPF program [filter] can be passed to
+   filter out incoming packets. If [promisc] is true, sets [interface]
+   to promiscuous mode, defaults to false.*)
+
+val close_link : t -> unit Deferred.t
+(** [close_link]. Closes a rawlink. *)
+
+val read_packet : t -> Cstruct.t Deferred.t
+(** [read_packet t]. Reads a full packet, may raise Unix.Unix_error. *)
+
+val send_packet : t -> Cstruct.t -> unit Deferred.t
+(** [send_packet t]. Sends a full packet, may raise Unix.Unix_error. *)
+
+val dhcp_server_filter : unit -> string
+(** [dhcp_server_filter]. Returns a BPF program suitable to be passed in
+    [open_link ~filter], it accepts UDP packets destined to
+    port 67 (DHCP server). *)
+
+val dhcp_client_filter : unit -> string
+(** [dhcp_client_filter]. Returns a BPF program suitable to be passed in
+    [open_link ~filter], it accepts UDP packets destined to
+    port 68 (DHCP client). *)

lib/dune

@@ -14,6 +14,14 @@
  (preprocess (pps ppx_cstruct))
  (foreign_stubs (language c) (names rawlink_stubs)))
 
+(library
+ (name async_rawlink)
+ (synopsis "Lwt_rawlink is a Lwt interface to BPF/AF_SOCKET")
+ (modules async_rawlink)
+ (public_name rawlink-async)
+ (preprocess (pps ppx_jane))
+ (libraries rawlink rawlink.lowlevel cstruct-async async async_unix))
+
 (library
  (name lwt_rawlink)
  (synopsis "Lwt_rawlink is a Lwt interface to BPF/AF_SOCKET")

rawlink-async.opam

@@ -0,0 +1,41 @@
+opam-version: "2.0"
+maintainer: [
+  "Christiano F. Haesbaert <haesbaert@haesbaert.org>"
+  "George Shammas <george@shamm.as>"
+]
+authors: "Christiano F. Haesbaert <haesbaert@haesbaert.org>"
+license: "ISC"
+homepage: "https://github.com/haesbaert/rawlink"
+bug-reports: "https://github.com/haesbaert/rawlink/issues"
+dev-repo: "git+https://github.com/haesbaert/rawlink.git"
+doc: "https://haesbaert.github.io/rawlink/"
+build: [
+  [ "dune" "subst" ] {dev}
+  [ "dune" "build" "-p" name "-j" jobs ] ]
+depends: [
+  "ocaml" {>= "4.09.0"}
+  "dune" {>= "3.2"}
+  "rawlink" {>= "2.1"}
+  "cstruct-async" {>= "6.2.0"}
+]
+depexts: [
+  ["linux-headers"] {os-distribution = "alpine"}
+]
+synopsis: "Portable library to read and write raw packets with Lwt bindings"
+description: """
+Rawlink is an ocaml library for sending and receiving raw packets at the link
+layer level. Sometimes you need to have full control of the packet, including
+building the full ethernet frame.
+
+The API is platform independent, it uses BPF on real UNIXes and AF_SOCKET on
+linux. Some functionality is sacrificed so that the API is portable enough.
+
+Currently BPF and AF_PACKET are implemented, including filtering capabilities.
+Writing a BPF program is a pain in the ass, so no facilities are provided for
+it. If you need a BPF filter, I suggest you write a small .c file with a
+function that returns the BPF program as a string, check `rawlink_stubs.c` for
+an example.
+
+This version of Rawlink is to be used with Async, the IO functions will produce
+Async.Deferred.
+"""