keychain_schema.ml

(* 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