diff --git a/README.md b/README.md
index 91ed44d..530bc83 100644
--- a/README.md
+++ b/README.md
@@ -34,7 +34,7 @@ https://github.com/hannesm/albatross`.
 The following elaborates on how to get the software up and running, following by
 provisioning and deploying some unikernels.  There is a *server* (`SRV`)
 component which needs six binaries: vmm_console, vmm_log, vmm_stats_lwt, vmmd,
-solo5-hvt.none, and solo5-hvt.net; a `CA` machine (which should be air-gapped, or
+solo5-hvt.none, solo5-hvt.net, solo5-hvt.block and solo5-hvt.block-net; a `CA` machine (which should be air-gapped, or
 at least use some hardware token) for provisioning which needs vmm_sign, and
 vmm_gen_ca; and a *development* (`DEV`) machine which has a fully featured OCaml
 and MirageOS environment.  Each step is prefixed with the machine it is supposed
diff --git a/app/vmm_cli.ml b/app/vmm_cli.ml
index 03f2d2c..57973e1 100644
--- a/app/vmm_cli.ml
+++ b/app/vmm_cli.ml
@@ -3,15 +3,13 @@
 open Astring
 open Vmm_core
 
-open Lwt.Infix
-
 let print_result version (header, reply) =
   if not (Vmm_commands.version_eq header.Vmm_commands.version version) then
     Logs.err (fun m -> m "version not equal")
   else match reply with
-    | `Success s -> Logs.app (fun m -> m "%a" Vmm_commands.pp_wire (header, reply))
-    | `Data d -> Logs.app (fun m -> m "%a" Vmm_commands.pp_wire (header, reply))
-    | `Failure d -> Logs.warn (fun m -> m "%a" Vmm_commands.pp_wire (header, reply))
+    | `Success _ -> Logs.app (fun m -> m "%a" Vmm_commands.pp_wire (header, reply))
+    | `Data _ -> Logs.app (fun m -> m "%a" Vmm_commands.pp_wire (header, reply))
+    | `Failure _ -> Logs.warn (fun m -> m "%a" Vmm_commands.pp_wire (header, reply))
     | `Command _ -> Logs.err (fun m -> m "unexpected command %a" Vmm_commands.pp_wire (header, reply))
 
 let setup_log style_renderer level =
@@ -88,13 +86,15 @@ let bridge =
   (parse, pp_bridge)
 
 let vm_c =
-  let parse s = `Ok (id_of_string s)
+  let parse s = match Name.of_string s with
+    | Error (`Msg msg) -> `Error msg
+    | Ok name -> `Ok name
   in
-  (parse, pp_id)
+  (parse, Name.pp)
 
 let opt_vm_name =
   let doc = "name of virtual machine." in
-  Arg.(value & opt vm_c [] & info [ "n" ; "name"] ~doc)
+  Arg.(value & opt vm_c Name.root & info [ "n" ; "name"] ~doc)
 
 let compress_level =
   let doc = "Compression level (0 for no compression)" in
@@ -130,7 +130,7 @@ let block_size =
 
 let opt_block_name =
   let doc = "Name of block device." in
-  Arg.(value & opt vm_c [] & info [ "name" ] ~doc)
+  Arg.(value & opt vm_c Name.root & info [ "name" ] ~doc)
 
 let opt_block_size =
   let doc = "Block storage to allow in MB" in
diff --git a/app/vmm_stats_pure.ml b/app/vmm_stats_pure.ml
index e3fccf5..538f809 100644
--- a/app/vmm_stats_pure.ml
+++ b/app/vmm_stats_pure.ml
@@ -114,10 +114,10 @@ let tick t =
                 ru', vmm', ifd
               in
               List.fold_left (fun out (id, socket) ->
-                  match Vmm_core.drop_super ~super:id ~sub:vmid with
-                  | None -> Logs.err (fun m -> m "couldn't drop super %a from sub %a" Vmm_core.pp_id id Vmm_core.pp_id vmid) ; out
+                  match Vmm_core.Name.drop_super ~super:id ~sub:vmid with
+                  | None -> Logs.err (fun m -> m "couldn't drop super %a from sub %a" Vmm_core.Name.pp id Vmm_core.Name.pp vmid) ; out
                   | Some real_id ->
-                    let header = Vmm_commands.{ version = my_version ; sequence = 0L ; id = real_id } in
+                    let header = Vmm_commands.{ version = my_version ; sequence = 0L ; name = real_id } in
                     ((socket, vmid, (header, `Data (`Stats_data stats))) :: out))
                 out xs)
           [] (Vmm_trie.all t'.vmid_pid)
@@ -133,8 +133,8 @@ let add_pid t vmid pid nics =
     let rec go cnt acc id =
       if id > 0 && cnt > 0 then
         match wrap sysctl_ifdata id with
-        | Some ifd when List.mem ifd.Vmm_core.Stats.name nics ->
-          go (pred cnt) ((id, ifd.Vmm_core.Stats.name) :: acc) (pred id)
+        | Some ifd when List.mem ifd.Vmm_core.Stats.ifname nics ->
+          go (pred cnt) ((id, ifd.Vmm_core.Stats.ifname) :: acc) (pred id)
         | _ -> go cnt acc (pred id)
       else
         List.rev acc
@@ -150,9 +150,9 @@ let add_pid t vmid pid nics =
     Ok { t with pid_nic ; vmid_pid }
 
 let remove_vmid t vmid =
-  Logs.info (fun m -> m "removing vmid %a" Vmm_core.pp_id vmid) ;
+  Logs.info (fun m -> m "removing vmid %a" Vmm_core.Name.pp vmid) ;
   match Vmm_trie.find vmid t.vmid_pid with
-  | None -> Logs.warn (fun m -> m "no pid found for %a" Vmm_core.pp_id vmid) ; t
+  | None -> Logs.warn (fun m -> m "no pid found for %a" Vmm_core.Name.pp vmid) ; t
   | Some pid ->
     Logs.info (fun m -> m "removing pid %d" pid) ;
     (try
@@ -179,7 +179,7 @@ let handle t socket (header, wire) =
     match wire with
     | `Command (`Stats_cmd cmd) ->
       begin
-        let id = header.Vmm_commands.id in
+        let id = header.Vmm_commands.name in
         match cmd with
         | `Stats_add (pid, taps) ->
           add_pid t id pid taps >>= fun t ->
diff --git a/app/vmmc_bistro.ml b/app/vmmc_bistro.ml
index 0f0440f..a942e23 100644
--- a/app/vmmc_bistro.ml
+++ b/app/vmmc_bistro.ml
@@ -31,7 +31,7 @@ let handle (host, port) cert key ca id (cmd : Vmm_commands.t) =
   Vmm_lwt.read_from_file key >>= fun key_cs ->
   let key = X509.Encoding.Pem.Private_key.of_pem_cstruct1 key_cs in
   let tmpkey = Nocrypto.Rsa.generate 4096 in
-  let name = Vmm_core.string_of_id id in
+  let name = Vmm_core.Name.to_string id in
   let extensions =
     [ (true, `Key_usage [ `Digital_signature ; `Key_encipherment ])
     ; (true, `Basic_constraints (false, None))
diff --git a/app/vmmc_local.ml b/app/vmmc_local.ml
index 79c664b..dc9199b 100644
--- a/app/vmmc_local.ml
+++ b/app/vmmc_local.ml
@@ -28,10 +28,10 @@ let read fd =
   in
   loop ()
 
-let handle opt_socket id (cmd : Vmm_commands.t) =
+let handle opt_socket name (cmd : Vmm_commands.t) =
   let sock, next = Vmm_commands.endpoint cmd in
   connect (socket sock opt_socket) >>= fun fd ->
-  let header = Vmm_commands.{ version ; sequence = 0L ; id } in
+  let header = Vmm_commands.{ version ; sequence = 0L ; name } in
   Vmm_lwt.write_wire fd (header, `Command cmd) >>= function
   | Error `Exception -> Lwt.return ()
   | Ok () ->
diff --git a/app/vmmd_console.ml b/app/vmmd_console.ml
index 96a5383..5fa4252 100644
--- a/app/vmmd_console.ml
+++ b/app/vmmd_console.ml
@@ -20,8 +20,7 @@ let pp_unix_error ppf e = Fmt.string ppf (Unix.error_message e)
 
 let active = ref String.Map.empty
 
-let read_console name ring channel () =
-  let id = Vmm_core.id_of_string name in
+let read_console id name ring channel () =
   Lwt.catch (fun () ->
       let rec loop () =
         Lwt_io.read_line channel >>= fun line ->
@@ -31,7 +30,7 @@ let read_console name ring channel () =
         (match String.Map.find name !active with
          | None -> Lwt.return_unit
          | Some fd ->
-           let header = Vmm_commands.{ version = my_version ; sequence = 0L ; id } in
+           let header = Vmm_commands.{ version = my_version ; sequence = 0L ; name = id } in
            Vmm_lwt.write_wire fd (header, `Data (`Console_data (t, line))) >>= function
            | Error _ ->
              Vmm_lwt.safe_close fd >|= fun () ->
@@ -68,21 +67,21 @@ let open_fifo name =
 let t = ref String.Map.empty
 
 let add_fifo id =
-  let name = Vmm_core.string_of_id id in
+  let name = Vmm_core.Name.to_string id in
   open_fifo name >|= function
   | Some f ->
     let ring = Vmm_ring.create "" () in
     Logs.debug (fun m -> m "inserting fifo %s" name) ;
     let map = String.Map.add name ring !t in
     t := map ;
-    Lwt.async (read_console name ring f) ;
+    Lwt.async (read_console id name ring f) ;
     Ok ()
   | None ->
     Error (`Msg "opening")
 
 let subscribe s id =
-  let name = Vmm_core.string_of_id id in
-  Logs.debug (fun m -> m "attempting to subscribe %a" Vmm_core.pp_id id) ;
+  let name = Vmm_core.Name.to_string id in
+  Logs.debug (fun m -> m "attempting to subscribe %a" Vmm_core.Name.pp id) ;
   match String.Map.find name !t with
   | None ->
     active := String.Map.add name s !active ;
@@ -100,9 +99,9 @@ let send_history s r id since =
     | None -> Vmm_ring.read r
     | Some ts -> Vmm_ring.read_history r ts
   in
-  Logs.debug (fun m -> m "%a found %d history" Vmm_core.pp_id id (List.length entries)) ;
+  Logs.debug (fun m -> m "%a found %d history" Vmm_core.Name.pp id (List.length entries)) ;
   Lwt_list.iter_s (fun (i, v) ->
-      let header = Vmm_commands.{ version = my_version ; sequence = 0L ; id } in
+      let header = Vmm_commands.{ version = my_version ; sequence = 0L ; name = id } in
       Vmm_lwt.write_wire s (header, `Data (`Console_data (i, v))) >>= function
       | Ok () -> Lwt.return_unit
       | Error _ -> Vmm_lwt.safe_close s)
@@ -120,7 +119,7 @@ let handle s addr () =
         Logs.err (fun m -> m "ignoring data with bad version") ;
         Lwt.return_unit
       end else begin
-        let name = header.Vmm_commands.id in
+        let name = header.Vmm_commands.name in
         match cmd with
         | `Console_add ->
           begin
diff --git a/app/vmmd_influx.ml b/app/vmmd_influx.ml
index 69d5579..5eca733 100644
--- a/app/vmmd_influx.ml
+++ b/app/vmmd_influx.ml
@@ -138,7 +138,7 @@ module P = struct
     in
     let fields = List.map (fun (k, v) -> k ^ "=" ^ v) fields in
     Printf.sprintf "interface,vm=%s,ifname=%s %s"
-      vm ifd.name (String.concat ~sep:"," fields)
+      vm ifd.ifname (String.concat ~sep:"," fields)
 end
 
 let my_version = `AV2
@@ -198,7 +198,7 @@ let rec read_sock_write_tcp c ?fd addr addrtype =
           safe_close c >|= fun () ->
           false
         end else
-          let name = string_of_id hdr.Vmm_commands.id in
+          let name = Name.to_string hdr.Vmm_commands.name in
           let ru = P.encode_ru name ru in
           let vmm = match vmm with None -> [] | Some xs -> [ P.encode_vmm name xs ] in
           let taps = List.map (P.encode_if name) ifs in
@@ -220,9 +220,9 @@ let rec read_sock_write_tcp c ?fd addr addrtype =
       read_sock_write_tcp c ?fd addr addrtype
 
 let query_sock vm c =
-  let header = Vmm_commands.{ version = my_version ; sequence = !command ; id = vm } in
+  let header = Vmm_commands.{ version = my_version ; sequence = !command ; name = vm } in
   command := Int64.succ !command  ;
-  Logs.debug (fun m -> m "%Lu requesting %a via socket" !command pp_id vm) ;
+  Logs.debug (fun m -> m "%Lu requesting %a via socket" !command Name.pp vm) ;
   Vmm_lwt.write_wire c (header, `Command (`Stats_cmd `Stats_subscribe))
 
 let rec maybe_connect stat_socket =
diff --git a/app/vmmd_log.ml b/app/vmmd_log.ml
index d668c11..47cf8b1 100644
--- a/app/vmmd_log.ml
+++ b/app/vmmd_log.ml
@@ -68,7 +68,7 @@ let send_history s ring id ts =
   let res =
     List.fold_left (fun acc (ts, event) ->
         let sub = Vmm_core.Log.name event in
-        if Vmm_core.is_sub_id ~super:id ~sub
+        if Vmm_core.Name.is_sub ~super:id ~sub
         then (ts, event) :: acc
         else acc)
       [] elements
@@ -77,7 +77,7 @@ let send_history s ring id ts =
   Lwt_list.fold_left_s (fun r (ts, event) ->
       match r with
       | Ok () ->
-        let header = Vmm_commands.{ version = my_version ; sequence = 0L ; id } in
+        let header = Vmm_commands.{ version = my_version ; sequence = 0L ; name = id } in
         Vmm_lwt.write_wire s (header, `Data (`Log_data (ts, event)))
       | Error e -> Lwt.return (Error e))
     (Ok ()) (List.rev res)
@@ -93,7 +93,7 @@ let handle_data s mvar ring hdr entry =
     Vmm_ring.write ring entry ;
     Lwt_mvar.put mvar entry >>= fun () ->
     let data' = (hdr, `Data (`Log_data entry)) in
-    broadcast hdr.Vmm_commands.id data' !tree >|= fun tree' ->
+    broadcast hdr.Vmm_commands.name data' !tree >|= fun tree' ->
     tree := tree'
   end
 
@@ -128,7 +128,7 @@ let handle mvar ring s addr () =
       end else begin
         match lc with
         | `Log_subscribe ts ->
-          let tree', ret = Vmm_trie.insert hdr.Vmm_commands.id s !tree in
+          let tree', ret = Vmm_trie.insert hdr.Vmm_commands.name s !tree in
           tree := tree' ;
           (match ret with
            | None -> Lwt.return_unit
@@ -138,7 +138,7 @@ let handle mvar ring s addr () =
           | Error _ -> Logs.err (fun m -> m "error while sending reply for subscribe") ;
             Lwt.return_unit
           | Ok () ->
-            send_history s ring hdr.Vmm_commands.id ts >>= function
+            send_history s ring hdr.Vmm_commands.name ts >>= function
             | Error _ -> Logs.err (fun m -> m "error while sending history") ; Lwt.return_unit
             | Ok () ->
               (* command processing is finished, but we leave the socket open
diff --git a/app/vmmd_stats.ml b/app/vmmd_stats.ml
index c853835..034a22d 100644
--- a/app/vmmd_stats.ml
+++ b/app/vmmd_stats.ml
@@ -66,7 +66,7 @@ let rec timer interval () =
       Vmm_lwt.write_wire s stat >>= function
       | Ok () -> Lwt.return_unit
       | Error `Exception ->
-        Logs.debug (fun m -> m "removing entry %a" Vmm_core.pp_id name) ;
+        Logs.debug (fun m -> m "removing entry %a" Vmm_core.Name.pp name) ;
         t := remove_entry !t name ;
         Vmm_lwt.safe_close s)
     outs >>= fun () ->
diff --git a/app/vmmd_tls.ml b/app/vmmd_tls.ml
index 3509f9f..13efaa0 100644
--- a/app/vmmd_tls.ml
+++ b/app/vmmd_tls.ml
@@ -71,8 +71,8 @@ let handle ca (tls, addr) =
            match r with
            | Error (`Msg msg) -> Lwt.return (Error (`Msg msg))
            | Ok () ->
-             Logs.debug (fun m -> m "adding policy for %a: %a" Vmm_core.pp_id id Vmm_core.pp_policy policy) ;
-             let header = Vmm_commands.{version = my_version ; sequence = !command ; id } in
+             Logs.debug (fun m -> m "adding policy for %a: %a" Vmm_core.Name.pp id Vmm_core.pp_policy policy) ;
+             let header = Vmm_commands.{version = my_version ; sequence = !command ; name = id } in
              command := Int64.succ !command ;
              Vmm_lwt.write_wire fd (header, `Command (`Policy_cmd (`Policy_add policy))) >>= function
              | Error `Exception -> Lwt.return (Error (`Msg "failed to write policy"))
@@ -91,7 +91,7 @@ let handle ca (tls, addr) =
       begin
         Logs.warn (fun m -> m "error while applying policies %s" msg) ;
         let wire =
-          let header = Vmm_commands.{version = my_version ; sequence = 0L ; id = name } in
+          let header = Vmm_commands.{version = my_version ; sequence = 0L ; name } in
           header, `Failure msg
         in
         Vmm_tls_lwt.write_tls tls wire >>= fun _ ->
@@ -100,7 +100,7 @@ let handle ca (tls, addr) =
       end
     | Ok () ->
       let wire =
-        let header = Vmm_commands.{version = my_version ; sequence = !command ; id = name } in
+        let header = Vmm_commands.{version = my_version ; sequence = !command ; name } in
         command := Int64.succ !command ;
         (header, `Command cmd)
       in
diff --git a/app/vmmp_request.ml b/app/vmmp_request.ml
index b69c389..a7b0f1e 100644
--- a/app/vmmp_request.ml
+++ b/app/vmmp_request.ml
@@ -15,7 +15,7 @@ let csr priv name cmd =
 
 let jump id cmd =
   Nocrypto_entropy_unix.initialize () ;
-  let name = Vmm_core.string_of_id id in
+  let name = Vmm_core.Name.to_string id in
   match
     priv_key None name >>= fun priv ->
     let csr = csr priv name cmd in
diff --git a/src/vmm_asn.ml b/src/vmm_asn.ml
index 6bb8341..f3523bf 100644
--- a/src/vmm_asn.ml
+++ b/src/vmm_asn.ml
@@ -150,14 +150,14 @@ let int32 =
 
 let ifdata =
   let open Stats in
-  let f (name, (flags, (send_length, (max_send_length, (send_drops, (mtu, (baudrate, (input_packets, (input_errors, (output_packets, (output_errors, (collisions, (input_bytes, (output_bytes, (input_mcast, (output_mcast, (input_dropped, output_dropped))))))))))))))))) =
-    { name; flags; send_length; max_send_length; send_drops; mtu; baudrate; input_packets; input_errors; output_packets; output_errors; collisions; input_bytes; output_bytes; input_mcast; output_mcast; input_dropped; output_dropped }
+  let f (ifname, (flags, (send_length, (max_send_length, (send_drops, (mtu, (baudrate, (input_packets, (input_errors, (output_packets, (output_errors, (collisions, (input_bytes, (output_bytes, (input_mcast, (output_mcast, (input_dropped, output_dropped))))))))))))))))) =
+    { ifname; flags; send_length; max_send_length; send_drops; mtu; baudrate; input_packets; input_errors; output_packets; output_errors; collisions; input_bytes; output_bytes; input_mcast; output_mcast; input_dropped; output_dropped }
   and g i =
-    (i.name, (i.flags, (i.send_length, (i.max_send_length, (i.send_drops, (i.mtu, (i.baudrate, (i.input_packets, (i.input_errors, (i.output_packets, (i.output_errors, (i.collisions, (i.input_bytes, (i.output_bytes, (i.input_mcast, (i.output_mcast, (i.input_dropped, i.output_dropped)))))))))))))))))
+    (i.ifname, (i.flags, (i.send_length, (i.max_send_length, (i.send_drops, (i.mtu, (i.baudrate, (i.input_packets, (i.input_errors, (i.output_packets, (i.output_errors, (i.collisions, (i.input_bytes, (i.output_bytes, (i.input_mcast, (i.output_mcast, (i.input_dropped, i.output_dropped)))))))))))))))))
   in
   Asn.S.map f g @@
   Asn.S.(sequence @@
-         (required ~label:"name" utf8_string)
+         (required ~label:"ifname" utf8_string)
        @ (required ~label:"flags" int32)
        @ (required ~label:"send_length" int32)
        @ (required ~label:"max_send_length" int32)
@@ -194,31 +194,37 @@ let stats_cmd =
            (explicit 1 null)
            (explicit 2 null))
 
+let of_name, to_name =
+  Name.to_list,
+  fun list -> match Name.of_list list with
+    | Error (`Msg msg) -> Asn.S.error (`Parse msg)
+    | Ok name -> name
+
 let log_event =
   let f = function
     | `C1 () -> `Startup
-    | `C2 (name, ip, port) -> `Login (name, ip, port)
-    | `C3 (name, ip, port) -> `Logout (name, ip, port)
-    | `C4 (name, pid, taps, block) -> `Vm_start (name, pid, taps, block)
+    | `C2 (name, ip, port) -> `Login (to_name name, ip, port)
+    | `C3 (name, ip, port) -> `Logout (to_name name, ip, port)
+    | `C4 (name, pid, taps, block) -> `Vm_start (to_name name, pid, taps, block)
     | `C5 (name, pid, status) ->
       let status' = match status with
         | `C1 n -> `Exit n
         | `C2 n -> `Signal n
         | `C3 n -> `Stop n
       in
-      `Vm_stop (name, pid, status')
+      `Vm_stop (to_name name, pid, status')
   and g = function
     | `Startup -> `C1 ()
-    | `Login (name, ip, port) -> `C2 (name, ip, port)
-    | `Logout (name, ip, port) -> `C3 (name, ip, port)
-    | `Vm_start (name, pid, taps, block) -> `C4 (name, pid, taps, block)
+    | `Login (name, ip, port) -> `C2 (of_name name, ip, port)
+    | `Logout (name, ip, port) -> `C3 (of_name name, ip, port)
+    | `Vm_start (name, pid, taps, block) -> `C4 (of_name name, pid, taps, block)
     | `Vm_stop (name, pid, status) ->
       let status' = match status with
         | `Exit n -> `C1 n
         | `Signal n -> `C2 n
         | `Stop n -> `C3 n
       in
-      `C5 (name, pid, status')
+      `C5 (of_name name, pid, status')
   in
   let endp =
     Asn.S.(sequence3
@@ -382,28 +388,28 @@ let data =
                           (required ~label:"event" log_event))))
 
 let header =
-  let f (version, sequence, id) = { version ; sequence ; id }
-  and g h = h.version, h.sequence, h.id
+  let f (version, sequence, name) = { version ; sequence ; name = to_name name }
+  and g h = h.version, h.sequence, of_name h.name
   in
   Asn.S.map f g @@
   Asn.S.(sequence3
            (required ~label:"version" version)
            (required ~label:"sequence" int64)
-           (required ~label:"id" (sequence_of utf8_string)))
+           (required ~label:"name" (sequence_of utf8_string)))
 
 let success =
   let f = function
     | `C1 () -> `Empty
     | `C2 str -> `String str
-    | `C3 policies -> `Policies policies
-    | `C4 vms -> `Vms vms
-    | `C5 blocks -> `Blocks blocks
+    | `C3 policies -> `Policies (List.map (fun (name, p) -> to_name name, p) policies)
+    | `C4 vms -> `Vms (List.map (fun (name, vm) -> to_name name, vm) vms)
+    | `C5 blocks -> `Blocks (List.map (fun (name, s, a) -> to_name name, s, a) blocks)
   and g = function
     | `Empty -> `C1 ()
     | `String s -> `C2 s
-    | `Policies ps -> `C3 ps
-    | `Vms vms -> `C4 vms
-    | `Blocks blocks -> `C5 blocks
+    | `Policies ps -> `C3 (List.map (fun (name, p) -> of_name name, p) ps)
+    | `Vms vms -> `C4 (List.map (fun (name, v) -> of_name name, v) vms)
+    | `Blocks blocks -> `C5 (List.map (fun (name, s, a) -> of_name name, s, a) blocks)
   in
   Asn.S.map f g @@
   Asn.S.(choice5
diff --git a/src/vmm_commands.ml b/src/vmm_commands.ml
index 0cc4fc2..9793378 100644
--- a/src/vmm_commands.ml
+++ b/src/vmm_commands.ml
@@ -113,25 +113,25 @@ let pp_data ppf = function
 type header = {
   version : version ;
   sequence : int64 ;
-  id : id ;
+  name : Name.t ;
 }
 
 type success = [
   | `Empty
   | `String of string
-  | `Policies of (id * policy) list
-  | `Vms of (id * vm_config) list
-  | `Blocks of (id * int * bool) list
+  | `Policies of (Name.t * policy) list
+  | `Vms of (Name.t * vm_config) list
+  | `Blocks of (Name.t * int * bool) list
 ]
 
 let pp_block ppf (id, size, active) =
-  Fmt.pf ppf "block %a size %d MB active %B" pp_id id size active
+  Fmt.pf ppf "block %a size %d MB active %B" Name.pp id size active
 
 let pp_success ppf = function
   | `Empty -> Fmt.string ppf "success"
   | `String data -> Fmt.pf ppf "success: %s" data
-  | `Policies ps -> Fmt.(list ~sep:(unit "@.") (pair ~sep:(unit ": ") pp_id pp_policy)) ppf ps
-  | `Vms vms -> Fmt.(list ~sep:(unit "@.") (pair ~sep:(unit ": ") pp_id pp_vm_config)) ppf vms
+  | `Policies ps -> Fmt.(list ~sep:(unit "@.") (pair ~sep:(unit ": ") Name.pp pp_policy)) ppf ps
+  | `Vms vms -> Fmt.(list ~sep:(unit "@.") (pair ~sep:(unit ": ") Name.pp pp_vm_config)) ppf vms
   | `Blocks blocks -> Fmt.(list ~sep:(unit "@.") pp_block) ppf blocks
 
 type wire = header * [
@@ -141,11 +141,11 @@ type wire = header * [
     | `Data of data ]
 
 let pp_wire ppf (header, data) =
-  let id = header.id in
+  let name = header.name in
   match data with
-  | `Command c -> Fmt.pf ppf "host %a: %a" pp_id id pp c
-  | `Failure f -> Fmt.pf ppf "host %a: command failed %s" pp_id id f
-  | `Success s -> Fmt.pf ppf "host %a: %a" pp_id id pp_success s
+  | `Command c -> Fmt.pf ppf "host %a: %a" Name.pp name pp c
+  | `Failure f -> Fmt.pf ppf "host %a: command failed %s" Name.pp name f
+  | `Success s -> Fmt.pf ppf "host %a: %a" Name.pp name pp_success s
   | `Data d -> pp_data ppf d
 
 let endpoint = function
diff --git a/src/vmm_commands.mli b/src/vmm_commands.mli
index 461565d..cc569ab 100644
--- a/src/vmm_commands.mli
+++ b/src/vmm_commands.mli
@@ -67,15 +67,15 @@ val pp_data : data Fmt.t
 type header = {
   version : version ;
   sequence : int64 ;
-  id : id ;
+  name : Name.t ;
 }
 
 type success = [
   | `Empty
   | `String of string
-  | `Policies of (id * policy) list
-  | `Vms of (id * vm_config) list
-  | `Blocks of (id * int * bool) list
+  | `Policies of (Name.t * policy) list
+  | `Vms of (Name.t * vm_config) list
+  | `Blocks of (Name.t * int * bool) list
 ]
 
 type wire = header * [
diff --git a/src/vmm_core.ml b/src/vmm_core.ml
index d2319d5..58331d5 100644
--- a/src/vmm_core.ml
+++ b/src/vmm_core.ml
@@ -40,31 +40,90 @@ let pp_vmtype ppf = function
   | `Hvt_amd64_compressed -> Fmt.pf ppf "hvt-amd64-compressed"
   | `Hvt_arm64 -> Fmt.pf ppf "hvt-arm64"
 
-type id = string list
+module Name = struct
+  type t = string list
 
-let string_of_id ids = String.concat ~sep:"." ids
+  let root = []
 
-let id_of_string str = String.cuts ~sep:"." str
+  let is_root x = x = []
 
-let drop_super ~super ~sub =
-  let rec go sup sub = match sup, sub with
-    | [], xs -> Some xs
-    | _, [] -> None
-    | x::xs, z::zs -> if String.equal x z then go xs zs else None
-  in
-  go super sub
+  let [@inline always] valid_label s =
+    String.length s < 20 &&
+    String.length s > 0 &&
+    String.get s 0 <> '-' && (* leading may not be '-' *)
+    String.for_all (function
+        | 'a'..'z' | 'A'..'Z' | '0'..'9' | '-' -> true
+        | _ -> false)
+      s (* only LDH (letters, digits, hyphen)! *)
 
-let is_sub_id ~super ~sub =
-  match drop_super ~super ~sub with None -> false | Some _ -> true
+  let to_string ids = String.concat ~sep:"." ids
 
-let domain id = match List.rev id with
-  | _::prefix -> List.rev prefix
-  | [] -> []
+  let to_list x = x
 
-let block_name vm_name dev = List.rev (dev :: List.rev (domain vm_name))
+  let append_exn lbl x =
+    if valid_label lbl then
+      x @ [ lbl ]
+    else
+      invalid_arg "label not valid"
 
-let pp_id ppf ids =
-  Fmt.(pf ppf "(%d)%a" (List.length ids) (list ~sep:(unit ".") string) ids)
+  let append lbl x =
+    if valid_label lbl then
+      Ok (x @ [ lbl ])
+    else
+      Error (`Msg "label not valid")
+
+  let prepend lbl x =
+    if valid_label lbl then
+      Ok (lbl :: x)
+    else
+      Error (`Msg "label not valid")
+
+  let domain id = match List.rev id with
+    | _::prefix -> List.rev prefix
+    | [] -> []
+
+  let image_file name =
+    let file = to_string name in
+    Fpath.(tmpdir / file + "img")
+
+  let fifo_file name =
+    let file = to_string name in
+    Fpath.(tmpdir / "fifo" / file)
+
+  let block_file name =
+    let file = to_string name in
+    Fpath.(blockdir / file)
+
+  let block_name vm_name dev =
+    List.rev (dev :: List.rev (domain vm_name))
+
+  let of_string str =
+    let id = String.cuts ~sep:"." str in
+    if List.for_all valid_label id then
+      Ok id
+    else
+      Error (`Msg "invalid name")
+
+  let of_list labels =
+    if List.for_all valid_label labels then
+      Ok labels
+    else
+      Error (`Msg "invalid name")
+
+  let drop_super ~super ~sub =
+    let rec go sup sub = match sup, sub with
+      | [], xs -> Some xs
+      | _, [] -> None
+      | x::xs, z::zs -> if String.equal x z then go xs zs else None
+    in
+    go super sub
+
+  let is_sub ~super ~sub =
+    match drop_super ~super ~sub with None -> false | Some _ -> true
+
+  let pp ppf ids =
+    Fmt.(pf ppf "(%d)%a" (List.length ids) (list ~sep:(unit ".") string) ids)
+end
 
 let pp_is ppf is = Fmt.pf ppf "%a" Fmt.(list ~sep:(unit ",") int) (IS.elements is)
 
@@ -237,7 +296,7 @@ module Stats = struct
     Fmt.(list ~sep:(unit "@.") (pair ~sep:(unit ": ") string int64)) ppf vmm
 
   type ifdata = {
-    name : string ;
+    ifname : string ;
     flags : int32 ;
     send_length : int32 ;
     max_send_length : int32 ;
@@ -258,8 +317,8 @@ module Stats = struct
   }
 
   let pp_ifdata ppf i =
-    Fmt.pf ppf "name %s flags %lX send_length %lu max_send_length %lu send_drops %lu mtu %lu baudrate %Lu input_packets %Lu input_errors %Lu output_packets %Lu output_errors %Lu collisions %Lu input_bytes %Lu output_bytes %Lu input_mcast %Lu output_mcast %Lu input_dropped %Lu output_dropped %Lu"
-      i.name i.flags i.send_length i.max_send_length i.send_drops i.mtu i.baudrate i.input_packets i.input_errors i.output_packets i.output_errors i.collisions i.input_bytes i.output_bytes i.input_mcast i.output_mcast i.input_dropped i.output_dropped
+    Fmt.pf ppf "ifname %s flags %lX send_length %lu max_send_length %lu send_drops %lu mtu %lu baudrate %Lu input_packets %Lu input_errors %Lu output_packets %Lu output_errors %Lu collisions %Lu input_bytes %Lu output_bytes %Lu input_mcast %Lu output_mcast %Lu input_dropped %Lu output_dropped %Lu"
+      i.ifname i.flags i.send_length i.max_send_length i.send_drops i.mtu i.baudrate i.input_packets i.input_errors i.output_packets i.output_errors i.collisions i.input_bytes i.output_bytes i.input_mcast i.output_mcast i.input_dropped i.output_dropped
 
   type t = rusage * vmm option * ifdata list
   let pp ppf (ru, vmm, ifs) =
@@ -278,11 +337,11 @@ let pp_process_exit ppf = function
 
 module Log = struct
   type log_event = [
-    | `Login of id * Ipaddr.V4.t * int
-    | `Logout of id * Ipaddr.V4.t * int
+    | `Login of Name.t * Ipaddr.V4.t * int
+    | `Logout of Name.t * Ipaddr.V4.t * int
     | `Startup
-    | `Vm_start of id * int * string list * string option
-    | `Vm_stop of id * int * process_exit
+    | `Vm_start of Name.t * int * string list * string option
+    | `Vm_stop of Name.t * int * process_exit
   ]
 
   let name = function
@@ -294,14 +353,14 @@ module Log = struct
 
   let pp_log_event ppf = function
     | `Startup -> Fmt.(pf ppf "startup")
-    | `Login (name, ip, port) -> Fmt.pf ppf "%a login %a:%d" pp_id name Ipaddr.V4.pp_hum ip port
-    | `Logout (name, ip, port) -> Fmt.pf ppf "%a logout %a:%d" pp_id name Ipaddr.V4.pp_hum ip port
+    | `Login (name, ip, port) -> Fmt.pf ppf "%a login %a:%d" Name.pp name Ipaddr.V4.pp_hum ip port
+    | `Logout (name, ip, port) -> Fmt.pf ppf "%a logout %a:%d" Name.pp name Ipaddr.V4.pp_hum ip port
     | `Vm_start (name, pid, taps, block) ->
       Fmt.pf ppf "%a started %d (tap %a, block %a)"
-        pp_id name pid Fmt.(list ~sep:(unit "; ") string) taps
+        Name.pp name pid Fmt.(list ~sep:(unit "; ") string) taps
         Fmt.(option ~none:(unit "no") string) block
     | `Vm_stop (name, pid, code) ->
-      Fmt.pf ppf "%a stopped %d with %a" pp_id name pid pp_process_exit code
+      Fmt.pf ppf "%a stopped %d with %a" Name.pp name pid pp_process_exit code
 
   type t = Ptime.t * log_event
 
diff --git a/src/vmm_core.mli b/src/vmm_core.mli
index d4815c7..f3fb057 100644
--- a/src/vmm_core.mli
+++ b/src/vmm_core.mli
@@ -20,14 +20,31 @@ module IM : sig
   include Map.S with type key = I.t
 end
 
-type id = string list
-val string_of_id : id -> string
-val id_of_string : string -> id
-val drop_super : super:id -> sub:id -> id option
-val is_sub_id : super:id -> sub:id -> bool
-val domain : id -> id
-val pp_id : id Fmt.t
-val block_name : id -> string -> id
+module Name : sig
+  type t
+
+  val is_root : t -> bool
+
+  val image_file : t -> Fpath.t
+  val fifo_file : t -> Fpath.t
+  val block_file : t -> Fpath.t
+
+  val of_list : string list -> (t, [> `Msg of string ]) result
+  val to_list : t -> string list
+  val append : string -> t -> (t, [> `Msg of string ]) result
+  val prepend : string -> t -> (t, [> `Msg of string ]) result
+  val append_exn : string -> t -> t
+
+  val root : t
+  val valid_label : string -> bool
+  val to_string : t -> string
+  val of_string : string -> (t, [> `Msg of string ]) result
+  val drop_super : super:t -> sub:t -> t option
+  val is_sub : super:t -> sub:t -> bool
+  val domain : t -> t
+  val pp : t Fmt.t
+  val block_name : t -> string -> t
+end
 
 type bridge =
   [ `External of string * Ipaddr.V4.t * Ipaddr.V4.t * Ipaddr.V4.t * int
@@ -70,7 +87,7 @@ type vm_config = {
 val pp_image : (vmtype * Cstruct.t) Fmt.t
 
 val pp_vm_config : vm_config Fmt.t
-val good_bridge : id -> 'a Astring.String.map -> bool
+val good_bridge : string list -> 'a Astring.String.map -> bool
 
 val vm_matches_res : policy -> vm_config -> bool
 
@@ -113,7 +130,7 @@ module Stats : sig
   val pp_vmm : vmm Fmt.t
 
   type ifdata = {
-    name : string;
+    ifname : string;
     flags : int32;
     send_length : int32;
     max_send_length : int32;
@@ -144,13 +161,13 @@ val pp_process_exit : process_exit Fmt.t
 
 module Log : sig
   type log_event = [
-    | `Login of id * Ipaddr.V4.t * int
-    | `Logout of id * Ipaddr.V4.t * int
+    | `Login of Name.t * Ipaddr.V4.t * int
+    | `Logout of Name.t * Ipaddr.V4.t * int
     | `Startup
-    | `Vm_start of id * int * string list * string option
-    | `Vm_stop of id * int * process_exit ]
+    | `Vm_start of Name.t * int * string list * string option
+    | `Vm_stop of Name.t * int * process_exit ]
 
-  val name : log_event -> id
+  val name : log_event -> Name.t
 
   val pp_log_event : log_event Fmt.t
 
diff --git a/src/vmm_resources.ml b/src/vmm_resources.ml
index bd9eeb0..0181476 100644
--- a/src/vmm_resources.ml
+++ b/src/vmm_resources.ml
@@ -27,14 +27,14 @@ type entry =
   | Policy of policy
 
 let pp_entry id ppf = function
-  | Vm vm -> Fmt.pf ppf "vm %a: %a@." pp_id id pp_vm_config vm.config
-  | Policy p -> Fmt.pf ppf "policy %a: %a@." pp_id id pp_policy p
-  | Block (size, used) -> Fmt.pf ppf "block device %a: %dMB (used %B)@." pp_id id size used
+  | Vm vm -> Fmt.pf ppf "vm %a: %a@." Name.pp id pp_vm_config vm.config
+  | Policy p -> Fmt.pf ppf "policy %a: %a@." Name.pp id pp_policy p
+  | Block (size, used) -> Fmt.pf ppf "block device %a: %dMB (used %B)@." Name.pp id size used
 
 type t = entry Vmm_trie.t
 
 let pp ppf t =
-  Vmm_trie.fold [] t
+  Vmm_trie.fold Name.root t
     (fun id ele () -> pp_entry id ppf ele) ()
 
 let empty = Vmm_trie.empty
@@ -75,7 +75,7 @@ let set_block_usage active t name vm =
   match vm.config.block_device with
   | None -> Ok t
   | Some block ->
-    let block_name = block_name name block in
+    let block_name = Name.block_name name block in
     match find_block t block_name with
     | None -> Error (`Msg "unknown block device")
     | Some (size, curr) ->
@@ -97,14 +97,14 @@ let remove_block t name = match find_block t name with
   | Some _ -> Ok (Vmm_trie.remove name t)
 
 let check_vm_policy t name vm =
-  let dom = domain name in
+  let dom = Name.domain name in
   let res = resource_usage t dom in
   match Vmm_trie.find dom t with
   | None -> Ok true
   | Some (Policy p) -> Ok (check_resource p vm res)
   | Some x ->
-    Logs.err (fun m -> m "id %a, expected policy, got %a" pp_id dom (pp_entry dom) x) ;
-    Rresult.R.error_msgf "expected policy for %a" pp_id dom
+    Logs.err (fun m -> m "id %a, expected policy, got %a" Name.pp dom (pp_entry dom) x) ;
+    Rresult.R.error_msgf "expected policy for %a" Name.pp dom
 
 let insert_vm t name vm =
   let open Rresult.R.Infix in
@@ -126,9 +126,9 @@ let check_policy_above t name p =
 
 let check_policy_below t name p =
   Vmm_trie.fold name t (fun name entry res ->
-      match name with
-      | [] -> res
-      | _ ->
+      if Name.is_root name then
+        res
+      else
         match res, entry with
         | Some p, Policy p' -> if is_sub ~super:p ~sub:p then Some p' else None
         | Some p, Vm vm ->
@@ -141,7 +141,7 @@ let check_policy_below t name p =
 
 let insert_policy t name p =
   match
-    check_policy_above t (domain name) p,
+    check_policy_above t (Name.domain name) p,
     check_policy_below t name p,
     check_resource_policy p (resource_usage t name)
   with
@@ -154,15 +154,15 @@ let check_block_policy t name size =
   match find_block t name with
   | Some _ -> Error (`Msg "block device with same name already exists")
   | None ->
-    let dom = domain name in
+    let dom = Name.domain name in
     let res = resource_usage t dom in
     let res' = { res with used_blockspace = res.used_blockspace + size } in
     match Vmm_trie.find dom t with
     | None -> Ok true
     | Some (Policy p) -> Ok (check_resource_policy p res')
     | Some x ->
-      Logs.err (fun m -> m "id %a, expected policy, got %a" pp_id dom (pp_entry dom) x) ;
-      Rresult.R.error_msgf "expected policy for %a" pp_id dom
+      Logs.err (fun m -> m "id %a, expected policy, got %a" Name.pp dom (pp_entry dom) x) ;
+      Rresult.R.error_msgf "expected policy for %a" Name.pp dom
 
 let insert_block t name size =
   let open Rresult.R.Infix in
diff --git a/src/vmm_resources.mli b/src/vmm_resources.mli
index bbcf25d..dc4023c 100644
--- a/src/vmm_resources.mli
+++ b/src/vmm_resources.mli
@@ -18,48 +18,48 @@ type t
 val empty : t
 
 (** [find_vm t id] is either [Some vm] or [None]. *)
-val find_vm : t -> Vmm_core.id -> Vmm_core.vm option
+val find_vm : t -> Vmm_core.Name.t -> Vmm_core.vm option
 
-(** [find_policy t id] is either [Some policy] or [None]. *)
-val find_policy : t -> Vmm_core.id -> Vmm_core.policy option
+(** [find_policy t Name.t] is either [Some policy] or [None]. *)
+val find_policy : t -> Vmm_core.Name.t -> Vmm_core.policy option
 
-(** [find_block t id] is either [Some (size, active)] or [None]. *)
-val find_block : t -> Vmm_core.id -> (int * bool) option
+(** [find_block t Name.t] is either [Some (size, active)] or [None]. *)
+val find_block : t -> Vmm_core.Name.t -> (int * bool) option
 
-(** [check_vm_policy t id vm] checks whether [vm] under [id] in [t] would be
+(** [check_vm_policy t Name.t vm] checks whether [vm] under [Name.t] in [t] would be
     allowed under the current policies. *)
-val check_vm_policy : t -> Vmm_core.id -> Vmm_core.vm_config -> (bool, [> `Msg of string ]) result
+val check_vm_policy : t -> Vmm_core.Name.t -> Vmm_core.vm_config -> (bool, [> `Msg of string ]) result
 
-(** [insert_vm t id vm] inserts [vm] under [id] in [t], and returns the new [t] or
+(** [insert_vm t Name.t vm] inserts [vm] under [Name.t] in [t], and returns the new [t] or
     an error. *)
-val insert_vm : t -> Vmm_core.id -> Vmm_core.vm -> (t, [> `Msg of string]) result
+val insert_vm : t -> Vmm_core.Name.t -> Vmm_core.vm -> (t, [> `Msg of string]) result
 
-(** [insert_policy t id policy] inserts [policy] under [id] in [t], and returns
+(** [insert_policy t Name.t policy] inserts [policy] under [Name.t] in [t], and returns
    the new [t] or an error. *)
-val insert_policy : t -> Vmm_core.id -> Vmm_core.policy -> (t, [> `Msg of string]) result
+val insert_policy : t -> Vmm_core.Name.t -> Vmm_core.policy -> (t, [> `Msg of string]) result
 
-(** [check_block_policy t id size] checks whether [size] under [id] in [t] would be
+(** [check_block_policy t Name.t size] checks whether [size] under [Name.t] in [t] would be
     allowed under the current policies. *)
-val check_block_policy : t -> Vmm_core.id -> int -> (bool, [> `Msg of string ]) result
+val check_block_policy : t -> Vmm_core.Name.t -> int -> (bool, [> `Msg of string ]) result
 
-(** [insert_block t id size] inserts [size] under [id] in [t], and returns the new [t] or
+(** [insert_block t Name.t size] inserts [size] under [Name.t] in [t], and returns the new [t] or
     an error. *)
-val insert_block : t -> Vmm_core.id -> int -> (t, [> `Msg of string]) result
+val insert_block : t -> Vmm_core.Name.t -> int -> (t, [> `Msg of string]) result
 
-(** [remove_vm t id] removes vm [id] from [t]. *)
-val remove_vm : t -> Vmm_core.id -> (t, [> `Msg of string ]) result
+(** [remove_vm t Name.t] removes vm [Name.t] from [t]. *)
+val remove_vm : t -> Vmm_core.Name.t -> (t, [> `Msg of string ]) result
 
-(** [remove_policy t id] removes policy [id] from [t]. *)
-val remove_policy : t -> Vmm_core.id -> (t, [> `Msg of string ]) result
+(** [remove_policy t Name.t] removes policy [Name.t] from [t]. *)
+val remove_policy : t -> Vmm_core.Name.t -> (t, [> `Msg of string ]) result
 
-(** [remove_block t id] removes block [id] from [t]. *)
-val remove_block : t -> Vmm_core.id -> (t, [> `Msg of string ]) result
+(** [remove_block t Name.t] removes block [Name.t] from [t]. *)
+val remove_block : t -> Vmm_core.Name.t -> (t, [> `Msg of string ]) result
 
-(** [fold t id f_vm f_policy f_block acc] folds [f_vm], [f_policy] and [f_block] below [id] over [t]. *)
-val fold : t -> Vmm_core.id ->
-  (Vmm_core.id -> Vmm_core.vm -> 'a -> 'a) ->
-  (Vmm_core.id -> Vmm_core.policy -> 'a -> 'a) ->
-  (Vmm_core.id -> int -> bool -> 'a -> 'a) -> 'a -> 'a
+(** [fold t Name.t f_vm f_policy f_block acc] folds [f_vm], [f_policy] and [f_block] below [Name.t] over [t]. *)
+val fold : t -> Vmm_core.Name.t ->
+  (Vmm_core.Name.t -> Vmm_core.vm -> 'a -> 'a) ->
+  (Vmm_core.Name.t -> Vmm_core.policy -> 'a -> 'a) ->
+  (Vmm_core.Name.t -> int -> bool -> 'a -> 'a) -> 'a -> 'a
 
 (** [pp] is a pretty printer for [t]. *)
 val pp : t Fmt.t
diff --git a/src/vmm_tls.ml b/src/vmm_tls.ml
index 7e8696b..06c56d6 100644
--- a/src/vmm_tls.ml
+++ b/src/vmm_tls.ml
@@ -12,7 +12,18 @@ let cert_name cert =
     if name = "" then
       match Vmm_asn.cert_extension_of_cstruct data with
       | Error (`Msg _) -> Error (`Msg "couldn't parse albatross extension")
-      | Ok (_, `Policy_cmd (`Policy_add _)) -> Error (`Msg "policy add may not have an empty name")
+      | Ok (_, `Policy_cmd pc) ->
+        begin match pc with
+          | `Policy_add _ -> Error (`Msg "policy add may not have an empty name")
+          | `Policy_remove -> Error (`Msg "policy remove may not have an empty name")
+          | `Policy_info -> Ok None
+        end
+      | Ok (_, `Block_cmd bc) ->
+        begin match bc with
+          | `Block_add _ -> Error (`Msg "block add may not have an empty name")
+          | `Block_remove -> Error (`Msg "block remove may not have an empty name")
+          | `Block_info -> Ok None
+        end
       | _ -> Ok None
     else Ok (Some name)
 
@@ -22,8 +33,12 @@ let name chain =
       | Error e, _ -> Error e
       | _, Error e -> Error e
       | Ok acc, Ok None -> Ok acc
-      | Ok acc, Ok Some data -> Ok (data :: acc))
-    (Ok []) chain
+      | Ok acc, Ok (Some data) -> Vmm_core.Name.prepend data acc)
+    (Ok Vmm_core.Name.root) chain >>= fun lbl ->
+  if List.length (Vmm_core.Name.to_list lbl) < 10 then
+    Ok lbl
+  else
+    Error (`Msg "too deep")
 
 (* this separates the leaf and top-level certificate from the chain,
    and also reverses the intermediates (to be (leaf, CA -> subCA -> subCA')
@@ -56,13 +71,13 @@ let extract_policies version chain =
           Vmm_commands.pp_version received
           Vmm_commands.pp_version version
       | Ok (prefix, acc), Ok (`Policy_cmd (`Policy_add p)) ->
-        (cert_name cert >>| function
-          | None -> prefix
-          | Some x -> x :: prefix) >>| fun name ->
+        (cert_name cert >>= function
+          | None -> Ok prefix
+          | Some x -> Vmm_core.Name.prepend x prefix) >>| fun name ->
         (name, (name, p) :: acc)
       | _, Ok wire ->
         R.error_msgf "unexpected wire %a" Vmm_commands.pp wire)
-    (Ok ([], [])) chain
+    (Ok (Vmm_core.Name.root, [])) chain
 
 let handle _addr version chain =
   separate_chain chain >>= fun (leaf, rest) ->
diff --git a/src/vmm_tls.mli b/src/vmm_tls.mli
index cae2c62..64bdd80 100644
--- a/src/vmm_tls.mli
+++ b/src/vmm_tls.mli
@@ -6,5 +6,5 @@ val wire_command_of_cert : Vmm_commands.version -> X509.t ->
 val handle :
   'a -> Vmm_commands.version ->
   X509.t list ->
-  (Vmm_core.id * (Vmm_core.id * Vmm_core.policy) list * Vmm_commands.t,
+  (Vmm_core.Name.t * (Vmm_core.Name.t * Vmm_core.policy) list * Vmm_commands.t,
    [> `Msg of string ]) Result.result
diff --git a/src/vmm_trie.ml b/src/vmm_trie.ml
index 9185fb7..db17633 100644
--- a/src/vmm_trie.ml
+++ b/src/vmm_trie.ml
@@ -21,7 +21,7 @@ let insert id e t =
       let entry, ret = go n xs in
       N (es, String.Map.add x entry m), ret
   in
-  go t id
+  go t (Vmm_core.Name.to_list id)
 
 let remove id t =
   let rec go (N (es, m)) = function
@@ -37,7 +37,7 @@ let remove id t =
       in
       if String.Map.is_empty m' && es = None then None else Some (N (es, m'))
   in
-  match go t id with
+  match go t (Vmm_core.Name.to_list id) with
   | None -> empty
   | Some n -> n
 
@@ -49,7 +49,7 @@ let find id t =
       | None -> None
       | Some n -> go n xs
   in
-  go t id
+  go t (Vmm_core.Name.to_list id)
 
 let collect id t =
   let rec go acc prefix (N (es, m)) =
@@ -63,9 +63,9 @@ let collect id t =
     | x::xs ->
       match String.Map.find_opt x m with
       | None -> acc'
-      | Some n -> go acc' (prefix @ [ x ]) n xs
+      | Some n -> go acc' (Vmm_core.Name.append_exn x prefix) n xs
   in
-  go [] [] t id
+  go [] Vmm_core.Name.root t (Vmm_core.Name.to_list id)
 
 let all t =
   let rec go acc prefix (N (es, m)) =
@@ -75,15 +75,15 @@ let all t =
       | Some e -> (prefix, e) :: acc
     in
     List.fold_left (fun acc (name, node) ->
-        go acc (prefix@[name]) node)
+        go acc (Vmm_core.Name.append_exn name prefix) node)
       acc' (String.Map.bindings m)
   in
-  go [] [] t
+  go [] Vmm_core.Name.root t
 
 let fold id t f acc =
   let rec explore (N (es, m)) prefix acc =
     let acc' =
-      String.Map.fold (fun name node acc -> explore node (prefix@[name]) acc)
+      String.Map.fold (fun name node acc -> explore node (Vmm_core.Name.append_exn name prefix) acc)
         m acc
     in
     match es with
@@ -91,9 +91,9 @@ let fold id t f acc =
     | Some e -> f prefix e acc'
   and down prefix (N (es, m)) =
     match prefix with
-    | [] -> explore (N (es, m)) [] acc
+    | [] -> explore (N (es, m)) Vmm_core.Name.root acc
     | x :: xs -> match String.Map.find_opt x m with
       | None -> acc
       | Some n -> down xs n
   in
-  down id t
+  down (Vmm_core.Name.to_list id) t
diff --git a/src/vmm_trie.mli b/src/vmm_trie.mli
index d0ff91b..afe058d 100644
--- a/src/vmm_trie.mli
+++ b/src/vmm_trie.mli
@@ -6,14 +6,14 @@ type 'a t
 
 val empty : 'a t
 
-val insert : id -> 'a -> 'a t -> 'a t * 'a option
+val insert : Name.t -> 'a -> 'a t -> 'a t * 'a option
 
-val remove : id -> 'a t -> 'a t
+val remove : Name.t -> 'a t -> 'a t
 
-val find : id -> 'a t -> 'a option
+val find : Name.t -> 'a t -> 'a option
 
-val collect : id -> 'a t -> (id * 'a) list
+val collect : Name.t -> 'a t -> (Name.t * 'a) list
 
-val all : 'a t -> (id * 'a) list
+val all : 'a t -> (Name.t * 'a) list
 
-val fold : id -> 'a t -> (id -> 'a -> 'b -> 'b) -> 'b -> 'b
+val fold : Name.t -> 'a t -> (Name.t -> 'a -> 'b -> 'b) -> 'b -> 'b
diff --git a/src/vmm_unix.ml b/src/vmm_unix.ml
index d356e2f..754fcbc 100644
--- a/src/vmm_unix.ml
+++ b/src/vmm_unix.ml
@@ -57,10 +57,6 @@ let rec mkfifo name =
   try Unix.mkfifo (Fpath.to_string name) 0o640 with
   | Unix.Unix_error (Unix.EINTR, _, _) -> mkfifo name
 
-let image_file, fifo_file =
-  ((fun name -> Fpath.(tmpdir / (string_of_id name) + "img")),
-   (fun name -> Fpath.(tmpdir / "fifo" / (string_of_id name))))
-
 let rec fifo_exists file =
   try Ok (Unix.((stat @@ Fpath.to_string file).st_kind = S_FIFO)) with
   | Unix.Unix_error (Unix.ENOENT, _, _) -> Error (`Msg "noent")
@@ -112,7 +108,7 @@ let prepare name vm =
        | Error () -> Error (`Msg "failed to uncompress")
      end
    | `Hvt_arm64, _ -> Error (`Msg "no amd64 hvt image found")) >>= fun image ->
-  let fifo = fifo_file name in
+  let fifo = Name.fifo_file name in
   (match fifo_exists fifo with
    | Ok true -> Ok ()
    | Ok false -> Error (`Msg ("file " ^ Fpath.to_string fifo ^ " exists and is not a fifo"))
@@ -126,13 +122,13 @@ let prepare name vm =
       create_tap b >>= fun tap ->
       Ok (tap :: acc))
     (Ok []) vm.network >>= fun taps ->
-  Bos.OS.File.write (image_file name) (Cstruct.to_string image) >>= fun () ->
+  Bos.OS.File.write (Name.image_file name) (Cstruct.to_string image) >>= fun () ->
   Ok (List.rev taps)
 
 let shutdown name vm =
   (* same order as prepare! *)
-  Bos.OS.File.delete (image_file name) >>= fun () ->
-  Bos.OS.File.delete (fifo_file name) >>= fun () ->
+  Bos.OS.File.delete (Name.image_file name) >>= fun () ->
+  Bos.OS.File.delete (Name.fifo_file name) >>= fun () ->
   List.fold_left (fun r n -> r >>= fun () -> destroy_tap n) (Ok ()) vm.taps
 
 let cpuset cpu =
@@ -145,8 +141,6 @@ let cpuset cpu =
     Ok ([ "taskset" ; "-c" ; cpustring ])
   | x -> Error (`Msg ("unsupported operating system " ^ x))
 
-let block_device_name name = Fpath.(blockdir / string_of_id name)
-
 let exec name vm taps block =
   (match taps, block with
    | [], None -> Ok "none"
@@ -155,7 +149,7 @@ let exec name vm taps block =
    | [_], Some _ -> Ok "block-net"
    | _, _ -> Error (`Msg "cannot handle multiple network interfaces")) >>= fun bin ->
   let net = List.map (fun t -> "--net=" ^ t) taps
-  and block = match block with None -> [] | Some dev -> [ "--disk=" ^ Fpath.to_string (block_device_name dev) ]
+  and block = match block with None -> [] | Some dev -> [ "--disk=" ^ Fpath.to_string (Name.block_file dev) ]
   and argv = match vm.argv with None -> [] | Some xs -> xs
   and mem = "--mem=" ^ string_of_int vm.requested_memory
   in
@@ -163,12 +157,12 @@ let exec name vm taps block =
   let cmd =
     Bos.Cmd.(of_list cpuset % p Fpath.(dbdir / "solo5-hvt" + bin) % mem %%
              of_list net %% of_list block %
-             "--" % p (image_file name) %% of_list argv)
+             "--" % p (Name.image_file name) %% of_list argv)
   in
   let line = Bos.Cmd.to_list cmd in
   let prog = try List.hd line with Failure _ -> failwith err_empty_line in
   let line = Array.of_list line in
-  let fifo = fifo_file name in
+  let fifo = Name.fifo_file name in
   Logs.debug (fun m -> m "write fd for fifo %a" Fpath.pp fifo);
   write_fd_for_file fifo >>= fun stdout ->
   Logs.debug (fun m -> m "opened file descriptor!");
@@ -194,7 +188,7 @@ let bytes_of_mb size =
     Error (`Msg "overflow while computing bytes")
 
 let create_block name size =
-  let block_name = block_device_name name in
+  let block_name = Name.block_file name in
   Bos.OS.File.exists block_name >>= function
   | true -> Error (`Msg "file already exists")
   | false ->
@@ -202,7 +196,7 @@ let create_block name size =
     Bos.OS.File.truncate block_name size'
 
 let destroy_block name =
-  Bos.OS.File.delete (block_device_name name)
+  Bos.OS.File.delete (Name.block_file name)
 
 let mb_of_bytes size =
   if size = 0 || size land 0xFFFFF <> 0 then
@@ -221,11 +215,13 @@ let find_block_devices () =
         Ok acc
       | true ->
         Bos.OS.Path.stat path >>= fun stats ->
-        match mb_of_bytes stats.Unix.st_size with
-        | Error (`Msg msg) ->
-          Logs.warn (fun m -> m "file %a error: %s" Fpath.pp path msg) ;
+        match mb_of_bytes stats.Unix.st_size, Name.of_string (Fpath.to_string file) with
+        | Error (`Msg msg), _ ->
+          Logs.warn (fun m -> m "file %a size error: %s" Fpath.pp path msg) ;
           Ok acc
-        | Ok size ->
-          let id = id_of_string (Fpath.to_string file) in
+        | _, Error (`Msg msg) ->
+          Logs.warn (fun m -> m "file %a name error: %s" Fpath.pp path msg) ;
+          Ok acc
+        | Ok size, Ok id ->
           Ok ((id, size) :: acc))
     (Ok []) files
diff --git a/src/vmm_unix.mli b/src/vmm_unix.mli
index 6596007..ba74287 100644
--- a/src/vmm_unix.mli
+++ b/src/vmm_unix.mli
@@ -4,18 +4,18 @@ open Rresult
 
 open Vmm_core
 
-val prepare : id -> vm_config -> (string list, [> R.msg ]) result
+val prepare : Name.t -> vm_config -> (string list, [> R.msg ]) result
 
-val shutdown : id -> vm -> (unit, [> R.msg ]) result
+val shutdown : Name.t -> vm -> (unit, [> R.msg ]) result
 
-val exec : id -> vm_config -> string list -> string list option -> (vm, [> R.msg ]) result
+val exec : Name.t -> vm_config -> string list -> Name.t option -> (vm, [> R.msg ]) result
 
 val destroy : vm -> unit
 
 val close_no_err : Unix.file_descr -> unit
 
-val create_block : id -> int -> (unit, [> R.msg ]) result
+val create_block : Name.t -> int -> (unit, [> R.msg ]) result
 
-val destroy_block : id -> (unit, [> R.msg ]) result
+val destroy_block : Name.t -> (unit, [> R.msg ]) result
 
-val find_block_devices : unit -> ((id * int) list, [> R.msg ]) result
+val find_block_devices : unit -> ((Name.t * int) list, [> R.msg ]) result
diff --git a/src/vmm_vmmd.ml b/src/vmm_vmmd.ml
index b7bb7c9..92813a6 100644
--- a/src/vmm_vmmd.ml
+++ b/src/vmm_vmmd.ml
@@ -34,7 +34,7 @@ let init wire_version =
       List.fold_left (fun r (id, size) ->
           match Vmm_resources.insert_block r id size with
           | Error (`Msg msg) ->
-            Logs.err (fun m -> m "couldn't insert block device %a (%dM): %s" pp_id id size msg) ;
+            Logs.err (fun m -> m "couldn't insert block device %a (%dM): %s" Name.pp id size msg) ;
             r
           | Ok r -> r)
         t.resources devs
@@ -49,9 +49,9 @@ type service_out = [
 
 type out = [ service_out | `Data of Vmm_commands.wire ]
 
-let log t id event =
+let log t name event =
   let data = (Ptime_clock.now (), event) in
-  let header = Vmm_commands.{ version = t.wire_version ; sequence = t.log_counter ; id } in
+  let header = Vmm_commands.{ version = t.wire_version ; sequence = t.log_counter ; name } in
   let log_counter = Int64.succ t.log_counter in
   Logs.debug (fun m -> m "log %a" Log.pp data) ;
   ({ t with log_counter }, `Log (header, `Data (`Log_data data)))
@@ -67,8 +67,8 @@ let handle_create t reply name vm_config =
   (match vm_config.block_device with
    | None -> Ok None
    | Some dev ->
-     let block_device_name = block_name name dev in
-     Logs.debug (fun m -> m "looking for block device %a" pp_id block_device_name) ;
+     let block_device_name = Name.block_name name dev in
+     Logs.debug (fun m -> m "looking for block device %a" Name.pp block_device_name) ;
      match Vmm_resources.find_block t.resources block_device_name with
      | Some (_, false) -> Ok (Some block_device_name)
      | Some (_, true) -> Error (`Msg "block device is busy")
@@ -77,7 +77,7 @@ let handle_create t reply name vm_config =
   Vmm_unix.prepare name vm_config >>= fun taps ->
   Logs.debug (fun m -> m "prepared vm with taps %a" Fmt.(list ~sep:(unit ",@ ") string) taps) ;
   let cons_out =
-    let header = Vmm_commands.{ version = t.wire_version ; sequence = t.console_counter ; id = name } in
+    let header = Vmm_commands.{ version = t.wire_version ; sequence = t.console_counter ; name } in
     (header, `Command (`Console_cmd `Console_add))
   in
   Ok ({ t with console_counter = Int64.succ t.console_counter },
@@ -87,14 +87,14 @@ let handle_create t reply name vm_config =
           Vmm_unix.exec name vm_config taps block_device >>= fun vm ->
           Logs.debug (fun m -> m "exec()ed vm") ;
           Vmm_resources.insert_vm t.resources name vm >>= fun resources ->
-          let tasks = String.Map.add (string_of_id name) task t.tasks in
+          let tasks = String.Map.add (Name.to_string name) task t.tasks in
           let t = { t with resources ; tasks } in
           let t, out = log t name (`Vm_start (name, vm.pid, vm.taps, None)) in
           Ok (t, [ reply (`String "created VM") ; out ], name, vm)))
 
 let setup_stats t name vm =
   let stat_out = `Stats_add (vm.pid, vm.taps) in
-  let header = Vmm_commands.{ version = t.wire_version ; sequence = t.stats_counter ; id = name } in
+  let header = Vmm_commands.{ version = t.wire_version ; sequence = t.stats_counter ; name } in
   let t = { t with stats_counter = Int64.succ t.stats_counter } in
   t, `Stat (header, `Command (`Stats_cmd stat_out))
 
@@ -108,8 +108,8 @@ let handle_shutdown t name vm r =
       t.resources
     | Ok resources -> resources
   in
-  let header = Vmm_commands.{ version = t.wire_version ; sequence = t.stats_counter ; id = name } in
-  let tasks = String.Map.remove (string_of_id name) t.tasks in
+  let header = Vmm_commands.{ version = t.wire_version ; sequence = t.stats_counter ; name } in
+  let tasks = String.Map.remove (Name.to_string name) t.tasks in
   let t = { t with stats_counter = Int64.succ t.stats_counter ; resources ; tasks } in
   let t, logout = log t name (`Vm_stop (name, vm.pid, r))
   in
@@ -117,11 +117,11 @@ let handle_shutdown t name vm r =
 
 let handle_policy_cmd t reply id = function
   | `Policy_remove ->
-    Logs.debug (fun m -> m "remove policy %a" pp_id id) ;
+    Logs.debug (fun m -> m "remove policy %a" Name.pp id) ;
     Vmm_resources.remove_policy t.resources id >>= fun resources ->
     Ok ({ t with resources }, [ reply (`String "removed policy") ], `End)
   | `Policy_add policy ->
-    Logs.debug (fun m -> m "insert policy %a" pp_id id) ;
+    Logs.debug (fun m -> m "insert policy %a" Name.pp id) ;
     let same_policy = match Vmm_resources.find_policy t.resources id with
       | None -> false
       | Some p' -> eq_policy policy p'
@@ -132,7 +132,7 @@ let handle_policy_cmd t reply id = function
       Vmm_resources.insert_policy t.resources id policy >>= fun resources ->
       Ok ({ t with resources }, [ reply (`String "added policy") ], `Loop)
   | `Policy_info ->
-    Logs.debug (fun m -> m "policy %a" pp_id id) ;
+    Logs.debug (fun m -> m "policy %a" Name.pp id) ;
     let policies =
       Vmm_resources.fold t.resources id
         (fun _ _ policies -> policies)
@@ -142,14 +142,14 @@ let handle_policy_cmd t reply id = function
     in
     match policies with
     | [] ->
-      Logs.debug (fun m -> m "policies: couldn't find %a" pp_id id) ;
+      Logs.debug (fun m -> m "policies: couldn't find %a" Name.pp id) ;
       Error (`Msg "policy: not found")
     | _ ->
       Ok (t, [ reply (`Policies policies) ], `End)
 
 let handle_vm_cmd t reply id msg_to_err = function
   | `Vm_info ->
-    Logs.debug (fun m -> m "info %a" pp_id id) ;
+    Logs.debug (fun m -> m "info %a" Name.pp id) ;
     let vms =
       Vmm_resources.fold t.resources id
         (fun id vm vms -> (id, vm.config) :: vms)
@@ -159,7 +159,7 @@ let handle_vm_cmd t reply id msg_to_err = function
     in
     begin match vms with
       | [] ->
-        Logs.debug (fun m -> m "info: couldn't find %a" pp_id id) ;
+        Logs.debug (fun m -> m "info: couldn't find %a" Name.pp id) ;
         Error (`Msg "info: not found")
       | _ ->
         Ok (t, [ reply (`Vms vms) ], `End)
@@ -178,7 +178,7 @@ let handle_vm_cmd t reply id msg_to_err = function
         | None -> handle_create t reply id vm_config
         | Some vm ->
           Vmm_unix.destroy vm ;
-          let id_str = string_of_id id in
+          let id_str = Name.to_string id in
           match String.Map.find_opt id_str t.tasks with
           | None -> handle_create t reply id vm_config
           | Some task ->
@@ -191,7 +191,7 @@ let handle_vm_cmd t reply id msg_to_err = function
     match Vmm_resources.find_vm t.resources id with
     | Some vm ->
       Vmm_unix.destroy vm ;
-      let id_str = string_of_id id in
+      let id_str = Name.to_string id in
       let out, next =
         let s = reply (`String "destroyed vm") in
         match String.Map.find_opt id_str t.tasks with
@@ -204,7 +204,7 @@ let handle_vm_cmd t reply id msg_to_err = function
 
 let handle_block_cmd t reply id = function
   | `Block_remove ->
-    Logs.debug (fun m -> m "removing block %a" pp_id id) ;
+    Logs.debug (fun m -> m "removing block %a" Name.pp id) ;
     begin match Vmm_resources.find_block t.resources id with
       | None -> Error (`Msg "remove block: not found")
       | Some (_, true) -> Error (`Msg "remove block: is in use")
@@ -215,7 +215,7 @@ let handle_block_cmd t reply id = function
     end
   | `Block_add size ->
     begin
-      Logs.debug (fun m -> m "insert block %a: %dMB" pp_id id size) ;
+      Logs.debug (fun m -> m "insert block %a: %dMB" Name.pp id size) ;
       match Vmm_resources.find_block t.resources id with
       | Some _ -> Error (`Msg "block device with same name already exists")
       | None ->
@@ -227,7 +227,7 @@ let handle_block_cmd t reply id = function
           Ok ({ t with resources }, [ reply (`String "added block device") ], `Loop)
     end
   | `Block_info ->
-    Logs.debug (fun m -> m "block %a" pp_id id) ;
+    Logs.debug (fun m -> m "block %a" Name.pp id) ;
     let blocks =
       Vmm_resources.fold t.resources id
         (fun _ _ blocks -> blocks)
@@ -237,7 +237,7 @@ let handle_block_cmd t reply id = function
     in
     match blocks with
     | [] ->
-      Logs.debug (fun m -> m "block: couldn't find %a" pp_id id) ;
+      Logs.debug (fun m -> m "block: couldn't find %a" Name.pp id) ;
       Error (`Msg "block: not found")
     | _ ->
       Ok (t, [ reply (`Blocks blocks) ], `End)
@@ -249,7 +249,7 @@ let handle_command t (header, payload) =
       Logs.err (fun m -> m "error while processing command: %s" msg) ;
       (t, [ `Data (header, `Failure msg) ], `End)
   and reply x = `Data (header, `Success x)
-  and id = header.Vmm_commands.id
+  and id = header.Vmm_commands.name
   in
   msg_to_err (
     match payload with
diff --git a/src/vmm_vmmd.mli b/src/vmm_vmmd.mli
index 53bc257..99dec53 100644
--- a/src/vmm_vmmd.mli
+++ b/src/vmm_vmmd.mli
@@ -12,17 +12,17 @@ type service_out = [
 
 type out = [ service_out | `Data of Vmm_commands.wire ]
 
-val handle_shutdown : 'a t -> Vmm_core.id -> Vmm_core.vm ->
+val handle_shutdown : 'a t -> Vmm_core.Name.t -> Vmm_core.vm ->
   [ `Exit of int | `Signal of int | `Stop of int ] -> 'a t * out list
 
 val handle_command : 'a t -> Vmm_commands.wire ->
   'a t * out list *
-  [ `Create of 'c t -> 'c -> ('c t * out list * Vmm_core.id * Vmm_core.vm, [> `Msg of string ]) result
+  [ `Create of 'c t -> 'c -> ('c t * out list * Vmm_core.Name.t * Vmm_core.vm, [> `Msg of string ]) result
   | `Loop
   | `End
   | `Wait of 'a * out
   | `Wait_and_create of 'a * ('a t -> 'a t * out list *
-                                      [ `Create of 'd t -> 'd -> ('d t * out list * Vmm_core.id * Vmm_core.vm, [> Rresult.R.msg ]) result
+                                      [ `Create of 'd t -> 'd -> ('d t * out list * Vmm_core.Name.t * Vmm_core.vm, [> Rresult.R.msg ]) result
                                       | `End ]) ]
 
-val setup_stats : 'a t -> Vmm_core.id -> Vmm_core.vm -> 'a t * out
+val setup_stats : 'a t -> Vmm_core.Name.t -> Vmm_core.vm -> 'a t * out