Skip to content

Commit 47a6291

Browse files
yomimonoyomimono
authored
Merge pull request #87 from hannesm/random
rework usage of randomness in Dhcp_client
2 parents 01eeef8 + bfc9a0d commit 47a6291

14 files changed

+114
-63
lines changed

‎charrua-client-lwt.opam

Lines changed: 12 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,24 +1,24 @@
1-
opam-version: "1.2"
1+
opam-version: "2.0"
22
name: "charrua-client-lwt"
33
maintainer: ["Mindy Preston"]
44
authors : ["Mindy Preston"]
55
homepage: "https://github.com/mirage/charrua-core"
66
bug-reports: "https://github.com/mirage/charrua-core/issues"
7-
dev-repo: "https://github.com/mirage/charrua-core.git"
7+
dev-repo: "git+https://github.com/mirage/charrua-core.git"
88
tags: [ "org:mirage"]
99
doc: "https://docs.mirage.io"
1010

1111
build: [
1212
["jbuilder" "subst" "-n" name] {pinned}
1313
["jbuilder" "build" "-p" name "-j" jobs]
14+
["jbuilder" "runtest" "-p" name "-j" jobs] {with-test}
1415
]
1516

16-
build-test: ["jbuilder" "runtest" "-p" name "-j" jobs]
17-
1817
depends: [
1918
"jbuilder" {build & >= "1.0+beta9"}
20-
"alcotest" {test}
21-
"cstruct-unix" {test}
19+
"ocaml" {>= "4.03.0"}
20+
"alcotest" {with-test}
21+
"cstruct-unix" {with-test}
2222
"charrua-core" {>= "0.10"}
2323
"charrua-client" {>= "0.10"}
2424
"cstruct" {>="3.0.2"}
@@ -33,4 +33,9 @@ depends: [
3333
"lwt"
3434
"mirage-types-lwt" {>="3.0.0"}
3535
]
36-
available: [ocaml-version >= "4.03.0"]
36+
synopsis: "A DHCP client using lwt as effectful layer"
37+
description: """
38+
`charrua-client-lwt` extends `charrua-client` with a functor `Dhcp_client_lwt`,
39+
using the provided modules for timing and networking logic,
40+
for convenient use by a program which might wish to implement a full client.
41+
"""

‎charrua-client-mirage.opam

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,10 @@
1-
opam-version: "1.2"
1+
opam-version: "2.0"
22
name: "charrua-client-mirage"
33
maintainer: ["Mindy Preston"]
44
authors : ["Mindy Preston"]
55
homepage: "https://github.com/mirage/charrua-core"
66
bug-reports: "https://github.com/mirage/charrua-core/issues"
7-
dev-repo: "https://github.com/mirage/charrua-core.git"
7+
dev-repo: "git+https://github.com/mirage/charrua-core.git"
88
tags: [ "org:mirage"]
99
doc: "https://docs.mirage.io"
1010

@@ -13,11 +13,9 @@ build: [
1313
["jbuilder" "build" "-p" name "-j" jobs]
1414
]
1515

16-
build-test: ["jbuilder" "runtest" "-p" name "-j" jobs]
17-
1816
depends: [
1917
"jbuilder" {build & >= "1.0+beta9"}
20-
"alcotest" {test}
18+
"ocaml" {>= "4.03.0"}
2119
"charrua-core" {>= "0.10"}
2220
"charrua-client-lwt" {>= "0.10"}
2321
"charrua-client" {>= "0.10"}
@@ -33,4 +31,8 @@ depends: [
3331
"lwt"
3432
"mirage-types-lwt" {>="3.0.0"}
3533
]
36-
available: [ocaml-version >= "4.03.0"]
34+
synopsis: "A DHCP client for MirageOS"
35+
description: """
36+
`charrua-client-mirage` exposes an additional `Dhcp_client_mirage` for direct use
37+
with the [MirageOS library operating system](https://github.com/mirage/mirage).
38+
"""

‎charrua-client.opam

Lines changed: 14 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,28 +1,33 @@
1-
opam-version: "1.2"
1+
opam-version: "2.0"
22
name: "charrua-client"
33
maintainer: ["Mindy Preston"]
44
authors : ["Mindy Preston"]
55
homepage: "https://github.com/mirage/charrua-core"
66
bug-reports: "https://github.com/mirage/charrua-core/issues"
7-
dev-repo: "https://github.com/mirage/charrua-core.git"
7+
dev-repo: "git+https://github.com/mirage/charrua-core.git"
88
tags: [ "org:mirage"]
99
doc: "https://docs.mirage.io"
1010

1111
build: [
1212
[ "jbuilder" "subst" "-n" name ] {pinned}
1313
[ "jbuilder" "build" "-p" name "-j" jobs ]
14-
]
15-
16-
build-test: [
17-
[ "jbuilder" "runtest" "-p" name "-j" jobs ]
14+
[ "jbuilder" "runtest" "-p" name "-j" jobs ] {with-test}
1815
]
1916

2017
depends: [
2118
"jbuilder" {build & >= "1.0+beta9"}
22-
"alcotest" {test}
23-
"cstruct-unix" {test}
19+
"ocaml" {>= "4.03.0"}
20+
"alcotest" {with-test}
21+
"cstruct-unix" {with-test}
22+
"mirage-random-test" {with-test}
2423
"charrua-core" {>= "0.10"}
2524
"cstruct" {>="3.0.2"}
2625
"ipaddr"
2726
]
28-
available: [ocaml-version >= "4.03.0"]
27+
synopsis: "DHCP client implementation"
28+
description: """
29+
charrua-client is a DHCP client powered by [charrua-core](https://github.com/haesbaert/charrua-core).
30+
31+
The base library exposes a simple state machine in `Dhcp_client`
32+
for use in acquiring a DHCP lease.
33+
"""

‎charrua-core.opam

Lines changed: 34 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,34 +1,58 @@
1-
opam-version: "1.2"
1+
opam-version: "2.0"
22
name: "charrua-core"
33
maintainer: "Christiano F. Haesbaert <[email protected]>"
44
authors: "Christiano F. Haesbaert <[email protected]>"
55
license: "ISC"
66
homepage: "https://github.com/mirage/charrua-core"
77
bug-reports: "https://github.com/mirage/charrua-core/issues"
8-
dev-repo: "https://github.com/mirage/charrua-core.git"
8+
dev-repo: "git+https://github.com/mirage/charrua-core.git"
99
doc: "https://mirage.github.io/charrua-core/api"
1010

11-
available: [ocaml-version >= "4.03" & opam-version >= "1.2"]
12-
1311
build: [
1412
["jbuilder" "subst" "-n" name] {pinned}
1513
["jbuilder" "build" "-p" name "-j" jobs]
16-
]
17-
18-
build-test: [
19-
["jbuilder" "runtest" "-p" name "-j" jobs]
14+
["jbuilder" "runtest" "-p" name "-j" jobs] {with-test}
2015
]
2116

2217
depends: [
2318
"jbuilder" {build & >="1.0+beta7"}
2419
"ppx_sexp_conv" {build}
2520
"ppx_cstruct" {build}
2621
"menhir" {build}
22+
"ocaml" {>= "4.0.3"}
2723
"cstruct" {>= "3.0.1"}
2824
"sexplib"
2925
"ipaddr" {>= "2.5.0"}
3026
"tcpip" {>= "3.2.0"}
3127
"rresult"
32-
"io-page-unix" {test}
33-
"cstruct-unix" {test}
28+
"io-page-unix" {with-test}
29+
"cstruct-unix" {with-test}
3430
]
31+
synopsis: "DHCP wire frame encoder and decoder"
32+
description: """
33+
Charrua-core consists of two modules, a `Dhcp_wire` responsible for parsing and
34+
constructing DHCP messages and a `Dhcp_server` module used for constructing DHCP
35+
servers.
36+
37+
You can browse the API for [charrua-core](http://www.github.com/mirage/charrua-core) at
38+
http://mirage.github.io/charrua-core/api
39+
40+
[dhcp](https://github.com/mirage/mirage-skeleton/tree/master/applications/dhcp)
41+
is a Mirage DHCP unikernel server based on charrua-core, included as a part of the MirageOS unikernel example and starting-point repository.
42+
43+
#### Features
44+
45+
* `Dhcp_server` supports a stripped down ISC dhcpd.conf, so you can probably just
46+
use your old `dhcpd.conf`. It also supports manual configuration building in
47+
OCaml.
48+
* `Dhcp_wire` provides marshalling and unmarshalling utilities for DHCP, it is the
49+
base for `Dhcp_server`.
50+
* Logic/sequencing is agnostic of IO and platform, so it can run on Unix as a
51+
process, as a Mirage unikernel or anything else.
52+
* All DHCP options are supported at the time of this writing.
53+
* Code is purely applicative.
54+
* It's in OCaml, so it's pretty cool.
55+
56+
The name `charrua` is a reference to the, now extinct, semi-nomadic people of
57+
southern South America.
58+
"""

‎charrua-unix.opam

Lines changed: 8 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,18 @@
1-
opam-version: "1.2"
1+
opam-version: "2.0"
22
name: "charrua-unix"
33
maintainer: "Christiano F. Haesbaert <[email protected]>"
44
authors: "Christiano F. Haesbaert <[email protected]>"
55
homepage: "https://github.com/haesbaert/charrua-unix"
66
bug-reports: "https://github.com/haesbaert/charrua-unix/issues"
77
license: "ISC"
8-
dev-repo: "https://github.com/haesbaert/charrua-unix.git"
9-
available: [ocaml-version >= "4.03.0" & opam-version >= "1.2"]
8+
dev-repo: "git+https://github.com/haesbaert/charrua-unix.git"
109
build: [
1110
["jbuilder" "subst" "-n" name] {pinned}
1211
["jbuilder" "build" "-p" name "-j" jobs]
1312
]
1413
depends: [
1514
"jbuilder" {build & >="1.0+beta9"}
15+
"ocaml" {>= "4.03.0"}
1616
"lwt" {>="3.0.0"}
1717
"lwt_log"
1818
"charrua-core" {>= "0.10"}
@@ -22,3 +22,8 @@ depends: [
2222
"tuntap" {>= "1.2.0"}
2323
"mtime" {>="1.0.0"}
2424
]
25+
synopsis: "Unix DHCP daemon"
26+
description: """
27+
charrua-unix is an _ISC-licensed_ Unix DHCP daemon based on
28+
[charrua-core](http://www.github.com/mirage/charrua-core).
29+
"""

‎client/dhcp_client.ml

Lines changed: 2 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -142,13 +142,9 @@ let offer t ~xid ~chaddr ~server_ip ~request_ip ~offer_options =
142142
(* make a new DHCP client. allow the user to request a specific xid, any
143143
requests, and the MAC address to use as the source for Ethernet messages and
144144
the chaddr in the fixed-length part of the message *)
145-
let create ?with_xid ?requests srcmac =
145+
let create ?requests xid srcmac =
146146
let open Constants in
147147
let open Dhcp_wire in
148-
let xid = match with_xid with
149-
| None -> Stdlibrandom.initialize (); Cstruct.BE.get_uint32 (Stdlibrandom.generate 4) 0
150-
| Some xid -> xid
151-
in
152148
let requests = match requests with
153149
| None | Some [] -> default_requests
154150
| Some requests -> requests
@@ -212,7 +208,7 @@ let input t buf =
212208
| Some DHCPACK, Renewing _
213209
| Some DHCPACK, Requesting _ -> `New_lease ({t with state = Bound incoming}, incoming)
214210
| Some DHCPNAK, Requesting _ | Some DHCPNAK, Renewing _ ->
215-
`Response (create ~with_xid:(xid t) ~requests:t.request_options t.srcmac)
211+
`Response (create ~requests:t.request_options (xid t) t.srcmac)
216212
| Some DHCPACK, Selecting _ (* too soon *)
217213
| Some DHCPACK, Bound _ -> (* too late *)
218214
`Noop

‎client/dhcp_client.mli

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -4,11 +4,11 @@ type buffer = Cstruct.t
44

55
val pp : Format.formatter -> t -> unit
66

7-
val create : ?with_xid : Cstruct.uint32 -> ?requests : Dhcp_wire.option_code list -> Macaddr.t -> (t * buffer)
8-
(** [create mac] returns a pair of [t, buffer]. [t] represents the current
7+
val create : ?requests : Dhcp_wire.option_code list -> Cstruct.uint32 -> Macaddr.t -> (t * buffer)
8+
(** [create xid mac] returns a pair of [t, buffer]. [t] represents the current
99
* state of the client in the lease transaction, and [buffer] is the suggested
1010
* next packet the caller should take to progress toward accepting a lease.
11-
* The optional argument [with_xid] allows the caller to specify a transaction ID
11+
* The argument [xid] allows the caller to specify a transaction ID
1212
* to use for the lease attempt.
1313
* [requests] is a list of option codes which the client should ask for in its
1414
* attempt to get a DHCP lease. If [requests] is not given, we'll make an educated

‎client/lwt/dhcp_client_lwt.ml

Lines changed: 9 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,21 +1,25 @@
11
let src = Logs.Src.create "dhcp_client_lwt"
22
module Log = (val Logs.src_log src : Logs.LOG)
33

4-
module Make(Time : Mirage_time_lwt.S) (Net : Mirage_net_lwt.S) = struct
4+
module Make(Random : Mirage_random.C)(Time : Mirage_time_lwt.S) (Net : Mirage_net_lwt.S) = struct
55
open Lwt.Infix
66

77
type lease = Dhcp_wire.pkt
88

99
type t = lease Lwt_stream.t
1010

1111
let connect ?(renew = true)
12-
?(with_xid)
12+
?xid
1313
?(requests : Dhcp_wire.option_code list option) net =
1414
(* listener needs to occasionally check to see whether the state has advanced,
1515
* and if not, start a new attempt at a lease transaction *)
1616
let sleep_interval = Duration.of_sec 4 in
1717

18-
let (client, dhcpdiscover) = Dhcp_client.create ?with_xid ?requests (Net.mac net) in
18+
let xid = match xid with
19+
| None -> Cstruct.BE.get_uint32 (Random.generate 4) 0
20+
| Some xid -> xid
21+
in
22+
let (client, dhcpdiscover) = Dhcp_client.create ?requests xid (Net.mac net) in
1923
let c = ref client in
2024

2125
let rec do_renew c t =
@@ -42,7 +46,8 @@ module Make(Time : Mirage_time_lwt.S) (Net : Mirage_net_lwt.S) = struct
4246
match Dhcp_client.lease !c with
4347
| Some lease -> Lwt.return_unit
4448
| None ->
45-
let (client, dhcpdiscover) = Dhcp_client.create ?requests (Net.mac net) in
49+
let xid = Cstruct.BE.get_uint32 (Random.generate 4) 0 in
50+
let (client, dhcpdiscover) = Dhcp_client.create ?requests xid (Net.mac net) in
4651
c := client;
4752
Log.info (fun f -> f "Timeout expired without a usable lease! Starting over...");
4853
Log.debug (fun f -> f "New lease attempt: %a" Dhcp_client.pp !c);

‎client/lwt/dhcp_client_lwt.mli

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,11 @@
1-
module Make(Time : Mirage_time_lwt.S) (Net : Mirage_net_lwt.S) : sig
1+
module Make(Random : Mirage_random.C)(Time : Mirage_time_lwt.S) (Net : Mirage_net_lwt.S) : sig
22
type lease = Dhcp_wire.pkt
33

44
type t = lease Lwt_stream.t
55

6-
val connect : ?renew:bool -> ?with_xid : Cstruct.uint32 ->
6+
val connect : ?renew:bool -> ?xid:Cstruct.uint32 ->
77
?requests:Dhcp_wire.option_code list -> Net.t -> t Lwt.t
8-
(** [connect renew with_xid requests net] starts a DHCP client communicating
8+
(** [connect renew ~xid requests net] starts a DHCP client communicating
99
over the network interface [net]. The client will attempt to get a DHCP
1010
lease at least once, and will return any leases obtained in the stream
1111
returned by [connect]. If [renew] is true, which it is by default,

‎client/mirage/dhcp_client_mirage.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -19,14 +19,14 @@ let config_of_lease lease : Mirage_protocols_lwt.ipv4_config option =
1919
| hd::_ ->
2020
Some Mirage_protocols_lwt.{ address; network; gateway = (Some hd) }
2121

22-
module Make(Time : Mirage_types_lwt.TIME) (Net : Mirage_types_lwt.NETWORK) = struct
22+
module Make(Random : Mirage_random.C)(Time : Mirage_types_lwt.TIME) (Net : Mirage_types_lwt.NETWORK) = struct
2323
open Lwt.Infix
2424
open Mirage_protocols_lwt
2525

2626
type t = ipv4_config Lwt_stream.t
2727

2828
let connect ?(requests : Dhcp_wire.option_code list option) net =
29-
let module Lwt_client = Dhcp_client_lwt.Make(Time)(Net) in
29+
let module Lwt_client = Dhcp_client_lwt.Make(Random)(Time)(Net) in
3030
Lwt_client.connect ~renew:false ?requests net >>= fun lease_stream ->
3131
Lwt.return @@ Lwt_stream.filter_map config_of_lease lease_stream
3232

0 commit comments

Comments
 (0)