swrup/mte
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Browse source
This commit is contained in:
swrup 2025-11-11 02:07:51 +01:00
parent aa2ff7b2f0
commit 2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

43
unikernel/duniverse/ocaml-uri/.github/workflows/test.yml vendored Normal file
View file

@ -0,0 +1,43 @@
name: Main workflow
on:
- pull_request
- push
jobs:
build:
strategy:
fail-fast: false
matrix:
os:
- macos-latest
ocaml-compiler:
- 5.0
- 4.14.1
- 4.13.1
- 4.08.1
runs-on: ${{ matrix.os }}
steps:
- name: Checkout code
uses: actions/checkout@v3
- name: Use OCaml ${{ matrix.ocaml-compiler }}
uses: ocaml/setup-ocaml@v2
with:
ocaml-compiler: ${{ matrix.ocaml-compiler }}
- name: Install dependencies
run: |
opam install . --deps-only --with-test
- name: Build
run: |
opam exec -- dune build
- name: Tests
run: |
opam exec -- dune build @runtest
- name: Opam Lint
run: |
opam lint uri.opam uri-re.opam uri-sexp.opam uri-bench.opam

5
unikernel/duniverse/ocaml-uri/.gitignore vendored Normal file
View file

@ -0,0 +1,5 @@
*.install
.*.swp
.merlin
_build/
_opam/

332
unikernel/duniverse/ocaml-uri/CHANGES.md Normal file
View file

