access via UID, iterator for store,fetch,search

Author: Gregory Tsipenyuk

Makefile

@@ -4,7 +4,7 @@ STORAGE_SRC = storage/block.ml* storage/irminSrvIpc.ml* storage/irminStorage.ml*
 
 IMAPLET_SRC = imaplet.ml account.ml* amailbox.ml* configuration.ml* connection.ml* contextlist.ml* contexts.ml* fetchregex.ml interpreter.ml* lex.mll parser.mly regex.ml* response.ml* server.ml* state.ml* states.ml utils.ml* 
 
-all: imaplet irmin_store_srv build_irmin_store read_store
+all: imaplet srv store read_store
 
 clean:
 	ocamlbuild -clean
@@ -13,10 +13,10 @@ clean:
 imaplet:$(STORAGE_SRC) $(IMAPLET_SRC) 
 	corebuild -Is storage -cflag -annot -tag debug -verbose 6 -use-menhir -tag thread -use-ocamlfind -quiet -package extlib,str,async,email_message,async_unix,async_kernel,sexplib imaplet.native
 
-irmin_store_srv: $(SRV_SRC)
+srv: $(SRV_SRC)
 	corebuild -Is storage -use-ocamlfind -no-hygiene -tag thread -tag "syntax(camlp4o)" -package core,lwt,lwt.unix,lwt.syntax,irminsule.backend.git,sexplib.syntax,comparelib.syntax,bin_prot.syntax,email_message,extlib,str irminStorageSrv.native
 
-build_irmin_store: $(STORAGE_SRC)
+store: $(STORAGE_SRC)
 	corebuild -Is storage -pkgs async,email_message,async_unix,str,extlib build_irmin_store.native
 
 read_store: read_store.ml storage/irminStorage.ml* storage/storageMeta.ml*

amailbox.ml

