diff --git a/ocaml/idl/markdown_backend.ml b/ocaml/idl/markdown_backend.ml
index e039a7cfc42..66110b7d694 100644
--- a/ocaml/idl/markdown_backend.ml
+++ b/ocaml/idl/markdown_backend.ml
@@ -43,8 +43,6 @@ let compare_case_ins x y =
   compare (String.lowercase_ascii x) (String.lowercase_ascii y)
 
 let escape s =
-  let open Xapi_stdext_std.Xstringext in
-  let sl = String.explode s in
   let esc_char = function
     | '\\' ->
         "\"
@@ -79,8 +77,7 @@ let escape s =
     | c ->
         String.make 1 c
   in
-  let escaped_list = List.map esc_char sl in
-  String.concat "" escaped_list
+  String.to_seq s |> Seq.map esc_char |> List.of_seq |> String.concat ""
 
 let rec of_ty_verbatim = function
   | SecretString | String ->
diff --git a/ocaml/libs/http-lib/http.ml b/ocaml/libs/http-lib/http.ml
index b6b4791e06f..c2f7e2aeda8 100644
--- a/ocaml/libs/http-lib/http.ml
+++ b/ocaml/libs/http-lib/http.ml
@@ -24,8 +24,6 @@ exception Forbidden
 
 exception Method_not_implemented
 
-exception Malformed_url of string
-
 exception Timeout
 
 exception Too_large
@@ -145,61 +143,8 @@ let output_http fd headers =
   |> String.concat ""
   |> Unixext.really_write_string fd
 
-let explode str = Astring.String.fold_right (fun c acc -> c :: acc) str []
-
-let implode chr_list =
-  String.concat "" (List.map Astring.String.of_char chr_list)
-
-let urldecode url =
-  let chars = explode url in
-  let rec fn ac = function
-    | '+' :: tl ->
-        fn (' ' :: ac) tl
-    | '%' :: a :: b :: tl ->
-        let cs =
-          try int_of_string (implode ['0'; 'x'; a; b])
-          with _ -> raise (Malformed_url url)
-        in
-        fn (Char.chr cs :: ac) tl
-    | x :: tl ->
-        fn (x :: ac) tl
-    | [] ->
-        implode (List.rev ac)
-  in
-  fn [] chars
-
 (* Encode @param suitably for appearing in a query parameter in a URL. *)
-let urlencode param =
-  let chars = explode param in
-  let rec fn = function
-    | x :: tl ->
-        let s =
-          if x = ' ' then
-            "+"
-          else
-            match x with
-            | 'A' .. 'Z'
-            | 'a' .. 'z'
-            | '0' .. '9'
-            | '$'
-            | '-'
-            | '_'
-            | '.'
-            | '!'
-            | '*'
-            | '\''
-            | '('
-            | ')'
-            | ',' ->
-                Astring.String.of_char x
-            | _ ->
-                Printf.sprintf "%%%2x" (Char.code x)
-        in
-        s ^ fn tl
-    | [] ->
-        ""
-  in
-  fn chars
+let urlencode param = Uri.pct_encode ~component:`Query param
 
 (** Parses strings of the form a=b;c=d (new, RFC-compliant cookie format)
     and a=b&c=d (old, incorrect style) into [("a", "b"); ("c", "d")] *)
@@ -219,7 +164,7 @@ let parse_cookies xs =
   List.map
     (function
       | k :: vs ->
-          (urldecode k, urldecode (String.concat "=" vs))
+          (Uri.pct_decode k, Uri.pct_decode (String.concat "=" vs))
       | [] ->
           raise Http_parse_failure
       )
diff --git a/ocaml/libs/http-lib/http.mli b/ocaml/libs/http-lib/http.mli
index 384367e2463..91590bcdcdd 100644
--- a/ocaml/libs/http-lib/http.mli
+++ b/ocaml/libs/http-lib/http.mli
@@ -235,6 +235,7 @@ val output_http : Unix.file_descr -> string list -> unit
 val parse_cookies : string -> (string * string) list
 
 val urlencode : string -> string
+(** Encode parameter suitably for appearing in a query parameter in a URL. *)
 
 type 'a ll = End | Item of 'a * (unit -> 'a ll)
 
diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.ml
index e89cefba3da..c290ab8e569 100644
--- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.ml
+++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.ml
@@ -208,4 +208,15 @@ module List = struct
   let find_minimum compare =
     let min a b = if compare a b <= 0 then a else b in
     function [] -> None | x :: xs -> Some (List.fold_left min x xs)
+
+  let find_index f l =
+    let rec loop i = function
+      | [] ->
+          None
+      | x :: _ when f x ->
+          Some i
+      | _ :: xs ->
+          loop (i + 1) xs
+    in
+    loop 0 l
 end
diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.mli b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.mli
index d836c751230..231c3891060 100644
--- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.mli
+++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/listext.mli
@@ -60,6 +60,13 @@ module List : sig
       the sort order of [cmp], or [None] if the list is empty. When two ore
       more elements match the lowest value, the left-most is returned. *)
 
+  val find_index : ('a -> bool) -> 'a list -> int option
+  (** [find_index f l] returns the position of the first element in [l] that
+      satisfies [f x]. If there is no such element, returns [None].
+
+      When using OCaml compilers 5.1 or later, please use the standard library
+      instead. *)
+
   (** {1 Using indices to manipulate lists} *)
 
   val chop : int -> 'a list -> 'a list * 'a list
diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.ml b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.ml
index 7fb16aba6f8..0b3da00c476 100644
--- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.ml
+++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.ml
@@ -39,10 +39,6 @@ module String = struct
     done ;
     !accu
 
-  let explode string = fold_right (fun h t -> h :: t) string []
-
-  let implode list = concat "" (List.map of_char list)
-
   (** True if string 'x' ends with suffix 'suffix' *)
   let endswith suffix x =
     let x_l = String.length x and suffix_l = String.length suffix in
@@ -56,16 +52,6 @@ module String = struct
   (** Returns true for whitespace characters, false otherwise *)
   let isspace = function ' ' | '\n' | '\r' | '\t' -> true | _ -> false
 
-  (** Removes all the characters from the ends of a string for which the predicate is true *)
-  let strip predicate string =
-    let rec remove = function
-      | [] ->
-          []
-      | c :: cs ->
-          if predicate c then remove cs else c :: cs
-    in
-    implode (List.rev (remove (List.rev (remove (explode string)))))
-
   let escaped ?rules string =
     match rules with
     | None ->
@@ -81,24 +67,28 @@ module String = struct
         in
         concat "" (fold_right aux string [])
 
-  (** Take a predicate and a string, return a list of strings separated by
-      runs of characters where the predicate was true (excluding those characters from the result) *)
   let split_f p str =
-    let not_p x = not (p x) in
-    let rec split_one p acc = function
-      | [] ->
-          (List.rev acc, [])
-      | c :: cs ->
-          if p c then split_one p (c :: acc) cs else (List.rev acc, c :: cs)
+    let split_one seq =
+      let not_p c = not (p c) in
+      let a = Seq.take_while not_p seq in
+      let b = Seq.drop_while not_p seq in
+      (a, b)
     in
-    let rec alternate acc drop chars =
-      if chars = [] then
+    let drop seq = Seq.drop_while p seq in
+    let rec split acc chars =
+      if Seq.is_empty chars then
         acc
       else
-        let a, b = split_one (if drop then p else not_p) [] chars in
-        alternate (if drop then acc else a :: acc) (not drop) b
+        let a, b = split_one chars in
+        let b = drop b in
+        let acc = if Seq.is_empty a then acc else Seq.cons a acc in
+        split acc b
     in
-    List.rev (List.map implode (alternate [] true (explode str)))
+    String.to_seq str
+    |> split Seq.empty
+    |> Seq.map String.of_seq
+    |> List.of_seq
+    |> List.rev
 
   let index_opt s c =
     let rec loop i =
diff --git a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.mli b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.mli
index e2587929916..e2b486285a6 100644
--- a/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.mli
+++ b/ocaml/libs/xapi-stdext/lib/xapi-stdext-std/xstringext.mli
@@ -29,12 +29,6 @@ module String : sig
   val fold_right : (char -> 'a -> 'a) -> string -> 'a -> 'a
   (** Iterate over the characters in a string in reverse order. *)
 
-  val explode : string -> char list
-  (** Split a string into a list of characters. *)
-
-  val implode : char list -> string
-  (** Concatenate a list of characters into a string. *)
-
   val endswith : string -> string -> bool
   (** True if string 'x' ends with suffix 'suffix' *)
 
@@ -44,9 +38,6 @@ module String : sig
   val isspace : char -> bool
   (** True if the character is whitespace *)
 
-  val strip : (char -> bool) -> string -> string
-  (** Removes all the characters from the ends of a string for which the predicate is true *)
-
   val escaped : ?rules:(char * string) list -> string -> string
   (** Backward-compatible string escaping, defaulting to the built-in
       	OCaml string escaping but allowing an arbitrary mapping from characters
@@ -54,7 +45,8 @@ module String : sig
 
   val split_f : (char -> bool) -> string -> string list
   (** Take a predicate and a string, return a list of strings separated by
-      	runs of characters where the predicate was true *)
+      runs of characters where the predicate was true. Avoid if possible, it's
+      very costly to execute. *)
 
   val split : ?limit:int -> char -> string -> string list
   (** split a string on a single char *)
diff --git a/ocaml/perftest/createpool.ml b/ocaml/perftest/createpool.ml
index ad4207427f6..bf96cfb7c36 100644
--- a/ocaml/perftest/createpool.ml
+++ b/ocaml/perftest/createpool.ml
@@ -350,24 +350,20 @@ let create_sdk_pool session_id sdkname pool_name key ipbase =
   let pingable = Array.make (Array.length hosts) false in
   let firstboot = Array.make (Array.length hosts) false in
   let string_of_status () =
-    Xstringext.String.implode
-      (Array.to_list
-         (Array.mapi
-            (fun i ping ->
-              let boot = firstboot.(i) in
-              match (ping, boot) with
-              | false, false ->
-                  '.'
-              | true, false ->
-                  'P'
-              | true, true ->
-                  'B'
-              | _, _ ->
-                  '?'
-            )
-            pingable
-         )
-      )
+    Array.to_seq pingable
+    |> Seq.mapi (fun i ping ->
+           let boot = firstboot.(i) in
+           match (ping, boot) with
+           | false, false ->
+               '.'
+           | true, false ->
+               'P'
+           | true, true ->
+               'B'
+           | _, _ ->
+               '?'
+       )
+    |> String.of_seq
   in
   let has_guest_booted i _vm =
     let ip = Printf.sprintf "192.168.%d.%d" pool.ipbase (i + 1) in
@@ -469,24 +465,20 @@ let create_sdk_pool session_id sdkname pool_name key ipbase =
   let live = Array.make (Array.length hosts) false in
   let enabled = Array.make (Array.length hosts) false in
   let string_of_status () =
-    Xstringext.String.implode
-      (Array.to_list
-         (Array.mapi
-            (fun i live ->
-              let enabled = enabled.(i) in
-              match (live, enabled) with
-              | false, false ->
-                  '.'
-              | true, false ->
-                  'L'
-              | true, true ->
-                  'E'
-              | _, _ ->
-                  '?'
-            )
-            live
-         )
-      )
+    Array.to_seq live
+    |> Seq.mapi (fun i live ->
+           let enabled = enabled.(i) in
+           match (live, enabled) with
+           | false, false ->
+               '.'
+           | true, false ->
+               'L'
+           | true, true ->
+               'E'
+           | _, _ ->
+               '?'
+       )
+    |> String.of_seq
   in
   let has_host_booted rpc session_id i host =
     try
diff --git a/ocaml/xapi-idl/lib_test/device_number_test.ml b/ocaml/xapi-idl/lib_test/device_number_test.ml
index 9105299a16e..fc8d5b210f1 100644
--- a/ocaml/xapi-idl/lib_test/device_number_test.ml
+++ b/ocaml/xapi-idl/lib_test/device_number_test.ml
@@ -30,7 +30,7 @@ let deprecated =
 let examples_to_test =
   let using_deprecated_ide =
     try
-      ignore (make (Ide, 4, 0)) ;
+      ignore (make Ide ~disk:4 ~partition:0) ;
       true
     with _ -> false
   in
@@ -46,16 +46,18 @@ let equivalent =
   ; ("d536p37", "xvdtq37")
   ]
 
+let invalid = ["d0p0q"]
+
 let test_examples =
   let tests =
     List.map
-      (fun (spec, linux, xenstore) ->
-        ( "test_examples " ^ linux
+      (fun ((bus, disk, partition), linux, xenstore) ->
+        let of_spec = make bus ~disk ~partition |> Option.get in
+        let of_linux = of_linux_device linux |> Option.get in
+        let of_xenstore = of_xenstore_key xenstore in
+        ( Printf.sprintf "%s = %s = %d" (to_debug_string of_spec) linux xenstore
         , `Quick
         , fun () ->
