Commits

Yaron Minsky committed 8615ebc

more cleanups

Comments (0)

Files changed (20)

 val encode_pubkey_string : string -> string
-val decode_pubkey : string -> Packet.packet list list
-val encode_pubkey : Packet.packet list -> string
+val decode_pubkey : string -> Packet.t list list
+val encode_pubkey : Packet.t list -> string
     common.cmo \
     parsePGP.cmo \
     poly_test.cmo \
+    recode.cmo \
+    settings.cmo \
+    request.cmo \
+    fixkey.cmo \
+    eventloop.cmo \
+    
 
 #    sks_do.native \
 #    sks.native \
 (* USA or see <http://www.gnu.org/licenses/>.                          *)
 (***********************************************************************)
 
-open StdLabels
-open MoreLabels
-open Printf
 open Common
-open Packet
-module Unix = UnixLabels
-open Unix
+open Core.Std
 
 
 (** Timeout code.
 
 exception SigAlarm
 let waiting_for_alarm = ref false
-let sigalarm_handler _ =
-  if !waiting_for_alarm
-  then raise SigAlarm
-  else ()
 
-let _ =
-  Sys.set_signal Sys.sigalrm (Sys.Signal_handle sigalarm_handler)
+let () =
+  Signal.Expert.handle Signal.alrm
+    (fun _ -> if !waiting_for_alarm then raise SigAlarm)
 
 type timed_event =
     Event of float * callback
-and timed_callback = { callback: unit -> timed_event list;
-                       timeout: int;
-                       name: string option;
-                     }
-and callback = | Callback of (unit -> timed_event list)
-               | TimedCallback of timed_callback
+
+and timed_callback =
+  { callback: unit -> timed_event list
+  ; timeout: int
+  ; name: string option
+  }
+and callback =
+  | Callback of (unit -> timed_event list)
+  | TimedCallback of timed_callback
 
 
 type timed_handler =
-    { h_callback: sockaddr -> in_channel -> out_channel -> timed_event list;
-      h_timeout: int;
-      h_name: string option;
+    { h_callback:
+        Unix.sockaddr -> in_channel -> out_channel -> timed_event list
+    ; h_timeout: int
+    ; h_name: string option
     }
 type handler =
-  | Handler of (sockaddr -> in_channel -> out_channel -> timed_event list)
+  | Handler of (Unix.sockaddr -> in_channel -> out_channel -> timed_event list)
   | TimedHandler of timed_handler
 
 
-let unwrap opt = match !opt with
-    None -> failwith "unwrap failure"
+let unwrap opt =
+  match !opt with
+  | None -> failwith "unwrap failure"
   | Some x -> x
 
 let make_tc ~name ~timeout ~cb =
   TimedCallback { callback = cb;
                   name = Some name;
-                  timeout = timeout;
+                  timeout;
                 }
 
 let make_th ~name ~timeout ~cb =
     let domain =
       Unix.domain_of_sockaddr addr in
     let sock =
-      socket ~domain ~kind:SOCK_STREAM ~protocol:0 in
-    setsockopt sock SO_REUSEADDR true;
-    bind sock ~addr;
-    listen sock ~max:20;
+      Unix.socket ~domain ~kind:Unix.SOCK_STREAM ~protocol:0 in
+    Unix.setsockopt sock Unix.SO_REUSEADDR true;
+    Unix.bind sock ~addr;
+    Unix.listen sock ~max:20;
     sock
   with
-    | Unix_error (_,"bind",_) ->
-        failwith "Failure while binding socket.  Probably another socket bound to this address"
-    | e -> raise e
+  | Unix.Unix_error (_,"bind",_) ->
+    failwith "Failure while binding socket.  \
+              Probably another socket bound to this address"
+  | e -> raise e
+
 let add_events heap evlist =
-  List.iter ~f:(fun (Event (time, callback)) ->
-                  Heap.push heap ~key:time ~data:callback)
-    evlist
+  List.iter evlist ~f:(fun (Event (time, callback)) ->
+    ignore (Heap.push heap (time,callback)))
 
 (***************************************************************)
 (*  Event Handlers  *******************************************)
 (***************************************************************)
 
 let handle_socket handler sock =
-  let (s,caller) = accept sock in
-  let inchan = in_channel_of_descr s in
-  let outchan = out_channel_of_descr s in
+  let (s,caller) = Unix.accept sock in
+  let inchan = Unix.in_channel_of_descr s in
+  let outchan = Unix.out_channel_of_descr s in
   protect ~f:(fun () -> handler caller inchan outchan)
     ~finally:(fun () -> Unix.close s)
 
   match handler with
       Handler handler ->
         Callback (fun () ->
-                    let (s,caller) = accept sock in
-                    let inchan = in_channel_of_descr s in
-                    let outchan = out_channel_of_descr s in
+                    let (s,caller) = Unix.accept sock in
+                    let inchan = Unix.in_channel_of_descr s in
+                    let outchan = Unix.out_channel_of_descr s in
                     protect ~f:(fun () -> handler caller inchan outchan)
                       ~finally:(fun () -> Unix.close s)
                  )
         TimedCallback
           { callback =
               (fun () ->
-                let (s,caller) = accept sock in
-                let inchan = in_channel_of_descr s
-                and outchan = out_channel_of_descr s in
+                let (s,caller) = Unix.accept sock in
+                let inchan = Unix.in_channel_of_descr s
+                and outchan = Unix.out_channel_of_descr s in
                 protect ~f:(fun () -> handler.h_callback
                               caller inchan outchan)
                   ~finally:(fun () -> Unix.close s)
 (*  Event Loop  ***********************************************)
 (***************************************************************)
 
-let some opt = match opt with
-    None -> false
-  | Some x -> true
-
-(***************************************************************)
-
 (** Does all events occuring at or before time [now], updating heap
   appropriately.  Returns the time left until the next undone event
   on the heap
 *)
 let rec do_current_events heap now =
-  match (try Some (Heap.top heap)
-         with Not_found -> None)
-  with
-    | Some (time,callback) ->
-        let timeout = time -. now in
-        if timeout <= 0.0 then (
-          ignore (Heap.pop heap);
-          add_events heap (do_callback callback);
-          do_current_events heap now;
-        ) else timeout
-    | None -> -1.0
+  match Heap.top heap with
+  | Some (time,callback) ->
+    let timeout = time -. now in
+    if timeout <= 0.0 then (
+      ignore (Heap.pop heap);
+      add_events heap (do_callback callback);
+      do_current_events heap now;
+    ) else timeout
+  | None -> -1.0
 
 (** function for adding to heap callbacks for handling
   incoming socket connections *)
 let add_socket_handlers heap now fdlist sockets =
   List.iter sockets
     ~f:(fun sock ->
-          try
-            let handler = List.assoc sock fdlist in
-            add_events heap
-              [ Event (now, handler_to_callback handler sock) ]
-          with
-              Not_found ->
-                plerror 0 "%s" ("BUG: eventloop -- socket without " ^
-                                "handler.  Event dropped")
-       )
+      match List.Assoc.find fdlist sock with
+      | None -> plerror 0 "%s" "BUG: eventloop -- socket without \
+                                handler.  Event dropped"
+      | Some handler ->
+        add_events heap
+          [ Event (now, handler_to_callback handler sock) ]
+    )
+
 (** Do all available events in FIFO order *)
 let do_next_event heap fdlist =
-  let now = gettimeofday () in
+  let now = Unix.gettimeofday () in
   let timeout = do_current_events heap now in
-  let (fds,_) = List.split fdlist in
-  let (rd,_,_) = select ~read:fds ~write:[] ~except:[] ~timeout in
-  add_socket_handlers heap now fdlist rd
+  let fds = List.map ~f:fst fdlist in
+  let {Unix.Select_fds. read; _ } =
+    Unix.select ()
+      ~read:fds ~write:[] ~except:[] ~timeout:(`After timeout)
+  in
+  add_socket_handlers heap now fdlist read
 
 (***************************************************************)
 (***************************************************************)
 
-let heap = Heap.empty (<) 20
+let heap =
+  Heap.create (fun (t1,_) (t2,_) -> Float.compare t1 t2)
 
 let evloop events socklist =
   add_events heap events;
             eprintf "Ctrl-C.  Exiting eventloop\n";
             flush Pervasives.stderr;
             raise Exit
-        | Unix_error (error,func_name,param) ->
+        | Unix.Unix_error (error,func_name,param) ->
             if error <> Unix.EINTR
               (* EINTR just means the alarm interrupted select *)
             then
 (* USA or see <http://www.gnu.org/licenses/>.                          *)
 (***********************************************************************)
 
-open Printf
-open StdLabels
-open MoreLabels
 open Common
-
-open Packet
-module Set = PSet.Set
+open Core.Std
 
 (* Compute PGP Key Fingerprint and PGP KeyIDs *)
 
               }
 
 let from_packet packet =
-  let cin = new Channel.string_in_channel packet.packet_body 0 in
+  let cin = new Channel.string_in_channel packet.Packet.packet_body 0 in
   let version = cin#read_byte in
   match version with
       2 | 3 ->
            and algorithm type (1 octet) *)
         let n = ParsePGP.read_mpi cin in (* modulus *)
         let e = ParsePGP.read_mpi cin in (* exponent *)
-        hash#add_substring n.mpi_data 0 ((n.mpi_bits + 7)/8);
-        hash#add_substring e.mpi_data 0 ((e.mpi_bits + 7)/8);
+        hash#add_substring n.Packet.mpi_data 0 ((n.Packet.mpi_bits + 7)/8);
+        hash#add_substring e.Packet.mpi_data 0 ((e.Packet.mpi_bits + 7)/8);
         let fingerprint = hash#result
         and keyid =
-          let len = String.length n.mpi_data in
-          String.sub n.mpi_data ~pos:(len - 8) ~len:8
+          let len = String.length n.Packet.mpi_data in
+          String.sub n.Packet.mpi_data ~pos:(len - 8) ~len:8
         in
         hash#wipe;
         { fp = fingerprint;
         (* This seems wrong.  The spec suggests that packet.packet_tag
            is what should be used here.  But this is what's done in the GPG
            codebase, so I'm copying it. *)
-        hash#add_byte ((packet.packet_length lsr 8) land 0xFF);
-        hash#add_byte (packet.packet_length land 0xFF);
-        hash#add_string packet.packet_body;
+        hash#add_byte ((packet.Packet.packet_length lsr 8) land 0xFF);
+        hash#add_byte (packet.Packet.packet_length land 0xFF);
+        hash#add_string packet.Packet.packet_body;
         let fingerprint = hash#result in
         let keyid =
           let len = String.length fingerprint in
         failwith "Fingerprint.from_packet: Unexpected version number"
 
 let rec from_key key = match key with
-    packet::key_tail ->
-      if  packet.packet_type = Public_Key_Packet
+  | packet :: key_tail ->
+      if  packet.Packet.packet_type = Packet.Public_Key_Packet
       then from_packet packet
       else from_key key_tail
   | [] ->
     then "0x" ^ s else s
   in
   let x = Int64.of_string s in
-  let x = Int64.to_int32 x in
+  let x = Int64.to_int32_exn x in
   let cout = Channel.new_buffer_outc 4 in
   cout#write_int32 x;
   cout#contents
 let keyid_of_string s =
   let x = Int64.of_string s in
   if is_32bit x then (
-    let x = Int64.to_int32 x in
+    let x = Int64.to_int32_exn x in
     let cout = Channel.new_buffer_outc 4 in
     cout#write_int32 x;
     cout#contents
 let key_and_subkey_results key =
   match key with
   | [] -> raise Not_found
-  | ({ packet_type = Public_Key_Packet} as lead_packet)::tl ->
+  | ({ Packet.packet_type = Packet.Public_Key_Packet; _ } as lead_packet)
+    :: tl
+    ->
     let rec loop packets = match packets with
       | [] -> []
-      | ({ packet_type = Public_Subkey_Packet} as pack)::tl ->
+      | ({ Packet.packet_type = Packet.Public_Subkey_Packet; _} as pack)
+        :: tl ->
         from_packet pack :: loop tl
-      | pack :: tl -> loop tl
+      | _ :: tl -> loop tl
     in
     (from_packet lead_packet, loop tl)
   | _ -> raise Not_found
   let key_id = get key_result in
   let subkey_ids =
     List.map ~f:get subkey_results
-    |! Set.of_list |! Set.remove key_id |! Set.elements
+    |> String.Set.of_list
+    |> (fun s -> Set.remove s key_id)
+    |> Set.elements
   in
   (key_id,subkey_ids)
 ;;
 (* USA or see <http://www.gnu.org/licenses/>.                          *)
 (***********************************************************************)
 
-open StdLabels
-open MoreLabels
 open Common
-open Packet
-
-module Map = PMap.Map
+open Core.Std
 
 exception Bad_key
 exception Standalone_revocation_certificate
 
 let get_keypacket pkey = pkey.KeyMerge.key
 
-let ( |= ) map key = Map.find key map
-let ( |< ) map (key,data) = Map.add ~key ~data map
-
-let rec join_by_keypacket map keylist = match keylist with
+let rec join_by_keypacket map keylist =
+  match keylist with
   | [] -> map
   | key::tl ->
-      let keypacket = get_keypacket key in
-      let map =
-        try
-          let keylist_ref = map |= keypacket in
-          keylist_ref := key::!keylist_ref;
-          map
-        with
-            Not_found ->
-              map |< (keypacket,ref [key])
-      in
-      join_by_keypacket map tl
+    let keypacket = get_keypacket key in
+    let map =
+      match Map.find map keypacket with
+      | None -> Map.add map ~key:keypacket ~data:(ref [key])
+      | Some keylist_ref ->
+        keylist_ref := key::!keylist_ref;
+        map
+    in
+    join_by_keypacket map tl
 
 (** Given a list of parsed keys, returns a list of parsed key lists,
   grouped by keypacket *)
 let join_by_keypacket keys =
-  Map.fold ~f:(fun ~key ~data list -> !data::list) ~init:[]
-    (join_by_keypacket Map.empty keys)
+  Map.fold ~f:(fun ~key:_ ~data list -> !data::list) ~init:[]
+    (join_by_keypacket Packet.Map.empty keys)
 
 
 (** merges a list of pkeys, throwing a failure if the merge cannot procede *)
               None::list
          )
   in
-  strip_opt replacements
+  List.filter_opt replacements
 
 
 (**********************************************************************)
   be discarded
 *)
 let is_revocation_signature pack =
-   match pack.packet_type with
-    | Signature_Packet ->
-      let parsed_signature = ParsePGP.parse_signature pack in
-      let sigtype = match parsed_signature with
-       | V3sig s -> s.v3s_sigtype
-       | V4sig s -> s.v4s_sigtype
-     in
-     let result =  match (int_to_sigtype sigtype) with
-           | Key_revocation_signature | Subkey_revocation_signature
-             | Certification_revocation_signature -> true
-           | _ -> false
-     in
-     result
-    | _ -> false
+  match pack.Packet.packet_type with
+  | Packet.Signature_Packet ->
+    let parsed_signature = ParsePGP.parse_signature pack in
+    let sigtype = match parsed_signature with
+      | Packet.V3sig s -> s.Packet.v3s_sigtype
+      | Packet.V4sig s -> s.Packet.v4s_sigtype
+    in
+    let result =  match (Packet.int_to_sigtype sigtype) with
+      | Packet.Key_revocation_signature
+      | Packet.Subkey_revocation_signature
+      | Packet.Certification_revocation_signature -> true
+      | _ -> false
+    in
+    result
+  | _ -> false
 
 let canonicalize key =
-  if is_revocation_signature (List.hd key)
-    then raise Standalone_revocation_certificate;
+  if is_revocation_signature (List.hd_exn key)
+  then raise Standalone_revocation_certificate;
   try KeyMerge.dedup_key key
   with KeyMerge.Unparseable_packet_sequence -> raise Bad_key
 
 
 let good_key pack =
   try ignore (ParsePGP.parse_pubkey_info pack); true
-  with e -> false
+  with _ -> false
 
 let good_signature pack =
   try ignore (ParsePGP.parse_signature pack); true
-  with e -> false
+  with _ -> false
 
 let drop_bad_sigs packlist =
   List.filter ~f:good_signature packlist
 exception Bad_key
 exception Standalone_revocation_certificate
 val filters : string list
-val get_keypacket : KeyMerge.pkey -> Packet.packet
-val ( |= ) : ('a, 'b) PMap.Map.t -> 'a -> 'b
-val ( |< ) : ('a, 'b) PMap.Map.t -> 'a * 'b -> ('a, 'b) PMap.Map.t
+val get_keypacket : KeyMerge.pkey -> Packet.t
 val join_by_keypacket : KeyMerge.pkey list -> KeyMerge.pkey list list
 val merge_pkeys : KeyMerge.pkey list -> KeyMerge.pkey
 val compute_merge_replacements :
-  Packet.packet list list ->
-  (Packet.packet list list * Packet.packet list) list
-val canonicalize : Packet.packet list -> Packet.packet list
-val good_key : Packet.packet -> bool
-val good_signature : Packet.packet -> bool
-val drop_bad_sigs : Packet.packet list -> Packet.packet list
+  Packet.t list list ->
+  (Packet.t list list * Packet.t list) list
+val canonicalize : Packet.t list -> Packet.t list
+val good_key : Packet.t -> bool
+val good_signature : Packet.t -> bool
+val drop_bad_sigs : Packet.t list -> Packet.t list
 val sig_filter_sigpair :
-  'a * Packet.packet list -> ('a * Packet.packet list) option
-val presentation_filter : Packet.packet list -> Packet.packet list option
+  'a * Packet.t list -> ('a * Packet.t list) option
+val presentation_filter : Packet.t list -> Packet.t list option

heap.ml

-(***********************************************************************)
-(* heap.ml - Simple heap implementation, adapted from CLR              *)
-(*                                                                     *)
-(* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *)
-(*               2011, 2012, 2013  Yaron Minsky and Contributors       *)
-(*                                                                     *)
-(* This file is part of SKS.  SKS is free software; you can            *)
-(* redistribute it and/or modify it under the terms of the GNU General *)
-(* Public License as published by the Free Software Foundation; either *)
-(* version 2 of the License, or (at your option) any later version.    *)
-(*                                                                     *)
-(* This program is distributed in the hope that it will be useful, but *)
-(* WITHOUT ANY WARRANTY; without even the implied warranty of          *)
-(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU   *)
-(* General Public License for more details.                            *)
-(*                                                                     *)
-(* You should have received a copy of the GNU General Public License   *)
-(* along with this program; if not, write to the Free Software         *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *)
-(* USA or see <http://www.gnu.org/licenses/>.                          *)
-(***********************************************************************)
-
-open StdLabels
-open MoreLabels
-
-(* Adapted from CLR *)
-
-type ('key,'data) heap_el = { key: 'key;
-                              data: 'data;
-                            }
-
-type ('key,'data) heap = { mutable a: ('key,'data) heap_el option array;
-                           mutable length: int;
-                           minsize: int;
-                           cmp: 'key -> 'key -> bool;
-                         }
-
-let length heap = heap.length
-let true_length heap = Array.length heap.a
-
-(***************************************************************)
-
-let parent i = (i-1)/2
-let left i = 2 * i + 1
-let right i = 2 * i + 2
-let get heap i = match heap.a.(i) with
-    None -> raise (Failure "Heap.get: Attempt to examine None")
-  | Some el -> el
-
-let exchange heap i j =
-  let temp = heap.a.(i) in
-    heap.a.(i) <- heap.a.(j);
-    heap.a.(j) <- temp
-
-(***************************************************************)
-
-let resize heap =
-  if heap.length > Array.length heap.a
-  then heap.a <-
-    Array.init ((Array.length heap.a) * 2)
-    ~f:(fun i ->
-          if i < (Array.length heap.a)
-          then heap.a.(i)
-          else None)
-
-  else
-    if heap.length <= (Array.length heap.a)/3
-      && (Array.length heap.a)/2 >= heap.minsize
-    then heap.a <-
-      Array.init ((Array.length heap.a)/ 2) ~f:(fun i -> heap.a.(i))
-
-
-(***************************************************************)
-
-let rec heapify heap i =
-  let left = left i in
-  let right = right i in
-  let largest =
-    if left < heap.length &&
-      heap.cmp (get heap left).key (get heap i).key
-    then left else i in
-  let largest =
-    if right < heap.length &&
-      heap.cmp (get heap right).key (get heap largest).key
-    then right
-    else largest
-  in
-    if i <> largest then
-      begin
-        exchange heap i largest;
-        heapify heap largest
-      end
-
-(***************************************************************)
-
-let build_heap_from_array cmp array length =
-  let heap = { a = array;
-               length = length;
-               minsize = length;
-               cmp = cmp
-             }
-  in
-  let rec loop i =
-    heapify heap i;
-    loop (i-1)
-  in
-    loop (parent length)
-
-(***************************************************************)
-
-let top heap = match heap.length with
-    0 -> raise Not_found
-  | _ -> let max = get heap 0 in
-      (max.key, max.data)
-
-
-(***************************************************************)
-
-let rec pop heap = match heap.length with
-    0 -> raise Not_found;
-  | _ -> let max = (get heap 0) in
-      heap.a.(0) <- heap.a.(heap.length - 1);
-      heap.length <- (heap.length - 1);
-      heapify heap 0;
-      resize heap;
-      (max.key, max.data)
-
-
-(***************************************************************)
-
-let push heap ~key ~data =
-  heap.length <- (heap.length + 1);
-  resize heap;
-  let rec loop i =
-    if i > 0 && heap.cmp key (get heap (parent i)).key then
-      begin
-        heap.a.(i) <- heap.a.(parent i);
-        loop (parent i)
-      end
-    else i
-  in
-  let i = loop (heap.length - 1) in
-    heap.a.(i) <- Some { key = key; data = data; }
-
-
-(***************************************************************)
-
-let empty cmp i =
-  { a = Array.create i None;
-    length = 0;
-    minsize = i;
-    cmp = cmp;
-  }
-

heap.mli

-(***********************************************************************)
-(* heap.mli - Simple heap implementation, adapted from CLR             *)
-(*                                                                     *)
-(* Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, *)
-(*               2011, 2012, 2013  Yaron Minsky and Contributors       *)
-(*                                                                     *)
-(* This file is part of SKS.  SKS is free software; you can            *)
-(* redistribute it and/or modify it under the terms of the GNU General *)
-(* Public License as published by the Free Software Foundation; either *)
-(* version 2 of the License, or (at your option) any later version.    *)
-(*                                                                     *)
-(* This program is distributed in the hope that it will be useful, but *)
-(* WITHOUT ANY WARRANTY; without even the implied warranty of          *)
-(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU   *)
-(* General Public License for more details.                            *)
-(*                                                                     *)
-(* You should have received a copy of the GNU General Public License   *)
-(* along with this program; if not, write to the Free Software         *)
-(* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *)
-(* USA or see <http://www.gnu.org/licenses/>.                          *)
-(***********************************************************************)
-
-type ('key,'data) heap
-val length : ('key,'data) heap -> int
-val top : ('key,'data) heap -> 'key * 'data
-val pop : ('key,'data) heap -> 'key * 'data
-val push : ('key,'data) heap -> key:'key -> data:'data -> unit
-val empty : ('key -> 'key -> bool) -> int -> ('key,'data) heap
 exception Bug of string
 val pos_next_rec :
-  ('a * Packet.packet) SStream.sstream ->
-  Packet.packet list -> Packet.packet list option
+  ('a * Packet.t) SStream.sstream ->
+  Packet.t list -> Packet.t list option
 val pos_next :
-  ('a * Packet.packet) SStream.sstream -> ('a * Packet.packet list) option
-val pos_get : ('a * Packet.packet) SStream.sstream -> 'a * Packet.packet list
+  ('a * Packet.t) SStream.sstream -> ('a * Packet.t list) option
+val pos_get : ('a * Packet.t) SStream.sstream -> 'a * Packet.t list
 val pos_next_of_channel :
   < inchan : in_channel; read_byte : int; read_string : int -> string; .. > ->
-  unit -> (int64 * Packet.packet list) option
+  unit -> (int64 * Packet.t list) option
 val pos_get_of_channel :
   < inchan : in_channel; read_byte : int; read_string : int -> string; .. > ->
-  unit -> int64 * Packet.packet list
+  unit -> int64 * Packet.t list
 val next_rec :
-  Packet.packet SStream.sstream ->
-  Packet.packet list -> Packet.packet list option
-val next : Packet.packet SStream.sstream -> Packet.packet list option
-val get : Packet.packet SStream.sstream -> Packet.packet list
+  Packet.t SStream.sstream ->
+  Packet.t list -> Packet.t list option
+val next : Packet.t SStream.sstream -> Packet.t list option
+val get : Packet.t SStream.sstream -> Packet.t list
 val next_of_channel :
   < read_byte : int; read_string : int -> string; .. > ->
-  unit -> Packet.packet list option
+  unit -> Packet.t list option
 val get_of_channel :
   < read_byte : int; read_string : int -> string; .. > ->
-  unit -> Packet.packet list
-val get_ids : Packet.packet list -> string list
+  unit -> Packet.t list
+val get_ids : Packet.t list -> string list
 val write :
-  Packet.packet list ->
+  Packet.t list ->
   < write_byte : int -> 'a; write_int : int -> 'b;
     write_string : string -> unit; .. > ->
   unit
-val to_string : Packet.packet list -> string
-val of_string : string -> Packet.packet list
-val of_string_multiple : string -> Packet.packet list list
-val to_string_multiple : Packet.packet list list -> string
-val to_words : Packet.packet list -> string list
+val to_string : Packet.t list -> string
+val of_string : string -> Packet.t list
+val of_string_multiple : string -> Packet.t list list
+val to_string_multiple : Packet.t list list -> string
+val to_words : Packet.t list -> string list
 (* USA or see <http://www.gnu.org/licenses/>.                          *)
 (***********************************************************************)
 
-open StdLabels
-open MoreLabels
-
-open Packet
-open Printf
+open Core.Std
 
 let hash_bytes = 16
 
 val hash_bytes : int
-val hash : Packet.packet list -> Digest.t
+val hash : Packet.t list -> Digest.t
 val hexify : string -> string
 val dehexify : string -> string
 (* USA or see <http://www.gnu.org/licenses/>.                          *)
 (***********************************************************************)
 
-open StdLabels
-open MoreLabels
-open Printf
 open Common
-open Packet
-
-module Set = PSet.Set
-module Map = PMap.Map
+open Core.Std
 
 exception Unparseable_packet_sequence
 
 (*******************************************************************)
 (* Types for representing the structure of a key *)
 
-type sigpair = packet * packet list
+type sigpair = Packet.t * Packet.t list
 
-type pkey = { key : packet;
-              selfsigs: packet list; (* revocations only in v3 keys *)
+type pkey = { key : Packet.t;
+              selfsigs: Packet.t list; (* revocations only in v3 keys *)
               uids: sigpair list;
               subkeys: sigpair list;
             }
 (*******************************************************************)
 
 let get_version packet =
-  match packet.packet_type with
-      Public_Key_Packet -> int_of_char packet.packet_body.[0]
-    | Signature_Packet -> int_of_char packet.packet_body.[0]
-    | _ -> raise Not_found
+  match packet.Packet.packet_type with
+  | Packet.Public_Key_Packet -> int_of_char packet.Packet.packet_body.[0]
+  | Packet.Signature_Packet -> int_of_char packet.Packet.packet_body.[0]
+  | _ -> raise Not_found
 
 let key_to_stream key =
-  let ptype_list = List.map ~f:(fun pack -> (pack.packet_type,pack)) key in
+  let ptype_list = List.map ~f:(fun pack -> (pack.Packet.packet_type,pack)) key in
   Stream.of_list ptype_list
 
-
-
-
 (*******************************************************************)
 (*** Key Parsing ***************************************************)
 (*******************************************************************)
 
-let rec parse_keystr = parser
-  | [< '(Public_Key_Packet,p) ; s >] ->
-      match get_version p with
-        | 4 ->
-            (match s with parser [< selfsigs = siglist;
-                                    uids = uidlist;
-                                    subkeys = subkeylist;
-                                 >]
-                 -> { key = p;
-                      selfsigs = selfsigs;
-                      uids = uids;
-                      subkeys = subkeys;
-                    })
-        | 2 | 3 ->
-            (match s with parser [< revocations = siglist;
-                                    uids = uidlist;
-                                 >] ->
-               { key = p ;
-                 selfsigs = revocations;
-                 uids = uids;
-                 subkeys = [];
-               })
-        | _ -> failwith "Unexpected key packet version number"
-and siglist = parser
-  | [< '(Signature_Packet,p); tl = siglist >] -> p::tl
-  | [< >] -> []
-and uidlist = parser
-  | [< '(User_ID_Packet,p); sigs = siglist; tl = uidlist >] ->
-      (p,sigs)::tl
-  | [< '(User_Attribute_Packet,p); sigs = siglist; tl = uidlist >] ->
-      (p,sigs)::tl
-      (*
-      (p,sigs)::(match s with parser
-                    | [< '(User_ID_Packet,p); sigs = siglist; tl = uidlist >] ->
-                       (p,sigs)::tl
-                   | [< >] -> [])
-      *)
-  | [< >] -> []
-and subkeylist = parser
-  | [< '(Public_Subkey_Packet,p); sigs = siglist; tl = subkeylist >] ->
-      (p,sigs)::tl
-  | [< >] -> []
+let rec parse_keystr =
+  parser
+| [< '(Packet.Public_Key_Packet,p) ; s >] ->
+  match get_version p with
+  | 4 ->
+    (match s with
+       parser [< selfsigs = siglist;
+                 uids = uidlist;
+                 subkeys = subkeylist;
+              >]
+       ->
+       { key = p;
+         selfsigs = selfsigs;
+         uids = uids;
+         subkeys = subkeys;
+       })
+  | 2 | 3 ->
+    (match s with
+       parser [< revocations = siglist;
+                 uids = uidlist;
+              >]
+       ->
+       { key = p ;
+        selfsigs = revocations;
+        uids = uids;
+        subkeys = [];
+      })
+  | _ -> failwith "Unexpected key packet version number"
+and siglist =
+  parser
+| [< '(Packet.Signature_Packet,p); tl = siglist >] -> p::tl
+| [< >] -> []
+and uidlist =
+  parser
+| [< '(Packet.User_ID_Packet,p); sigs = siglist; tl = uidlist >] ->
+  (p,sigs)::tl
+| [< '(Packet.User_Attribute_Packet,p); sigs = siglist; tl = uidlist >] ->
+  (p,sigs)::tl
+| [< >] -> []
+and subkeylist =
+  parser
+| [< '(Packet.Public_Subkey_Packet,p); sigs = siglist; tl = subkeylist >] ->
+  (p,sigs)::tl
+| [< >] -> []
 
 (*******************************************************************)
 (*** Key Merging Code  *********************************************)
 (*******************************************************************)
 
-let set_of_list list = List.fold_left ~init:Set.empty list
-                         ~f:(fun set x -> Set.add x set)
-
 let merge_sigpairs pairs =
-  let map =
-    List.fold_left pairs
-      ~f:(fun map (pack,sigs) ->
-            try
-              let old_sigs = Map.find pack map in
-              (* If front packet is already there, add in new sigs,
-                 discarding duplicates *)
-              Map.add ~key:pack ~data:(Utils.dedup (old_sigs @ sigs)) map
-            with
-                (* otherwise, add in data by itself *)
-                Not_found -> Map.add ~key:pack ~data:sigs map)
-      ~init:Map.empty
-  in
-  Map.fold ~f:(fun ~key:pack ~data:sigs list -> (pack,sigs)::list) map ~init:[]
+  List.fold pairs ~init:Packet.Map.empty ~f:(fun map (pack,sigs) ->
+      match Map.find map pack with
+      | None -> Map.add ~key:pack ~data:sigs map
+      | Some old_sigs ->
+        (* If front packet is already there, add in new sigs,
+           discarding duplicates *)
+        Map.add ~key:pack ~data:(Utils.dedup (old_sigs @ sigs)) map
+    )
+  |> Map.fold ~f:(fun ~key:pack ~data:sigs list -> (pack,sigs)::list) ~init:[]
 
 let merge_sigpair_lists l1 l2 =
   merge_sigpairs (l1 @ l2)
     let pkey1 = key_to_pkey key1
     and pkey2 = key_to_pkey key2 in
     let mkey = merge_pkeys pkey1 pkey2 in
-    apply_opt ~f:flatten mkey
+    Option.map ~f:flatten mkey
   with
-      Unparseable_packet_sequence -> None
+    Unparseable_packet_sequence -> None
 
 let dedup_sigpairs pairs =
   let map =
-    List.fold_left pairs ~init:Map.empty
-      ~f:(fun map (pack,sigs) ->
-            try
-              let old_sigs = Map.find pack map in
-              Map.add ~key:pack ~data:(Utils.dedup (sigs @ old_sigs)) map
-            with
-                Not_found -> Map.add ~key:pack ~data:sigs map
-         )
+    List.fold_left pairs ~init:Packet.Map.empty ~f:(fun map (pack,sigs) ->
+      Map.change map pack (function
+        | None -> Some sigs
+        | Some old_sigs -> Some (List.dedup (sigs @ old_sigs)))
+    )
   in
   Map.to_alist map
 
 (* USA or see <http://www.gnu.org/licenses/>.                          *)
 (***********************************************************************)
 
-open StdLabels
-open MoreLabels
-open Printf
 open Common
-module Set = PSet.Set
+open Core.Std
 
 (** Invariants to check:
 
 *)
 
 open Bdb
-open Packet
 
 type dbsettings = { withtxn: bool;
                     cache_bytes: int option;
              | Public_Subkey_Packet
              | Private_or_Experimental_ptype
              | Unexpected_ptype
+with sexp, compare
 
-type packet = { content_tag: int;
-                packet_type: ptype;
-                packet_length: int;
-                packet_body: string;
-              }
+module T = struct
+  type t = { content_tag: int;
+             packet_type: ptype;
+             packet_length: int;
+             packet_body: string;
+           }
+  with sexp, compare
+end
+include T
+include Comparable.Make(T)
 
 type sigsubpacket =
     { ssp_length: int;
       ssp_type: int;
       ssp_body: string;
     }
+with sexp, compare
 
 let ssp_type_to_string i = match i with
   | 2 -> "signature creation time"
 type mpi = { mpi_bits: int;
              mpi_data: string;
            }
+with sexp, compare
 
 let pubkey_algorithm_string i =  match i with
   | 1 -> "RSA (Encrypt or Sign)"
       pk_alg: int;
       pk_keylen: int;
     }
-
+with sexp, compare
 
 
 type sigtype = | Signature_of_a_binary_document
                | Certification_revocation_signature
                | Timestamp_signature
                | Unexpected_sigtype
+with sexp, compare
 
 type v3sig =
     { v3s_sigtype: int;
       v3s_hash_value: string;
       v3s_mpis: mpi list;
     }
+with sexp, compare
 
 type v4sig =
     { v4s_sigtype: int;
       v4s_hash_value: string;
       v4s_mpis: mpi list;
     }
+with sexp, compare
 
-type signature = V3sig of v3sig | V4sig of v4sig
+type signature =
+    V3sig of v3sig | V4sig of v4sig
+with sexp, compare
 
 let int_to_sigtype byte =
   match byte with
+open Core.Std
+
 type ptype =
-    Reserved
+  | Reserved
   | Public_Key_Encrypted_Session_Key_Packet
   | Signature_Packet
   | Symmetric_Key_Encrypted_Session_Key_Packet
   | Public_Subkey_Packet
   | Private_or_Experimental_ptype
   | Unexpected_ptype
-type packet = {
+
+type t = {
   content_tag : int;
   packet_type : ptype;
   packet_length : int;
   packet_body : string;
 }
+include Comparable with type t := t
+
 type sigsubpacket = { ssp_length : int; ssp_type : int; ssp_body : string; }
+
 val ssp_type_to_string : int -> string
-type key = packet list
+
+type key = t list
 val sigtype_to_string : int -> string
 val content_tag_to_ptype : int -> ptype
 val ptype_to_string : ptype -> string
+
 type mpi = { mpi_bits : int; mpi_data : string; }
 val pubkey_algorithm_string : int -> string
+
 type pubkeyinfo = {
   pk_version : int;
   pk_ctime : int64;
   pk_keylen : int;
 }
 type sigtype =
-    Signature_of_a_binary_document
+  | Signature_of_a_binary_document
   | Signature_of_a_canonical_text_document
   | Standalone_signature
   | Generic_certification_of_a_User_ID_and_Public_Key_packet
   | Certification_revocation_signature
   | Timestamp_signature
   | Unexpected_sigtype
+
 type v3sig = {
   v3s_sigtype : int;
   v3s_ctime : int64;
   v3s_hash_value : string;
   v3s_mpis : mpi list;
 }
+
 type v4sig = {
   v4s_sigtype : int;
   v4s_pk_alg : int;
   v4s_hash_value : string;
   v4s_mpis : mpi list;
 }
+
 type signature = V3sig of v3sig | V4sig of v4sig
+
 val int_to_sigtype : int -> sigtype
 val content_tag_to_string : int -> string
-val print_packet : packet -> unit
-val write_packet_new :
-  packet ->
-  < write_byte : int -> 'a; write_int : int -> 'b;
-    write_string : string -> 'c; .. > ->
-  'c
+val print_packet : t -> unit
+
+val write_packet_new
+  :  t
+  -> < write_byte : int -> 'a; write_int : int -> 'b;
+       write_string : string -> 'c; .. >
+  -> 'c
 val pk_alg_to_ident : int -> string
-val write_packet_old :
-  packet ->
-  < write_byte : int -> 'a; write_int : int -> 'b;
-    write_string : string -> 'c; .. > ->
-  'c
-val write_packet :
-  packet ->
-  < write_byte : int -> 'a; write_int : int -> 'b;
-    write_string : string -> 'c; .. > ->
-  'c
+val write_packet_old
+  :  t
+  -> < write_byte : int -> 'a; write_int : int -> 'b;
+       write_string : string -> 'c; .. >
+  -> 'c
+val write_packet
+  :  t
+  -> < write_byte : int -> 'a; write_int : int -> 'b;
+       write_string : string -> 'c; .. >
+  -> 'c
 
 open Common
 open Core.Std
-open Packet
 
 exception Overlong_mpi
 exception Partial_body_length of int
                let length_str = cin#read_string length_length in
                let length = Utils.int_from_bstring length_str
                               ~pos:0 ~len:length_length in
-               { content_tag = content_tag;
-                 packet_type = content_tag_to_ptype content_tag;
+               { Packet.
+                 content_tag;
+                 packet_type = Packet.content_tag_to_ptype content_tag;
                  packet_length = length;
                  packet_body = cin#read_string length;
                }
         let content_tag = packet_tag land 0b111111 in
         let length = parse_new_packet_length cin in
         { (* packet_tag = packet_tag; *)
-          content_tag = content_tag;
-          packet_type = content_tag_to_ptype content_tag;
+          Packet.
+          content_tag;
+          packet_type = Packet.content_tag_to_ptype content_tag;
           packet_length = length;
           packet_body = cin#read_string length;
         }
     let data = cin#read_string
                  ((length + 7)/8)
     in
-    { mpi_bits = length; mpi_data = data }
+    { Packet. mpi_bits = length; mpi_data = data }
   with
       End_of_file -> raise Overlong_mpi
 
    psize
 
 let parse_pubkey_info packet =
-  let cin = new Channel.string_in_channel packet.packet_body 0 in
+  let cin = new Channel.string_in_channel packet.Packet.packet_body 0 in
   let version = cin#read_byte in
   let creation_time = cin#read_int64_size 4 in
   let (algorithm,mpi,expiration, psize) =
       let algorithm = cin#read_byte in
       let (tmpmpi, tmpsize) =  match algorithm with
         | 18 -> parse_ecdh_pubkey cin
-        | 19 -> ( {mpi_bits = 0; mpi_data = ""}, (parse_ecdsa_pubkey cin))
-        | _ -> ( {mpi_bits = 0; mpi_data = ""} , -1 )
+        | 19 -> ( { Packet. mpi_bits = 0; mpi_data = ""}, (parse_ecdsa_pubkey cin))
+        | _ -> ( {Packet.mpi_bits = 0; mpi_data = ""} , -1 )
       in
       let mpis = match algorithm with
        | 18 -> tmpmpi
       (algorithm,mpi,Some expiration, -1)
       | _ -> failwith (sprintf "Unexpected pubkey version: %d" version)
   in
-  { pk_version = version;
+  { Packet.
+    pk_version = version;
     pk_ctime = creation_time;
     pk_expiration = (match expiration with Some 0 -> None | x -> x);
     pk_alg = algorithm;
-    pk_keylen = (match algorithm with |18|19 -> psize | _ -> mpi.mpi_bits);
+    pk_keylen = (match algorithm with |18|19 -> psize | _ -> mpi.Packet.mpi_bits);
   }
 
 (********************************************************)
   let length = parse_sigsubpacket_length cin in
   let ssp_type = cin#read_byte land 0x7f in
   let body = cin#read_string (length - 1) in
-  { ssp_length = length - 1;
+  { Packet.
+    ssp_length = length - 1;
     ssp_type = ssp_type;
     ssp_body = body;
   }
   loop []
 
 let parse_signature packet =
-  let cin = new Channel.string_in_channel packet.packet_body 0 in
+  let cin = new Channel.string_in_channel packet.Packet.packet_body 0 in
   let version = cin#read_byte in
   match version with
 
         let hash_alg = cin#read_byte in
         let hash_value = cin#read_string 2 in
         let mpis = read_mpis cin in
-        V3sig { v3s_sigtype = sigtype;
-                v3s_ctime = ctime;
-                v3s_keyid = keyid;
-                v3s_pk_alg = pk_alg;
-                v3s_hash_alg = hash_alg;
-                v3s_hash_value = hash_value;
-                v3s_mpis = mpis;
-              }
+        Packet.V3sig
+          { Packet.
+            v3s_sigtype = sigtype;
+            v3s_ctime = ctime;
+            v3s_keyid = keyid;
+            v3s_pk_alg = pk_alg;
+            v3s_hash_alg = hash_alg;
+            v3s_hash_value = hash_value;
+            v3s_mpis = mpis;
+          }
 
     | 4 ->
         let sigtype = cin#read_byte in
 
         let hash_value = cin#read_string 2 in
         let mpis = read_mpis cin in
-        V4sig { v4s_sigtype = sigtype;
-                v4s_pk_alg = pk_alg;
-                v4s_hashed_subpackets = hashed_subpackets;
-                v4s_unhashed_subpackets = unhashed_subpackets;
-                v4s_hash_value = hash_value;
-                v4s_mpis = mpis;
-              }
-
+        Packet.V4sig
+          { Packet.
+            v4s_sigtype = sigtype;
+            v4s_pk_alg = pk_alg;
+            v4s_hashed_subpackets = hashed_subpackets;
+            v4s_unhashed_subpackets = unhashed_subpackets;
+            v4s_hash_value = hash_value;
+            v4s_mpis = mpis;
+          }
 
     | _ -> failwith (sprintf "Unexpected signature version: %d" version)
 
   cin#read_int64_size (String.length s)
 
 let get_key_exptimes sign = match sign with
-  | V3sig sign ->
-      (Some sign.v3s_ctime, None)
-  | V4sig sign ->
-      let hashed_subpackets = sign.v4s_hashed_subpackets in
-      let (ctime,exptime_delta) =
-        List.fold_left hashed_subpackets ~init:(None,None)
-          ~f:(fun (ctime,exptime) ssp ->
-                if ssp.ssp_type = ssp_ctime_id && ssp.ssp_length = 4 then
-                  (Some (int64_of_string ssp.ssp_body),exptime)
-                else if ssp.ssp_type = ssp_keyexptime_id && ssp.ssp_length = 4 then
-                  (ctime,Some (int64_of_string ssp.ssp_body))
-                else
-                  (ctime,exptime)
-             )
-      in
-      match exptime_delta with
-        | None -> (None,None)
-        | Some _ -> (ctime,exptime_delta)
+  | Packet.V3sig sign ->
+    (Some sign.Packet.v3s_ctime, None)
+  | Packet.V4sig sign ->
+    let hashed_subpackets = sign.Packet.v4s_hashed_subpackets in
+    let (ctime,exptime_delta) =
+      List.fold_left hashed_subpackets ~init:(None,None)
+        ~f:(fun (ctime,exptime) ssp ->
+          if ssp.Packet.ssp_type = ssp_ctime_id
+          && ssp.Packet.ssp_length = 4
+          then (Some (int64_of_string ssp.Packet.ssp_body),exptime)
+          else if ssp.Packet.ssp_type = ssp_keyexptime_id
+               && ssp.Packet.ssp_length = 4
+          then (ctime,Some (int64_of_string ssp.Packet.ssp_body))
+          else (ctime,exptime)
+        )
+    in
+    match exptime_delta with
+    | None -> (None,None)
+    | Some _ -> (ctime,exptime_delta)
 
 
 let get_times sign = match sign with
-  | V3sig sign ->
-      (Some sign.v3s_ctime, None)
-  | V4sig sign ->
-      let hashed_subpackets = sign.v4s_hashed_subpackets in
-      let (ctime,exptime_delta) =
-        List.fold_left hashed_subpackets ~init:(None,None)
-          ~f:(fun (ctime,exptime) ssp ->
-                if ssp.ssp_type = ssp_ctime_id && ssp.ssp_length = 4 then
-                  (Some (int64_of_string ssp.ssp_body),exptime)
-                else if ssp.ssp_type = ssp_exptime_id && ssp.ssp_length = 4 then
-                  (ctime,Some (int64_of_string ssp.ssp_body))
-                else
-                  (ctime,exptime)
-             )
-      in
-      match (ctime,exptime_delta) with
-        | (Some x,None) -> (Some x,None)
-        | (None,_) -> (None,None)
-        | (Some x,Some y) -> (Some x,Some (Int64.(x + y)))
+  | Packet.V3sig sign ->
+    (Some sign.Packet.v3s_ctime, None)
+  | Packet.V4sig sign ->
+    let hashed_subpackets = sign.Packet.v4s_hashed_subpackets in
+    let (ctime,exptime_delta) =
+      List.fold_left hashed_subpackets ~init:(None,None)
+        ~f:(fun (ctime,exptime) ssp ->
+          if ssp.Packet.ssp_type = ssp_ctime_id
+          && ssp.Packet.ssp_length = 4
+          then (Some (int64_of_string ssp.Packet.ssp_body),exptime)
+          else if ssp.Packet.ssp_type = ssp_exptime_id
+               && ssp.Packet.ssp_length = 4
+          then (ctime,Some (int64_of_string ssp.Packet.ssp_body))
+          else (ctime,exptime)
+        )
+    in
+    match (ctime,exptime_delta) with
+    | (Some x,None) -> (Some x,None)
+    | (None,_) -> (None,None)
+    | (Some x,Some y) -> (Some x,Some (Int64.(x + y)))
 exception Overlong_mpi
 exception Partial_body_length of int
-val parse_new_packet_length : < read_byte : int; .. > -> int
-val read_packet :
-  < read_byte : int; read_string : int -> string; .. > -> Packet.packet
+val parse_new_packet_length
+  :  < read_byte : int; .. >
+  -> int
+val read_packet
+  :  < read_byte : int; read_string : int -> string; .. >
+  -> Packet.t
 val offset_read_packet :
   < inchan : in_channel; read_byte : int; read_string : int -> string; .. > ->
-  int64 * Packet.packet
+  int64 * Packet.t
 val offset_length_read_packet :
   < inchan : in_channel; read_byte : int; read_string : int -> string; .. > ->
-  Packet.packet * int * int
+  Packet.t * int * int
 val read_mpi :
   < read_byte : int; read_string : int -> string; .. > -> Packet.mpi
 val read_mpis :
   < read_byte : int; read_string : int -> string; .. > -> Packet.mpi list
-val parse_pubkey_info : Packet.packet -> Packet.pubkeyinfo
+val parse_pubkey_info : Packet.t -> Packet.pubkeyinfo
 val parse_sigsubpacket_length : < read_byte : int; .. > -> int
 val read_sigsubpacket :
   < read_byte : int; read_string : int -> string; .. > -> Packet.sigsubpacket
   'b
 val read_subpackets :
   < read_string : 'a -> string; .. > -> 'a -> Packet.sigsubpacket list
-val parse_signature : Packet.packet -> Packet.signature
+val parse_signature : Packet.t -> Packet.signature
 val ssp_ctime_id : int
 val ssp_exptime_id : int
 val int32_of_string : string -> int32
 (* USA or see <http://www.gnu.org/licenses/>.                          *)
 (***********************************************************************)
 
-open Printf
-open StdLabels
-open MoreLabels
-
-open Packet
+open Core.Std
 
 let limit = try int_of_string Sys.argv.(1) with _ -> 10
 let cin = new Channel.sys_in_channel stdin
 val limit : int
 val cin : Channel.sys_in_channel
 val cout : Channel.sys_out_channel
-val getkey : unit -> Packet.packet list
+val getkey : unit -> Packet.t list
 (* USA or see <http://www.gnu.org/licenses/>.                          *)
 (***********************************************************************)
 
-open StdLabels
-open MoreLabels
-open Printf
 open Common
+open Core.Std
 
 let amp = Str.regexp "&"
 
 let chsplit c s =
-  let eqpos = String.index s c in
+  let eqpos = String.index_exn s c in
   let first = Str.string_before s eqpos
   and second = Str.string_after s (eqpos + 1) in
   (first, second)
           match hd with
             | ("options",options) ->
                 let options = Str.split comma_rxp options in
-                if List.mem "mr" options
+                if List.mem options "mr"
                 then { request with machine_readable = true }
                 else request
             | ("op","stats") -> {request with kind = Stats };