package mirage

  1. Overview
  2. Docs
The MirageOS library operating system

Install 

dune-project
 Dependency

github.com Readme Changelog ISC License Edit opam file Versions (14)

Authors

  1. T
    Thomas Gazagnaire
  2. A
    Anil Madhavapeddy
  3. Gabriel Radanne
  4. M
    Mindy Preston
  5. T
    Thomas Leonard
  6. N
    Nicolas Ojeda Bar
  7. D
    Dave Scott
  8. D
    David Kaloper
  9. H
    Hannes Mehnert
  10. R
    Richard Mortier

Maintainers

  1. A
    anil@recoil.org
  2. T
    thomas@gazagnaire.org

Sources

mirage-4.0.0.tbz
sha256=f804161872de6cf20699364f09d03370ed06aafffb12f1d586190832c73a194d
sha512=75c1c1cac4c6f862c0055381c7ced123785193234b40da8a8e238cb289cba1a4494378587c4edf2ed872aee7fbfc756f84087941c1037ac19cbd1733ff6cca6a

doc/src/mirage.impl/mirage_impl_fs.ml.html

Source file mirage_impl_fs.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
open Functoria
open Mirage_impl_block
open Mirage_impl_misc
module Key = Mirage_key

type t = FS

let typ = Type.v FS
let fat_pkg = package ~min:"0.14.0" ~max:"0.15.0" "fat-filesystem"

let connect err _ modname l =
  match l with
  | [ block_name ] -> Fmt.str "%s.connect %s" modname block_name
  | _ -> failwith (connect_err err 1)

let fat_conf =
  let packages = [ fat_pkg ] in
  impl ~connect:(connect "fat") ~packages "Fat.FS" (block @-> typ)

let fat block = fat_conf $ block

let fat_shell_script fmt ~block_file ~dir ~regexp =
  Fmt.pf fmt
    {|#!/bin/sh

echo This uses the 'fat' command-line tool to build a simple FAT
echo filesystem image.

FAT=$(which fat)
if [ ! -x "${FAT}" ]; then
  echo I couldn\'t find the 'fat' command-line tool.
  echo Try running 'opam install fat-filesystem'
  exit 1
fi

IMG=$(pwd)/%s
rm -f ${IMG}
cd %a
SIZE=$(du -s . | cut -f 1)
${FAT} create ${IMG} ${SIZE}KiB
${FAT} add ${IMG} %s
echo Created '%s'
|}
    block_file Fpath.pp dir regexp block_file

let count =
  let i = ref 0 in
  fun () ->
    incr i;
    !i

let fat_block ?(dir = ".") ?(regexp = "*") () =
  let name = "fat_block" ^ string_of_int (count ()) in
  let block_file = name ^ ".img" in
  let file = Fmt.str "make-%s-image.sh" name in
  let pre_configure _ =
    let dir = Fpath.of_string dir |> Rresult.R.error_msg_to_invalid_arg in
    Log.info (fun m -> m "Generating block generator script: %s" file);
    Action.with_output ~mode:0o755 ~path:(Fpath.v file)
      ~purpose:"fat shell script" (fun fmt ->
        fat_shell_script fmt ~block_file ~dir ~regexp)
  in
  let dune _ =
    let dune =
      Dune.stanzaf
        {|
(rule
 (targets %s)
 (deps (source_tree %s))
 (action (run %s)))
|}
        block_file dir file
    in
    [ dune ]
  in
  let packages = [ fat_pkg ] in
  let block = Mirage_impl_block.block_conf block_file in
  of_device @@ Device.extend ~packages ~dune ~pre_configure block

let fat_of_files ?dir ?regexp () = fat @@ fat_block ?dir ?regexp ()

let kv_ro_of_fs_conf =
  let packages = [ package ~min:"3.0.0" ~max:"4.0.0" "mirage-fs" ] in
  let connect _ modname = function
    | [ fs ] -> Fmt.str "%s.connect %s" modname fs
    | _ -> failwith (connect_err "kv_ro_of_fs" 1)
  in
  impl ~packages ~connect "Mirage_fs.To_KV_RO" (typ @-> Mirage_impl_kv.ro)

let kv_ro_of_fs x = kv_ro_of_fs_conf $ x

(** generic kv_ro. *)

let generic_kv_ro ?group ?(key = Key.value @@ Key.kv_ro ?group ()) dir =
  match_impl key
    [
      (`Fat, kv_ro_of_fs @@ fat_of_files ~dir ());
      (`Archive, archive_of_files ~dir ());
      (`Crunch, Mirage_impl_kv.crunch dir);
      (`Direct, Mirage_impl_kv.direct_kv_ro dir);
    ]
    ~default:(Mirage_impl_kv.direct_kv_ro dir)