@@ -435,8 +435,30 @@ let search mbx (keys:('a)States.searchKeys) (buid:bool) :
       let (module Mailbox) = storage_factory mbx name () in
       Mailbox.MailboxStorage.search_with Mailbox.this ~filter:(buid,keys) >>= fun acc -> return (`Ok acc)
 
+let get_smallest_uid buid accs =
+  if buid = false then
+    return (Some 1)
+  else
+    let (module Accessor : StorageAccessor_inst) = accs in
+    Accessor.StorageAccessor.reader_metadata Accessor.this (`Position 1) >>= function
+    | `Eof -> return None
+    | `Ok metadata -> return (Some metadata.uid)
+
+let get_iterator mbx name accs buid sequence =
+  let (module Mailbox) = storage_factory mbx name () in
+  (if Iterator.SequenceIterator.single sequence then
+    return Int.max_value
+  else
+    Mailbox.MailboxStorage.get_mailbox_metadata Mailbox.this >>= fun metadata ->
+    if buid then return (metadata.uidnext-1) else return metadata.count
+  ) >>= fun max ->
+  get_smallest_uid buid accs >>= function
+  | None -> return None
+  | Some min -> return (Some (Iterator.SequenceIterator.create sequence min max))
+
 let fetch (mbx:t) (resp_writer:(string->unit)) (sequence:States.sequence) (fetchattr:States.fetch)
 (buid:bool) : [`NotExists|`NotSelectable|`Error of string|`Ok ] Deferred.t = 
+  let open Interpreter in
   match (selected_mbox mbx) with
   | None -> return (`Error "Not selected")
   | Some name ->
@@ -445,21 +467,31 @@ let fetch (mbx:t) (resp_writer:(string->unit)) (sequence:States.sequence) (fetch
     | `NotSelectable -> return (`NotSelectable)
     | `ValidMailbox -> 
       let (module Mailbox) = storage_factory mbx name () in
-      Mailbox.MailboxStorage.fold Mailbox.this ~exclusive:true ~init:() ~f:(fun () accs ->
-        let rec doread accs seq =
-          let (module Accessor : StorageAccessor_inst) = accs in
-          let filter = Some (States.Key (States.Search_SeqSet sequence)) in
-          Accessor.StorageAccessor.reader Accessor.this ?filter (`Position seq) >>= function
+      Mailbox.MailboxStorage.fold Mailbox.this ~exclusive:true
+      ~init:()
+      ~f:(fun () accs ->
+        (* should add the smallest uid to the the index header TBD
+         *)
+        get_iterator mbx name accs buid sequence >>= function
+        | None -> return ()
+        | Some it ->
+        let (module Accessor : StorageAccessor_inst) = accs in
+        let rec read = function
+          | `End -> return ()
+          | `Ok seq ->
+            let pos = if buid then (`UID seq) else (`Position seq) in
+            Accessor.StorageAccessor.reader Accessor.this pos >>= function
             | `Eof -> return ()
-            | `NotFound -> doread accs (seq + 1)
+            | `NotFound -> read (Iterator.SequenceIterator.next it)
             | `Ok (message,metadata) -> 
               printf "============= %s" (Email_message.Mailbox.Message.to_string message);
+              (* probably still need this since UID may not be sequential *)
               let res = Interpreter.exec_fetch seq sequence message metadata fetchattr buid in
               match res with
-              | Some res -> resp_writer res; doread accs (seq + 1)
-              | None -> doread accs (seq + 1)
+              | Some res -> resp_writer res; read (Iterator.SequenceIterator.next it)
+              | None -> read (Iterator.SequenceIterator.next it)
         in
-        doread accs 1
+        read (Iterator.SequenceIterator.next it)
       ) >>= fun () -> return `Ok
 
 let store (mbx:t) (resp_writer:(string->unit)) (sequence:States.sequence)
@@ -474,23 +506,29 @@ let store (mbx:t) (resp_writer:(string->unit)) (sequence:States.sequence)
   | `ValidMailbox ->
       let (module Mailbox) = storage_factory mbx name () in
       Mailbox.MailboxStorage.fold Mailbox.this ~exclusive:true ~init:() ~f:(fun () accs ->
-        let rec doread accs seq =
-          let (module Accessor : StorageAccessor_inst) = accs in
-          Accessor.StorageAccessor.reader_metadata Accessor.this (`Position seq) >>= function
+        let (module Accessor : StorageAccessor_inst) = accs in
+        get_iterator mbx name accs buid sequence >>= function
+        | None -> return ()
+        | Some it ->
+        let rec doread = function
+          | `End -> return ()
+          | `Ok seq ->
+          let pos = if buid then (`UID seq) else (`Position seq) in
+          Accessor.StorageAccessor.reader_metadata Accessor.this pos >>= function
             | `Eof -> return ()
+            | `NotFound -> doread (Iterator.SequenceIterator.next it)
             | `Ok metadata -> 
               let update metadata seq =
-                Accessor.StorageAccessor.writer_metadata Accessor.this metadata 
-                (`Position seq) >>= function
+                Accessor.StorageAccessor.writer_metadata Accessor.this metadata pos >>= function
                  | `Eof -> return ()
-                 | `Ok -> doread accs (seq + 1)
+                 | `NotFound|`Ok -> doread (Iterator.SequenceIterator.next it)
               in
               match Interpreter.exec_store metadata seq sequence storeattr flagsval buid with
-              | `None -> doread accs (seq + 1)
+              | `None -> doread (Iterator.SequenceIterator.next it)
               | `Silent metadata -> update metadata seq
               | `Ok (metadata,res) -> resp_writer res;update metadata seq
         in
-        doread accs 1
+        doread (Iterator.SequenceIterator.next it)
       ) >>= fun () -> return `Ok
 
 (** if copy fails it should restore the mailbox, so need to copy TBD **)

irminStorageSrv.ml

@@ -34,23 +34,25 @@ let create_socket () =
   socket
 
 let get_pos = function
-  | `Position pos -> pos
+  | `Position p -> "seq " ^ (string_of_int p)
+  | `UID u -> "uid " ^ (string_of_int u)
 
 let handle_reader user loc filter pos = 
-  Printf.printf "------irminStorageSrv handle_reader %s %s %d\n%!" user loc (get_pos pos);
+  Printf.printf "------irminStorageSrv handle_reader %s %s %s\n%!" user loc (get_pos pos);
   let mbox = IrminMailbox.create user loc in
-  IrminMailbox.read_message mbox ?filter (get_pos pos) >>= function
+  IrminMailbox.read_message mbox ?filter pos >>= function
   | `Ok (msg, meta) ->
       return (`Reader (`Ok (msg, meta)))
   | `NotFound -> return (`Reader `NotFound)
   | `Eof -> return (`Reader `Eof)
 
-let handle_reader_metadata user loc pos =
-  Printf.printf "------irminStorageSrv handle_reader_metadata %s %s %d\n%!" user loc (get_pos pos);
+let handle_reader_metadata user loc filter pos =
+  Printf.printf "------irminStorageSrv handle_reader_metadata %s %s %s\n%!" user loc (get_pos pos);
   let mbox = IrminMailbox.create user loc in
-  IrminMailbox.read_metadata mbox (get_pos pos) >>= function
+  IrminMailbox.read_metadata mbox ?filter pos >>= function
   | `Ok meta -> return (`Reader_metadata (`Ok meta))
-  | `NotFound -> return (`Reader_metadata `Eof)
+  | `NotFound -> return (`Reader_metadata `NotFound)
+  | `Eof -> return (`Reader_metadata `Eof)
 
 let handle_writer user loc message metadata =
   Printf.printf "------irminStorageSrv handle_writer %s %s \n%!" user loc;
@@ -59,11 +61,12 @@ let handle_writer user loc message metadata =
     return (`Writer `Ok)
 
 let handle_writer_metadata user loc pos metadata =
-  Printf.printf "------irminStorageSrv handle_writer_metadata %s %s %d\n%!" user loc (get_pos pos);
+  Printf.printf "------irminStorageSrv handle_writer_metadata %s %s %s\n%!" user loc (get_pos pos);
   let mbox = IrminMailbox.create user loc in
-  IrminMailbox.update_metadata mbox (get_pos pos) metadata >>= function
+  IrminMailbox.update_metadata mbox pos metadata >>= function
     | `Ok -> return (`Writer_metadata `Ok)
-    | `NotFound -> return (`Writer_metadata `Eof)
+    | `NotFound -> return (`Writer_metadata `NotFound)
+    | `Eof -> return (`Writer_metadata `Eof)
 
 let handle_exists user loc =
   Printf.printf "------irminStorageSrv handle_exists %s %s\n%!" user loc;
@@ -100,8 +103,9 @@ let handle_delete user loc =
 let handle_expunge user loc =
   Printf.printf "------irminStorageSrv handle_expunge %s %s\n%!" user loc;
   let mbox = IrminMailbox.create user loc in
-  IrminMailbox.expunge mbox >>= fun () ->
-    return `Expunge
+  IrminMailbox.expunge mbox >>= fun res ->
+    Printf.printf "%d records expunged\n%!" (Core.Std.List.length res);
+    return (`Expunge res)
 
 let handle_copy user loc1 loc2 filter =
   Printf.printf "------irminStorageSrv handle_copy %s %s %s\n%!" user loc1 loc2;
@@ -181,7 +185,7 @@ let process_request outchan msg =
   | `Mailbox_metadata (user, loc) -> handle_get_metadata user loc
   | `Move (user, loc1, loc2) -> handle_move user loc1 loc2
   | `Reader (user,loc,pos,filter) -> handle_reader user loc filter pos 
-  | `Reader_metadata (user,loc,pos) -> handle_reader_metadata user loc pos
+  | `Reader_metadata (user,loc,filter,pos) -> handle_reader_metadata user loc filter pos
   | `Remove_account (user) -> handle_remove_account user 
   | `Rebuild_index (user, loc) -> handle_rebuild_index user loc
   | `Search_with (user, loc, filter) -> handle_search_with user loc filter

iterator.ml

@@ -0,0 +1,69 @@
+open Async.Std
+open States
+
+module type SequenceIterator_intf = 
+  sig
+    type t
+
+    (* sequence -> max in seq *)
+    val create : sequence -> int -> int -> t
+
+    val single : sequence -> bool
+
+    val next : t -> [`Ok of int|`End]
+
+  end  
+
+module SequenceIterator : SequenceIterator_intf with type t = sequence*int
+ref*int ref*int ref*int*int = 
+  struct
+    (* sequence, next element in sequence, current counter, max for the
+       counter, overal min and max for the mailbox *)
+    type t = sequence * int ref*int ref*int ref*int * int
+
+    let create seq min max = (seq,ref 0, ref 0, ref 0, min,max)
+
+    let single seq =
+      if Core.Std.List.length seq = 1 then
+        match (Core.Std.List.hd_exn seq) with
+        | SeqNumber sn ->
+          (
+          match sn with
+          | Number n -> true
+          | Wild -> false
+          )
+        | SeqRange _ -> false
+      else
+        false
+
+    let next t = 
+      let s,nc,c,cmax,min,max = t in
+      let get_n m = function
+        | Number n -> n
+        | Wild -> m
+      in
+      let update mi mx =
+        c := mi;
+        cmax := mx;
+        `Ok !c
+      in
+      c := !c + 1;
+      if !c > !cmax then (
+        let seq = Core.Std.List.nth s !nc in
+        match seq with
+        | None -> `End
+        | Some seq ->
+          (
+          nc := !nc + 1; (* ref to the next element in the sequence *)
+          match seq with
+          | SeqNumber sn ->
+            (match sn with
+            | Number n -> update n n
+            | Wild -> update min max
+            )
+          | SeqRange (sn1,sn2) ->
+              update (get_n min sn1) (get_n max sn2)
+          )
+      ) else
+        `Ok !c
+  end

iterator.mli

@@ -0,0 +1,17 @@
+open States
+
+module type SequenceIterator_intf = 
+  sig
+    type t
+
+    (* sequence -> max in seq *)
+    val create : sequence -> int -> int -> t
+
+    val single : sequence -> bool
+
+    val next : t -> [`Ok of int|`End]
+
+  end  
+
+module SequenceIterator : SequenceIterator_intf with 
+    type t = sequence * int ref*int ref*int ref*int * int

read_store.ml

@@ -58,12 +58,13 @@ let rec selected user mbox =
   | "message" -> prompt "position? " >>= fun pos -> 
     (
     let pos = int_of_string pos in
-    IrminMailbox.read_message mbox pos >>= function
+    IrminMailbox.read_message mbox (`Position pos) >>= function
     | `Ok (message,meta) ->
       Printf.printf "%s\n%!" (Sexp.to_string (sexp_of_mailbox_message_metadata meta));
       Printf.printf "%s\n%!" (Sexp.to_string (Mailbox.Message.sexp_of_t message));
       return ()
     | `NotFound -> Printf.printf "not found\n%!"; return ()
+    | `Eof -> Printf.printf "eof\n%!"; return ()
     ) >>= fun() -> selected user mbox
   | "list" -> 
     IrminMailbox.list_store mbox >>= fun l ->