-            let of_spec = make spec in
-            let of_linux = of_linux_device linux in
-            let of_xenstore = of_xenstore_key xenstore in
             Alcotest.check device_number "examples must be equal" of_spec
               of_linux ;
             Alcotest.check device_number "examples must be equal" of_spec
@@ -64,7 +66,7 @@ let test_examples =
       )
       examples_to_test
   in
-  tests
+  ("Compare with linux and xenstore values", tests)
 
 (* NB we always understand the deprecated linux/xenstore devices even if we
    don't generate them ourselves *)
@@ -72,40 +74,50 @@ let test_deprecated =
   let tests =
     List.map
       (fun (_, linux, xenstore) ->
-        ( "test_deprecated " ^ linux
+        ( linux
         , `Quick
         , fun () ->
-            let of_linux = of_linux_device linux in
+            let of_linux = of_linux_device linux |> Option.get in
             let of_xenstore = of_xenstore_key xenstore in
             Alcotest.check device_number "must be equal" of_linux of_xenstore
         )
       )
       deprecated
   in
-  tests
+  ("Deprecated linux device", tests)
 
 let test_equivalent =
   let tests =
     List.map
       (fun (x, y) ->
-        let test_name = Printf.sprintf "test_equivalent %s=%s" x y in
+        let test_name = Printf.sprintf "%s = %s" x y in
         ( test_name
         , `Quick
         , fun () ->
-            let x' = of_string false x in
-            let y' = of_string false y in
+            let x' = of_string ~hvm:false x |> Option.get in
+            let y' = of_string ~hvm:false y |> Option.get in
             Alcotest.check device_number "must be equal" x' y'
         )
       )
       equivalent
   in
-  tests
+  ("Equivalent devices", tests)
+
+let test_invalid =
+  let test x () =
+    if Option.is_some (of_string ~hvm:false x) then
+      Alcotest.failf "%s was not rejected" x
+  in
+  let tests = List.map (fun x -> (x, `Quick, test x)) invalid in
+  ("Reject invalid devices", tests)
 
 let test_2_way_convert =
   (* We now always convert Ide specs into xvd* linux devices, so they become Xen
      specs when converted back. *)
-  let equal_linux old_t new_t =
-    match (spec old_t, spec new_t) with
+  let equal_linux (old_t : t) (new_t : t) =
+    match
+      ((old_t, new_t) :> (bus_type * int * int) * (bus_type * int * int))
+    with
     | (Ide, disk1, partition1), (Xen, disk2, partition2)
       when disk1 = disk2 && partition1 = partition2 ->
         true
@@ -117,25 +129,36 @@ let test_2_way_convert =
       (Fmt.of_to_string Device_number.to_debug_string)
       equal_linux
   in
+  let test disk_number hvm =
+    let original = of_disk_number hvm disk_number |> Option.get in
+    let of_linux = of_linux_device (to_linux_device original) |> Option.get in
+    let of_xenstore = of_xenstore_key (to_xenstore_key original) in
+    Alcotest.check device_number_equal_linux
+      "of_linux must be equal to original" original of_linux ;
+    Alcotest.check device_number "of_xenstore must be equal to original"
+      original of_xenstore
+  in
+
+  let max_d = (1 lsl 20) - 1 in
+  ( "2-way conversion"
+  , [
+      ( Printf.sprintf "All disk numbers until %d" max_d
+      , `Slow
+      , fun () ->
+          for disk_number = 0 to max_d do
+            List.iter (test disk_number) [true; false]
+          done
+      )
+    ]
+  )
+
+let tests =
   [
-    ( "test_2_way_convert"
-    , `Slow
-    , fun () ->
-        for disk_number = 0 to (1 lsl 20) - 1 do
-          List.iter
-            (fun hvm ->
-              let original = of_disk_number hvm disk_number in
-              let of_linux = of_linux_device (to_linux_device original) in
-              let of_xenstore = of_xenstore_key (to_xenstore_key original) in
-              Alcotest.check device_number_equal_linux
-                "of_linux must be equal to original" original of_linux ;
-              Alcotest.check device_number
-                "of_xenstore must be equal to original" original of_xenstore
-            )
-            [true; false]
-        done
-    )
+    test_examples
+  ; test_deprecated
+  ; test_equivalent
+  ; test_invalid
+  ; test_2_way_convert
   ]
 
-let tests =
-  test_examples @ test_deprecated @ test_equivalent @ test_2_way_convert
+let () = Alcotest.run "Device_number" tests
diff --git a/ocaml/xapi-idl/lib_test/device_number_test.mli b/ocaml/xapi-idl/lib_test/device_number_test.mli
new file mode 100644
index 00000000000..e69de29bb2d
diff --git a/ocaml/xapi-idl/lib_test/dune b/ocaml/xapi-idl/lib_test/dune
index 0806453c035..1b1e8193ca7 100644
--- a/ocaml/xapi-idl/lib_test/dune
+++ b/ocaml/xapi-idl/lib_test/dune
@@ -18,11 +18,22 @@
  )
 )
 
+(test
+ (name device_number_test)
+ (package xapi-idl)
+ (modules device_number_test)
+ (libraries
+   alcotest
+   fmt
+   xapi-idl.xen.interface.types
+ )
+)
+
 (test
  (name test)
  (modes exe)
  (package xapi-idl)
- (modules (:standard \ idl_test_common guard_interfaces_test))
+ (modules (:standard \ idl_test_common guard_interfaces_test device_number_test))
  (deps (source_tree test_data))
  (libraries
    alcotest
@@ -47,7 +58,6 @@
    xapi-idl.v6
    xapi-idl.xen
    xapi-idl.xen.interface
-   xapi-idl.xen.interface.types
    xapi-log
  )
  (preprocess (per_module ((pps ppx_deriving_rpc) Task_server_test Updates_test))))
diff --git a/ocaml/xapi-idl/lib_test/test.ml b/ocaml/xapi-idl/lib_test/test.ml
index 712ac7a4640..bba5c5f6055 100644
--- a/ocaml/xapi-idl/lib_test/test.ml
+++ b/ocaml/xapi-idl/lib_test/test.ml
@@ -17,7 +17,6 @@ let () =
     ; ("Syslog tests", Syslog_test.tests)
     ; ("Cohttp_posix_io tests", Http_test.tests)
     ; ("Xenops_interface tests", Xen_test.tests)
-    ; ("Device_number tests", Device_number_test.tests)
     ; ("xcp-config-file tests", Config_file_test.tests)
       (* "xcp-channel-test", Channel_test.tests; TODO: Turn these on when the
          code works. *)
diff --git a/ocaml/xapi-idl/xen/device_number.ml b/ocaml/xapi-idl/xen/device_number.ml
index 2577c8a54ad..2233354b030 100644
--- a/ocaml/xapi-idl/xen/device_number.ml
+++ b/ocaml/xapi-idl/xen/device_number.ml
@@ -1,63 +1,48 @@
-type bus_type = Xen | Scsi | Floppy | Ide [@@deriving rpcty]
-
-type spec = bus_type * int * int [@@deriving rpcty]
+module Listext = Xapi_stdext_std.Listext.List
 
-type t = spec [@@deriving rpcty]
+type bus_type = Xen | Scsi | Floppy | Ide [@@deriving rpcty]
 
-let to_debug_string = function
-  | Xen, disk, partition ->
-      Printf.sprintf "Xen(%d, %d)" disk partition
-  | Scsi, disk, partition ->
-      Printf.sprintf "Scsi(%d, %d)" disk partition
-  | Floppy, disk, partition ->
-      Printf.sprintf "Floppy(%d, %d)" disk partition
-  | Ide, disk, partition ->
-      Printf.sprintf "Ide(%d, %d)" disk partition
+type t = bus_type * int * int [@@deriving rpcty]
 
-(* ocamlp4-friendly operators *)
-let ( <| ) = ( lsl )
+let bus_type_to_string = function
+  | Xen ->
+      "Xen"
+  | Scsi ->
+      "Scsi"
+  | Floppy ->
+      "Floppy"
+  | Ide ->
+      "Ide"
 
-let ( >| ) = ( lsr )
+let to_debug_string (bus, disk, partition) =
+  Printf.sprintf "%s(%d, %d)" (bus_type_to_string bus) disk partition
 
-let int_of_string x =
-  try int_of_string x
-  with _ -> failwith (Printf.sprintf "int_of_string [%s]" x)
+let ( let* ) = Option.bind
 
 (* If this is true then we will use the deprecated (linux-specific) IDE
    encodings for disks > 3 *)
 let use_deprecated_ide_encoding = true
 
-let make (x : spec) : t =
-  let max_xen = ((1 <| 20) - 1, 15) in
-  let max_scsi = (15, 15) in
-  let max_ide = if use_deprecated_ide_encoding then (19, 63) else (3, 63) in
-  let max_floppy = (2, 0) in
-  let assert_in_range description (disk_limit, partition_limit) (disk, partition)
-      =
-    if disk < 0 || disk > disk_limit then
-      failwith
-        (Printf.sprintf "%s disk number out of range 0 <= %d <= %d" description
-           disk disk_limit
-        ) ;
-    if partition < 0 || partition > partition_limit then
-      failwith
-        (Printf.sprintf "%s partition number out of range 0 <= %d <= %d"
-           description partition partition_limit
-        )
+let max_of = function
+  | Xen ->
+      ((1 lsl 20) - 1, 15)
+  | Scsi ->
+      (15, 15)
+  | Floppy ->
+      (2, 0)
+  | Ide ->
+      if use_deprecated_ide_encoding then (19, 63) else (3, 63)
+
+let make bus ~disk ~partition =
+  let in_range ~min ~max n = min <= n && n <= max in
+  let all_in_range (disk_max, partition_max) ~disk ~partition =
+    in_range ~min:0 ~max:disk_max disk
+    && in_range ~min:0 ~max:partition_max partition
   in
-  ( match x with
-  | Xen, disk, partition ->
-      assert_in_range "xen" max_xen (disk, partition)
-  | Scsi, disk, partition ->
-      assert_in_range "scsi" max_scsi (disk, partition)
-  | Floppy, disk, partition ->
-      assert_in_range "floppy" max_floppy (disk, partition)
-  | Ide, disk, partition ->
-      assert_in_range "ide" max_ide (disk, partition)
-  ) ;
-  x
-
-let spec (x : t) : spec = x
+  if all_in_range (max_of bus) ~disk ~partition then
+    Some (bus, disk, partition)
+  else
+    None
 
 let ( || ) = ( lor )
 
@@ -67,43 +52,41 @@ let deprecated_ide_table = standard_ide_table @ [33; 34; 56; 57; 88; 89; 90; 91]
 
 let to_xenstore_int = function
   | Xen, disk, partition when disk < 16 ->
-      202 <| 8 || disk <| 4 || partition
+      (202 lsl 8) || (disk lsl 4) || partition
   | Xen, disk, partition ->
-      1 <| 28 || disk <| 8 || partition
+      (1 lsl 28) || (disk lsl 8) || partition
   | Scsi, disk, partition ->
-      8 <| 8 || disk <| 4 || partition
+      (8 lsl 8) || (disk lsl 4) || partition
   | Floppy, disk, partition ->
-      203 <| 8 || disk <| 4 || partition
+      (203 lsl 8) || (disk lsl 4) || partition
   | Ide, disk, partition ->
       let m = List.nth deprecated_ide_table (disk / 2) in
       let n = disk - (disk / 2 * 2) in
       (* NB integers behave differently to reals *)
-      m <| 8 || n <| 6 || partition
+      (m lsl 8) || (n lsl 6) || partition
 
 let of_xenstore_int x =
-  let ( && ) = ( land ) in
-  if (x && 1 <| 28) <> 0 then
-    (Xen, x >| 8 && ((1 <| 20) - 1), x && ((1 <| 8) - 1))
+  if x land (1 lsl 28) <> 0 then
+    (Xen, (x lsr 8) land ((1 lsl 20) - 1), x land ((1 lsl 8) - 1))
   else
-    match x >| 8 with
+    match x lsr 8 with
     | 202 ->
-        (Xen, x >| 4 && ((1 <| 4) - 1), x && ((1 <| 4) - 1))
+        (Xen, (x lsr 4) land ((1 lsl 4) - 1), x land ((1 lsl 4) - 1))
     | 8 ->
-        (Scsi, x >| 4 && ((1 <| 4) - 1), x && ((1 <| 4) - 1))
+        (Scsi, (x lsr 4) land ((1 lsl 4) - 1), x land ((1 lsl 4) - 1))
     | 203 ->
-        (Floppy, x >| 4 && ((1 <| 4) - 1), x && ((1 <| 4) - 1))
+        (Floppy, (x lsr 4) land ((1 lsl 4) - 1), x land ((1 lsl 4) - 1))
     | n ->
         let idx =
-          snd
-            (List.fold_left
-               (fun (i, res) e -> (i + 1, if e = n then i else res))
-               (0, -1) deprecated_ide_table
-            )
+          match Listext.find_index (Int.equal n) deprecated_ide_table with
+          | Some idx ->
+              idx
+          | None ->
+              failwith (Printf.sprintf "Unknown device number: %d" x)
         in
-        if idx < 0 then failwith (Printf.sprintf "Unknown device number: %d" x) ;
-        (Ide, (x >| 6 && ((1 <| 2) - 1)) + (idx * 2), x && ((1 <| 6) - 1))
-
-type xenstore_key = int
+        let disk = ((x lsr 6) land ((1 lsl 2) - 1)) + (idx * 2) in
+        let partition = x land ((1 lsl 6) - 1) in
+        (Ide, disk, partition)
 
 let to_xenstore_key x = to_xenstore_int x
 
@@ -119,112 +102,119 @@ let rec string_of_int26 x =
   let low' = String.make 1 (char_of_int (low + int_of_char 'a' - 1)) in
   high' ^ low'
 
-module String = struct
-  include String
-
-  let fold_right f string accu =
-    let accu = ref accu in
-    for i = length string - 1 downto 0 do
-      accu := f string.[i] !accu
-    done ;
-    !accu
-
-  let explode string = fold_right (fun h t -> h :: t) string []
-
-  let implode list = concat "" (List.map (String.make 1) list)
-end
-
-(** Convert a linux device string back into an integer *)
-let int26_of_string x =
-  let ints =
-    List.map (fun c -> int_of_char c - int_of_char 'a' + 1) (String.explode x)
-  in
-  List.fold_left (fun acc x -> (acc * 26) + x) 0 ints - 1
-
-let to_linux_device =
+let to_linux_prefix = function
+  | Xen ->
+      "xvd"
+  | Scsi ->
+      "sd"
+  | Floppy ->
+      "fd"
+  | Ide ->
+      "xvd"
+
+let to_linux_device (bus, disk, part) =
   let p x = if x = 0 then "" else string_of_int x in
-  function
-  | Xen, disk, part ->
-      Printf.sprintf "xvd%s%s" (string_of_int26 disk) (p part)
-  | Scsi, disk, part ->
-      Printf.sprintf "sd%s%s" (string_of_int26 disk) (p part)
-  | Floppy, disk, part ->
-      Printf.sprintf "fd%s%s" (string_of_int26 disk) (p part)
-  | Ide, disk, part ->
-      Printf.sprintf "xvd%s%s" (string_of_int26 disk) (p part)
+  let bus = to_linux_prefix bus in
+  Printf.sprintf "%s%s%s" bus (string_of_int26 disk) (p part)
 
 let of_linux_device x =
-  let letter c = 'a' <= c && c <= 'z' in
-  let digit c = '0' <= c && c <= '9' in
-  let take f x =
-    let rec inner f acc = function
-      | x :: xs ->
-          if f x then inner f (x :: acc) xs else (List.rev acc, x :: xs)
-      | [] ->
-          (List.rev acc, [])
+  let open Astring in
+  let b26_to_int x =
+    (* Convert a linux device string back into an integer *)
+    (* Assumes all characters are in range *)
+    let b26 =
+      String.Sub.to_string x
+      |> Stdlib.String.to_seq
+      |> Seq.map (fun c -> int_of_char c - int_of_char 'a' + 1)
+      |> Seq.fold_left (fun acc x -> (acc * 26) + x) 0
     in
-    inner f [] x
+    b26 - 1
+  in
+
+  let parse_int x =
+    match String.Sub.span ~min:1 ~sat:Char.Ascii.is_digit x with
+    | i, s ->
+        Option.map (fun i -> (i, s)) (String.Sub.to_int i)
+  in
+  let parse_b26 x =
+    match String.Sub.span ~min:1 ~sat:Char.Ascii.is_lower x with
+    | b, s ->
+        (b26_to_int b, s)
   in
   (* Parse a string "abc123" into x, y where x is "abc" interpreted as base-26
      and y is 123 *)
   let parse_b26_int x =
-    let d, p = take letter x in
-    let d' = int26_of_string (String.implode d) in
-    let p' = if p = [] then 0 else int_of_string (String.implode p) in
-    (d', p')
+    let pre, x = parse_b26 x in
+    if String.Sub.is_empty x then
+      Some (pre, 0)
+    else
+      let* post, x = parse_int x in
+      if not (String.Sub.is_empty x) then
+        None
+      else
+        Some (pre, post)
   in
   (* Parse a string "123p456" into x, y where x = 123 and y = 456 *)
   let parse_int_p_int x =
-    let d, rest = take digit x in
-    match rest with
-    | 'p' :: rest ->
-        let p, _ = take digit rest in
-        (int_of_string (String.implode d), int_of_string (String.implode p))
-    | [] ->
-        (int_of_string (String.implode d), 0)
-    | _ ->
-        failwith
-          (Printf.sprintf "expected digit+ p digit+ got: %s" (String.implode x))
+    let parse_p x =
+      match String.Sub.head x with
+      | Some 'p' ->
+          Some (String.Sub.tail x)
+      | Some _ | None ->
+          None
+    in
+    let* pre, x = parse_int x in
+    if String.Sub.is_empty x then
+      Some (pre, 0)
+    else
+      let* x = parse_p x in
+      let* post, x = parse_int x in
+      if not (String.Sub.is_empty x) then
+        None
+      else
+        Some (pre, post)
   in
-  match String.explode x with
-  | 'x' :: 'v' :: 'd' :: rest ->
-      let disk, partition = parse_b26_int rest in
-      (Xen, disk, partition)
-  | 's' :: 'd' :: rest ->
-      let disk, partition = parse_b26_int rest in
-      (Scsi, disk, partition)
-  | 'f' :: 'd' :: rest ->
-      let disk, partition = parse_b26_int rest in
-      (Floppy, disk, partition)
-  | 'h' :: 'd' :: rest ->
-      let disk, partition = parse_b26_int rest in
-      (Ide, disk, partition)
-  | 'd' :: rest ->
-      let disk, partition = parse_int_p_int rest in
-      (Xen, disk, partition)
-  | _ ->
-      failwith (Printf.sprintf "Failed to parse device name: %s" x)
+  if String.is_prefix ~affix:"xvd" x then
+    let rest = String.sub_with_range ~first:3 x in
+    let* disk, partition = parse_b26_int rest in
+    Some (Xen, disk, partition)
+  else if String.is_prefix ~affix:"sd" x then
+    let rest = String.sub_with_range ~first:2 x in
+    let* disk, partition = parse_b26_int rest in
+    Some (Scsi, disk, partition)
+  else if String.is_prefix ~affix:"fd" x then
+    let rest = String.sub_with_range ~first:2 x in
+    let* disk, partition = parse_b26_int rest in
+    Some (Floppy, disk, partition)
+  else if String.is_prefix ~affix:"hd" x then
+    let rest = String.sub_with_range ~first:2 x in
+    let* disk, partition = parse_b26_int rest in
+    Some (Ide, disk, partition)
+  else if String.is_prefix ~affix:"d" x then
+    let rest = String.sub_with_range ~first:1 x in
+    let* disk, partition = parse_int_p_int rest in
+    Some (Xen, disk, partition)
+  else
+    None
 
 let upgrade_linux_device x =
-  match String.explode x with
-  | 'h' :: 'd' :: rest ->
-      "xvd" ^ String.implode rest
-  | _ ->
-      x
-
-type disk_number = int
-
-let to_disk_number = function
-  | Xen, disk, _ ->
-      disk
-  | Scsi, disk, _ ->
-      disk
-  | Floppy, disk, _ ->
-      disk
-  | Ide, disk, _ ->
-      disk
-
-let of_disk_number hvm n = if hvm && n < 4 then (Ide, n, 0) else (Xen, n, 0)
-
-let of_string hvm name =
-  try of_disk_number hvm (int_of_string name) with _ -> of_linux_device name
+  if Astring.String.is_prefix ~affix:"hd" x then
+    let rest = Astring.String.with_range ~first:2 x in
+    "xvd" ^ rest
+  else
+    x
+
+let disk (_, disk, _) = disk
+
+let bus (bus, _, _) = bus
+
+let of_disk_number hvm n =
+  let bus = if hvm && n < 4 then Ide else Xen in
+  make bus ~disk:n ~partition:0
+
+let of_string ~hvm name =
+  let maybe_disk =
+    let* n = int_of_string_opt name in
+    of_disk_number hvm n
+  in
+  match maybe_disk with None -> of_linux_device name | dev -> dev
diff --git a/ocaml/xapi-idl/xen/device_number.mli b/ocaml/xapi-idl/xen/device_number.mli
index 4b5c431cd62..ffcfcbd05e9 100644
--- a/ocaml/xapi-idl/xen/device_number.mli
+++ b/ocaml/xapi-idl/xen/device_number.mli
@@ -5,23 +5,22 @@ type bus_type =
   | Floppy  (** A floppy bus *)
   | Ide  (** An IDE bus *)
 
-(** A specification for a device number. There are more valid specifications
-    than valid device numbers because of hardware and/or protocol limits. *)
-type spec = bus_type * int * int
-
 (** A valid device number *)
-type t
+type t = private bus_type * int * int
 
 val typ_of : t Rpc.Types.typ
 
-val make : spec -> t
-(** [make spec] validates a given device number specification [spec] and returns
-    a device number *)
+val make : bus_type -> disk:int -> partition:int -> t option
+(** [make bus ~disk ~partition] returns [Some device] when the parameters
+    define a valid device number, or [None] otherwise. *)
+
+val disk : t -> int
+(** [disk t] returns the corresponding non-negative disk number *)
 
-val spec : t -> spec
-(** [spec t] takes a [t] and returns the corresponding [spec] *)
+val bus : t -> bus_type
+(** [bus t] returns the bus type of the device *)
 
-val of_string : bool -> string -> t
+val of_string : hvm:bool -> string -> t option
 (** [of_string hvm name] returns the interface which best matches the [name] by
     applying the policy: first check if it is a disk_number, else fall back to a
     linux_device for backwards compatability *)
@@ -33,26 +32,19 @@ val to_linux_device : t -> string
 (** [to_linux_device i] returns a possible linux string representation of
     interface [i] *)
 
-val of_linux_device : string -> t
+val of_linux_device : string -> t option
 (** [of_linux_device x] returns the interface corresponding to string [x] *)
 
 val upgrade_linux_device : string -> string
 (** [upgrade_linux_device x] upgrades hd* style device names to xvd* and leaves
     all other device names unchanged. *)
 
-type xenstore_key = int
-
-val to_xenstore_key : t -> xenstore_key
+val to_xenstore_key : t -> int
 (** [to_xenstore_key i] returns the xenstore key from interface [i] *)
 
-val of_xenstore_key : xenstore_key -> t
+val of_xenstore_key : int -> t
 (** [of_xenstore_key key] returns an interface from a xenstore key *)
 
-type disk_number = int
-
-val to_disk_number : t -> disk_number
-(** [to_disk_number i] returns the corresponding non-negative disk number *)
-
-val of_disk_number : bool -> disk_number -> t
+val of_disk_number : bool -> int -> t option
 (** [of_disk_number hvm n] returns the interface corresponding to disk number
     [n] which depends on whether the guest is [hvm] or not. *)
diff --git a/ocaml/xapi-idl/xen/dune b/ocaml/xapi-idl/xen/dune
index c2352eff385..16ed23ecd22 100644
--- a/ocaml/xapi-idl/xen/dune
+++ b/ocaml/xapi-idl/xen/dune
@@ -3,6 +3,7 @@
  (public_name xapi-idl.xen.interface.types)
  (modules xenops_types device_number)
  (libraries
+   astring
    result
    rpclib.core
    rresult
@@ -10,6 +11,7 @@
    sexplib0
    threads
    xapi-idl
+   xapi-stdext-std
  )
  (wrapped false)
  (preprocess (pps ppx_deriving_rpc ppx_sexp_conv)))
diff --git a/ocaml/xapi/dbsync_slave.ml b/ocaml/xapi/dbsync_slave.ml
index 84af29bbf7f..32ee7d44d21 100644
--- a/ocaml/xapi/dbsync_slave.ml
+++ b/ocaml/xapi/dbsync_slave.ml
@@ -69,7 +69,7 @@ let get_start_time () =
     debug "Calculating boot time..." ;
     let now = Unix.time () in
     let uptime = Unixext.string_of_file "/proc/uptime" in
-    let uptime = String.strip String.isspace uptime in
+    let uptime = String.trim uptime in
     let uptime = String.split ' ' uptime in
     let uptime = List.hd uptime in
     let uptime = float_of_string uptime in
diff --git a/ocaml/xapi/storage_access.ml b/ocaml/xapi/storage_access.ml
index 02e5545d16e..a307eb48bdd 100644
--- a/ocaml/xapi/storage_access.ml
+++ b/ocaml/xapi/storage_access.ml
@@ -558,8 +558,17 @@ let of_vbd ~__context ~vbd ~domid =
     Helpers.has_qemu ~__context ~self:(Db.VBD.get_VM ~__context ~self:vbd)
   in
   let dbg = Context.get_task_id __context in
-  let device_number = Device_number.of_string has_qemu userdevice in
-  let device = Device_number.to_linux_device device_number in
+  let device =
+    Option.map Device_number.to_linux_device
+      (Device_number.of_string ~hvm:has_qemu userdevice)
+  in
+  let device =
+    match device with
+    | Some dev ->
+        dev
+    | None ->
+        raise Api_errors.(Server_error (invalid_device, [userdevice]))
+  in
   let dp = datapath_of_vbd ~domid ~device in
   ( rpc
   , Ref.string_of dbg
diff --git a/ocaml/xapi/vbdops.ml b/ocaml/xapi/vbdops.ml
index 18e1f8413b9..0b9494e6f9e 100644
--- a/ocaml/xapi/vbdops.ml
+++ b/ocaml/xapi/vbdops.ml
@@ -24,15 +24,15 @@ module L = Debug.Make (struct let name = "license" end)
 (** Thrown if an empty VBD which isn't a CDROM is attached to an HVM guest *)
 exception Only_CD_VBDs_may_be_empty
 
-let translate_vbd_device vbd_ref name is_hvm =
-  try
-    let i = Device_number.of_string is_hvm name in
-    debug "VBD device name %s interpreted as %s (hvm = %b)" name
-      (Device_number.to_debug_string i)
-      is_hvm ;
-    i
-  with _ ->
-    raise
-      (Api_errors.Server_error
-         (Api_errors.illegal_vbd_device, [Ref.string_of vbd_ref; name])
-      )
+let translate_vbd_device vbd_ref name hvm =
+  match Device_number.of_string ~hvm name with
+  | Some i ->
+      debug "VBD device name %s interpreted as %s (hvm = %b)" name
+        (Device_number.to_debug_string i)
+        hvm ;
+      i
+  | None ->
+      raise
+        (Api_errors.Server_error
+           (Api_errors.illegal_vbd_device, [Ref.string_of vbd_ref; name])
+        )
diff --git a/ocaml/xapi/xapi_dr_task.ml b/ocaml/xapi/xapi_dr_task.ml
index 6766775a5f1..415a4e45c8f 100644
--- a/ocaml/xapi/xapi_dr_task.ml
+++ b/ocaml/xapi/xapi_dr_task.ml
@@ -31,7 +31,7 @@ type sr_probe_sr = {uuid: string; name_label: string; name_description: string}
 (* Attempt to parse a key/value pair from XML. *)
 let parse_kv = function
   | Xml.Element (key, _, [Xml.PCData v]) ->
-      (key, String.strip String.isspace v) (* remove whitespace at both ends *)
+      (key, String.trim v)
   | Xml.Element (key, _, []) ->
       (key, "")
   | _ ->
diff --git a/ocaml/xapi/xapi_templates_install.ml b/ocaml/xapi/xapi_templates_install.ml
index c22e51bf0ae..fc126b588bb 100644
--- a/ocaml/xapi/xapi_templates_install.ml
+++ b/ocaml/xapi/xapi_templates_install.ml
@@ -34,10 +34,7 @@ let is_whitelisted script =
     | _ ->
         false
   in
-  let safe_str str =
-    List.fold_left ( && ) true
-      (List.map safe_char (Xapi_stdext_std.Xstringext.String.explode str))
-  in
+  let safe_str str = String.for_all safe_char str in
   (* make sure the script prefix is the allowed dom0 directory *)
   Filename.dirname script = !Xapi_globs.post_install_scripts_dir
   (* avoid ..-style attacks and other weird things *)
diff --git a/ocaml/xapi/xapi_vbd.ml b/ocaml/xapi/xapi_vbd.ml
index 1da2516d809..5e1b31c5bee 100644
--- a/ocaml/xapi/xapi_vbd.ml
+++ b/ocaml/xapi/xapi_vbd.ml
@@ -215,24 +215,23 @@ let create ~__context ~vM ~vDI ~device ~userdevice ~bootable ~mode ~_type
                      )
                   )
           in
-          if
-            (not (valid_device userdevice ~_type))
-            || (userdevice = "autodetect" && possibilities = [])
-          then
-            raise
-              (Api_errors.Server_error (Api_errors.invalid_device, [userdevice])) ;
+          let raise_invalid_device () =
+            raise Api_errors.(Server_error (invalid_device, [userdevice]))
+          in
+          if not (valid_device userdevice ~_type) then
+            raise_invalid_device () ;
           (* Resolve the "autodetect" into a fixed device name now *)
           let userdevice =
-            if userdevice = "autodetect" then
-              match _type with
-              (* already checked for [] above *)
-              | `Floppy ->
-                  Device_number.to_linux_device (List.hd possibilities)
-              | `CD | `Disk ->
-                  string_of_int
-                    (Device_number.to_disk_number (List.hd possibilities))
-            else
+            if userdevice <> "autodetect" then
               userdevice
+            else
+              match (_type, possibilities) with
+              | _, [] ->
+                  raise_invalid_device ()
+              | `Floppy, dev :: _ ->
+                  Device_number.to_linux_device dev
+              | (`CD | `Disk), dev :: _ ->
+                  string_of_int (Device_number.disk dev)
           in
           let uuid = Uuidx.make () in
           let ref = Ref.make () in
diff --git a/ocaml/xapi/xapi_vbd_helpers.ml b/ocaml/xapi/xapi_vbd_helpers.ml
index 6226b26c34e..1285c740c27 100644
--- a/ocaml/xapi/xapi_vbd_helpers.ml
+++ b/ocaml/xapi/xapi_vbd_helpers.ml
@@ -376,38 +376,17 @@ let clear_current_operations ~__context ~self =
 
 (** Check if the device string has the right form *)
 let valid_device dev ~_type =
-  let check_rest rest =
-    (* checks the rest of the device name = [] is ok, or a number is ok *)
-    if rest = [] then
-      true
-    else
-      try
-        ignore (int_of_string (String.implode rest)) ;
-        true
-      with _ -> false
-  in
   dev = "autodetect"
+  || Option.is_none (Device_number.of_string dev ~hvm:false)
   ||
-  match String.explode dev with
-  | 's' :: 'd' :: 'a' .. 'p' :: rest ->
-      check_rest rest
-  | 'x' :: 'v' :: 'd' :: 'a' .. 'p' :: rest ->
-      check_rest rest
-  | 'h' :: 'd' :: 'a' .. 'p' :: rest ->
-      check_rest rest
-  | 'f' :: 'd' :: 'a' .. 'b' :: rest ->
-      check_rest rest
-      (* QEMU only supports up to 2 floppy drives, hence fda or fdb *)
+  match _type with
+  | `Floppy ->
+      false
   | _ -> (
-    match _type with
-    | `Floppy ->
-        false
-    | _ -> (
-      try
-        let n = int_of_string dev in
-        n >= 0 || n < 16
-      with _ -> false
-    )
+    try
+      let n = int_of_string dev in
+      n >= 0 || n < 16
+    with _ -> false
   )
 
 (** VBD.destroy doesn't require any interaction with xen *)
diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml
index 8819d393170..eff46f84b93 100644
--- a/ocaml/xapi/xapi_vm.ml
+++ b/ocaml/xapi/xapi_vm.ml
@@ -1206,7 +1206,7 @@ let get_possible_hosts ~__context ~vm =
 
 let get_allowed_VBD_devices ~__context ~vm =
   List.map
-    (fun d -> string_of_int (Device_number.to_disk_number d))
+    (fun d -> string_of_int (Device_number.disk d))
     (snd @@ allowed_VBD_devices ~__context ~vm ~_type:`Disk)
 
 let get_allowed_VIF_devices = allowed_VIF_devices
diff --git a/ocaml/xapi/xapi_vm_helpers.ml b/ocaml/xapi/xapi_vm_helpers.ml
index c715303b836..88590dc195b 100644
--- a/ocaml/xapi/xapi_vm_helpers.ml
+++ b/ocaml/xapi/xapi_vm_helpers.ml
@@ -1284,7 +1284,7 @@ let set_HVM_shadow_multiplier ~__context ~self ~value =
 let inclusive_range a b = List.init (b - a + 1) (fun k -> a + k)
 
 let vbd_inclusive_range hvm a b =
-  List.map (Device_number.of_disk_number hvm) (inclusive_range a b)
+  List.filter_map (Device_number.of_disk_number hvm) (inclusive_range a b)
 
 let vif_inclusive_range a b = List.map string_of_int (inclusive_range a b)
 
@@ -1302,8 +1302,8 @@ let allowed_VBD_devices_PV = vbd_inclusive_range false 0 254
 let allowed_VBD_devices_control_domain = vbd_inclusive_range false 0 255
 
 let allowed_VBD_devices_HVM_floppy =
-  List.map
-    (fun x -> Device_number.make (Device_number.Floppy, x, 0))
+  List.filter_map
+    (fun x -> Device_number.(make Floppy ~disk:x ~partition:0))
     (inclusive_range 0 1)
 
 let allowed_VIF_devices_HVM = vif_inclusive_range 0 6
@@ -1314,8 +1314,8 @@ let allowed_VIF_devices_PV = vif_inclusive_range 0 6
     	represent possible interpretations of [s]. *)
 let possible_VBD_devices_of_string s =
   (* NB userdevice fields are arbitrary strings and device fields may be "" *)
-  let parse hvm x = try Some (Device_number.of_string hvm x) with _ -> None in
-  Listext.List.unbox_list [parse true s; parse false s]
+  let parse hvm x = Device_number.of_string ~hvm x in
+  List.filter_map Fun.id [parse true s; parse false s]
 
 (** [all_used_VBD_devices __context self] returns a list of Device_number.t
     	which are considered to be already in-use in the VM *)
diff --git a/ocaml/xapi/xapi_xenops.ml b/ocaml/xapi/xapi_xenops.ml
index cb1932aab0a..dfb2b666205 100644
--- a/ocaml/xapi/xapi_xenops.ml
+++ b/ocaml/xapi/xapi_xenops.ml
@@ -555,31 +555,37 @@ module MD = struct
       | `pv_in_pvh | `pv | `pvh | `unspecified ->
           false
     in
-    let device_number = Device_number.of_string hvm vbd.API.vBD_userdevice in
+    let device_number =
+      match Device_number.of_string ~hvm vbd.API.vBD_userdevice with
+      | Some dev ->
+          dev
+      | None ->
+          raise
+            Api_errors.(Server_error (invalid_device, [vbd.API.vBD_userdevice]))
+    in
     let open Vbd in
     let ty = vbd.API.vBD_qos_algorithm_type in
     let params = vbd.API.vBD_qos_algorithm_params in
     let qos_class params =
-      if List.mem_assoc "class" params then
-        match List.assoc "class" params with
-        | "highest" ->
-            Highest
-        | "high" ->
-            High
-        | "normal" ->
-            Normal
-        | "low" ->
-            Low
-        | "lowest" ->
-            Lowest
-        | s -> (
-          try Other (int_of_string s)
-          with _ ->
-            warn "Unknown VBD QoS scheduler class (try 'high' 'low' 'normal')" ;
-            Normal
-        )
-      else
-        Normal
+      match List.assoc_opt "class" params with
+      | Some "highest" ->
+          Highest
+      | Some "high" ->
+          High
+      | Some "normal" ->
+          Normal
+      | Some "low" ->
+          Low
+      | Some "lowest" ->
+          Lowest
+      | Some s -> (
+        try Other (int_of_string s)
+        with _ ->
+          warn "Unknown VBD QoS scheduler class (try 'high' 'low' 'normal')" ;
+          Normal
+      )
+      | None ->
+          Normal
     in
     let qos_scheduler params =
       try
@@ -2459,18 +2465,16 @@ let update_vbd ~__context (id : string * string) =
           in
           let linux_device = snd id in
           let device_number = Device_number.of_linux_device linux_device in
-          (* only try matching against disk number if the device is not a floppy (as "0" shouldn't match "fda") *)
-          let disk_number =
-            match Device_number.spec device_number with
-            | Device_number.Ide, _, _ | Device_number.Xen, _, _ ->
-                Some
-                  (device_number
-                  |> Device_number.to_disk_number
-                  |> string_of_int
-                  )
+          let disk_of dev =
+            (* only try matching against disk number if the device is not a
+               floppy (as "0" shouldn't match "fda") *)
+            match Device_number.bus dev with
+            | Ide | Xen ->
+                Some (string_of_int Device_number.(disk dev))
             | _ ->
                 None
           in
+          let disk_number = Option.bind device_number disk_of in
           debug "VM %s VBD userdevices = [ %s ]" (fst id)
             (String.concat "; "
                (List.map (fun (_, r) -> r.API.vBD_userdevice) vbdrs)
diff --git a/ocaml/xapi/xha_interface.ml b/ocaml/xapi/xha_interface.ml
index 608ae9a64a2..53be303e04c 100644
--- a/ocaml/xapi/xha_interface.ml
+++ b/ocaml/xapi/xha_interface.ml
@@ -40,9 +40,9 @@ let first_xml_element_with_name elements name =
     are stripped of leading and trailing whitespace. *)
 let hash_table_entry_of_leaf_xml_element = function
   | Xml.Element (name, _, Xml.PCData value :: _) ->
-      Some (String.strip String.isspace name, String.strip String.isspace value)
+      Some (String.trim name, String.trim value)
   | Xml.Element (name, _, []) ->
-      Some (String.strip String.isspace name, "")
+      Some (String.trim name, "")
   | _ ->
       None
 
diff --git a/ocaml/xapi/xmlrpc_sexpr.ml b/ocaml/xapi/xmlrpc_sexpr.ml
index 4e394fdb697..d241491cdc3 100644
--- a/ocaml/xapi/xmlrpc_sexpr.ml
+++ b/ocaml/xapi/xmlrpc_sexpr.ml
@@ -41,7 +41,7 @@ let xmlrpc_to_sexpr (root : xml) =
     | _, [] ->
         []
     | _, PCData text :: _ ->
-        let text = String.strip String.isspace text in
+        let text = String.trim text in
         [SExpr.String text]
     (* empty <value>s have default value '' *)
     | h, Element ("value", _, []) :: siblings ->
@@ -69,7 +69,7 @@ let xmlrpc_to_sexpr (root : xml) =
     (*ignore incorrect member*)
     (* any other element *)
     | h, Element (tag, _, children) :: siblings ->
-        let tag = String.strip String.isspace tag in
+        let tag = String.trim tag in
         let mytag = SExpr.String tag in
         let (mychildren : SExpr.t list) = visit (h + 1) children in
         let anode = SExpr.Node (mytag :: mychildren) in
diff --git a/ocaml/xenopsd/cli/xn.ml b/ocaml/xenopsd/cli/xn.ml
index 5ac6100669c..9658650699f 100644
--- a/ocaml/xenopsd/cli/xn.ml
+++ b/ocaml/xenopsd/cli/xn.ml
@@ -223,20 +223,30 @@ type disk_info = {
 let parse_disk_info x =
   match Re.Str.split_delim (Re.Str.regexp "[,]") x with
   | [source; device_number; rw] ->
-      let ty, device_number, device_number' =
+      let maybe_device =
         match Re.Str.split_delim (Re.Str.regexp "[:]") device_number with
         | [x] ->
-            (Vbd.Disk, x, Device_number.of_string false x)
+            Some (Vbd.Disk, x)
         | [x; "floppy"] ->
-            (Vbd.Floppy, x, Device_number.of_string false x)
+            Some (Vbd.Floppy, x)
         | [x; "cdrom"] ->
-            (Vbd.CDROM, x, Device_number.of_string false x)
+            Some (Vbd.CDROM, x)
         | _ ->
+            None
+      in
+      let get_position (ty, id) =
+        Option.map (fun x -> (ty, id, x)) (Device_number.of_string ~hvm:false id)
+      in
+      let ty, device_number, position =
+        match Option.bind maybe_device get_position with
+        | None ->
             Printf.fprintf stderr
               "Failed to understand disk name '%s'. It should be 'xvda' or \
                'hda:cdrom'\n"
               device_number ;
             exit 2
+        | Some disk ->
+            disk
       in
       let mode =
         match String.lowercase_ascii rw with
@@ -250,7 +260,7 @@ let parse_disk_info x =
             exit 2
       in
       let backend = parse_source source in
-      {id= device_number; ty; position= device_number'; mode; disk= backend}
+      {id= device_number; ty; position; mode; disk= backend}
   | _ ->
       Printf.fprintf stderr
         "I don't understand '%s'. Please use 'phy:path,xvda,w'\n" x ;
diff --git a/ocaml/xenopsd/lib/xenops_server_simulator.ml b/ocaml/xenopsd/lib/xenops_server_simulator.ml
index c12a929392f..c5123641978 100644
--- a/ocaml/xenopsd/lib/xenops_server_simulator.ml
+++ b/ocaml/xenopsd/lib/xenops_server_simulator.ml
@@ -240,12 +240,20 @@ let add_vbd (vm : Vm.id) (vbd : Vbd.t) () =
   debug "add_vbd" ;
   let d = DB.read_exn vm in
   (* there shouldn't be any None values in here anyway *)
-  let ps = List.map (fun vbd -> vbd.Vbd.position) d.Domain.vbds in
-  assert (not (List.mem None ps)) ;
-  let dns = List.map Option.get ps in
-  let indices = List.map Device_number.to_disk_number dns in
+  let dns = List.filter_map (fun vbd -> vbd.Vbd.position) d.Domain.vbds in
+  let indices = List.map Device_number.disk dns in
   let next_index = List.fold_left max (-1) indices + 1 in
   let next_dn = Device_number.of_disk_number d.Domain.hvm next_index in
+  let next_dn =
+    match next_dn with
+    | None ->
+        raise
+          (Xenopsd_error
+             (Internal_error "Ran out of available device numbers for the vbd")
+          )
+    | Some dn ->
+        dn
+  in
   let this_dn = Option.value ~default:next_dn vbd.Vbd.position in
   if List.mem this_dn dns then (
     debug "VBD.plug %s.%s: Already exists" (fst vbd.Vbd.id) (snd vbd.Vbd.id) ;
diff --git a/ocaml/xenopsd/xc/device.ml b/ocaml/xenopsd/xc/device.ml
index 20f2405a7e7..3f6da8152a6 100644
--- a/ocaml/xenopsd/xc/device.ml
+++ b/ocaml/xenopsd/xc/device.ml
@@ -585,17 +585,18 @@ module Vbd_Common = struct
         (fun x ->
           x.frontend.devid
           |> Device_number.of_xenstore_key
-          |> Device_number.spec
-          |> function
-          | _, disk, _ ->
-              disk
+          |> Device_number.disk
         )
         (Device_common.list_frontends ~xs domid)
     in
     let next = List.fold_left max 0 disks + 1 in
     let open Device_number in
     let bus_type = if hvm && next < 4 then Ide else Xen in
-    (bus_type, next, 0)
+    match make bus_type ~disk:next ~partition:0 with
+    | Some x ->
+        x
+    | None ->
+        raise (Xenopsd_error (Internal_error "Unable to decide slot for vbd"))
 
   type t = {
       mode: mode
@@ -620,7 +621,7 @@ module Vbd_Common = struct
       | Some x ->
           x
       | None ->
-          make (free_device ~xs hvm domid)
+          free_device ~xs hvm domid
     in
     let devid = to_xenstore_key device_number in
     let device =
@@ -2986,7 +2987,11 @@ module Backend = struct
         qemu-upstream-compat backend *)
     module Vbd = struct
       let cd_of devid =
-        devid |> Device_number.of_xenstore_key |> Device_number.spec |> function
+        match
+          ( Device_number.of_xenstore_key devid
+            :> Device_number.bus_type * int * int
+            )
+        with
         | Ide, 0, _ ->
             "ide0-cd0"
         | Ide, 1, _ ->
diff --git a/ocaml/xenopsd/xc/xenops_server_xen.ml b/ocaml/xenopsd/xc/xenops_server_xen.ml
index 44d4e4e942c..ee4524cf781 100644
--- a/ocaml/xenopsd/xc/xenops_server_xen.ml
+++ b/ocaml/xenopsd/xc/xenops_server_xen.ml
@@ -3774,14 +3774,14 @@ module VBD = struct
             let qemu_domid = this_domid ~xs in
             let qemu_frontend =
               let maybe_create_vbd_frontend () =
-                let index = Device_number.to_disk_number device_number in
+                let index = Device_number.disk device_number in
                 match vbd.Vbd.backend with
                 | None ->
                     Some (index, Empty)
                 | Some _ ->
                     Some (index, create_vbd_frontend ~xc ~xs task qemu_domid vdi)
               in
-              match Device_number.spec device_number with
+              match (device_number :> Device_number.bus_type * int * int) with
               | Ide, n, _ when 0 <= n && n < 4 ->
                   maybe_create_vbd_frontend ()
               | Floppy, n, _ when 0 <= n && n < 2 ->
diff --git a/quality-gate.sh b/quality-gate.sh
index 8f761718627..e4a8379f214 100755
--- a/quality-gate.sh
+++ b/quality-gate.sh
@@ -3,7 +3,7 @@
 set -e
 
 list-hd () {
-  N=302
+  N=300
   LIST_HD=$(git grep -r --count 'List.hd' -- **/*.ml | cut -d ':' -f 2 | paste -sd+ - | bc)
   if [ "$LIST_HD" -eq "$N" ]; then
     echo "OK counted $LIST_HD List.hd usages"
@@ -25,7 +25,7 @@ verify-cert () {
 }
 
 mli-files () {
-  N=513
+  N=512
   # do not count ml files from the tests in ocaml/{tests/perftest/quicktest}
   MLIS=$(git ls-files -- '**/*.mli' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest|ocaml/message-switch/core_test" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;)
   MLS=$(git  ls-files -- '**/*.ml'  | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest|ocaml/message-switch/core_test" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;)
diff --git a/xapi-idl.opam b/xapi-idl.opam
index d6e7a390671..1af2c2bd516 100644
--- a/xapi-idl.opam
+++ b/xapi-idl.opam
@@ -36,6 +36,7 @@ depends: [
   "xapi-open-uri"
   "xapi-stdext-date"
   "xapi-stdext-pervasives"
+  "xapi-stdext-std"
   "xapi-stdext-threads"
   "xapi-tracing"
   "xapi-inventory"
diff --git a/xapi-idl.opam.template b/xapi-idl.opam.template
index 6c879e68b97..b07bec320ec 100644
--- a/xapi-idl.opam.template
+++ b/xapi-idl.opam.template
@@ -34,6 +34,7 @@ depends: [
   "xapi-open-uri"
   "xapi-stdext-date"
   "xapi-stdext-pervasives"
+  "xapi-stdext-std"
   "xapi-stdext-threads"
   "xapi-tracing"
   "xapi-inventory"