linse 4 years ago
parent
commit
0cce79cb11
  1. 6
      Makefile
  2. 1
      carddav.opam
  3. 2
      dune-project
  4. 5
      mirage/config.ml
  5. 27
      mirage/unikernel.ml
  6. 1
      src/webdav_api.ml
  7. 10
      src/webdav_server.ml
  8. 2
      test/dune

6
Makefile

@ -1,6 +1,8 @@
all:
opam reinstall caldav
git commit --amend -a
opam reinstall carddav
cd mirage; make
mirage/carddav --data "/tmp/card" --host localhost --http 7070 --admin epsilon -l debug
test: clean
dune runtest --no-buffer -j 1 test --profile=release
@ -12,7 +14,7 @@ depend:
opam install -t --deps-only .
pin:
opam pin add caldav .
opam pin add carddav .
clean:
dune clean

1
carddav.opam

@ -44,6 +44,7 @@ depends: [
"xmlm"
"tyxml"
"icalendar"
"vcard"
"rresult"
]

2
dune-project

@ -1,2 +1,2 @@
(lang dune 1.3)
(name caldav)
(name carddav)

5
mirage/config.ml

@ -60,7 +60,8 @@ let main =
let direct_dependencies = [
package "uri" ;
package "mirage-kv-unix" ;
package ~pin:"git+https://github.com/roburio/caldav.git" "caldav" ;
package ~pin:"git+https://github.com/roburio/carddav.git" "carddav" ;
(*package ~pin:"git+https://github.com/roburio/caldav.git" "caldav" ;*)
package ~pin:"git+https://github.com/hannesm/ocaml-crunch.git#kv-ng" "crunch" ;
package ~pin:"git+https://github.com/mirage/mirage-kv-mem.git" "mirage-kv-mem" ;
package ~pin:"git+https://github.com/samoht/ocaml-tls.git#ro-ng" "tls" ;
@ -88,4 +89,4 @@ let main =
"Unikernel.Main" (random @-> pclock @-> mclock @-> kv_ro @-> http @-> resolver @-> conduit @-> job)
let () =
register "caldav" [main $ default_random $ default_posix_clock $ default_monotonic_clock $ certs $ http_srv $ resolver_dns net $ conduit_direct ~tls:true net ]
register "carddav" [main $ default_random $ default_posix_clock $ default_monotonic_clock $ certs $ http_srv $ resolver_dns net $ conduit_direct ~tls:true net ]

27
mirage/unikernel.ml

@ -12,18 +12,18 @@ module Access_log = (val Logs.src_log access_src : Logs.LOG)
module Main (R : Mirage_random.C) (Clock: Mirage_clock.PCLOCK) (Mclock: Mirage_clock.MCLOCK) (KEYS: Mirage_types_lwt.KV_RO) (S: HTTP) (Resolver : Resolver_lwt.S) (Conduit : Conduit_mirage.S) = struct
module X509 = Tls_mirage.X509(KEYS)(Clock)
module Store = Irmin_mirage.Git.KV_RW(Irmin_git.Mem)(Clock)
module Dav_fs = Caldav.Webdav_fs.Make(Store)
module Dav = Caldav.Webdav_api.Make(R)(Clock)(Dav_fs)
module Webdav_server1 = Caldav.Webdav_server.Make(R)(Clock)(Dav_fs)(S)
module Dav_fs = Carddav.Webdav_fs.Make(Store)
module Dav = Carddav.Webdav_api.Make(R)(Clock)(Dav_fs)
module Webdav_server1 = Carddav.Webdav_server.Make(R)(Clock)(Dav_fs)(S)
module Dav_fs2 = Caldav.Webdav_fs.Make(Mirage_kv_unix)
module Dav2 = Caldav.Webdav_api.Make(R)(Clock)(Dav_fs2)
module Webdav_server2 = Caldav.Webdav_server.Make(R)(Clock)(Dav_fs2)(S)
module Dav_fs2 = Carddav.Webdav_fs.Make(Mirage_kv_unix)
module Dav2 = Carddav.Webdav_api.Make(R)(Clock)(Dav_fs2)
module Webdav_server2 = Carddav.Webdav_server.Make(R)(Clock)(Dav_fs2)(S)
module KV_mem = Mirage_kv_mem.Make(Clock)
module Dav_fs3 = Caldav.Webdav_fs.Make(KV_mem)
module Dav3 = Caldav.Webdav_api.Make(R)(Clock)(Dav_fs3)
module Webdav_server3 = Caldav.Webdav_server.Make(R)(Clock)(Dav_fs3)(S)
module Dav_fs3 = Carddav.Webdav_fs.Make(KV_mem)
module Dav3 = Carddav.Webdav_api.Make(R)(Clock)(Dav_fs3)
module Webdav_server3 = Carddav.Webdav_server.Make(R)(Clock)(Dav_fs3)(S)
(*
module Metrics_reporter = Metrics_mirage.Influx(Mclock)(STACK)
*)
@ -108,7 +108,7 @@ module Main (R : Mirage_random.C) (Clock: Mirage_clock.PCLOCK) (Mclock: Mirage_c
in
let config host =
let do_trust_on_first_use = Key_gen.tofu () in
Caldav.Webdav_config.config ~do_trust_on_first_use host
Carddav.Webdav_config.config ~do_trust_on_first_use host
in
let init_fs_for_runtime config =
let dir = Key_gen.fs_root ()
@ -133,6 +133,7 @@ module Main (R : Mirage_random.C) (Clock: Mirage_clock.PCLOCK) (Mclock: Mirage_c
Dav3.connect fs config admin_pass >|= fun fs ->
`Mem fs
*)
Logs.err (fun m -> m "hello");
Mirage_kv_unix.connect dir >>= fun fs ->
Dav2.connect fs config admin_pass >|= fun fs ->
`Unix fs
@ -143,16 +144,16 @@ module Main (R : Mirage_random.C) (Clock: Mirage_clock.PCLOCK) (Mclock: Mirage_c
Logs.err (fun m -> m "no port provided for neither HTTP nor HTTPS, exiting") ;
Lwt.return_unit
| Some port, None ->
let config = config @@ Caldav.Webdav_config.host ~port ~hostname () in
let config = config @@ Carddav.Webdav_config.host ~port ~hostname () in
init_fs_for_runtime config >>=
init_http port config
| None, Some port ->
let config = config @@ Caldav.Webdav_config.host ~scheme:"https" ~port ~hostname () in
let config = config @@ Carddav.Webdav_config.host ~scheme:"https" ~port ~hostname () in
init_fs_for_runtime config >>=
init_https port config
| Some http_port, Some https_port ->
Server_log.info (fun f -> f "redirecting on %d/HTTP to %d/HTTPS" http_port https_port);
let config = config @@ Caldav.Webdav_config.host ~scheme:"https" ~port:https_port ~hostname () in
let config = config @@ Carddav.Webdav_config.host ~scheme:"https" ~port:https_port ~hostname () in
init_fs_for_runtime config >>= fun fs ->
Lwt.pick [
http (`TCP http_port) @@ serve (redirect https_port) ;

1
src/webdav_api.ml

@ -1102,6 +1102,7 @@ let initialize_fs_for_apple_testsuite fs now config =
let initialize_fs fs now config =
make_dir_if_not_present fs now (admin_acl config) (`Dir [config.principals]) >>= fun _ ->
make_dir_if_not_present fs now (calendars_acl config) (`Dir [config.calendars]) >>= fun _ ->
make_dir_if_not_present fs now (calendars_acl config) (`Dir ["addressbooks"]) >>= fun _ ->
Lwt.return_unit
let change_user_password fs config ~name ~password ~salt =

10
src/webdav_server.ml

@ -259,11 +259,15 @@ module Make (R : Mirage_random.C) (Clock : Mirage_clock.PCLOCK) (Fs : Webdav_fs.
Wm.continue [] rd
method process_property rd =
Logs.debug (fun m -> m "Redirecting %s to %s %s" (Uri.to_string rd.uri) (Uri.to_string config.host) config.calendars);
let rd' = redirect (Uri.to_string @@ Uri.with_path config.host config.calendars) rd in
(* TODO add redirect to addressbook *)
Wm.respond 301 rd'
method private redirect rd =
Logs.debug (fun m -> m "Redirecting %s to %s %s" (Uri.to_string rd.uri) (Uri.to_string config.host) config.calendars);
let rd' = redirect (Uri.to_string @@ Uri.with_path config.host config.calendars) rd in
(* TODO add redirect to addressbook *)
Wm.respond 301 rd'
end
@ -507,7 +511,11 @@ module Make (R : Mirage_random.C) (Clock : Mirage_clock.PCLOCK) (Fs : Webdav_fs.
end
(* the route table *)
let routes config fs now generate_salt = [
let routes config fs now generate_salt =
Logs.debug(fun m -> m "routing");
[
(* TODO redirect should get url directly *)
("/.well-known/carddav", fun () -> new redirect config) ;
("/.well-known/caldav", fun () -> new redirect config) ;
("/users/:id", fun () -> new user config fs now generate_salt) ;
("/groups/:group_id/users/:user_id", fun () -> new group_users config fs now) ;

2
test/dune

@ -1,4 +1,4 @@
(test
(name test)
(libraries alcotest logs.fmt ptime.clock.os caldav lwt.unix mirage-kv-mem mirage-random-test mirage-clock-unix)
(libraries alcotest logs.fmt ptime.clock.os carddav caldav lwt.unix mirage-kv-mem mirage-random-test mirage-clock-unix)
(package carddav))

Loading…
Cancel
Save