@ -0,0 +1,332 @@
v4.4.0 2023-09-25
-----------------
* **breaking change** Fix parsing & printing of IPv6 addresses in the host part of an uri
If we follow the RFC3986 correctly, IPv6 must be surrounded by '[' and ']'. Old versions
of `ocaml-uri` escaped these characters. The new version interprets these characters to
recognize an IPv6 address.
Users should take note of this change in behaviour, which fixes a number of bugs in HTTP
requests. (@anmonteiro, review by several maintainers, #169)
* Upgrade tests to `ounit2` (@Alessandro-Barbieri, #161)
v4.3.0 2023-04-19
-----------------
* Add `Uri.Absolute_http`, an RFC9110-compliance specialization of a
`Uri.t`. (#164 #162 @torinnd).
* Add a `uri-bench` package for the benchmarking dependencies in this
repository (#166 @tmcgilchrist).
v4.2.0 2021-04-26
-----------------
* Do not mutate the base encoder when using custom percent encoders.
This was a bug introduced in #147. (#156 @aantron)
* Disable Travis CI tests and switch Win/Mac tests to GitHub Actions and
Linux ones to ocaml-ci (@avsm).
v4.1.0 2021-01-04
-----------------
* `uri-re` is deprecated, it is a legacy implementation that is now outdated.
`uri` should be used instead (@dinosaure, #152).
* Fix build system for cross-compilation (@TheLortex, #151).
v4.0.0 2020-01-01
-----------------
* sexp: use the sexplib v0.13 ppx directives (@avsm, #143).
* rework the URI parser with `angstrom` (@anmonteiro, review @avsm & @dinosaure, #142).
* add simple fuzzer tests between `angstrom` parser and _legacy_ parser (with `re.posix`, #142)
* add support of modifying pct encoding (with a custom one) (@orbitz, review @anmonteiro, @tmcgilchrist, @avsm & @dinosaure, #147)
* allow the selection of generic set of safe characters (with `Generic`) (@madroach, review @dinosaure, #141)
v3.1.0 2019-11-23
-----------------
* Add `Uri_sexp.equal` (#139 @vbmithr)
* Update opam files to remove dune as a build-only dep (@craigfe #140)
v3.0.0 2019-07-06
-----------------
* Complete the migration of making sexp an optional dependency that was
started in 2.0.0. We now remove the `uri.sexp` ocamlfind package and
have `uri` and `uri-sexp` for both the ocamlfind and opam packages.
Code that was formerly using `uri.sexp` in its build will now need to
move to `uri-sexp` instead (#134 @Julow @dinosaure).
* Remove the deprecated `Uri_re` module. All code should be using the
`Uri.Re` module instead (@avsm @Julow).
* Remove the `uri.top` library, since we install the toplevel printer
automatically since 2.2.0 via an attribute.
v2.2.1 2019-06-02
-----------------
* Fix deprecation warnings in Re 1.9.0 (#137 @avsm).
v2.2.0 2019-01-31
-----------------
* Add `Uri.pp` as an alias to `Uri.pp_hum`, as the `pp` form
is more commonly used. (#133 @avsm)
* Add an `[@@ocaml.toplevel_printer]` attribute to Uri.pp
so that it will be automatically loaded on modern Utop versions. (#133 @avsm)
* Upgrade last remaining `jbuild` file to `dune` (#133 @avsm)
* OCamldoc improvements in section headers (@avsm)
v2.1.0 2018-12-12
-----------------
* Expose a `compare` function in `Uri_sexp` so that it will work
with `deriving compare,sexp`.
* Upgrade the opam metadata to the 2.0 format.
* Update Travis to test OCaml 4.03->4.07.
* Minimum OCaml version is now 4.04.0+ due to sexplib0 dependency.
v2.0.0 2018-10-15
-----------------
* Create a new subpackage `uri.sexp` for the sexpression converters, so
that the base Uri package is more dependency free (based on #121 by @Julow).
To convert old code, simply use `Uri_sexp.t` instead of `Uri.t` in a record
type for which you are using `[@@deriving sexp]`. This is a type alias to
`Uri.t` but also has the right sexp-conversion functions in scope.
* Deprecate `Uri_re` in favour of `Uri.Re`. The unwrapped `Uri_re` will
be removed in a future release of this library.
* Switch to using sexplib0 instead of sexplib for easier dependencies
(based on #123 by @mseri)
* Port build to Dune from jbuilder.
* Add benchmarks using `core_bench` (#125 via @drup)
v1.9.7 2018-07-01
-----------------
* Use latest interfaces in Re >=1.7.2 (#122)
* When resolving URI inherit userinfo from the base URI (#116)
v1.9.6 2018-01-11
-----------------
* Change code generation strategy to avoid big switches in
the services file; improves build time by 10x (#114 by @gasche).
* Remove deprecated function use (`String.lowercase`)
* Add development Makefile with more targets.
v1.9.5 2017-11-05
-----------------
* Fix build with OCaml 4.06 (and -safe-string) (#108 @hcarty)
* Set (wrapped false) in jbuilder (#105 @avsm)
* Add OCaml 4.06 to the travis CI matrix (#109 @djs55)
v1.9.4 2017-05-30
-----------------
* Port build system to jbuilder (#100 @vbmithr @rgrinberg @avsm @dsheets).
There should be no observable changes, except that `Uri_services` is now
in a separate subdirectory. This means that packages that implicitly
depended on the module without including the ocamlfind `uri.services`
package may now fail. Just adding the ocamlfind dependency will fix it,
and is backwards compatible with older Uri releases.
* Restrict build to OCaml 4.03.0+ (was formerly OCaml 4.02.0+).
* Add Appveyor tests for Windows compilation.
v1.9.3 2017-03-06
-----------------
* Port build system to topkg (#95 by @fgimenez)
* Add a tighter opam constraint on `ppx_sexp` (#94)
* Explicitly depend on `ppx_deriving` for improving future compatibility
with Jane Street upstream (#98).
* Update Travis CI to include OCaml 4.04 and 4.03 in the matrix.
v1.9.2 2016-02-12
-----------------
* Remove sexplib.syntax, `type_conv` deps and camlp4 transitive dependency
* Add `ppx_sexp_conv` dependency
* Require OCaml 4.02.3+
v1.9.1 2015-06-26
-----------------
* Fix `with_password None` when no userinfo present (#78 from Hezekiah M. Carty)
v1.9.0 2015-05-15
-----------------
* Colon (":") is no longer percent-encoded in path segments
* URNs are now supported (#67)
* Relative paths with colons in first segment have "./" prepended in to_string
* Add Uri.empty, the zero length URI reference
* `Uri_services` now includes service aliases (e.g. www, www-http, http)
* `Uri_services` now includes chargen and git
* Add `Uri.canonicalize` for scheme-specific normalization (#70)
* Add `Uri.verbatim_query` to extract literal query string (#57)
* Add `Uri.equal`
* Add `Uri.user` and `Uri.password` accessors for subcomponents of userinfo (#62)
* Add `Uri.with_password` functional setter for password subcomponent of userinfo
* Fix file scheme host normalization bug which introduced empty host (#59)
v1.8.0 2015-02-16
-----------------
* `Uri.with_port` no longer sets the host fragment to a blank value if both
the host and port are empty (#63).
* `Uri.compare` imposes an ordering by host, scheme, port, userinfo, path,
query, and finally fragment. (#55).
* Uri is now an `OrderedType` and can be used directly in Maps and Sets (#55).
* Remove deprecation warnings with OCaml 4.02.0+ (#58).
* Drop support for OCaml 3.12.1, and now require OCaml 4.00.1+.
* Modernise Travis scripts to use OPAM 1.2 workflow.
v1.7.2 2014-08-10
-----------------
* Fix empty-but-existing query ("?") parsing bug
* Fix `with_userinfo` against hostless URI representation bug
* Fix `with_port` against hostless URI representation bug
* Fix `with_path` with relative path against hosted URI representation bug (#51)
* Fix `make` without host but with userinfo or port representation bug
* Fix `make` with host, userinfo, or port and relative path representation bug
v1.7.1 2014-07-05
-----------------
* Add RFC6874 compliance for IPv6 literals with zones (#48).
v1.7.0 2014-06-16
-----------------
* Expose the list of known services in the `Uri_services` module via
new functions that list TCP, UDP and an association list of both.
v1.6.0 2014-04-28
-----------------
* Remove `Uri_IP` module, superseded by the `ipaddr` package (#30).
* Do not depend on `camlp4` for link-time, only compile time (#39).
* Add `with_scheme` and `with_userinfo` functional setters (#40).
* Always percent-escape semicolon in structured query encoding (#44).
v1.5.0 2014-03-24
-----------------
* Make library POSIX thread-safe by removing dependency on `Re_str`.
* Add Merlin IDE configuration.
v1.4.0 2014-02-16
-----------------
* Fix `path` and `path_and_query` encoding bugs (#35).
* Fix userinfo percent-encoding/delimiter bug (#35).
* Add optional scheme parameter to `encoding_of_query`.
v1.3.13 2014-01-16
-----------------
* Remove internal use of Scanf.
* Expose `with sexp` for the Uri types.
v1.3.12 2013-12-28
-----------------
* Be lenient about decoding incorrect encoded percent-strings (#31).
* Improve ocamldoc for `Uri.of_string`.
* Regenerate build files with OASIS 0.4.1.
* Add an `mldylib` to build the cmxs Natdynlink plugin properly (#29).
v1.3.11 2013-10-13
-----------------
* Add relative-relative URI resolution support.
* OCamldoc fixes.
* Add Travis continous build tests.
v1.3.10 2013-09-05
-----------------
* Rename `Install_printer` to `Uri_top` to prevent conflict with other libraries with similar name (#24).
v1.3.9 2013-08-30
-----------------
* Add back support for OCaml 3.12.1 by fixing the compiler-libs linking.
v1.3.8 2013-05-19
-----------------
* Add `Uri.get_query_param` which selects a single value for a query key.
* Add `Uri.get_query_param'` which returns a list of values associated with a query key.
* Fix ocamldoc in `Uri` module to have a header.
v1.3.7 2013-01-23
-----------------
* Add a top-level printer for `Uri.t` that converts it to a string instead
of just displaying an `<abstract>` type.
v1.3.6 2012-12-29
-----------------
* Add `with_host`, `with_port`, `with_fragment` and `with_host`, to modify
the respective fields of an input URI.
v1.3.5 2012-12-19
-----------------
* Fix percent encoding of characters from 0x0 to 0xf.
* Add `Uri.remove_query_param` function to remove keys from query sets.
v1.3.4 2012-11-08
-----------------
* Always encode `+` in URLs to be more compatible with form encoding.
v1.3.3 2012-10-14
-----------------
* Add singleton variants of query functions that accept a `string->string`
instead of a string list of values, for convenience.
v1.3.2 2012-09-20
-----------------
* Fix parsing of unreserved characters in hostnames (e.g. `foo-bar.com`).
* Add unit tests for the `Uri_services` module.
* Various URI parsing bugs and test cases for better RFC3986 compliance.
* Fix `port_of_uri` to detect port overrides in a URI before doing a lookup.
v1.3.1 2012-09-12
-----------------
* Make the `Uri_services_full` library optional, as it takes a loooong time
to compile. It will return as a UNIX binding to getservent(2) also.
v1.3.0 2012-08-24
-----------------
* Add `Uri_services` to lookup IANA the common well-known ports and services
* Add `Uri_services_full` with a complete database of the IANA database.
v1.2 2012-08-21
---------------
* Add `Uri.path_and_query` to retrieve a path/query combination string.
* Add `Uri.host_with_default` to retrieve a hostname string.
v1.1 2012-08-02
---------------
* Fix query parsing order.
* Improve safe character handling across URI components.
v1.0 2012-08-01
---------------
* Initial public release.

16
unikernel/duniverse/ocaml-uri/LICENSE.md Normal file
View file

@ -0,0 +1,16 @@
(*
* Copyright (c) <the authors, see individual headers on files>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
*)

19
unikernel/duniverse/ocaml-uri/Makefile Normal file
View file

@ -0,0 +1,19 @@
.PHONY: build clean test install uninstall doc
build:
dune build @install
test:
dune runtest
install:
dune install
uninstall:
dune uninstall
clean:
dune clean
doc:
dune build @doc

48
unikernel/duniverse/ocaml-uri/README.md Normal file
View file

@ -0,0 +1,48 @@
Uri -- an RFC3986 URI/URL parsing library
-----------------------------------------
This is an OCaml implementation of the [RFC3986](http://tools.ietf.org/html/rfc3986) specification
for parsing URI or URLs.
## Installation
### Via OPAM
The [OPAM](https://opam.ocaml.org) package manager can be used to install this library from source.
opam install uri
### Locally
You can build the source code locally via the [dune](https://github.com/ocaml/dune)
build system.
opam install uri --deps-only
eval `opam config env`
dune build
dune runtest
will install the dependencies via OPAM, build the library and then run the tests in the [lib_test/](lib_test/) directory.
## Usage
Once installed, there are three ocamlfind packages available for your use:
- `uri` - the base `Uri` module
- `uri-re` - the _legacy_ implementation
At the beginning, `uri` used `re` to parse a `string`. Since 4.0.0,
we use `angstrom` - if something breaks with `uri.4.0.0`, you should compare
with `uri-re` and submit an issue. `uri-re` is deprecated and it will be
removed on the next release (see #150)
- `uri.top` - the toplevel printers for use with [utop](https://github.com/diml/utop)
- `uri-sexp` - provides converters to and from s-expressions (via a `Uri_sexp.t` type alias)
- `uri.services` - the `Uri_services` module that provides the equivalent of *[services(5)](http://man7.org/linux/man-pages/man5/services.5.html)*
- `uri.services_full` - the `Uri_services_full` module that provides a complete copy of the `/etc/services` file. This is quite large and normally not needed.
## Contact
- Issues: <https://github.com/mirage/ocaml-uri/issues>
- E-mail: <mirageos-devel@lists.xenproject.org>
- API Documentation: <http://docs.mirage.io/uri/>
[![Build Status](https://travis-ci.org/mirage/ocaml-uri.png)](https://travis-ci.org/mirage/ocaml-uri)

15
unikernel/duniverse/ocaml-uri/appveyor.yml Normal file
View file

@ -0,0 +1,15 @@
platform:
- x86
environment:
FORK_USER: ocaml
FORK_BRANCH: master
CYG_ROOT: C:\cygwin64
PACKAGE: uri
OCAML_VERSION: 4.06
install:
- ps: iex ((new-object net.webclient).DownloadString("https://raw.githubusercontent.com/$env:FORK_USER/ocaml-ci-scripts/$env:FORK_BRANCH/appveyor-install.ps1"))
build_script:
- call %CYG_ROOT%\bin\bash.exe -l %APPVEYOR_BUILD_FOLDER%\appveyor-opam.sh

35
unikernel/duniverse/ocaml-uri/benchmarks/benchmark.ml Normal file
View file

@ -0,0 +1,35 @@
open Core
open Core_bench
let make_bench_parsing (name, str) =
Bench.Test.create ~name
(fun () -> Uri.of_string str)
let parsing_benchs = [
"small", "http://foo.com" ;
"ipv6",
"http://%5Bdead%3Abeef%3A%3Adead%3A0%3Abeaf%5D" ;
"complete",
"https://user:pass@foo.com:123/wh/at/ever?foo=1&bar=5#5";
"query",
"//domain?f+1=bar&+f2=bar%212";
"path",
"http://a/b/c/g;x?y#s";
"urn",
"urn:uuid:f81d4fae-7dec-11d0-a765-00a0c91e6bf6";
]
let benchmarks = [
Bench.Test.create_group ~name:"parsing"
(List.map ~f:make_bench_parsing parsing_benchs);
]
let () =
Bench.make_command benchmarks
|> Command_unix.run

12
unikernel/duniverse/ocaml-uri/benchmarks/dune Normal file
View file

@ -0,0 +1,12 @@
(executables
(names benchmark)
(package uri-bench)
(public_names uri-bench)
(libraries uri core_bench core_unix.command_unix))
(alias
(name bench)
(deps
(:< benchmark.exe))
(action
(run %{<})))

4
unikernel/duniverse/ocaml-uri/config/dune Normal file
View file

@ -0,0 +1,4 @@
(executable
(name gen_services)
(modules gen_services)
(libraries stringext))

104
unikernel/duniverse/ocaml-uri/config/gen_services.ml Normal file
View file

@ -0,0 +1,104 @@
(*
* Copyright (c) 2012 Anil Madhavapeddy <anil@recoil.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
*)
(* Convert a UNIX /etc/services into an ML module to lookup entries *)
open Printf
let hashtbl_add_list h k v =
try
let l = Hashtbl.find h k in
l := v :: !l
with Not_found -> Hashtbl.add h k (ref [v])
let spaced_list = Stringext.split_trim_left ~on:" " ~trim:" "
let nonempty = List.filter ((<>) "")
let iter f h =
let bindings = Hashtbl.fold (fun k v a -> (k,v)::a) h [] in
List.iter (fun (k, v) -> f k v) (List.sort compare bindings)
let _ =
let fin = open_in Sys.argv.(1) in
let tcp_ports = Hashtbl.create 1 in
let udp_ports = Hashtbl.create 1 in
let ports_tcp = Hashtbl.create 1 in
let ports_udp = Hashtbl.create 1 in
let tcp_services = Hashtbl.create 1 in
let udp_services = Hashtbl.create 1 in
(try while true do
let line = input_line fin in
match line.[0] with
|'#'|' ' -> ()
|_ ->
Scanf.sscanf line "%s %d/%s %s@\n" (fun svc port proto rest ->
let alias_s = List.hd (Stringext.split ~on:'#' (" "^rest)) in
let aliases = nonempty (spaced_list alias_s) in
match proto with
|"tcp" ->
List.iter (fun svc ->
hashtbl_add_list tcp_ports svc port;
hashtbl_add_list ports_tcp port svc;
Hashtbl.replace tcp_services svc ()
) (svc::aliases)
|"udp" ->
List.iter (fun svc ->
hashtbl_add_list udp_ports svc port;
hashtbl_add_list ports_udp port svc;
Hashtbl.replace udp_services svc ();
) (svc::aliases)
|"ddp" | "sctp" | "divert" -> ()
|x -> failwith ("unknown proto " ^ x)
)
done with End_of_file -> ());
let print_keys quote ppf table =
iter (fun k _v -> fprintf ppf ("%s; ") (quote k)) table in
let print_values quote ppf table =
iter (fun _k v -> fprintf ppf "[ %s ]; "
(String.concat "; " (List.map quote !v))) table in
let quote_string s = sprintf "%S" s in
printf "(* Autogenerated by gen_services.ml, do not edit directly *)\n";
printf "let tcp_port_of_service_tables = (\n [| %a |],\n [| %a |]\n)\n\n"
(print_keys quote_string) tcp_ports
(print_values string_of_int) tcp_ports;
printf "let udp_port_of_service_tables = (\n [| %a |],\n [| %a |]\n)\n\n"
(print_keys quote_string) udp_ports
(print_values string_of_int) udp_ports;
printf "let service_of_tcp_port_tables = (\n [| %a |],\n [| %a |]\n)\n\n"
(print_keys string_of_int) ports_tcp
(print_values quote_string) ports_tcp;
printf "let service_of_udp_port_tables = (\n [| %a |],\n [| %a |]\n)\n\n"
(print_keys string_of_int) ports_udp
(print_values quote_string) ports_udp;
let hashset_elems table =
Hashtbl.fold (fun k () a -> quote_string k :: a) table []
|> List.sort String.compare
|> String.concat "; "
in
printf "let known_tcp_services =\n [ %s ]\n\n"
(hashset_elems tcp_services);
printf "let known_udp_services =\n [ %s ]\n\n"
(hashset_elems udp_services);
printf "let known_services = [\n";
printf " (\"tcp\", known_tcp_services);\n";
printf " (\"udp\", known_udp_services) ]\n\n";

3
unikernel/duniverse/ocaml-uri/dune-project Normal file
View file

@ -0,0 +1,3 @@
(lang dune 1.2)
(name uri)
(version v4.4.0)

25
unikernel/duniverse/ocaml-uri/etc/dune Normal file
View file

@ -0,0 +1,25 @@
(rule
(targets uri_services.ml)
(deps services.short uri_services_raw.ml)
(action (with-stdout-to %{targets}
(progn (run ../config/gen_services.exe %{deps})
(cat uri_services_raw.ml)))))
(rule
(targets uri_services_full.ml)
(deps services.full uri_services_raw.ml)
(action (with-stdout-to %{targets}
(progn (run ../config/gen_services.exe %{deps})
(cat uri_services_raw.ml)))))
(library
(name uri_services)
(public_name uri.services)
(modules uri_services)
(libraries uri))
(library
(name uri_services_full)
(public_name uri.services_full)
(modules uri_services_full)
(libraries uri))

13921
unikernel/duniverse/ocaml-uri/etc/services.full Normal file
View file

File diff suppressed because it is too large Load diff

133
unikernel/duniverse/ocaml-uri/etc/services.short Normal file
View file

@ -0,0 +1,133 @@
echo 4/ddp #AppleTalk Echo Protocol
echo 7/udp # Echo
echo 7/tcp # Echo
discard 9/udp # Discard
discard 9/tcp # Discard
systat 11/udp # Active Users
systat 11/tcp # Active Users
daytime 13/udp # Daytime (RFC 867)
daytime 13/tcp # Daytime (RFC 867)
msp 18/udp # Message Send Protocol
msp 18/tcp # Message Send Protocol
chargen 19/tcp #
ftp-data 20/udp # File Transfer [Default Data]
ftp-data 20/tcp # File Transfer [Default Data]
ftp 21/udp # File Transfer [Control]
ftp 21/tcp # File Transfer [Control]
ssh 22/udp # SSH Remote Login Protocol
ssh 22/tcp # SSH Remote Login Protocol
telnet 23/udp # Telnet
telnet 23/tcp # Telnet
smtp 25/udp # Simple Mail Transfer
smtp 25/tcp # Simple Mail Transfer
time 37/udp # Time
time 37/tcp # Time
domain 53/udp # Domain Name Server
domain 53/tcp # Domain Name Server
bootps 67/udp # Bootstrap Protocol Server
bootps 67/tcp # Bootstrap Protocol Server
bootpc 68/udp # Bootstrap Protocol Client
bootpc 68/tcp # Bootstrap Protocol Client
tftp 69/udp # Trivial File Transfer
tftp 69/tcp # Trivial File Transfer
gopher 70/udp # Gopher
gopher 70/tcp # Gopher
finger 79/udp # Finger
finger 79/tcp # Finger
http 80/udp www www-http # World Wide Web HTTP
http 80/tcp www www-http # World Wide Web HTTP
kerberos 88/udp # Kerberos
kerberos 88/tcp # Kerberos
pop3 110/udp # Post Office Protocol - Version 3
pop3 110/tcp # Post Office Protocol - Version 3
sunrpc 111/udp # SUN Remote Procedure Call
sunrpc 111/tcp # SUN Remote Procedure Call
auth 113/udp # Authentication Service
auth 113/tcp ident #
nntp 119/udp # Network News Transfer Protocol
nntp 119/tcp # Network News Transfer Protocol
ntp 123/udp # Network Time Protocol
ntp 123/tcp # Network Time Protocol
netbios-ns 137/udp # NETBIOS Name Service
netbios-ns 137/tcp # NETBIOS Name Service
netbios-dgm 138/udp # NETBIOS Datagram Service
netbios-dgm 138/tcp # NETBIOS Datagram Service
netbios-ssn 139/udp # NETBIOS Session Service
netbios-ssn 139/tcp # NETBIOS Session Service
imap 143/udp # Internet Message Access Protocol
imap 143/tcp # Internet Message Access Protocol
genrad-mux 176/tcp # GENRAD-MUX
xdmcp 177/udp # X Display Manager Control Protocol
xdmcp 177/tcp # X Display Manager Control Protocol
bgp 179/udp # Border Gateway Protocol
bgp 179/tcp # Border Gateway Protocol
irc 194/udp # Internet Relay Chat Protocol
irc 194/tcp # Internet Relay Chat Protocol
qmtp 209/udp # The Quick Mail Transfer Protocol
qmtp 209/tcp # The Quick Mail Transfer Protocol
ipx 213/udp # IPX
ipx 213/tcp # IPX
ldap 389/udp # Lightweight Directory Access Protocol
ldap 389/tcp # Lightweight Directory Access Protocol
https 443/udp # http protocol over TLS/SSL
https 443/tcp # http protocol over TLS/SSL
kpasswd 464/udp # kpasswd
kpasswd 464/tcp # kpasswd
syslog 514/udp #
printer 515/udp # spooler
printer 515/tcp # spooler
talk 517/tcp # like tenex link, but across
talk 517/udp # like tenex link, but across
ntalk 518/udp #
ntalk 518/tcp #
utime 519/udp # unixtime
utime 519/tcp # unixtime
efs 520/tcp # extended file name server
irc-serv 529/udp # IRC-SERV
irc-serv 529/tcp # IRC-SERV
klogin 543/udp #
klogin 543/tcp #
kshell 544/udp # krcmd
kshell 544/tcp # krcmd
dhcpv6-client 546/udp # DHCPv6 Client
dhcpv6-client 546/tcp # DHCPv6 Client
dhcpv6-server 547/udp # DHCPv6 Server
dhcpv6-server 547/tcp # DHCPv6 Server
pirp 553/udp # pirp
pirp 553/tcp # pirp
rtsp 554/udp # Real Time Stream Control Protocol
rtsp 554/tcp # Real Time Stream Control Protocol
9pfs 564/udp # plan 9 file service
9pfs 564/tcp # plan 9 file service
keyserver 584/udp # Key Server
keyserver 584/tcp # Key Server
imap4-ssl 585/udp # IMAP4+SSL (use 993 instead)
imap4-ssl 585/tcp # IMAP4+SSL (use 993 instead)
syslog-conn 601/udp # Reliable Syslog Service
syslog-conn 601/tcp # Reliable Syslog Service
acap 674/udp # ACAP
acap 674/tcp # ACAP
dctp 675/udp # DCTP
dctp 675/tcp # DCTP
nmap 689/udp # NMAP
nmap 689/tcp # NMAP
silc 706/udp # SILC
silc 706/tcp # SILC
kerberos-adm 749/udp # kerberos administration
kerberos-adm 749/tcp # kerberos administration
rsync 873/udp # rsync
rsync 873/tcp # rsync
ftps-data 989/udp # ftp protocol, data, over TLS/SSL
ftps-data 989/tcp # ftp protocol, data, over TLS/SSL
ftps 990/udp # ftp protocol, control, over TLS/SSL
ftps 990/tcp # ftp protocol, control, over TLS/SSL
telnets 992/udp # telnet protocol over TLS/SSL
telnets 992/tcp # telnet protocol over TLS/SSL
imaps 993/udp # imap4 protocol over TLS/SSL
imaps 993/tcp # imap4 protocol over TLS/SSL
ircs 994/udp # irc protocol over TLS/SSL
ircs 994/tcp # irc protocol over TLS/SSL
pop3s 995/udp # pop3 protocol over TLS/SSL (was spop3)
pop3s 995/tcp # pop3 protocol over TLS/SSL (was spop3)
git 9418/tcp # git pack transfer service
git 9418/udp # git pack transfer service

51
unikernel/duniverse/ocaml-uri/etc/uri_services.mli Normal file
View file

@ -0,0 +1,51 @@
(*
* Copyright (c) 2012-2014 Anil Madhavapeddy <anil@recoil.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
*)
(** Module that maps the more common IANA well-known ports to and from their
textual service names. To save memory, this module does not contains only
the more common services. Use the [Uri_services_full] module if you need
the complete list. *)
val service_of_tcp_port : int -> string list
(** Convert a TCP port number into a list of IANA well-known service names *)
val service_of_udp_port : int -> string list
(** Convert a UDP port number into a list of IANA well-known service names *)
val tcp_port_of_service : string -> int list
(** Convert a IANA well-known service name into a list of valid TCP port numbers *)
val udp_port_of_service : string -> int list
(** Convert a IANA well-known service name into a list of valid UDP port numbers *)
val tcp_port_of_uri : ?default:string -> Uri.t -> int option
(** Extract a TCP port from a URI, using a default service if the URI does not contain a scheme *)
val udp_port_of_uri : ?default:string -> Uri.t -> int option
(** Extract a UDP port from a URI, using a default service if the URI does not contain a scheme *)
val known_tcp_services : string list
(** List of known TCP services.
These keys are guaranteed to match in the rest of the lookup functions. *)
val known_udp_services : string list
(** List of known UDP services.
These keys are guaranteed to match in the rest of the lookup functions. *)
val known_services : (string * string list) list
(** Association list of [protocol * service list]. Usually populated with
at least "tcp" and "udp" keys for those respective protocols. *)

48
unikernel/duniverse/ocaml-uri/etc/uri_services_full.mli Normal file
View file

@ -0,0 +1,48 @@
(*
* Copyright (c) 2012 Anil Madhavapeddy <anil@recoil.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
*)
(** Module that maps the IANA well-known ports to and from their textual service names *)
val service_of_tcp_port : int -> string list
(** Convert a TCP port number into a list of IANA well-known service names *)
val service_of_udp_port : int -> string list
(** Convert a UDP port number into a list of IANA well-known service names *)
val tcp_port_of_service : string -> int list
(** Convert a IANA well-known service name into a list of valid TCP port numbers *)
val udp_port_of_service : string -> int list
(** Convert a IANA well-known service name into a list of valid UDP port numbers *)
val tcp_port_of_uri : ?default:string -> Uri.t -> int option
(** Extract a TCP port from a URI, using a default service if the URI does not contain a scheme *)
val udp_port_of_uri : ?default:string -> Uri.t -> int option
(** Extract a UDP port from a URI, using a default service if the URI does not contain a scheme *)
val known_tcp_services : string list
(** List of known TCP services.
These keys are guaranteed to match in the rest of the lookup functions. *)
val known_udp_services : string list
(** List of known UDP services.
These keys are guaranteed to match in the rest of the lookup functions. *)
val known_services : (string * string list) list
(** Association list of [protocol * service list]. Usually populated with
at least "tcp" and "udp" keys for those respective protocols. *)

60
unikernel/duniverse/ocaml-uri/etc/uri_services_raw.ml Normal file
View file

@ -0,0 +1,60 @@
let search_string keys k =
let rec loop keys k low high =
if low > high then (-1)
else begin
let mid = (high + low) / 2 in
let diff = String.compare k keys.(mid) in
if diff < 0 then loop keys k low (mid - 1)
else if diff > 0 then loop keys k (mid + 1) high
else mid
end
in loop keys k 0 (Array.length keys - 1)
let search_int keys k =
let rec loop keys k low high =
if low > high then (-1)
else begin
let mid = (high + low) / 2 in
let diff = k - keys.(mid) in
if diff < 0 then loop keys k low (mid - 1)
else if diff > 0 then loop keys k (mid + 1) high
else mid
end
in loop keys k 0 (Array.length keys - 1)
let lookup search (keys, values) k =
let i = search keys k in
if i < 0 then []
else values.(i)
let service_of_tcp_port p =
lookup search_int service_of_tcp_port_tables p
let service_of_udp_port p =
lookup search_int service_of_udp_port_tables p
let tcp_port_of_service s =
lookup search_string tcp_port_of_service_tables s
let udp_port_of_service s =
lookup search_string udp_port_of_service_tables s
let port_of_uri ?default lookupfn uri =
match Uri.port uri with
|Some _port as x -> x
|None -> begin
match Uri.scheme uri, default with
|None, None -> None
|None, Some scheme
|Some scheme, _ -> begin
match lookupfn scheme with
|[] -> None
|hd::_ -> Some hd
end
end
let tcp_port_of_uri ?default uri =
port_of_uri ?default tcp_port_of_service uri
let udp_port_of_uri ?default uri =
port_of_uri ?default udp_port_of_service uri

5
unikernel/duniverse/ocaml-uri/fuzz/dune Normal file
View file

@ -0,0 +1,5 @@
(tests
(names fuzz)
(package uri-re)
(libraries uri uri-re crowbar)
(deps (source_tree input)))

46
unikernel/duniverse/ocaml-uri/fuzz/fuzz.ml Normal file
View file

@ -0,0 +1,46 @@
open Crowbar
let () =
add_test ~name:"create" [bytes] (fun a ->
(* Parse \n as this is a known deviation of behaviour *)
let a = Str.(global_replace (regexp_string "\n") a "") in
let x = try Uri.(of_string a |> to_string) with _ -> "" in
let y = try Uri_legacy.(of_string a |> to_string) with _ -> "" in
check_eq ~pp:pp_string x y
);
add_test ~name:"query" [bytes] (fun a ->
(* Parse \n as this is a known deviation of behaviour *)
let a = Str.(global_replace (regexp_string "\n") a "") in
let x = try Uri.(of_string a |> query) with _ -> [] in
let y = try Uri_legacy.(of_string a |> query) with _ -> [] in
check_eq x y
);
add_test ~name:"scheme" [bytes] (fun a ->
(* Parse \n as this is a known deviation of behaviour *)
let a = Str.(global_replace (regexp_string "\n") a "") in
let x = try Uri.(of_string a |> scheme) with _ -> None in
let y = try Uri_legacy.(of_string a |> scheme) with _ -> None in
check_eq x y
);
add_test ~name:"host" [bytes] (fun a ->
(* Parse \n as this is a known deviation of behaviour *)
let a = Str.(global_replace (regexp_string "\n") a "") in
let x = try Uri.(of_string a |> host) with _ -> None in
let y = try Uri_legacy.(of_string a |> host) with _ -> None in
check_eq x y
);
add_test ~name:"userinfo" [bytes] (fun a ->
(* Parse \n as this is a known deviation of behaviour *)
let a = Str.(global_replace (regexp_string "\n") a "") in
let x = try Uri.(of_string a |> userinfo) with _ -> None in
let y = try Uri_legacy.(of_string a |> userinfo) with _ -> None in
check_eq x y
);
add_test ~name:"port" [bytes] (fun a ->
(* Parse \n as this is a known deviation of behaviour *)
let a = Str.(global_replace (regexp_string "\n") a "") in
let x = try Uri.(of_string a |> port) with _ -> None in
let y = try Uri_legacy.(of_string a |> port) with _ -> None in
check_eq x y
);

1
unikernel/duniverse/ocaml-uri/fuzz/input/start Normal file
View file

@ -0,0 +1 @@
foo

4
unikernel/duniverse/ocaml-uri/lib/dune Normal file
View file

@ -0,0 +1,4 @@
(library
(name uri)
(public_name uri)
(libraries stringext angstrom))

1248
unikernel/duniverse/ocaml-uri/lib/uri.ml Normal file
View file

File diff suppressed because it is too large Load diff

304
unikernel/duniverse/ocaml-uri/lib/uri.mli Normal file
View file

@ -0,0 +1,304 @@
(*
* Copyright (c) 2012-2013 Anil Madhavapeddy <anil@recoil.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
*)
(** Uniform Resource Identifier handling that is RFC3986-compliant. *)
(** A single URI that is a compact sequence of characters that identifies
an abstract or physical resource. *)
type t
type component = [
`Scheme
| `Authority
| `Userinfo (** subcomponent of authority in some schemes *)
| `Host (** subcomponent of authority in some schemes *)
| `Path
| `Query
| `Query_key
| `Query_value
| `Fragment
| `Generic
| `Custom of (component * string * string) (* (component * safe chars * unsafe chars) *)
]
(** For pct encoding customization when converting a URI to a string. *)
type pct_encoder
(** {2 Core functionality } *)
(** The empty (zero length) URI reference. Useful for constructing
URIs piece-by-piece. *)
val empty : t
(** Comparator ordering by host, scheme, port, userinfo, path, query,
and finally fragment. Designed to produce a reasonable sort order. *)
val compare : t -> t -> int
(** [equal a b] is [compare a b = 0]. *)
val equal : t -> t -> bool
(** Percent-encode a string. The [component] argument defaults to `Path *)
val pct_encode : ?scheme:string -> ?component:component -> string -> string
(** Construct a pct_encoder. *)
val pct_encoder :
?scheme:component ->
?userinfo:component ->
?host:component ->
?path:component ->
?query_key:component ->
?query_value:component ->
?fragment:component ->
unit ->
pct_encoder
(** Percent-decode a percent-encoded string *)
val pct_decode : string -> string
(** Parse a URI string literal into a URI structure. A bare string will be
interpreted as a path; a string prefixed with `//` will be interpreted as a
host.
*)
val of_string : string -> t
(** Convert a URI structure into a percent-encoded URI string *)
val to_string : ?pct_encoder:pct_encoder -> t -> string
(** Resolve a URI against a default scheme and base URI *)
val resolve : string -> t -> t -> t
(** Canonicalize a URI according to Sec 6.2.3 "Scheme-Based
Normalization". This transform is more aggressive than the
standard URI-generic normalization automatically done. In
particular, HTTP(S) URIs with empty path components will have
their path components set to "/". Some applications like web
servers may rely on the distinction between a path-less and a
root-path URI to distinguish request URIs (e.g. OPTIONS * vs
OPTIONS /).
@see <https://tools.ietf.org/html/rfc3986#section-6.2.3> RFC 3986.6.2.3
*)
val canonicalize : t -> t
(** Make a URI from supplied components. If userinfo or port are
supplied without host, an empty host is added. If path is supplied
and userinfo, host, or port is also supplied, path is made
absolute but not resolved. *)
val make : ?scheme:string -> ?userinfo:string -> ?host:string ->
?port:int -> ?path:string -> ?query:(string * string list) list ->
?fragment:string -> unit -> t
(** Functional update for a URI using the supplied components. If a component
is unspecified then it will be unchanged. If a component is supplied as
[None] then the component will be removed in the returned URI. If a
component is supplied as [Some x] then [x] will be added if it does not
exist in the source URI or replaced if it does exist. *)
val with_uri : ?scheme:string option -> ?userinfo:string option ->
?host:string option -> ?port:int option -> ?path:string option ->
?query:(string * string list) list option -> ?fragment:string option -> t -> t
(** {2 Query functions }
The query string API attempts to accommodate conventional query
string representations (i.e. [?key0=value0&key1=value1]) while
maximally exposing any meaning in those representations. For
example, it is not necessarily the case that [/] and [/?] are
equivalent to a web server. In the former case, we observe a zero
query string whereas in the latter case, we observe a query string
with a single key, [""] and a zero value. Compare this with [/?=]
which has a single key and a single empty value,
[""]. Additionally, some query functions return lists of values
for a key. These list values are extracted from a {b single} key
with a comma-separated value list. If a query string has multiple
identical keys, you must use {! query} to retrieve the entirety of
the structured query string.
*)
(** Get a query string from a URI *)
val query : t -> (string * string list) list
(** Get a verbatim query string from a URI. If the provenance of the
URI is a string and its query component has not been updated, this
is the literal query string as parsed. Otherwise, this is the
composition of {!query} and {!encoded_of_query} *)
val verbatim_query : ?pct_encoder:pct_encoder -> t -> string option
(** Make a percent-encoded query string from percent-decoded query tuple *)
val encoded_of_query :
?scheme:string ->
?pct_encoder:pct_encoder ->
(string * string list) list ->
string
(** Parse a percent-encoded query string into a percent-decoded query tuple *)
val query_of_encoded : string -> (string * string list) list
(** Replace the query URI with the supplied list.
Input URI is not modified
*)
val with_query : t -> (string * string list) list -> t
(** Replace the query URI with the supplied singleton query list.
Input URI is not modified
*)
val with_query' : t -> (string * string) list -> t
(** [get_query_param' q key] returns the list of values for the
[key] parameter in query [q]. Note that an empty list is not the
same as a [None] return value. For a query [foo], the mapping is:
- [/] returns None
- [/?foo] returns Some []
- [/?foo=] returns [Some [""]]
- [/?foo=bar] returns [Some ["bar"]]
- [/?foo=bar,chi] returns [Some ["bar","chi"]]
Query keys can be duplicated in the URI, in which case the first
one is returned. If you want to resolve duplicate keys, obtain
the full result set with {! query } instead.
*)
val get_query_param' : t -> string -> string list option
(** [get_query_param q key] returns the value found for a [key] in
query [q]. If there are multiple values for the key, then the
first one is returned. *)
val get_query_param: t -> string -> string option
(** Add a query parameter to the input query URI.
Input URI is not modified
*)
val add_query_param : t -> (string * string list) -> t
(** Add a query parameter to the input singleton query URI.
Input URI is not modified
*)
val add_query_param' : t -> (string * string) -> t
(** Add a query parameter list to the input query URI.
Input URI is not modified
*)
val add_query_params : t -> (string * string list) list -> t
(** Add a query singleton parameter list to the input query URI.
Input URI is not modified
*)
val add_query_params' : t -> (string * string) list -> t
(** Remove a query key from the input query URI.
Input URI is not modified, and no error is generated if the
key does not already exist in the URI.
*)
val remove_query_param : t -> string -> t
(** {2 Component getters and setters } *)
(** Get the encoded path component of a URI *)
val path : ?pct_encoder:pct_encoder -> t -> string
(** Get the encoded path and query components of a URI *)
val path_and_query : t -> string
(** Replace the path URI with the supplied encoded path.
If a host is present in the supplied URI, the path is made absolute but not
resolved. If the path is empty, the path component is removed.
Input URI is not modified *)
val with_path : t -> string -> t
(** Get the scheme component of a URI *)
val scheme : t -> string option
(** Replace the scheme portion of the URI with the supplied [scheme].
Input URI is not modified *)
val with_scheme : t -> string option -> t
(** Get the userinfo component of a URI *)
val userinfo : ?pct_encoder:pct_encoder -> t -> string option
(** Replace the userinfo portion of the URI with the supplied [string option].
If no host is present in the supplied URI, an empty host is added.
Input URI is not modified. *)
val with_userinfo : t -> string option -> t
(** Get the username component of a URI *)
val user : t -> string option
(** Get the password component of a URI *)
val password : t -> string option
(** Replace the password portion of the URI with the supplied [string option].
If no host is present in the supplied URI, an empty host is added.
Input URI is not modified.
*)
val with_password : t -> string option -> t
(** Get the host component of a URI *)
val host : t -> string option
(** Replace the host component of the URI.
Input URI is not modified. *)
val with_host: t -> string option -> t
(** Get the host component of a URI, with a default supplied if one is
not present *)
val host_with_default: ?default:string -> t -> string
(** Get the port component of a URI *)
val port : t -> int option
(** Replace the port component of the URI with the supplied port.
If no host is present in the supplied URI, an empty host is added.
Input URI is not modified. *)
val with_port : t -> int option -> t
(** Get the fragment component of a URI *)
val fragment : t -> string option
(** Replace the fragment component of a URI with the supplied fragment.
Input URI is not modified *)
val with_fragment : t -> string option -> t
(** {2 Formatters } *)
(** [pp ppf t] will output a human readable version of the Uri [t]
to the formatter [ppf] *)
val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer]
(** [pp_hum] is now an alias for the {!pp} function. *)
val pp_hum : Format.formatter -> t -> unit
module Parser : sig
val ipv6 : string Angstrom.t
val uri_reference : t Angstrom.t
end
(** Specializations for HTTP and HTTPS schemes as per RFC9110 *)
module Absolute_http : sig
type uri := t
type t
val of_uri : uri -> (t, [ `Msg of string ]) result
val to_uri : t -> uri
val of_string : string -> t
val to_string : ?pct_encoder:pct_encoder -> t -> string
val make : scheme:[ `Http | `Https ]-> host:string ->
?userinfo:string -> ?port:int -> ?path:string ->
?query:(string * string list) list -> ?fragment:string -> unit -> t
val host : t -> string
val scheme : t -> [`Http | `Https]
end

5
unikernel/duniverse/ocaml-uri/lib_re/dune Normal file
View file

@ -0,0 +1,5 @@
(library
(name uri_re)
(public_name uri-re)
(wrapped false)
(libraries re.posix stringext))

1000
unikernel/duniverse/ocaml-uri/lib_re/uri_legacy.ml Normal file
View file

File diff suppressed because it is too large Load diff

269
unikernel/duniverse/ocaml-uri/lib_re/uri_legacy.mli Normal file
View file

@ -0,0 +1,269 @@
(*
* Copyright (c) 2012-2013 Anil Madhavapeddy <anil@recoil.org>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
*)
(** Uniform Resource Identifier handling that is RFC3986-compliant. *)
(** A single URI that is a compact sequence of characters that identifies
an abstract or physical resource. *)
type t
type component = [
`Scheme
| `Authority
| `Userinfo (** subcomponent of authority in some schemes *)
| `Host (** subcomponent of authority in some schemes *)
| `Path
| `Query
| `Query_key
| `Query_value
| `Fragment
]
(** {2 Core functionality } *)
(** The empty (zero length) URI reference. Useful for constructing
URIs piece-by-piece. *)
val empty : t
(** Comparator ordering by host, scheme, port, userinfo, path, query,
and finally fragment. Designed to produce a reasonable sort order. *)
val compare : t -> t -> int
(** [equal a b] is [compare a b = 0]. *)
val equal : t -> t -> bool
(** Percent-encode a string. The [scheme] argument defaults to 'http' and
the [component] argument defaults to `Path *)
val pct_encode : ?scheme:string -> ?component:component -> string -> string
(** Percent-decode a percent-encoded string *)
val pct_decode : string -> string
(** Parse a URI string literal into a URI structure. A bare string will be
interpreted as a path; a string prefixed with `//` will be interpreted as a
host.
*)
val of_string : string -> t
(** Convert a URI structure into a percent-encoded URI string *)
val to_string : t -> string
(** Resolve a URI against a default scheme and base URI *)
val resolve : string -> t -> t -> t
(** Canonicalize a URI according to Sec 6.2.3 "Scheme-Based
Normalization". This transform is more aggressive than the
standard URI-generic normalization automatically done. In
particular, HTTP(S) URIs with empty path components will have
their path components set to "/". Some applications like web
servers may rely on the distinction between a path-less and a
root-path URI to distinguish request URIs (e.g. OPTIONS * vs
OPTIONS /).
@see <https://tools.ietf.org/html/rfc3986#section-6.2.3> RFC 3986.6.2.3
*)
val canonicalize : t -> t
(** Make a URI from supplied components. If userinfo or port are
supplied without host, an empty host is added. If path is supplied
and userinfo, host, or port is also supplied, path is made
absolute but not resolved. *)
val make : ?scheme:string -> ?userinfo:string -> ?host:string ->
?port:int -> ?path:string -> ?query:(string * string list) list ->
?fragment:string -> unit -> t
(** Functional update for a URI using the supplied components. If a component
is unspecified then it will be unchanged. If a component is supplied as
[None] then the component will be removed in the returned URI. If a
component is supplied as [Some x] then [x] will be added if it does not
exist in the source URI or replaced if it does exist. *)
val with_uri : ?scheme:string option -> ?userinfo:string option ->
?host:string option -> ?port:int option -> ?path:string option ->
?query:(string * string list) list option -> ?fragment:string option -> t -> t
(** {2 Query functions }
The query string API attempts to accommodate conventional query
string representations (i.e. [?key0=value0&key1=value1]) while
maximally exposing any meaning in those representations. For
example, it is not necessarily the case that [/] and [/?] are
equivalent to a web server. In the former case, we observe a zero
query string whereas in the latter case, we observe a query string
with a single key, [""] and a zero value. Compare this with [/?=]
which has a single key and a single empty value,
[""]. Additionally, some query functions return lists of values
for a key. These list values are extracted from a {b single} key
with a comma-separated value list. If a query string has multiple
identical keys, you must use {! query} to retrieve the entirety of
the structured query string.
*)
(** Get a query string from a URI *)
val query : t -> (string * string list) list
(** Get a verbatim query string from a URI. If the provenance of the
URI is a string and its query component has not been updated, this
is the literal query string as parsed. Otherwise, this is the
composition of {!query} and {!encoded_of_query} *)
val verbatim_query : t -> string option
(** Make a percent-encoded query string from percent-decoded query tuple *)
val encoded_of_query : ?scheme:string -> (string * string list) list -> string
(** Parse a percent-encoded query string into a percent-decoded query tuple *)
val query_of_encoded : string -> (string * string list) list
(** Replace the query URI with the supplied list.
Input URI is not modified
*)
val with_query : t -> (string * string list) list -> t
(** Replace the query URI with the supplied singleton query list.
Input URI is not modified
*)
val with_query' : t -> (string * string) list -> t
(** [get_query_param' q key] returns the list of values for the
[key] parameter in query [q]. Note that an empty list is not the
same as a [None] return value. For a query [foo], the mapping is:
- [/] returns None
- [/?foo] returns Some []
- [/?foo=] returns [Some [""]]
- [/?foo=bar] returns [Some ["bar"]]
- [/?foo=bar,chi] returns [Some ["bar","chi"]]
Query keys can be duplicated in the URI, in which case the first
one is returned. If you want to resolve duplicate keys, obtain
the full result set with {! query } instead.
*)
val get_query_param' : t -> string -> string list option
(** [get_query_param q key] returns the value found for a [key] in
query [q]. If there are multiple values for the key, then the
first one is returned. *)
val get_query_param: t -> string -> string option
(** Add a query parameter to the input query URI.
Input URI is not modified
*)
val add_query_param : t -> (string * string list) -> t
(** Add a query parameter to the input singleton query URI.
Input URI is not modified
*)
val add_query_param' : t -> (string * string) -> t
(** Add a query parameter list to the input query URI.
Input URI is not modified
*)
val add_query_params : t -> (string * string list) list -> t
(** Add a query singleton parameter list to the input query URI.
Input URI is not modified
*)
val add_query_params' : t -> (string * string) list -> t
(** Remove a query key from the input query URI.
Input URI is not modified, and no error is generated if the
key does not already exist in the URI.
*)
val remove_query_param : t -> string -> t
(** {2 Component getters and setters } *)
(** Get the encoded path component of a URI *)
val path : t -> string
(** Get the encoded path and query components of a URI *)
val path_and_query : t -> string
(** Replace the path URI with the supplied encoded path.
If a host is present in the supplied URI, the path is made absolute but not
resolved. If the path is empty, the path component is removed.
Input URI is not modified *)
val with_path : t -> string -> t
(** Get the scheme component of a URI *)
val scheme : t -> string option
(** Replace the scheme portion of the URI with the supplied [scheme].
Input URI is not modified *)
val with_scheme : t -> string option -> t
(** Get the userinfo component of a URI *)
val userinfo : t -> string option
(** Replace the userinfo portion of the URI with the supplied [string option].
If no host is present in the supplied URI, an empty host is added.
Input URI is not modified. *)
val with_userinfo : t -> string option -> t
(** Get the username component of a URI *)
val user : t -> string option
(** Get the password component of a URI *)
val password : t -> string option
(** Replace the password portion of the URI with the supplied [string option].
If no host is present in the supplied URI, an empty host is added.
Input URI is not modified.
*)
val with_password : t -> string option -> t
(** Get the host component of a URI *)
val host : t -> string option
(** Replace the host component of the URI.
Input URI is not modified. *)
val with_host: t -> string option -> t
(** Get the host component of a URI, with a default supplied if one is
not present *)
val host_with_default: ?default:string -> t -> string
(** Get the port component of a URI *)
val port : t -> int option
(** Replace the port component of the URI with the supplied port.
If no host is present in the supplied URI, an empty host is added.
Input URI is not modified. *)
val with_port : t -> int option -> t
(** Get the fragment component of a URI *)
val fragment : t -> string option
(** Replace the fragment component of a URI with the supplied fragment.
Input URI is not modified *)
val with_fragment : t -> string option -> t
(** {2 Formatters } *)
(** [pp ppf t] will output a human readable version of the Uri [t]
to the formatter [ppf] *)
val pp : Format.formatter -> t -> unit [@@ocaml.toplevel_printer]
(** [pp_hum] is now an alias for the {!pp} function. *)
val pp_hum : Format.formatter -> t -> unit
(** Regular expressions for URI parsing. *)
module Re : sig
val ipv4_address : Re.re
val ipv6_address : Re.re
val uri_reference : Re.re
val authority : Re.re
val host : Re.re
end

78
unikernel/duniverse/ocaml-uri/lib_re/uri_re.ml Normal file
View file

@ -0,0 +1,78 @@
(*
* Copyright (c) 2012-2014 Anil Madhavapeddy <anil@recoil.org>
* Copyright (c) 2012-2014 David Sheets <sheets@alum.mit.edu>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
*)
open Re
module Raw = struct
let (+) a b = seq [a;b]
let (/) a b = alt [a;b]
let sub_delims = Posix.re "[!$&'()*+,;=]"
let c_at = char '@'
let c_colon = char ':'
let c_dot = char '.'
let unreserved = Posix.re "[A-Za-z0-9-._~]"
let hexdig = Posix.re "[0-9A-Fa-f]"
let pct_encoded = (char '%') + hexdig + hexdig
let dec_octet = Posix.re "25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?"
let ipv4_address = (repn (dec_octet + c_dot) 3 (Some 3)) + dec_octet
(* following RFC2234, RFC3986, RFC6874 and
http://people.spodhuis.org/phil.pennock/software/emit_ipv6_regexp-0.304
*)
let zone_id = unreserved / pct_encoded
let ipv6_address =
let (=|) n a = repn a n (Some n) in
let (<|) n a = repn a 0 (Some n) in
let h16 = repn hexdig 1 (Some 4) in
let h16c = h16 + c_colon in
let cc = c_colon + c_colon in
let ls32 = (h16c + h16) / ipv4_address in
( char '['
+ (((6=|h16c) + ls32)
/ ( cc + (5=|h16c) + ls32)
/ ((1<| h16) + cc + (4=|h16c) + ls32)
/ ((1<|((1<|h16c) + h16)) + cc + (3=|h16c) + ls32)
/ ((1<|((2<|h16c) + h16)) + cc + (2=|h16c) + ls32)
/ ((1<|((3<|h16c) + h16)) + cc + h16c + ls32)
/ ((1<|((4<|h16c) + h16)) + cc + ls32)
/ ((1<|((5<|h16c) + h16)) + cc + h16)
/ ((1<|((6<|h16c) + h16)) + cc )
)
+ (opt (Posix.re "%25" + rep1 zone_id))
+ char ']'
)
let reg_name = rep ( unreserved / pct_encoded / sub_delims )
let host = ipv6_address / ipv4_address / reg_name (* | ipv4_literal TODO *)
let userinfo = rep (unreserved / pct_encoded / sub_delims / c_colon)
let port = Posix.re "[0-9]*"
let authority = (opt ((group userinfo) + c_at)) + (group host) + (opt (c_colon + (group port)))
let uri_reference = Posix.re "^(([^:/?#]+):)?(//([^/?#]*))?([^?#]*)(\\?([^#]*))?(#(.*))?"
end
let ipv4_address = Posix.compile Raw.ipv4_address
let ipv6_address = Posix.compile Raw.ipv6_address
let uri_reference = Posix.compile Raw.uri_reference
let authority = Posix.compile Raw.authority
let host = Posix.compile Raw.host

7
unikernel/duniverse/ocaml-uri/lib_re/uri_re.mli Normal file
View file

@ -0,0 +1,7 @@
(** Regular expressions for URI parsing. *)
val ipv4_address : Re.re
val ipv6_address : Re.re
val uri_reference : Re.re
val authority : Re.re
val host : Re.re

6
unikernel/duniverse/ocaml-uri/lib_sexp/dune Normal file
View file

@ -0,0 +1,6 @@
(library
(name uri_sexp)
(public_name uri-sexp)
(modules uri_sexp)
(preprocess (pps ppx_sexp_conv))
(libraries sexplib0 uri))

65
unikernel/duniverse/ocaml-uri/lib_sexp/uri_sexp.ml Normal file
View file

@ -0,0 +1,65 @@
open Uri
module Derived =
struct
open Sexplib0.Sexp_conv
type component = [
| `Scheme
| `Authority
| `Userinfo (* subcomponent of authority in some schemes *)
| `Host (* subcomponent of authority in some schemes *)
| `Path
| `Query
| `Query_key
| `Query_value
| `Fragment
| `Generic
| `Custom of (component * string * string)
] [@@deriving sexp]
type t = {
scheme: string option [@default None] [@sexp_drop_default.sexp];
userinfo: string option [@default None] [@sexp_drop_default.sexp];
host: string option [@default None] [@sexp_drop_default.sexp];
port: int option [@default None] [@sexp_drop_default.sexp];
path: string [@default ""] [@sexp_drop_default.sexp];
query: (string * string list) list [@sexp.list];
fragment: string option [@default None] [@sexp_drop_default.sexp]
} [@@deriving sexp]
end
open Derived
let component_of_sexp = component_of_sexp
let sexp_of_component = sexp_of_component
let t_of_sexp sexp =
let t = t_of_sexp sexp in
Uri.make
?scheme:t.scheme
?userinfo:t.userinfo
?host:t.host
?port:t.port
~path:t.path
~query:t.query
?fragment:t.fragment
()
let sexp_of_t t =
sexp_of_t {
scheme = scheme t;
userinfo = userinfo t;
host = host t;
port = port t;
path = path t;
query = query t;
fragment = fragment t
}
type component = Uri.component
let compare a b = Uri.compare a b
let equal a b = Uri.equal a b
type t = Uri.t

11
unikernel/duniverse/ocaml-uri/lib_sexp/uri_sexp.mli Normal file
View file

@ -0,0 +1,11 @@
open Sexplib0
val component_of_sexp : Sexp.t -> Uri.component
val sexp_of_component : Uri.component -> Sexp.t
val t_of_sexp : Sexp.t -> Uri.t
val sexp_of_t : Uri.t -> Sexp.t
type component = Uri.component
val compare : Uri.t -> Uri.t -> int
val equal : Uri.t -> Uri.t -> bool
type t = Uri.t

11
unikernel/duniverse/ocaml-uri/lib_test/dune Normal file
View file

@ -0,0 +1,11 @@
(test
(name test_runner)
(package uri)
(modules test_runner)
(libraries uri uri.services ounit2))
(test
(name test_runner_sexp)
(package uri-sexp)
(modules test_runner_sexp)
(libraries uri uri.services uri-sexp ounit2))

783
unikernel/duniverse/ocaml-uri/lib_test/test_runner.ml Normal file
View file

@ -0,0 +1,783 @@
(*
* Copyright (c) 2012-2014 Anil Madhavapeddy <anil@recoil.org>
* Copyright (c) 2012-2014 David Sheets <sheets@alum.mit.edu>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
*)
open OUnit
open Printf
(* Tuples of decoded and encoded strings. The first element is a number to
refer to the test, as the pcts_large version duplicates the second field
to a large size, so it cant be used as the name of the test *)
let pcts = [
(1, "hello world!", "hello%20world!");
(2, "[", "%5B");
(3, "[[[[[", "%5B%5B%5B%5B%5B");
(4, "1]", "1%5D");
(5, "%20", "%2520");
(6, "", "");
(7, "f", "f");
(8, "\001", "%01");
(9, "\n", "%0A");
]
(* Make an artificially large string version of the pct strings *)
let pcts_large =
List.map (fun (n,a,b) ->
let num = 100000 in
let a' = Buffer.create (String.length a * num) in
let b' = Buffer.create (String.length b * num) in
for _ = 1 to num do
Buffer.add_string a' a;
Buffer.add_string b' b;
done;
(n, Buffer.contents a', Buffer.contents b')
) pcts
(* Tuple of string URI and the decoded version *)
let uri_encodes = [
"https://user:pass@foo.com:123/wh/at/ever?foo=1&bar=5#5",
(Uri.make ~scheme:"https" ~userinfo:"user:pass" ~host:"foo.com"
~port:123 ~path:"/wh/at/ever" ~query:["foo",["1"];"bar",["5"]] ~fragment:"5" ());
"http://foo.com", (Uri.make ~scheme:"http" ~host:"foo.com" ());
"http://foo-bar.com", (Uri.make ~scheme:"http" ~host:"foo-bar.com" ());
"http://foo-bar.com:8080/h1", (Uri.make ~scheme:"http" ~host:"foo-bar.com" ~port:8080 ~path:"/h1" ());
"http://foo%21.com", (Uri.make ~scheme:"http" ~host:"foo!.com" ());
"/wh/at/ev/er", (Uri.make ~path:"/wh/at/ev/er" ());
"/wh/at!/ev%20/er", (Uri.make ~path:"/wh/at!/ev /er" ());
(* IPv6 literal *)
"http://[dead:beef::dead:0:beaf]",
(Uri.make ~scheme:"http" ~host:"[dead:beef::dead:0:beaf]" ());
"http://user:pass@[2001:41d1:fe67:500:227:c6ff:fe5a:efa0]:6789/wh/at/ever?foo=1&bar=5#5",
(Uri.make ~scheme:"http" ~userinfo:"user:pass" ~host:"[2001:41d1:fe67:500:227:c6ff:fe5a:efa0]"
~port:6789 ~path:"/wh/at/ever" ~query:["foo",["1"];"bar",["5"]] ~fragment:"5" ());
(* IPv6 literal with zone id *)
"http://user:pass@%5B2001%3A41d1%3Afe67%3A500%3A227%3Ac6ff%3Afe5a%3Aefa0%25wlan0%5D:6789/wh/at/ever?foo=1&bar=5#5",
(Uri.make ~scheme:"http" ~userinfo:"user:pass" ~host:"[2001:41d1:fe67:500:227:c6ff:fe5a:efa0%wlan0]"
~port:6789 ~path:"/wh/at/ever" ~query:["foo",["1"];"bar",["5"]] ~fragment:"5" ());
"foo+bar:", (Uri.make ~scheme:"foo+bar" ());
"foo+bar:///", (Uri.make ~scheme:"foo+bar" ~host:"" ~path:"/" ());
"foo2-bar.baz:///", (Uri.make ~scheme:"foo2-bar.baz" ~host:"" ~path:"/" ());
"//foobar.com/quux", (Uri.make ~host:"foobar.com" ~path:"quux" ());
"quux%2F%20", (Uri.make ~path:"quux%2f " ());
"urn:uuid:f81d4fae-7dec-11d0-a765-00a0c91e6bf6",
(Uri.make ~scheme:"urn" ~path:"uuid:f81d4fae-7dec-11d0-a765-00a0c91e6bf6" ());
]
let map_pcts_tests size _name test args =
List.map (fun (n, a,b) ->
let name = sprintf "pct_%s:%d:%s" size n a in
let a1, b1 = test a b in
let test () = assert_equal ~printer:(fun x -> x) a1 b1 in
name >:: test
) args
let test_pct_small =
(map_pcts_tests "small" "encode" (fun a b -> b, (Uri.pct_encode a)) pcts) @
(map_pcts_tests "small" "decode" (fun a b -> (Uri.pct_decode b), a) pcts)
let test_pct_large =
(map_pcts_tests "large" "encode" (fun a b -> (Uri.pct_encode a), b) pcts_large) @
(map_pcts_tests "large" "decode" (fun a b -> (Uri.pct_decode b), a) pcts_large)
(* Test that a URL encodes to the expected value *)
let test_uri_encode =
List.map (fun (uri_str, uri) ->
let name = sprintf "uri:%s" uri_str in
let test () = assert_equal ~printer:(fun x -> x) uri_str (Uri.to_string uri) in
name >:: test
) uri_encodes
let test_uri_custom_encode =
let str = "https://google.com?test=@" in
let uri = Uri.of_string str in
let pct_encoder = Uri.pct_encoder ~query_value:(`Custom (`Query_value, "", "@")) () in
assert_equal ~printer:(fun x -> x) "https://google.com?test=%40" (Uri.to_string ~pct_encoder uri)
(* Test that a URI decodes to the expected value *)
let test_uri_decode =
List.map (fun (uri_str, uri) ->
let name = sprintf "uribi:%s" uri_str in
let test () = assert_equal ~printer:(fun x -> x) uri_str (Uri.(to_string (of_string (Uri.to_string uri)))) in
name >:: test
) uri_encodes
(* Test URI query decoding *)
let uri_query = [
"https://user:pass@foo.com:123/wh/at/ever?foo=1&bar=5#5", ["foo",["1"]; "bar",["5"]];
"//domain?f+1=bar&+f2=bar%212", ["f 1",["bar"];" f2",["bar!2"]];
"//domain?foo=&bar=", ["foo",[""];"bar",[""]];
"//domain?a=b%26c%3Dd", ["a",["b&c=d"]];
"",[];
"?",["",[]];
"?&",["",[];"",[]];
"?&&",["",[];"",[];"",[]];
"??&/&",["?",[];"/",[];"",[]];
"?#?/#",["",[]];
"?%23",["#",[]];
"?=&==",["",[""];"",["="]];
"?==,&=,=",["",["=";""];"",["";"="]];
"?a=,,%26&,%2C=%2C,",["a",["";"";"&"];",,",[",";""]];
"?%3D=%3D",["=",["="]];
"?,",[",",[]];
]
let test_query_decode =
List.map (fun (uri_str,res) ->
let uri = Uri.of_string uri_str in
let test () = assert_equal ~printer:(fun l ->
String.concat " "
(List.map
(fun (k,v) -> sprintf "\"%s\" = \"%s\"" k (String.concat "," v)) l))
res (Uri.query uri) in
uri_str >:: test
) uri_query
(* Test URI query encoding. No pct encoding as that is done later by Uri.to_string *)
let uri_query_make = [
[], "";
["foo",["bar"]], "foo=bar";
["foo1",["bar1"];"foo2",["bar2"]], "foo1=bar1&foo2=bar2";
["foo1",["bar1"];"foo2",["bar2"];"foo3",["bar3"]],
"foo1=bar1&foo2=bar2&foo3=bar3";
["semicolon",[";"]],"semicolon=%3B";
[";",["semicolon"]],"%3B=semicolon";
["#",["#";"#"]], "%23=%23,%23";
["",[]], "";
["",[""]], "=";
["",["";""]], "=,";
["&",["&"]], "%26=%26";
["=",["="]], "%3D==";
[",",[",";""]], ",=%2C,";
]
let test_query_encode =
List.map (fun (qs,res) ->
let test () = assert_equal ~printer:(fun l -> l) res (Uri.encoded_of_query qs) in
res >:: test
) uri_query_make
(* Test relative URI resolution
from <http://tools.ietf.org/html/rfc3986#section-5.4> *)
let uri_rel_res = [
(* "normal" *)
"g:h", "g:h";
"g", "http://a/b/c/g";
"./g", "http://a/b/c/g";
"g/", "http://a/b/c/g/";
"/g", "http://a/g";
"//g", "http://g";
"?y", "http://a/b/c/d;p?y";
"g?y", "http://a/b/c/g?y";
"#s", "http://a/b/c/d;p?q#s";
"g#s", "http://a/b/c/g#s";
"g?y#s", "http://a/b/c/g?y#s";
";x", "http://a/b/c/;x";
"g;x", "http://a/b/c/g;x";
"g;x?y#s", "http://a/b/c/g;x?y#s";
"", "http://a/b/c/d;p?q";
".", "http://a/b/c/";
"./", "http://a/b/c/";
"..", "http://a/b/";
"../", "http://a/b/";
"../g", "http://a/b/g";
"../..", "http://a/";
"../../", "http://a/";
"../../g", "http://a/g";
(* "abnormal" *)
"../../../g", "http://a/g";
"../../../../g", "http://a/g";
"/./g", "http://a/g";
"/../g", "http://a/g";
"g.", "http://a/b/c/g.";
".g", "http://a/b/c/.g";
"g..", "http://a/b/c/g..";
"..g", "http://a/b/c/..g";
"./../g", "http://a/b/g";
"./g/.", "http://a/b/c/g/";
"g/./h", "http://a/b/c/g/h";
"g/../h", "http://a/b/c/h";
"g;x=1/./y", "http://a/b/c/g;x=1/y";
"g;x=1/../y", "http://a/b/c/y";
"g?y/./x", "http://a/b/c/g?y/./x";
"g?y/../x", "http://a/b/c/g?y/../x";
"g#s/./x", "http://a/b/c/g#s/./x";
"g#s/../x", "http://a/b/c/g#s/../x";
"http:g", "http:g";
(* extra *)
(* From <http://lists.w3.org/Archives/Public/uri/2014Jun/0000.html> *)
".%2E", "http://a/b/";
]
let test_rel_res =
let base = Uri.of_string "http://a/b/c/d;p?q" in
List.map (fun (rel,abs) ->
let test () = assert_equal ~printer:(fun l -> l)
abs (Uri.to_string (Uri.resolve "http" base (Uri.of_string rel))) in
rel >:: test
) uri_rel_res
let file_uri_rel_res = [ (* http://tools.ietf.org/html/rfc1738#section-3.10 *)
"/foo/bar/baz", "/foo/bar/baz";
"//localhost/foo", "///foo";
]
let test_file_rel_res =
List.map (fun (rel,abs) ->
let test () = assert_equal ~printer:(fun l -> l)
abs (Uri.to_string (Uri.resolve "file" Uri.empty (Uri.of_string rel))) in
rel >:: test
) file_uri_rel_res
let uri_rel_rel_res = [ (* relative-relative resolution *)
"a", "b", "a";
"a", "/", "/a";
"a", "b/", "b/a";
"a", "//b", "//b/a";
"a", "//b/","//b/a";
"a", "///", "///a";
"?a", "b", "b?a";
"?a", "/", "/?a";
"?a", "//b", "//b?a";
"?a", "///", "///?a";
"#a", "b", "b#a";
"#a", "/", "/#a";
"#a", "//b", "//b#a";
"#a", "///", "///#a";
"../a", "b", "../a";
"../a", "b/", "a";
"../a", "b/./", "a";
"../a", "../b", "../../a";
"../a", "../b/", "../a";
"../a", "../b/./", "../a";
"../a", "../b/c/", "../b/a";
"../a", "../../b", "../../../a";
"../a", "../b/../", "../../a";
"../a", "../b/./", "../a";
"../a/..", "../", "../../";
"../a/../", "../", "../../";
"..", "b/c/", "b/";
"", "b", "b";
"a", "", "a";
(* TODO: relative username, ... *)
]
let rel_empty_path_res = [
"/foo/bar/..", "/foo/";
"/foo/bar//..", "/foo/bar/";
"/foo/bar///..", "/foo/bar//";
"/foo/bar//../baz", "/foo/bar/baz"
]
let test_rel_empty_path_res =
List.map (fun (rel, res) ->
let test () = assert_equal ~printer:(fun l -> l)
res Uri.(to_string (resolve "" empty (of_string rel))) in
rel >:: test
) rel_empty_path_res
let test_rel_rel_res =
List.map (fun (rel,base,res) ->
let rel = Uri.of_string rel in
let base = Uri.of_string base in
let test () = assert_equal ~printer:(fun l -> l)
res (Uri.to_string (Uri.resolve "" base rel)) in
res >:: test
) uri_rel_rel_res
let userinfo_res = [
"http://user:pwd@bar.com/foo",
["bar", "http://user:pwd@bar.com/bar";
"/", "http://user:pwd@bar.com/";
"http://boo:bar@bar.com/foo", "http://boo:bar@bar.com/foo";
]
]
let test_userinfo_res =
userinfo_res |> List.map (fun (base,tests) ->
let base = Uri.of_string base in
List.map (fun (uri,res) ->
let uri = Uri.of_string uri in
let test () = assert_equal ~printer:(fun l -> l)
res (Uri.to_string (Uri.resolve "" base uri)) in
res >::test
) tests
) |> List.fold_left List.rev_append []
let generic_uri_norm = [
"HTTP://example.com/", "http://example.com/";
"http://example.com/%3a%3f", "http://example.com/:%3F";
"http://Example.Com/", "http://example.com/";
"http://example.com/%68%65%6c%6c%6f", "http://example.com/hello";
"http://example.com/../", "http://example.com/";
"http://example.com/./././", "http://example.com/";
"%", "%25";
"%3", "%253";
"%3g", "%253g";
"%3:", "%253:";
"%3@", "%253@";
"%3/", "%253/";
"%%25", "%25%25";
"%2%25", "%252%25";
"/foo%2fbar/", "/foo%2Fbar/";
"//colon%3Auser:colon%3Apassword@example.net/",
"//colon%3Auser:colon%3Apassword@example.net/";
"//colon%3Auser@example.net/",
"//colon%3Auser@example.net/";
"foo+bar%3a", "./foo+bar:";
"http://[2001:DB8:1234:5678:90ab:cdef::0123]/%68%65%6c%6c%6f", "http://[2001:db8:1234:5678:90ab:cdef::0123]/hello";
(let p_q = "/foo%20bar/" in
p_q, Uri.(path_and_query (of_string p_q)));
]
let test_generic_uri_norm =
List.map (fun (o,n) ->
let test () = assert_equal ~printer:(fun l -> l)
n (Uri.to_string (Uri.resolve "http" Uri.empty (Uri.of_string o))) in
o >:: test
) generic_uri_norm
let rel_id = [
"a/path/fragment";
"/an/absolute/path";
"?a&b&c";
"?a=&b=&c=";
"?a=b&b=c&c=a";
"foo+bar:///";
]
let test_rel_id =
List.map (fun id ->
let test () = assert_equal ~printer:(fun l -> l)
id (Uri.to_string (Uri.of_string id)) in
id >:: test
) rel_id
let default_scheme = "ftp"
let tcp_port_of_uri = [
"a/relative/path",
List.hd (Uri_services.tcp_port_of_service default_scheme);
"https://foo.bar/", 443;
"ssh://user@host.tld/", 22;
"http://foo.bar/", 80;
"http://foo.bar:8000/", 8000;
]
let test_tcp_port_of_uri =
let string_of_int_option = function None -> "None"
| Some i -> sprintf "Some %d" i
in List.map (fun (uri,pn) ->
let test () = assert_equal ~printer:string_of_int_option
(Some pn)
(Uri_services.tcp_port_of_uri ~default:default_scheme
(Uri.of_string uri))
in uri >:: test
) tcp_port_of_uri
let query_key_add_remove =
let test () =
let uri = Uri.of_string "http://foo.com/?k1=1&k2=2" in
let printer x = Uri.(to_string (with_query uri x)) in
assert_equal ~printer (Uri.query uri) [("k1",["1"]);("k2",["2"])];
let uri = Uri.add_query_param uri ("k3",["3"]) in
assert_equal ~printer (Uri.query uri) [("k3",["3"]);("k1",["1"]);("k2",["2"])];
assert_equal (Uri.get_query_param' uri "k3") (Some ["3"]);
assert_equal (Uri.get_query_param uri "k3") (Some "3");
let uri = Uri.remove_query_param uri "k1" in
assert_equal ~printer (Uri.query uri) [("k3",["3"]);("k2",["2"])];
let uri = Uri.remove_query_param uri "k2" in
let uri = Uri.remove_query_param uri "k3" in
assert_equal ~printer (Uri.query uri) []
in ["query_key_add_remove" >:: test]
let test_with_change = [
"test_with_scheme" >:: (fun () ->
let printer = Uri.to_string in
let uri = Uri.of_string "https://foo.bar/a/b/c" in
let uri2 = Uri.with_scheme uri (Some "https") in
let uri3 = Uri.with_scheme uri (Some "f o o") in
assert_equal ~printer uri uri2;
let exp = "f%20o%20o://foo.bar/a/b/c" in
let msg = sprintf "%s <> %s" (Uri.to_string uri3) exp in
assert_equal ~msg (Uri.to_string uri3) exp;
let uri = Uri.with_scheme Uri.empty (Some "http") in
let uri_s = Uri.to_string uri in
let uri_exp = "http:" in
let msg = sprintf "with_scheme empty (%s <> %s).string" uri_s uri_exp in
assert_equal ~msg uri_s uri_exp;
let urn = Uri.of_string "urn:uuid:f81d4fae-7dec-11d0-a765-00a0c91e6bf6" in
let urn2= Uri.with_scheme urn (Some "urn") in
assert_equal ~printer urn urn2;
let urn_path =
Uri.with_path Uri.empty "uuid:f81d4fae-7dec-11d0-a765-00a0c91e6bf6"
in
let urn2 = Uri.with_scheme urn_path (Some "urn") in
assert_equal ~printer urn urn2
);
"test_with_userinfo" >:: (fun () ->
let uri = Uri.of_string "https://foo.bar/a/b/c" in
let uri2 = Uri.with_userinfo uri (Some "avsm:pa:sswo%20rd") in
let uri3 = Uri.with_userinfo uri (Some "avsm:pa%3Asswo rd") in
let exp = "https://avsm:pa%3Asswo%20rd@foo.bar/a/b/c" in
let msg t = sprintf "%s %s <> %s" t (Uri.to_string uri2) exp in
assert_equal ~msg:(msg "string") (Uri.to_string uri2) exp;
assert_equal ~msg:(msg "rep") uri2 (Uri.of_string exp);
let msg t = sprintf "%s %s <> %s" t (Uri.to_string uri3) exp in
assert_equal ~msg:(msg "string") (Uri.to_string uri3) exp;
assert_equal ~msg:(msg "rep") uri3 (Uri.of_string exp);
let uri_some = Uri.with_userinfo Uri.empty (Some "avsm") in
let exp = "//avsm@" in
let msg t = sprintf "%s %s <> %s" t (Uri.to_string uri_some) exp in
assert_equal ~msg:(msg "string") (Uri.to_string uri_some) exp;
assert_equal ~msg:(msg "rep") uri_some (Uri.of_string exp)
);
"test_with_password" >:: (fun () ->
let uri = Uri.of_string "/" in
let uri_wp = Uri.with_password uri None in
assert_equal "/" (Uri.to_string uri_wp);
let uri_wp = Uri.with_password uri (Some "") in
assert_equal "//:@/" (Uri.to_string uri_wp);
let uri_wp = Uri.with_password uri (Some ":") in
assert_equal "//:%3A@/" (Uri.to_string uri_wp);
let uri = Uri.of_string "//user:pass@foo" in
let uri_wp = Uri.with_password uri None in
assert_equal "//user@foo" (Uri.to_string uri_wp);
let uri_wp = Uri.with_password uri (Some "") in
assert_equal "//user:@foo" (Uri.to_string uri_wp);
let uri_wp = Uri.with_password uri (Some ":") in
assert_equal "//user:%3A@foo" (Uri.to_string uri_wp)
);
"test_with_host" >:: (fun () ->
let uri = Uri.of_string "//www.meow.com" in
let uri_none = Uri.with_host uri None in
let uri_exp = "" in
let msg = sprintf "host removal with None (%s <> %s)"
uri_exp (Uri.to_string uri_none) in
assert_equal ~msg (Uri.of_string uri_exp) uri_none;
let uri_exp = "//" in
let uri_some_empty = Uri.with_host uri (Some "") in
let msg = sprintf "host removal with empty (%s <> %s)"
uri_exp (Uri.to_string uri_some_empty) in
assert_equal ~msg (Uri.of_string uri_exp) uri_some_empty;
let uri_some = Uri.with_host uri (Some "www.woof.com") in
let uri_woof = Uri.of_string "//www.woof.com" in
assert_equal ~msg:"host change" uri_woof uri_some;
let uri_some = Uri.with_host Uri.empty (Some "www.woof.com") in
assert_equal ~msg:"create host" uri_woof uri_some
);
"test_with_port" >:: (fun () ->
let uri_port = Uri.with_port Uri.empty (Some 80) in
let uri_exp = "//:80" in
let msg = sprintf "add port to empty (%s <> %s)"
uri_exp (Uri.to_string uri_port) in
assert_equal ~msg (Uri.of_string uri_exp) uri_port;
let uri = Uri.of_string "//foo.com" in
let uri_port = Uri.with_port uri (Some 80) in
assert_equal (Uri.of_string "//foo.com:80") uri_port;
let foo = Uri.of_string "http://foo.com" in
let foo_port = Uri.with_port foo (Some 80) in
assert_equal (Uri.of_string "http://foo.com:80") foo_port;
let uri_no_port = Uri.with_port foo_port None in
assert_equal foo uri_no_port;
assert_equal (Uri.of_string "/") (Uri.with_port (Uri.of_string "/") None)
);
"test_with_path" >:: (fun () ->
let uri_empty = Uri.with_path Uri.empty "" in
assert_equal ~msg:"empty host empty path" Uri.empty uri_empty;
let uri_pct = Uri.with_path Uri.empty "a%2F" in
let msg = sprintf "empty host percent / path (%s <> %s)"
(Uri.to_string uri_pct) "a%2F" in
assert_equal ~msg (Uri.to_string uri_pct) "a%2F";
let uri_some = Uri.with_path Uri.empty "a" in
assert_equal ~msg:"empty host some path" (Uri.of_string "a") uri_some;
let uri = Uri.of_string "//" in
let uri_empty = Uri.with_path uri "" in
let msg = sprintf "some host empty path (%s <> %s)"
(Uri.to_string uri) (Uri.to_string uri_empty) in
assert_equal ~msg uri uri_empty;
let uri_some = Uri.with_path uri "a" in
let uri_exp_s = "///a" in
let uri_exp = Uri.of_string uri_exp_s in
let uri_exp_str = Uri.to_string uri_exp in
let uri_some_str = Uri.to_string uri_some in
let msg = sprintf "path relative host (%S <> %S)"
uri_exp_str uri_some_str in
assert_equal ~msg uri_exp uri_some
);
"test_with_query" >:: (fun () ->
let cmp = Uri.equal in
let test_with_query prefix =
let uri = Uri.of_string prefix in
let uri_empty = Uri.with_query uri [] in
let msg = prefix ^ " empty" in
assert_equal ~cmp ~msg (Uri.of_string prefix) uri_empty;
let uri_quest = Uri.with_query uri ["",[]] in
let uri_exp_s = prefix ^ "?" in
let uri_exp = Uri.of_string uri_exp_s in
let uri_exp_str = Uri.to_string uri_exp in
let uri_quest_str = Uri.to_string uri_quest in
let msg = sprintf "'%s' quest (%S <> %S)"
prefix uri_exp_str uri_quest_str in
assert_equal ~cmp ~msg uri_exp uri_quest;
let uri_equal = Uri.with_query uri ["",[""]] in
let msg = prefix ^ " equal" in
assert_equal ~cmp ~msg (Uri.of_string (prefix^"?=")) uri_equal;
let uri_comma = Uri.with_query uri ["",["";""]] in
let msg = prefix ^ " comma" in
assert_equal ~cmp ~msg (Uri.of_string (prefix^"?=,")) uri_comma;
let uri_empty = Uri.with_query' uri [] in
let msg = prefix ^ " empty'" in
assert_equal ~cmp ~msg (Uri.of_string prefix) uri_empty;
let uri_equal = Uri.with_query' uri ["",""] in
let msg = prefix ^" equal'" in
assert_equal ~cmp ~msg (Uri.of_string (prefix^"?=")) uri_equal;
in
test_with_query "";
test_with_query "//";
test_with_query "///";
let uri = Uri.of_string "//#" in
let uri_quest = Uri.with_query uri ["",[]] in
let msg = "?#" in
assert_equal ~cmp ~msg (Uri.of_string "//?#") uri_quest;
let uri_equal = Uri.with_query' uri ["",""] in
let uri_exp_s = "//?=#" in
let msg = sprintf "%s <> %s" uri_exp_s (Uri.to_string uri_equal) in
assert_equal ~cmp ~msg (Uri.of_string "//?=#") uri_equal;
let printer x = x in
let uri_exp_s = "?name=3+4%20+%3a|" in
let uri = Uri.of_string uri_exp_s in
(match Uri.verbatim_query uri with
| None -> assert_failure "no query string! (1)"
| Some qs -> assert_equal uri_exp_s ("?"^qs)
);
assert_equal ~printer "?name=3%204%20%20:%7C" (Uri.to_string uri);
let uri_plus = Uri.add_query_param' uri ("time","now") in
let uri_exp_s = "?time=now&name=3%204%20%20:%7C" in
(match Uri.verbatim_query uri_plus with
| None -> assert_failure "no query string! (2)"
| Some qs -> assert_equal ~printer uri_exp_s ("?"^qs)
);
);
"test_with_fragment" >:: (fun () ->
let test_with_fragment prefix =
let uri = Uri.of_string prefix in
let uri_empty = Uri.with_fragment uri None in
assert_equal uri uri_empty;
let uri_some = Uri.with_fragment uri (Some "") in
assert_equal (Uri.of_string (prefix^"#")) uri_some
in
test_with_fragment "";
test_with_fragment "//";
let uri = Uri.of_string "//#" in
let uri_empty = Uri.with_fragment uri None in
assert_equal (Uri.of_string "//") uri_empty
);
]
let canonical_map = [
"http://foo.bar/a/b/c", "http://foo.bar/a/b/c";
"http://foo.bar:/a/b/c", "http://foo.bar/a/b/c";
"http://foo.bar:80/a/b/c", "http://foo.bar/a/b/c";
"http://foo.bar:443/a/b/c", "http://foo.bar:443/a/b/c";
"https://foo.bar/a/b/c", "https://foo.bar/a/b/c";
"https://foo.bar:/a/b/c", "https://foo.bar/a/b/c";
"https://foo.bar:80/a/b/c", "https://foo.bar:80/a/b/c";
"https://foo.bar:443/a/b/c", "https://foo.bar/a/b/c";
"//example.net:80/a", "//example.net:80/a";
"http://example.org", "http://example.org/";
"https://example.org", "https://example.org/";
"ftp://example.org", "ftp://example.org";
"ssh://example.org", "ssh://example.org";
"git://example.org", "git://example.org";
"", "";
"..", "../";
"/..", "/";
"/foo/./bar", "/foo/bar";
"/foo/../../", "/";
"http://@bar:?#", "http://@bar/?#";
(*"mailto:Joe@Example.COM", "mailto:Joe@example.com";*)
]
let canonical uri_s = Uri.(to_string (canonicalize (of_string uri_s)))
let test_canonicalize =
List.map (fun (input, output) ->
input >:: (fun () ->
assert_equal ~printer:(fun l -> l) output (canonical input)
)
) canonical_map
let with_uri =
let base = Uri.of_string "scheme://user:pass@host:0/path?query=arg#fragment" in
[Uri.with_uri base, Uri.to_string base;
Uri.with_uri ~scheme:None base, "//user:pass@host:0/path?query=arg#fragment";
Uri.with_uri ~scheme:(Some "new") base, "new://user:pass@host:0/path?query=arg#fragment";
Uri.with_uri ~userinfo:None base, "scheme://host:0/path?query=arg#fragment";
Uri.with_uri ~userinfo:(Some "new") base, "scheme://new@host:0/path?query=arg#fragment";
Uri.with_uri ~host:None base, "scheme://user:pass@:0/path?query=arg#fragment";
Uri.with_uri ~host:(Some "new") base, "scheme://user:pass@new:0/path?query=arg#fragment";
Uri.with_uri ~port:None base, "scheme://user:pass@host/path?query=arg#fragment";
Uri.with_uri ~port:(Some 1) base, "scheme://user:pass@host:1/path?query=arg#fragment";
Uri.with_uri ~path:None base, "scheme://user:pass@host:0?query=arg#fragment";
Uri.with_uri ~path:(Some "new") base, "scheme://user:pass@host:0/new?query=arg#fragment";
Uri.with_uri ~query:None base, "scheme://user:pass@host:0/path#fragment";
Uri.with_uri ~query:(Some ["new", ["a"]]) base, "scheme://user:pass@host:0/path?new=a#fragment";
Uri.with_uri ~fragment:None base, "scheme://user:pass@host:0/path?query=arg";
Uri.with_uri ~fragment:(Some "new") base, "scheme://user:pass@host:0/path?query=arg#new";
Uri.with_uri ~host:(Some "2001:DB8:1234:5678:90ab:cdef::0123") base,
"scheme://user:pass@[2001:DB8:1234:5678:90ab:cdef::0123]:0/path?query=arg#fragment"
]
let test_with_uri =
List.map (fun (input, output) ->
input >:: (fun () ->
assert_equal ~printer:(fun l -> l) output input
)
) (List.map (fun (i, o) -> Uri.to_string i, o) with_uri)
let ipv6_addresses =
["::", "::"
; "::1", "::1"
;"fe02::1","fe02::1"
;"::ffff:192.0.2.1", "::ffff:192.0.2.1"
;"2001:DB8::42","2001:DB8::42"
;"2001:DB8:1234:5678:90ab:cdef:0123:4567","2001:DB8:1234:5678:90ab:cdef:0123:4567"
;"2001:DB8:1234:5678:90ab:cdef:0123::","2001:DB8:1234:5678:90ab:cdef:0123::"
;"2001:DB8:1234:5678:90ab:cdef::0123","2001:DB8:1234:5678:90ab:cdef::0123"
;"2001:DB8:1234:5678:90ab:cdef:192.0.2.1","2001:DB8:1234:5678:90ab:cdef:192.0.2.1"
;"2001:DB8:1234:5678:90ab:cdef:192.0.2.1","2001:DB8:1234:5678:90ab:cdef:192.0.2.1"
]
let test_ipv6_parsing =
List.map (fun (input, expected) ->
let name = sprintf "ipv6:%s" input in
let test () =
match Angstrom.parse_string ~consume:All Uri.Parser.ipv6 input with
| Ok parsed ->
assert_equal ~printer:(fun x -> x) expected parsed
| Error msg -> assert_failure msg
in
name >:: test
) ipv6_addresses
let compat_uris =
[ "http://\nhost"
; "http://host\n/path"
; "http://host/path\n?query=1"
; "http://host/path?query=1&other\n=2"
; "http://user\n:password@host/path"
; "http://user:password@\nhost/path"
]
let http_uris =
[ "http://foo.bar/a/b/c"
; "http://foo.bar:443/a/b/c"
; "https://foo.bar/a/b/c"
; "https://foo.bar:80/a/b/c"
; "http://example.org/path?query=foo"
]
let non_http_uris =
[ "//example.net:80/a"
; "ftp://example.org"
; "ssh://example.org"
; "git://example.org"
; ""
; ".."
; "/.."
; "/foo/./bar"
; "/foo/../../"
]
let eval_rfc9110_uris tests ~f =
List.map (fun input ->
let name = sprintf "http_uri:%s" input in
let test () =
Uri.of_string input |> Uri.Absolute_http.of_uri |> f ~input in
name >:: test
) tests
let test_parseable_rfc9110_uris =
let eval ~input = function
| Ok http_uri ->
assert_equal (Uri.Absolute_http.to_string http_uri) input
| Error (`Msg msg) -> assert_failure msg
in
eval_rfc9110_uris http_uris ~f:eval
let test_unparseable_rfc9110_uris =
let eval ~input = function
| Ok _ -> assert_failure (sprintf "unexpected conversion of non-rfc9110 uri: %s" input)
| Error _ -> ()
in
eval_rfc9110_uris non_http_uris ~f:eval
(* Returns true if the result list contains successes only.
Copied from oUnit source as it isnt exposed by the mli *)
let rec was_successful =
function
| [] -> true
| RSuccess _::t
| RSkip _::t ->
was_successful t
| RFailure _::_
| RError _::_
| RTodo _::_ ->
false
let _ =
let suite = "URI" >::: (
test_pct_small
@ test_pct_large
@ test_uri_encode
@ test_uri_decode
@ test_query_decode
@ test_query_encode
@ test_rel_res
@ test_file_rel_res
@ test_rel_rel_res
@ test_userinfo_res
@ test_rel_empty_path_res
@ test_generic_uri_norm
@ test_rel_id
@ test_tcp_port_of_uri
@ query_key_add_remove
@ test_with_change
@ test_canonicalize
@ test_with_uri
@ test_ipv6_parsing
@ test_parseable_rfc9110_uris
@ test_unparseable_rfc9110_uris
) in
let verbose = ref false in
let set_verbose _ = verbose := true in
Arg.parse
[("-verbose", Arg.Unit set_verbose, "Run the test in verbose mode.");]
(fun x -> raise (Arg.Bad ("Bad argument : " ^ x)))
("Usage: " ^ Sys.argv.(0) ^ " [-verbose]");
if not (was_successful (run_test_tt ~verbose:!verbose suite)) then
exit 1

63
unikernel/duniverse/ocaml-uri/lib_test/test_runner_sexp.ml Normal file
View file

@ -0,0 +1,63 @@
(*
* Copyright (c) 2012-2014 Anil Madhavapeddy <anil@recoil.org>
* Copyright (c) 2012-2014 David Sheets <sheets@alum.mit.edu>
*
* Permission to use, copy, modify, and distribute this software for any
* purpose with or without fee is hereby granted, provided that the above
* copyright notice and this permission notice appear in all copies.
*
* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
*
*)
open OUnit
open Printf
let test_sexping =
let tests = [
"1", "https://example.com/foo?bar=1#frag",
"((scheme(https))(host(example.com))(path /foo)(query((bar(1))))(fragment(frag)))";
"2", "", "()";
"3", "/?foo=bar", "((path /)(query((foo(bar)))))";
] in
let test uri exp =
let uri = Uri.of_string uri in
let s = Sexplib0.Sexp.to_string (Uri_sexp.sexp_of_t uri) in
let msg = sprintf "%s <> %s" s exp in
assert_equal ~msg s exp
in
List.map (fun (id,uri,exp) ->
("test_sexping_"^id) >:: (fun () -> test uri exp)
) tests
(* Returns true if the result list contains successes only.
Copied from oUnit source as it isnt exposed by the mli *)
let rec was_successful =
function
| [] -> true
| RSuccess _::t
| RSkip _::t ->
was_successful t
| RFailure _::_
| RError _::_
| RTodo _::_ ->
false
let _ =
let suite = "URI-SEXP" >::: (
test_sexping
) in
let verbose = ref false in
let set_verbose _ = verbose := true in
Arg.parse
[("-verbose", Arg.Unit set_verbose, "Run the test in verbose mode.");]
(fun x -> raise (Arg.Bad ("Bad argument : " ^ x)))
("Usage: " ^ Sys.argv.(0) ^ " [-verbose]");
if not (was_successful (run_test_tt ~verbose:!verbose suite)) then
exit 1

26
unikernel/duniverse/ocaml-uri/uri-bench.opam Normal file
View file

@ -0,0 +1,26 @@
version: "4.4.0"
opam-version: "2.0"
maintainer: "anil@recoil.org"
authors: ["Anil Madhavapeddy" "David Sheets" "Rudi Grinberg"]
license: "ISC"
tags: ["url" "uri" "org:mirage" "org:xapi-project"]
homepage: "https://github.com/mirage/ocaml-uri"
bug-reports: "https://github.com/mirage/ocaml-uri/issues"
dev-repo: "git+https://github.com/mirage/ocaml-uri.git"
doc: "https://mirage.github.io/ocaml-uri/"
synopsis: "Benchmarking package for ocaml-uri"
description: """
This is a benchmarking package for the OCaml implementation of the [RFC3986](http://tools.ietf.org/html/rfc3986) specification for parsing URI or URLs.
"""
depends: [
"ocaml" {>= "4.04.0"}
"dune" {>= "1.2.0"}
"uri" {= version}
"core_bench" {with-test & >= "v0.14.0"}
"core_unix" {with-test & >= "v0.14.0"}
]
build: [
["dune" "subst"] {pinned}
["dune" "build" "-p" name "-j" jobs]
["dune" "runtest" "-p" name "-j" jobs] {with-test}
]

29
unikernel/duniverse/ocaml-uri/uri-re.opam Normal file
View file

@ -0,0 +1,29 @@
version: "4.4.0"
opam-version: "2.0"
maintainer: "anil@recoil.org"
authors: ["Anil Madhavapeddy" "David Sheets" "Rudi Grinberg"]
license: "ISC"
tags: ["url" "uri" "org:mirage" "org:xapi-project"]
homepage: "https://github.com/mirage/ocaml-uri"
bug-reports: "https://github.com/mirage/ocaml-uri/issues"
dev-repo: "git+https://github.com/mirage/ocaml-uri.git"
doc: "https://mirage.github.io/ocaml-uri/"
synopsis: "An RFC3986 URI/URL parsing library"
description: """
This is an OCaml implementation of the [RFC3986](http://tools.ietf.org/html/rfc3986) specification
for parsing URI or URLs.
"""
depends: [
"ocaml" {>= "4.04.0"}
"dune" {>= "1.2.0"}
"ounit2" {with-test & >= "1.0.2"}
"ppx_sexp_conv" {with-test & >= "v0.9.0"}
"re" {>= "1.9.0"}
"stringext" {>= "1.4.0"}
]
build: [
["dune" "subst"] {pinned}
["dune" "build" "-p" name "-j" jobs]
["dune" "runtest" "-p" name "-j" jobs] {with-test}
]
messages: [ "Deprecated. This package is outdated, you should consider using uri instead" ]

26
unikernel/duniverse/ocaml-uri/uri-sexp.opam Normal file
View file

@ -0,0 +1,26 @@
version: "4.4.0"
opam-version: "2.0"
maintainer: "anil@recoil.org"
authors: ["Anil Madhavapeddy" "David Sheets" "Rudi Grinberg"]
license: "ISC"
tags: ["url" "uri" "org:mirage" "org:xapi-project"]
homepage: "https://github.com/mirage/ocaml-uri"
bug-reports: "https://github.com/mirage/ocaml-uri/issues"
dev-repo: "git+https://github.com/mirage/ocaml-uri.git"
doc: "https://mirage.github.io/ocaml-uri/"
synopsis: "An RFC3986 URI/URL parsing library"
description: """
ocaml-uri with sexp support
"""
depends: [
"uri" {= version}
"dune" {>= "1.2.0"}
"ppx_sexp_conv" {>= "v0.13.0"}
"sexplib0"
"ounit2" {with-test}
]
build: [
["dune" "subst"] {pinned}
["dune" "build" "-p" name "-j" jobs]
["dune" "runtest" "-p" name "-j" jobs] {with-test}
]

29
unikernel/duniverse/ocaml-uri/uri.opam Normal file
View file

@ -0,0 +1,29 @@
version: "4.4.0"
opam-version: "2.0"
maintainer: "anil@recoil.org"
authors: ["Anil Madhavapeddy" "David Sheets" "Rudi Grinberg"]
license: "ISC"
tags: ["url" "uri" "org:mirage" "org:xapi-project"]
homepage: "https://github.com/mirage/ocaml-uri"
bug-reports: "https://github.com/mirage/ocaml-uri/issues"
dev-repo: "git+https://github.com/mirage/ocaml-uri.git"
doc: "https://mirage.github.io/ocaml-uri/"
synopsis: "An RFC3986 URI/URL parsing library"
description: """
This is an OCaml implementation of the [RFC3986](http://tools.ietf.org/html/rfc3986) specification
for parsing URI or URLs.
"""
depends: [
"ocaml" {>= "4.04.0"}
"dune" {>= "1.2.0"}
"ounit2" {with-test & >= "1.0.2"}
"ppx_sexp_conv" {with-test & >= "v0.9.0"}
"crowbar" {with-test & >= "0.2"}
"stringext" {>= "1.4.0"}
"angstrom" {>= "0.14.0"}
]
build: [
["dune" "subst"] {pinned}
["dune" "build" "-p" name "-j" jobs]
["dune" "runtest" "-p" name "-j" jobs] {with-test}
]