Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
351 lines (326 sloc) 12.7 KB
(* autogenerated by sql_orm *)
module Sql_access = struct
(*
* Copyright (c) 2009 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.
*)
open Sqlite3
open Printf
type transaction_mode = [
|`Deferred
|`Immediate
|`Exclusive
]
type state = {
db : db;
mutable in_transaction: int;
busyfn: db -> unit;
mode: transaction_mode;
}
let default_busyfn (db:Sqlite3.db) =
print_endline "WARNING: busy";
Thread.delay (Random.float 1.)
let raise_sql_error x =
raise (Sqlite3.Error (Rc.to_string x))
let try_finally fn finalfn =
try
let r = fn () in
finalfn ();
r
with e -> begin
print_endline (sprintf "WARNING: exception: %s" (Printexc.to_string e));
finalfn ();
raise e
end
(* retry until a non-BUSY error code is returned *)
let rec db_busy_retry db fn =
match fn () with
|Rc.BUSY ->
db.busyfn db.db;
db_busy_retry db fn;
|x -> x
(* make sure an OK is returned from the database *)
let db_must_ok db fn =
match db_busy_retry db fn with
|Rc.OK -> ()
|x -> raise_sql_error x
(* make sure a DONE is returned from the database *)
let db_must_done db fn =
match db_busy_retry db fn with
|Rc.DONE -> ()
|x -> raise_sql_error x
(* request a transaction *)
let transaction db fn =
let m = match db.mode with
|`Deferred -> "DEFERRED" |`Immediate -> "IMMEDIATE" |`Exclusive -> "EXCLUSIVE" in
try_finally (fun () ->
if db.in_transaction = 0 then (
db_must_ok db (fun () -> exec db.db (sprintf "BEGIN %s TRANSACTION" m));
);
db.in_transaction <- db.in_transaction + 1;
fn ();
) (fun () ->
if db.in_transaction = 1 then (
db_must_ok db (fun () -> exec db.db "END TRANSACTION");
);
db.in_transaction <- db.in_transaction - 1
)
(* iterate over a result set *)
let step_fold db stmt iterfn =
let stepfn () = Sqlite3.step stmt in
let rec fn a = match db_busy_retry db stepfn with
|Sqlite3.Rc.ROW -> fn (iterfn stmt :: a)
|Sqlite3.Rc.DONE -> a
|x -> raise_sql_error x
in
fn []
end
open Sql_access
module Passwd = struct
type t = <
id : int64 option;
set_id : int64 option -> unit;
service : string;
set_service : string -> unit;
ctime : float;
set_ctime : float -> unit;
username : string;
set_username : string -> unit;
encpasswd : string;
set_encpasswd : string -> unit;
comment : string;
set_comment : string -> unit;
save: int64; delete: unit
>
let init db =
let sql = "create table if not exists passwd (id integer primary key autoincrement,service text,ctime real,username text,encpasswd text,comment text);" in
db_must_ok db (fun () -> Sqlite3.exec db.db sql);
let sql = "CREATE UNIQUE INDEX IF NOT EXISTS passwd_grp_service__username_idx ON passwd (service,username) " in
db_must_ok db (fun () -> Sqlite3.exec db.db sql);
()
(* object definition *)
let t ?(id=None) ~service ~ctime ~username ~encpasswd ~comment db : t = object
(* get functions *)
val mutable _id = id
method id : int64 option = _id
val mutable _service = service
method service : string = _service
val mutable _ctime = ctime
method ctime : float = _ctime
val mutable _username = username
method username : string = _username
val mutable _encpasswd = encpasswd
method encpasswd : string = _encpasswd
val mutable _comment = comment
method comment : string = _comment
(* set functions *)
method set_id v =
_id <- v
method set_service v =
_service <- v
method set_ctime v =
_ctime <- v
method set_username v =
_username <- v
method set_encpasswd v =
_encpasswd <- v
method set_comment v =
_comment <- v
(* admin functions *)
method delete =
match _id with
|None -> ()
|Some id ->
let sql = "DELETE FROM passwd WHERE id=?" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (Sqlite3.Data.INT id));
ignore(step_fold db stmt (fun _ -> ()));
_id <- None
method save = transaction db (fun () ->
(* insert any foreign-one fields into their table and get id *)
let _curobj_id = match _id with
|None -> (* insert new record *)
let sql = "INSERT INTO passwd VALUES(NULL,?,?,?,?,?)" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (let v = _service in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 2 (let v = _ctime in Sqlite3.Data.FLOAT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 3 (let v = _username in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 4 (let v = _encpasswd in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 5 (let v = _comment in Sqlite3.Data.TEXT v));
db_must_done db (fun () -> Sqlite3.step stmt);
let __id = Sqlite3.last_insert_rowid db.db in
_id <- Some __id;
__id
|Some id -> (* update *)
let sql = "UPDATE passwd SET service=?,ctime=?,username=?,encpasswd=?,comment=? WHERE id=?" in
let stmt = Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> Sqlite3.bind stmt 1 (let v = _service in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 2 (let v = _ctime in Sqlite3.Data.FLOAT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 3 (let v = _username in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 4 (let v = _encpasswd in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 5 (let v = _comment in Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> Sqlite3.bind stmt 6 (Sqlite3.Data.INT id));
db_must_done db (fun () -> Sqlite3.step stmt);
id
in
_curobj_id
)
end
(* General get function for any of the columns *)
let get ?(id=None) ?(service=None) ?(ctime=None) ?(username=None) ?(encpasswd=None) ?(comment=None) ?(custom_where=("",[])) db =
(* assemble the SQL query string *)
let q = "" in
let _first = ref true in
let f () = match !_first with |true -> _first := false; " WHERE " |false -> " AND " in
let q = match id with |None -> q |Some b -> q ^ (f()) ^ "passwd.id=?" in
let q = match service with |None -> q |Some b -> q ^ (f()) ^ "passwd.service=?" in
let q = match ctime with |None -> q |Some b -> q ^ (f()) ^ "passwd.ctime=?" in
let q = match username with |None -> q |Some b -> q ^ (f()) ^ "passwd.username=?" in
let q = match encpasswd with |None -> q |Some b -> q ^ (f()) ^ "passwd.encpasswd=?" in
let q = match comment with |None -> q |Some b -> q ^ (f()) ^ "passwd.comment=?" in
let q = match custom_where with |"",_ -> q |w,_ -> q ^ (f()) ^ "(" ^ w ^ ")" in
let sql="SELECT passwd.id, passwd.service, passwd.ctime, passwd.username, passwd.encpasswd, passwd.comment FROM passwd " ^ q in
let stmt=Sqlite3.prepare db.db sql in
(* bind the position variables to the statement *)
let bindpos = ref 1 in
ignore(match id with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.INT v));
incr bindpos
);
ignore(match service with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.TEXT v));
incr bindpos
);
ignore(match ctime with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.FLOAT v));
incr bindpos
);
ignore(match username with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.TEXT v));
incr bindpos
);
ignore(match encpasswd with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.TEXT v));
incr bindpos
);
ignore(match comment with |None -> () |Some v ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos (Sqlite3.Data.TEXT v));
incr bindpos
);
ignore(match custom_where with |_,[] -> () |_,eb ->
List.iter (fun b ->
db_must_ok db (fun () -> Sqlite3.bind stmt !bindpos b);
incr bindpos
) eb);
(* convert statement into an ocaml object *)
let of_stmt stmt =
t
(* native fields *)
~id:(
(match Sqlite3.column stmt 0 with
|Sqlite3.Data.NULL -> None
|x -> Some (match x with |Sqlite3.Data.INT i -> i |x -> (try Int64.of_string (Sqlite3.Data.to_string x) with _ -> failwith "error: passwd id")))
)
~service:(
(match Sqlite3.column stmt 1 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~ctime:(
(match Sqlite3.column stmt 2 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> match x with |Sqlite3.Data.FLOAT i -> i|x -> (try float_of_string (Sqlite3.Data.to_string x) with _ -> failwith "error: passwd ctime"))
)
~username:(
(match Sqlite3.column stmt 3 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~encpasswd:(
(match Sqlite3.column stmt 4 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~comment:(
(match Sqlite3.column stmt 5 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
(* foreign fields *)
db
in
(* execute the SQL query *)
step_fold db stmt of_stmt
let get_by_service_username ~service ~username ?(custom_where=("",[])) db =
let q = "WHERE passwd.service=? AND passwd.username=?" in
let q = match custom_where with |"",_ -> q |w,_ -> q ^ " AND (" ^ w ^ ")" in
let sql="SELECT passwd.id, passwd.service, passwd.ctime, passwd.username, passwd.encpasswd, passwd.comment FROM passwd " ^ q in
let stmt=Sqlite3.prepare db.db sql in
db_must_ok db (fun () -> let v = service in Sqlite3.bind stmt 1 (Sqlite3.Data.TEXT v));
db_must_ok db (fun () -> let v = username in Sqlite3.bind stmt 2 (Sqlite3.Data.TEXT v));
ignore(match custom_where with |_,[] -> () |_,eb ->
let pos = ref 3 in
List.iter (fun b ->
db_must_ok db (fun () -> Sqlite3.bind stmt !pos b);
incr pos;
) eb);
(* convert statement into an ocaml object *)
let of_stmt stmt =
t
(* native fields *)
~id:(
(match Sqlite3.column stmt 0 with
|Sqlite3.Data.NULL -> None
|x -> Some (match x with |Sqlite3.Data.INT i -> i |x -> (try Int64.of_string (Sqlite3.Data.to_string x) with _ -> failwith "error: passwd id")))
)
~service:(
(match Sqlite3.column stmt 1 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~ctime:(
(match Sqlite3.column stmt 2 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> match x with |Sqlite3.Data.FLOAT i -> i|x -> (try float_of_string (Sqlite3.Data.to_string x) with _ -> failwith "error: passwd ctime"))
)
~username:(
(match Sqlite3.column stmt 3 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~encpasswd:(
(match Sqlite3.column stmt 4 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
~comment:(
(match Sqlite3.column stmt 5 with
|Sqlite3.Data.NULL -> failwith "null of_stmt"
|x -> Sqlite3.Data.to_string x)
)
(* foreign fields *)
db
in
(* execute the SQL query *)
step_fold db stmt of_stmt
end
module Init = struct
type t = state
type transaction_mode = [`Exclusive |`Deferred |`Immediate ]
let t ?(busyfn=default_busyfn) ?(mode=`Immediate) db_name =
let db = {db=Sqlite3.db_open db_name; in_transaction=0; mode=mode; busyfn=busyfn } in
Passwd.init db;
db
let db handle = handle.db
end
Something went wrong with that request. Please try again.