Skip to content
Browse files

Import source tree

  • Loading branch information...
0 parents commit f698793231538f181358b5cdfdeeeb4171b9c8ce @astrada committed May 20, 2012
Showing with 5,858 additions and 0 deletions.
  1. +11 −0 .gitignore
  2. +20 −0 LICENSE
  3. +50 −0 README.md
  4. +26 −0 _oasis
  5. +19 −0 _tags
  6. +460 −0 myocamlbuild.ml
  7. +5,023 −0 setup.ml
  8. +160 −0 src/gdfuse.ml
  9. +56 −0 src/keyValueStore.ml
  10. +27 −0 src/state.ml
  11. +6 −0 src/utils.ml
11 .gitignore
@@ -0,0 +1,11 @@
+*.swp
+*.bak
+
+_build
+*.byte
+*.native
+
+*.docdir
+setup.data
+setup.log
+
20 LICENSE
@@ -0,0 +1,20 @@
+Copyright (c) 2012 Alessandro Strada
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
+
50 README.md
@@ -0,0 +1,50 @@
+FUSE filesystem over Google Drive
+=================================
+
+**google-drive-ocamlfuse** is a FUSE filesystem backed by Google Drive,
+written in OCaml.
+
+Getting started
+---------------
+
+### Requirements
+
+This library was developed with the following dependencies ([Unofficial OCaml
+packages for Debian](http://ocaml.debian.net/debian/ocaml-3.12.1/)):
+
+* [OCaml][] = 3.12.1
+* [Findlib][] = 1.2.7
+* [gapi-ocaml][] = 0.1.8
+
+[OCaml]: http://caml.inria.fr/ocaml/release.en.html
+[Findlib]: http://projects.camlcity.org/projects/findlib.html/
+[gapi-ocaml]: http://forge.ocamlcore.org/projects/gapi-ocaml
+
+### Configuration and installation
+
+To build the executable, run
+
+ $ ocaml setup.ml -configure
+ $ ocaml setup.ml -build
+
+To install it, run (as root, if your user doesn't have enough privileges)
+
+ $ ocaml setup.ml -install
+
+To uninstall anything that was previously installed, execute
+
+ $ ocaml setup.ml -uninstall
+
+### Usage
+
+The first time, you should launch this command:
+
+ $ gdfuse -setup
+
+to build the configuration directory and to authorize access to your Google
+Drive.
+
+Then you can mount the filesystem:
+
+ $ gdfuse mountpoint
+
26 _oasis
@@ -0,0 +1,26 @@
+OASISFormat: 0.2
+OCamlVersion: >= 3.12.0
+Name: google-drive-ocamlfuse
+Version: 0.1
+Synopsis: A FUSE filesystem over Google Drive
+Authors: Alessandro Strada
+License: MIT
+LicenseFile: LICENSE
+Homepage: https://github.com/astrada/google-drive-ocamlfuse
+BuildTools: ocamlbuild
+
+# Executables
+Executable gdfuse
+ Path: src
+ MainIs: gdfuse.ml
+ Install: true
+ CompiledObject: best
+ BuildDepends: gdata
+
+# VCS
+SourceRepository head
+ Type: git
+ Location: https://github.com/astrada/google-drive-ocamlfuse.git
+ Browser: https://github.com/astrada/google-drive-ocamlfuse
+ Branch: master
+
19 _tags
@@ -0,0 +1,19 @@
+# OASIS_START
+# DO NOT EDIT (digest: e60a74c16bd8a001456b1ccc7cc6fb74)
+# Ignore VCS directories, you can use the same kind of rule outside
+# OASIS_START/STOP if you want to exclude directories that contains
+# useless stuff for the build process
+<**/.svn>: -traverse
+<**/.svn>: not_hygienic
+".bzr": -traverse
+".bzr": not_hygienic
+".hg": -traverse
+".hg": not_hygienic
+".git": -traverse
+".git": not_hygienic
+"_darcs": -traverse
+"_darcs": not_hygienic
+# Executable gdfuse
+<src/gdfuse.{native,byte}>: pkg_gdata
+<src/*.ml{,i}>: pkg_gdata
+# OASIS_STOP
460 myocamlbuild.ml
@@ -0,0 +1,460 @@
+(* OASIS_START *)
+(* DO NOT EDIT (digest: 139b5b2319f42be76afbb4b8d683e27f) *)
+module OASISGettext = struct
+# 21 "/home/alex/.odb/install-oasis/oasis-0.2.1~alpha1/src/oasis/OASISGettext.ml"
+
+ let ns_ str =
+ str
+
+ let s_ str =
+ str
+
+ let f_ (str : ('a, 'b, 'c, 'd) format4) =
+ str
+
+ let fn_ fmt1 fmt2 n =
+ if n = 1 then
+ fmt1^^""
+ else
+ fmt2^^""
+
+ let init =
+ []
+
+end
+
+module OASISExpr = struct
+# 21 "/home/alex/.odb/install-oasis/oasis-0.2.1~alpha1/src/oasis/OASISExpr.ml"
+
+
+
+ open OASISGettext
+
+ type test = string
+
+ type flag = string
+
+ type t =
+ | EBool of bool
+ | ENot of t
+ | EAnd of t * t
+ | EOr of t * t
+ | EFlag of flag
+ | ETest of test * string
+
+
+ type 'a choices = (t * 'a) list
+
+ let eval var_get t =
+ let rec eval' =
+ function
+ | EBool b ->
+ b
+
+ | ENot e ->
+ not (eval' e)
+
+ | EAnd (e1, e2) ->
+ (eval' e1) && (eval' e2)
+
+ | EOr (e1, e2) ->
+ (eval' e1) || (eval' e2)
+
+ | EFlag nm ->
+ let v =
+ var_get nm
+ in
+ assert(v = "true" || v = "false");
+ (v = "true")
+
+ | ETest (nm, vl) ->
+ let v =
+ var_get nm
+ in
+ (v = vl)
+ in
+ eval' t
+
+ let choose ?printer ?name var_get lst =
+ let rec choose_aux =
+ function
+ | (cond, vl) :: tl ->
+ if eval var_get cond then
+ vl
+ else
+ choose_aux tl
+ | [] ->
+ let str_lst =
+ if lst = [] then
+ s_ "<empty>"
+ else
+ String.concat
+ (s_ ", ")
+ (List.map
+ (fun (cond, vl) ->
+ match printer with
+ | Some p -> p vl
+ | None -> s_ "<no printer>")
+ lst)
+ in
+ match name with
+ | Some nm ->
+ failwith
+ (Printf.sprintf
+ (f_ "No result for the choice list '%s': %s")
+ nm str_lst)
+ | None ->
+ failwith
+ (Printf.sprintf
+ (f_ "No result for a choice list: %s")
+ str_lst)
+ in
+ choose_aux (List.rev lst)
+
+end
+
+
+module BaseEnvLight = struct
+# 21 "/home/alex/.odb/install-oasis/oasis-0.2.1~alpha1/src/base/BaseEnvLight.ml"
+
+ module MapString = Map.Make(String)
+
+ type t = string MapString.t
+
+ let default_filename =
+ Filename.concat
+ (Sys.getcwd ())
+ "setup.data"
+
+ let load ?(allow_empty=false) ?(filename=default_filename) () =
+ if Sys.file_exists filename then
+ begin
+ let chn =
+ open_in_bin filename
+ in
+ let st =
+ Stream.of_channel chn
+ in
+ let line =
+ ref 1
+ in
+ let st_line =
+ Stream.from
+ (fun _ ->
+ try
+ match Stream.next st with
+ | '\n' -> incr line; Some '\n'
+ | c -> Some c
+ with Stream.Failure -> None)
+ in
+ let lexer =
+ Genlex.make_lexer ["="] st_line
+ in
+ let rec read_file mp =
+ match Stream.npeek 3 lexer with
+ | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
+ Stream.junk lexer;
+ Stream.junk lexer;
+ Stream.junk lexer;
+ read_file (MapString.add nm value mp)
+ | [] ->
+ mp
+ | _ ->
+ failwith
+ (Printf.sprintf
+ "Malformed data file '%s' line %d"
+ filename !line)
+ in
+ let mp =
+ read_file MapString.empty
+ in
+ close_in chn;
+ mp
+ end
+ else if allow_empty then
+ begin
+ MapString.empty
+ end
+ else
+ begin
+ failwith
+ (Printf.sprintf
+ "Unable to load environment, the file '%s' doesn't exist."
+ filename)
+ end
+
+ let var_get name env =
+ let rec var_expand str =
+ let buff =
+ Buffer.create ((String.length str) * 2)
+ in
+ Buffer.add_substitute
+ buff
+ (fun var ->
+ try
+ var_expand (MapString.find var env)
+ with Not_found ->
+ failwith
+ (Printf.sprintf
+ "No variable %s defined when trying to expand %S."
+ var
+ str))
+ str;
+ Buffer.contents buff
+ in
+ var_expand (MapString.find name env)
+
+ let var_choose lst env =
+ OASISExpr.choose
+ (fun nm -> var_get nm env)
+ lst
+end
+
+
+module MyOCamlbuildFindlib = struct
+# 21 "/home/alex/.odb/install-oasis/oasis-0.2.1~alpha1/src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml"
+
+ (** OCamlbuild extension, copied from
+ * http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild
+ * by N. Pouillard and others
+ *
+ * Updated on 2009/02/28
+ *
+ * Modified by Sylvain Le Gall
+ *)
+ open Ocamlbuild_plugin
+
+ (* these functions are not really officially exported *)
+ let run_and_read =
+ Ocamlbuild_pack.My_unix.run_and_read
+
+ let blank_sep_strings =
+ Ocamlbuild_pack.Lexers.blank_sep_strings
+
+ let split s ch =
+ let x =
+ ref []
+ in
+ let rec go s =
+ let pos =
+ String.index s ch
+ in
+ x := (String.before s pos)::!x;
+ go (String.after s (pos + 1))
+ in
+ try
+ go s
+ with Not_found -> !x
+
+ let split_nl s = split s '\n'
+
+ let before_space s =
+ try
+ String.before s (String.index s ' ')
+ with Not_found -> s
+
+ (* this lists all supported packages *)
+ let find_packages () =
+ List.map before_space (split_nl & run_and_read "ocamlfind list")
+
+ (* this is supposed to list available syntaxes, but I don't know how to do it. *)
+ let find_syntaxes () = ["camlp4o"; "camlp4r"]
+
+ (* ocamlfind command *)
+ let ocamlfind x = S[A"ocamlfind"; x]
+
+ let dispatch =
+ function
+ | Before_options ->
+ (* by using Before_options one let command line options have an higher priority *)
+ (* on the contrary using After_options will guarantee to have the higher priority *)
+ (* override default commands by ocamlfind ones *)
+ Options.ocamlc := ocamlfind & A"ocamlc";
+ Options.ocamlopt := ocamlfind & A"ocamlopt";
+ Options.ocamldep := ocamlfind & A"ocamldep";
+ Options.ocamldoc := ocamlfind & A"ocamldoc";
+ Options.ocamlmktop := ocamlfind & A"ocamlmktop"
+
+ | After_rules ->
+
+ (* When one link an OCaml library/binary/package, one should use -linkpkg *)
+ flag ["ocaml"; "link"; "program"] & A"-linkpkg";
+
+ (* For each ocamlfind package one inject the -package option when
+ * compiling, computing dependencies, generating documentation and
+ * linking. *)
+ List.iter
+ begin fun pkg ->
+ flag ["ocaml"; "compile"; "pkg_"^pkg] & S[A"-package"; A pkg];
+ flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S[A"-package"; A pkg];
+ flag ["ocaml"; "doc"; "pkg_"^pkg] & S[A"-package"; A pkg];
+ flag ["ocaml"; "link"; "pkg_"^pkg] & S[A"-package"; A pkg];
+ flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S[A"-package"; A pkg];
+ end
+ (find_packages ());
+
+ (* Like -package but for extensions syntax. Morover -syntax is useless
+ * when linking. *)
+ List.iter begin fun syntax ->
+ flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
+ flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
+ flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
+ flag ["ocaml"; "infer_interface"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
+ end (find_syntaxes ());
+
+ (* The default "thread" tag is not compatible with ocamlfind.
+ * Indeed, the default rules add the "threads.cma" or "threads.cmxa"
+ * options when using this tag. When using the "-linkpkg" option with
+ * ocamlfind, this module will then be added twice on the command line.
+ *
+ * To solve this, one approach is to add the "-thread" option when using
+ * the "threads" package using the previous plugin.
+ *)
+ flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]);
+ flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]);
+ flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]);
+ flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"])
+
+ | _ ->
+ ()
+
+end
+
+module MyOCamlbuildBase = struct
+# 21 "/home/alex/.odb/install-oasis/oasis-0.2.1~alpha1/src/plugins/ocamlbuild/MyOCamlbuildBase.ml"
+
+ (** Base functions for writing myocamlbuild.ml
+ @author Sylvain Le Gall
+ *)
+
+
+
+ open Ocamlbuild_plugin
+
+ type dir = string
+ type file = string
+ type name = string
+ type tag = string
+
+# 55 "/home/alex/.odb/install-oasis/oasis-0.2.1~alpha1/src/plugins/ocamlbuild/MyOCamlbuildBase.ml"
+
+ type t =
+ {
+ lib_ocaml: (name * dir list) list;
+ lib_c: (name * dir * file list) list;
+ flags: (tag list * (spec OASISExpr.choices)) list;
+ }
+
+ let env_filename =
+ Pathname.basename
+ BaseEnvLight.default_filename
+
+ let dispatch_combine lst =
+ fun e ->
+ List.iter
+ (fun dispatch -> dispatch e)
+ lst
+
+ let dispatch t e =
+ let env =
+ BaseEnvLight.load
+ ~filename:env_filename
+ ~allow_empty:true
+ ()
+ in
+ match e with
+ | Before_options ->
+ let no_trailing_dot s =
+ if String.length s >= 1 && s.[0] = '.' then
+ String.sub s 1 ((String.length s) - 1)
+ else
+ s
+ in
+ List.iter
+ (fun (opt, var) ->
+ try
+ opt := no_trailing_dot (BaseEnvLight.var_get var env)
+ with Not_found ->
+ Printf.eprintf "W: Cannot get variable %s" var)
+ [
+ Options.ext_obj, "ext_obj";
+ Options.ext_lib, "ext_lib";
+ Options.ext_dll, "ext_dll";
+ ]
+
+ | After_rules ->
+ (* Declare OCaml libraries *)
+ List.iter
+ (function
+ | lib, [] ->
+ ocaml_lib lib;
+ | lib, dir :: tl ->
+ ocaml_lib ~dir:dir lib;
+ List.iter
+ (fun dir ->
+ flag
+ ["ocaml"; "use_"^lib; "compile"]
+ (S[A"-I"; P dir]))
+ tl)
+ t.lib_ocaml;
+
+ (* Declare C libraries *)
+ List.iter
+ (fun (lib, dir, headers) ->
+ (* Handle C part of library *)
+ flag ["link"; "library"; "ocaml"; "byte"; "use_lib"^lib]
+ (S[A"-dllib"; A("-l"^lib); A"-cclib"; A("-l"^lib)]);
+
+ flag ["link"; "library"; "ocaml"; "native"; "use_lib"^lib]
+ (S[A"-cclib"; A("-l"^lib)]);
+
+ flag ["link"; "program"; "ocaml"; "byte"; "use_lib"^lib]
+ (S[A"-dllib"; A("dll"^lib)]);
+
+ (* When ocaml link something that use the C library, then one
+ need that file to be up to date.
+ *)
+ dep ["link"; "ocaml"; "use_lib"^lib]
+ [dir/"lib"^lib^"."^(!Options.ext_lib)];
+
+ (* TODO: be more specific about what depends on headers *)
+ (* Depends on .h files *)
+ dep ["compile"; "c"]
+ headers;
+
+ (* Setup search path for lib *)
+ flag ["link"; "ocaml"; "use_"^lib]
+ (S[A"-I"; P(dir)]);
+ )
+ t.lib_c;
+
+ (* Add flags *)
+ List.iter
+ (fun (tags, cond_specs) ->
+ let spec =
+ BaseEnvLight.var_choose cond_specs env
+ in
+ flag tags & spec)
+ t.flags
+ | _ ->
+ ()
+
+ let dispatch_default t =
+ dispatch_combine
+ [
+ dispatch t;
+ MyOCamlbuildFindlib.dispatch;
+ ]
+
+end
+
+
+open Ocamlbuild_plugin;;
+let package_default =
+ {MyOCamlbuildBase.lib_ocaml = []; lib_c = []; flags = []; }
+ ;;
+
+let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;;
+
+(* OASIS_STOP *)
+Ocamlbuild_plugin.dispatch dispatch_default;;
5,023 setup.ml
5,023 additions, 0 deletions not shown because the diff is too large. Please use a local Git client to view these changes.
160 src/gdfuse.ml
@@ -0,0 +1,160 @@
+open Utils.Infix
+open GapiLens.Infix
+open GapiLens.StateInfix
+open GapiMonad.SessionM
+open GdataDocumentsV3Model
+open GdataDocumentsV3Service
+
+(* Application files *)
+let app_dir = Filename.concat (Sys.getenv "HOME") ".gdfuse"
+let config_path = Filename.concat app_dir "config"
+let state_path = Filename.concat app_dir "state"
+let log_path = Filename.concat app_dir "log"
+
+(* Google Services parameters *)
+let application_name = "google-drive-ocamlfuse"
+let gae_proxy = "http://localhost:8080"
+let client_id = "564921029129.apps.googleusercontent.com"
+let redirect_uri = gae_proxy ^ "/oauth2callback"
+let scope = [GdataDocumentsV3Service.all_scopes]
+
+let gapi_config = GapiConfig.default_debug
+ |> GapiConfig.application_name ^= application_name
+
+(* Authorization *)
+let get_authorization_url request_id =
+ GapiOAuth2.authorization_code_url
+ ~redirect_uri
+ ~scope
+ ~state:request_id
+ ~response_type:"code"
+ client_id
+
+let start_browser request_id =
+ let url = get_authorization_url request_id in
+ let command = Printf.sprintf "xdg-open \"%s\"" url in
+ let ch = Unix.open_process_in command in
+ let status = Unix.close_process_in ch in
+ if status <> (Unix.WEXITED 0) then
+ failwith ("Error executing this command: " ^ command)
+
+type auth_data = {
+ request_id : string;
+ user_id : string;
+ access_token : string;
+ refresh_token : string;
+ date : GapiDate.t;
+}
+
+let get_tokens request_id =
+ let rid = Netencoding.Url.encode request_id in
+ let gettokens_url = gae_proxy ^ "/gettokens?requestid=" ^ rid in
+ GapiConversation.with_curl
+ gapi_config
+ (fun session ->
+ let (tokens, _) =
+ GapiConversation.request
+ GapiCore.HttpMethod.GET
+ session
+ gettokens_url
+ (fun pipe code headers session ->
+ let response = GapiConversation.read_all pipe in
+ if code <> 200 then begin
+ failwith (Printf.sprintf
+ "Cannot retrieve auth tokens: Server response: %s (code=%d)"
+ response code);
+ end else if response = "Not_found" then begin
+ raise Not_found
+ end;
+ let json = Json_io.json_of_string response in
+ let open Json_type.Browse in
+ let obj = objekt json in
+ let table = make_table obj in
+ { request_id = field table "request_id" |> string;
+ user_id = field table "user_id" |> string;
+ access_token = field table "access_token" |> string;
+ refresh_token = field table "refresh_token" |> string;
+ date = field table "date" |> string |> GapiDate.of_string;
+ }
+ )
+ in
+ tokens)
+
+let start_server_polling request_id =
+ let rec loop n =
+ if n = 30 then failwith "Cannot retrieve auth tokens: Timeout expired";
+ try
+ get_tokens request_id
+ with Not_found ->
+ Unix.sleep 10;
+ loop (succ n)
+ in
+ loop 0
+(* END Authorization *)
+
+(* Setup *)
+let rng =
+ let open Cryptokit.Random in
+ let dev_rng = device_rng "/dev/urandom" in
+ string dev_rng 20 |> pseudo_rng
+
+let setup_application () =
+ print_endline "Setup";
+ let request_id = Cryptokit.Random.string rng 32
+ |> Base64.str_encode
+ in
+ start_browser request_id;
+ try
+ let tokens = start_server_polling request_id in
+ Printf.printf "request_id=%s,\nuser_id=%s,\naccess_token=%s\nrefresh_token=%s\ndate=%s\n\n"
+ tokens.request_id
+ tokens.user_id
+ tokens.access_token
+ tokens.refresh_token
+ (GapiDate.to_string tokens.date)
+ with e ->
+ prerr_endline "Cannot retrieve auth tokens.";
+ Printexc.to_string e |> prerr_endline;
+ exit 1
+(* END setup *)
+
+(* FUSE bindings *)
+let init_filesystem mounpoint =
+ print_endline ("Init filesystem " ^ mounpoint)
+(* END FUSE bindings *)
+
+(* Main program *)
+let () =
+ let setup = ref false in
+ let mountpoint = ref "" in
+ let program = Filename.basename Sys.executable_name in
+ let usage =
+ Printf.sprintf
+ "Usage: %s -setup\n %s mountpoint"
+ program program in
+ let arg_specs =
+ Arg.align (
+ ["-setup",
+ Arg.Set setup,
+ " Create configuration directory ~/.gdfuse and request oauth2 tokens.";
+ ]) in
+ let () =
+ Arg.parse
+ arg_specs
+ (fun s -> mountpoint := s)
+ usage in
+ let () =
+ if not !setup && !mountpoint = "" then begin
+ prerr_endline "You must specify a mountpoint (or -setup option).";
+ prerr_endline usage;
+ exit 1
+ end
+ in
+ if !setup then begin
+ setup_application ();
+ end;
+ if !mountpoint <> "" then begin
+ init_filesystem !mountpoint;
+ end
+(* END Main program *)
+
56 src/keyValueStore.ml
@@ -0,0 +1,56 @@
+module type FileStore =
+sig
+ type data
+
+ type t = {
+ path : string;
+ data : data
+ }
+
+ val save : t -> unit
+
+ val load : string -> t
+
+end
+
+module type Data =
+sig
+ type t
+
+ val of_table : (string, string) Hashtbl.t -> t
+
+ val to_table : t -> (string, string) Hashtbl.t
+
+end
+
+module MakeFileStore(D : Data) =
+struct
+ type data = D.t
+
+ type t = {
+ path : string;
+ data : data
+ }
+
+ let load filename =
+ let sb = Scanf.Scanning.from_file filename in
+ let table = Hashtbl.create 16 in
+ while (not (Scanf.Scanning.end_of_input sb)) do
+ let (key, value) = Scanf.bscanf sb "%s@=%s@\n" (fun k v -> (k, v)) in
+ Hashtbl.add table key value
+ done;
+ { path = filename;
+ data = D.of_table table;
+ }
+
+ let save store =
+ let table = D.to_table store.data in
+ let out_ch = open_out store.path in
+ Hashtbl.iter
+ (fun key value ->
+ Printf.fprintf out_ch "%s=%s\n" key value)
+ table;
+ close_out out_ch
+
+end
+
27 src/state.ml
@@ -0,0 +1,27 @@
+open Utils.Infix
+
+type t = {
+ auth_request_id : string;
+ auth_request_date : GapiDate.t;
+ user_id : string;
+ refresh_token : string;
+ last_access_token : string;
+}
+
+let of_table table =
+ let get = Hashtbl.find table in
+ { auth_request_id = get "auth_request_id";
+ auth_request_date = get "auth_request_date" |> GapiDate.of_string;
+ user_id = get "user_id";
+ refresh_token = get "refresh_token";
+ last_access_token = get "last_access_token";
+ }
+
+let to_table data =
+ let add = Hashtbl.add table in
+ add "auth_request_id" data.auth_request_id;
+ GapiDate.to_string data.auth_request_date |> add "auth_request_date";
+ add "user_id" data.user_id;
+ add "refresh_token" data.refresh_token;
+ add "last_access_token" data.last_access_token
+
6 src/utils.ml
@@ -0,0 +1,6 @@
+module Infix =
+struct
+ let (|>) x f = f x
+
+end
+

0 comments on commit f698793

Please sign in to comment.
Something went wrong with that request. Please try again.