+(* Do compression. *)
+and go_compress extcompress images =
+ (* Create a Diskimage machine description from the requested images. This
+ * also checks that everything we need is readable.
+ *)
+ let machine =
+ Diskimage.open_machine "diskzip" (List.map (fun n -> (n,n)) images) in
+
+ (* Scan the images for filesystems. *)
+ let machine = Diskimage.scan_machine machine in
+
+ (* Create ownership tables. *)
+ let ownership = Diskimage.create_ownership machine in
+
+ (* Create ownership bitmap for each disk. *)
+ List.iter (
+ fun { Diskimage.d_name = name; d_dev = disk } ->
+ let blocksize = disk#blocksize in
+ let size = disk#size in (* Size in bytes. *)
+ let nr_blocks = size /^ blocksize in (* Number of disk sectors. *)
+
+ if !Diskimage.debug then
+ eprintf "Creating bitmap for %s (%s sectors) ...\n%!"
+ disk#name (Int63.to_string nr_blocks);
+
+ (* Create an empty bitmap, one bit per sector. *)
+ let bitmap = Bitmap.create nr_blocks in
+
+ (* Get the lookup function for this disk. *)
+ let lookup = Diskimage.get_owners_lookup machine ownership disk in
+
+ (* Lookup each sector. *)
+ Bitmap.iter_set (
+ fun blk _ ->
+ let owners = lookup blk in
+ false
+ ) bitmap
+ ) machine.Diskimage.m_disks;
+
+ (* Redirect output through external pipe if asked. *)
+ (match extcompress with
+ | None -> ()
+ | Some prog ->
+ let prog, progargs =
+ match prog with
+ | BZip2 -> "bzip2", [|"bzip2"; "-c"|]
+ | GZip -> "gzip", [|"gzip"; "-c"|]
+ | External prog -> "sh", [|"sh"; "-c"; prog |] in
+ let rfd, wfd = pipe () in
+ let pid = fork () in
+ if pid = 0 then ( (* child *)
+ close wfd;
+ dup2 rfd stdin;
+ close rfd;
+ execvp prog progargs
+ ) else ( (* parent *)
+ close rfd;
+ dup2 wfd stdout;
+ close wfd
+ )
+ )
+
+
+
+
+
+
+
+
+
+