250 lines
10 KiB
OCaml
250 lines
10 KiB
OCaml
|
(* (c) 2017 Hannes Mehnert, all rights reserved *)
|
||
|
|
|
||
|
|
type 'a t
|
||
|
|
(** The type of a domain name, a sequence of labels separated by dots. Each
|
||
|
|
label may contain any bytes. The length of each label may not exceed 63
|
||
|
|
characters. The total length of a domain name is limited to 253 (its byte
|
||
|
|
representation is 255), but other protocols (such as SMTP) may apply even
|
||
|
|
smaller limits. A domain name label is case preserving, comparison is done
|
||
|
|
in a case insensitive manner. Every [t] is a fully qualified domain name,
|
||
|
|
its last label is the [root] label. The specification of domain names
|
||
|
|
originates from {{:https://tools.ietf.org/html/rfc1035}RFC 1035}.
|
||
|
|
|
||
|
|
The invariants on the length of domain names are preserved throughout the
|
||
|
|
module - no [t] will exist which violates these.
|
||
|
|
|
||
|
|
Phantom types are used for further name restrictions, {!host} checks for
|
||
|
|
host names ([`host t]): only letters, digits, and hyphen allowed, hyphen not
|
||
|
|
first or last character of a label, the last label must contain at least one letter.
|
||
|
|
{!service} checks for a service name ([`service t]): its first label is a
|
||
|
|
service name: 1-15 characters, no double-hyphen, hyphen not first or last
|
||
|
|
charactes, only letters, digits and hyphen allowed, and the second label is a
|
||
|
|
protocol ([_tcp] or [_udp] or [_sctp]).
|
||
|
|
|
||
|
|
When a [t] is constructed (either from a string, etc.), it is a [`raw t].
|
||
|
|
Subsequent modifications, such as adding or removing labels, appending, of
|
||
|
|
any kind of name also result in a [`raw t], which needs to be checked for
|
||
|
|
[`host t] (using {!host}) or [`service t] (using {!service}) if desired.
|
||
|
|
|
||
|
|
Constructing a [t] (via {!of_string}, {!of_string_exn}, {!of_strings} etc.)
|
||
|
|
does not require a trailing dot.
|
||
|
|
|
||
|
|
|
||
|
|
{e v0.5.0 - {{:https://github.com/hannesm/domain-name }homepage}} *)
|
||
|
|
|
||
|
|
(** {2 Constructor} *)
|
||
|
|
|
||
|
|
val root : [ `raw ] t
|
||
|
|
(** [root] is the root domain ("."), the empty label. *)
|
||
|
|
|
||
|
|
(** {2 String representation} *)
|
||
|
|
|
||
|
|
val of_string : string -> ([ `raw ] t, [> `Msg of string ]) result
|
||
|
|
(** [of_string name] is either [t], the domain name, or an error if the provided
|
||
|
|
[name] is not a valid domain name. A trailing dot is not requred. *)
|
||
|
|
|
||
|
|
val of_string_exn : string -> [ `raw ] t
|
||
|
|
(** [of_string_exn name] is [t], the domain name. A trailing dot is not
|
||
|
|
required.
|
||
|
|
|
||
|
|
@raise Invalid_argument if [name] is not a valid domain name. *)
|
||
|
|
|
||
|
|
val to_string : ?trailing:bool -> 'a t -> string
|
||
|
|
(** [to_string ~trailing t] is [String.concat ~sep:"." (to_strings t)], a
|
||
|
|
human-readable representation of [t]. If [trailing] is provided and
|
||
|
|
[true] (defaults to [false]), the resulting string will contain a trailing
|
||
|
|
dot. *)
|
||
|
|
|
||
|
|
(** {2 Predicates and basic operations} *)
|
||
|
|
|
||
|
|
val canonical : 'a t -> 'a t
|
||
|
|
(** [canonical t] is [t'], the canonical domain name, as specified in RFC 4034
|
||
|
|
(and 2535): all characters are lowercase. *)
|
||
|
|
|
||
|
|
val host : 'a t -> ([ `host ] t, [> `Msg of string ]) result
|
||
|
|
(** [host t] is a [`host t] if [t] is a hostname: the contents of the domain
|
||
|
|
name is limited: each label may start with a digit or letter, followed by
|
||
|
|
digits, letters, or hyphens. *)
|
||
|
|
|
||
|
|
val host_exn : 'a t -> [ `host ] t
|
||
|
|
(** [host_exn t] is a [`host t] if [t] is a hostname: the contents of the domain
|
||
|
|
name is limited: each label may start with a digit or letter, followed by
|
||
|
|
digits, letters, or hyphens.
|
||
|
|
|
||
|
|
@raise Invalid_argument if [t] is not a hostname. *)
|
||
|
|
|
||
|
|
val service : 'a t -> ([ `service ] t, [> `Msg of string ]) result
|
||
|
|
(** [service t] is [`service t] if [t] contains a service name, the following
|
||
|
|
conditions have to be met:
|
||
|
|
The first label is a service name (or port number); an underscore preceding
|
||
|
|
1-15 characters from the set [- a-z A-Z 0-9].
|
||
|
|
The service name may not contain a hyphen ([-]) following another hyphen;
|
||
|
|
no hyphen at the beginning or end.
|
||
|
|
|
||
|
|
The second label is the protocol, one of [_tcp], [_udp], or [_sctp].
|
||
|
|
The remaining labels must form a valid hostname.
|
||
|
|
|
||
|
|
This function can be used to validate RR's of the types SRV (RFC 2782)
|
||
|
|
and TLSA (RFC 7671). *)
|
||
|
|
|
||
|
|
val service_exn : 'a t -> [ `service ] t
|
||
|
|
(** [service_exn t] is [`service t] if [t] is a service name (see {!service}).
|
||
|
|
|
||
|
|
@raise Invalid_argument if [t] is not a service names. *)
|
||
|
|
|
||
|
|
val raw : 'a t -> [ `raw ] t
|
||
|
|
(** [raw t] is the [`raw t]. *)
|
||
|
|
|
||
|
|
val count_labels : 'a t -> int
|
||
|
|
(** [count_labels name] returns the amount of labels in [name]. *)
|
||
|
|
|
||
|
|
val is_subdomain : subdomain:'a t -> domain:'b t -> bool
|
||
|
|
(** [is_subdomain ~subdomain ~domain] is [true] if [subdomain] contains any
|
||
|
|
labels prepended to [domain]: [foo.bar.com] is a subdomain of [bar.com] and
|
||
|
|
of [com], [sub ~subdomain:x ~domain:root] is true for all [x]. *)
|
||
|
|
|
||
|
|
val get_label : ?rev:bool -> 'a t -> int -> (string, [> `Msg of string ]) result
|
||
|
|
(** [get_label ~rev name idx] retrieves the label at index [idx] from [name]. If
|
||
|
|
[idx] is out of bounds, an Error is returned. If [rev] is provided and [true]
|
||
|
|
(defaults to [false]), [idx] is from the end instead of the beginning. *)
|
||
|
|
|
||
|
|
val get_label_exn : ?rev:bool -> 'a t -> int -> string
|
||
|
|
(** [get_label_exn ~rev name idx] is the label at index [idx] in [name].
|
||
|
|
|
||
|
|
@raise Invalid_argument if [idx] is out of bounds in [name]. *)
|
||
|
|
|
||
|
|
val find_label : ?rev:bool -> 'a t -> (string -> bool) -> int option
|
||
|
|
(** [find_label ~rev name p] returns the first position where [p lbl] is [true]
|
||
|
|
in [name], if it exists, otherwise [None]. If [rev] is provided and [true]
|
||
|
|
(defaults to [false]), the [name] is traversed from the end instead of the
|
||
|
|
beginning. *)
|
||
|
|
|
||
|
|
val find_label_exn : ?rev:bool -> 'a t -> (string -> bool) -> int
|
||
|
|
(** [find_label_exn ~rev name p], see {!find_label}.
|
||
|
|
|
||
|
|
@raise Invalid_argument if [p] does not return [true] in [name]. *)
|
||
|
|
|
||
|
|
(** {2 Label addition and removal} *)
|
||
|
|
val prepend_label : 'a t -> string -> ([ `raw ] t, [> `Msg of string ]) result
|
||
|
|
(** [prepend_label name pre] is either [t], the new domain name, or an error. *)
|
||
|
|
|
||
|
|
val prepend_label_exn : 'a t -> string -> [ `raw ] t
|
||
|
|
(** [prepend_label_exn name pre] is [t], the new domain name.
|
||
|
|
|
||
|
|
@raise Invalid_argument if [pre] is not a valid domain name. *)
|
||
|
|
|
||
|
|
val drop_label : ?rev:bool -> ?amount:int -> 'a t ->
|
||
|
|
([ `raw ] t, [> `Msg of string ]) result
|
||
|
|
(** [drop_label ~rev ~amount t] is either [t], a domain name with [amount]
|
||
|
|
(defaults to [1]) labels dropped from the beginning - if [rev] is provided
|
||
|
|
and [true] (defaults to [false]) labels are dropped from the end.
|
||
|
|
[drop_label (of_string_exn "foo.com") = Ok (of_string_exn "com")],
|
||
|
|
[drop_label ~rev:true (of_string_exn "foo.com") = Ok (of_string_exn "foo")].
|
||
|
|
*)
|
||
|
|
|
||
|
|
val drop_label_exn : ?rev:bool -> ?amount:int -> 'a t -> [ `raw ] t
|
||
|
|
(** [drop_label_exn ~rev ~amount t], see {!drop_label}. Instead of a [result],
|
||
|
|
the value is returned directly.
|
||
|
|
|
||
|
|
@raise Invalid_argument if there are not sufficient labels. *)
|
||
|
|
|
||
|
|
val append : 'a t -> 'b t -> ([ `raw ] t, [> `Msg of string ]) result
|
||
|
|
(** [append pre post] is [pre ^ "." ^ post]. *)
|
||
|
|
|
||
|
|
val append_exn : 'a t -> 'b t -> [ `raw ] t
|
||
|
|
(** [append_exn pre post] is [pre ^ "." ^ post].
|
||
|
|
|
||
|
|
@raise Invalid_argument if the result would violate length restrictions. *)
|
||
|
|
|
||
|
|
(** {2 Comparison} *)
|
||
|
|
|
||
|
|
val equal : ?case_sensitive:bool -> 'a t -> 'b t -> bool
|
||
|
|
(** [equal ~case_sensitive t t'] is [true] if all labels of [t] and [t'] are
|
||
|
|
equal. If [case_sensitive] is provided and [true], the cases of the labels
|
||
|
|
are respected (defaults to [false]). *)
|
||
|
|
|
||
|
|
val compare : 'a t -> 'b t -> int
|
||
|
|
(** [compare t t'] compares the domain names [t] and [t'] using a case
|
||
|
|
insensitive string comparison. This conforms to the canonical DNS name
|
||
|
|
order, as described in RFC 4034, Section 6.1. *)
|
||
|
|
|
||
|
|
val equal_label : ?case_sensitive:bool -> string -> string -> bool
|
||
|
|
(** [equal_label ~case_sensitive a b] is [true] if [a] and [b] are equal
|
||
|
|
ignoring casing. If [case_sensitive] is provided and [true] (defaults to
|
||
|
|
[false]), the casing is respected. *)
|
||
|
|
|
||
|
|
val compare_label : string -> string -> int
|
||
|
|
(** [compare_label t t'] compares the labels [t] and [t'] using a case
|
||
|
|
insensitive string comparison. *)
|
||
|
|
|
||
|
|
(** {2 Collections} *)
|
||
|
|
|
||
|
|
module Host_map : sig
|
||
|
|
include Map.S with type key = [ `host ] t
|
||
|
|
|
||
|
|
(** [find key t] is [Some a] where a is the binding of [key] in [t]. [None] if
|
||
|
|
the [key] is not present. *)
|
||
|
|
val find : key -> 'a t -> 'a option
|
||
|
|
end
|
||
|
|
(** The module of a host name map *)
|
||
|
|
|
||
|
|
module Host_set : Set.S with type elt = [ `host ] t
|
||
|
|
(** The module of a host name set *)
|
||
|
|
|
||
|
|
module Service_map : sig
|
||
|
|
include Map.S with type key = [ `service ] t
|
||
|
|
|
||
|
|
(** [find key t] is [Some a] where a is the binding of [key] in [t]. [None] if
|
||
|
|
the [key] is not present. *)
|
||
|
|
val find : key -> 'a t -> 'a option
|
||
|
|
end
|
||
|
|
(** The module of a service name map *)
|
||
|
|
|
||
|
|
module Service_set : Set.S with type elt = [ `service ] t
|
||
|
|
(** The module of a service name set *)
|
||
|
|
|
||
|
|
module Map : sig
|
||
|
|
include Map.S with type key = [ `raw ] t
|
||
|
|
|
||
|
|
(** [find key t] is [Some a] where a is the binding of [key] in [t]. [None] if
|
||
|
|
the [key] is not present. *)
|
||
|
|
val find : key -> 'a t -> 'a option
|
||
|
|
end
|
||
|
|
(** The module of a domain name map *)
|
||
|
|
|
||
|
|
module Set : Set.S with type elt = [ `raw ] t
|
||
|
|
(** The module of a domain name set *)
|
||
|
|
|
||
|
|
(** {2 String list representation} *)
|
||
|
|
|
||
|
|
val of_strings : string list -> ([ `raw ] t, [> `Msg of string ]) result
|
||
|
|
(** [of_strings labels] is either [t], a domain name, or an error if
|
||
|
|
the provided [labels] violate domain name constraints. A trailing empty
|
||
|
|
label is not required. *)
|
||
|
|
|
||
|
|
val of_strings_exn : string list -> [ `raw ] t
|
||
|
|
(** [of_strings_exn labels] is [t], a domain name. A trailing empty
|
||
|
|
label is not required.
|
||
|
|
|
||
|
|
@raise Invalid_argument if [labels] are not a valid domain name. *)
|
||
|
|
|
||
|
|
val to_strings : ?trailing:bool -> 'a t -> string list
|
||
|
|
(** [to_strings ~trailing t] is the list of labels of [t]. If [trailing] is
|
||
|
|
provided and [true] (defaults to [false]), the resulting list will contain
|
||
|
|
a trailing empty label. *)
|
||
|
|
|
||
|
|
(** {2 Pretty printer} *)
|
||
|
|
|
||
|
|
val pp : Format.formatter -> 'a t -> unit
|
||
|
|
(** [pp ppf t] pretty prints the domain name [t] on [ppf]. *)
|
||
|
|
|
||
|
|
(**/**)
|
||
|
|
(* exposing internal structure, used by udns (but could as well use Obj.magic *)
|
||
|
|
|
||
|
|
val of_array : string array -> [ `raw ] t
|
||
|
|
(** [of_array a] is [t], a domain name from [a], an array containing a reversed
|
||
|
|
domain name. *)
|
||
|
|
|
||
|
|
val to_array : 'a t -> string array
|
||
|
|
(** [to_array t] is [a], an array containing the reversed domain name of [t]. *)
|