diff options
Diffstat (limited to 'src/vyconfd.ml')
| -rw-r--r-- | src/vyconfd.ml | 33 |
1 files changed, 32 insertions, 1 deletions
diff --git a/src/vyconfd.ml b/src/vyconfd.ml index fc47bf6..885fd20 100644 --- a/src/vyconfd.ml +++ b/src/vyconfd.ml @@ -95,6 +95,10 @@ let teardown token = with Not_found -> {response_tmpl with status=Fail; error=(Some "Session not found")} +let session_changed world token (_req: request_session_changed) = + if Session.session_changed world (find_session token) then response_tmpl + else {response_tmpl with status=Fail} + let exists world token (req: request_exists) = if Session.exists world (find_session token) req.path then response_tmpl else {response_tmpl with status=Fail} @@ -163,6 +167,29 @@ let delete world token (req: request_delete) = response_tmpl with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)} +let discard world token (_req: request_discard) = + try + let session = Session.discard world (find_session token) + in + Hashtbl.replace sessions token session; + response_tmpl + with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)} + +let load world token (req: request_load) = + try + let session = Session.load world (find_session token) req.location + in + Hashtbl.replace sessions token session; + response_tmpl + with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)} + +let save world token (req: request_save) = + try + let _ = Session.save world (find_session token) req.location + in + response_tmpl + with Session.Session_error msg -> {response_tmpl with status=Fail; error=(Some msg)} + let commit world token (req: request_commit) = let s = find_session token in let at = world.Session.running_config in @@ -236,7 +263,7 @@ let rec handle_connection world ic oc () = | _ as req -> begin (match req with - | _, Status -> response_tmpl + | _, Prompt -> response_tmpl | _, Setup_session r -> setup_session world r | _, Reload_reftree r -> reload_reftree world r | None, _ -> {response_tmpl with status=Fail; output=(Some "Operation requires session token")} @@ -251,6 +278,10 @@ let rec handle_connection world ic oc () = | Some t, Validate r -> validate world t r | Some t, Set r -> set world t r | Some t, Delete r -> delete world t r + | Some t, Discard r -> discard world t r + | Some t, Session_changed r -> session_changed world t r + | Some t, Load r -> load world t r + | Some t, Save r -> save world t r | _ -> failwith "Unimplemented" ) |> Lwt.return end |