+(* 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
+
+ (* 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
+ )
+ );
+
+ (* Write the main header. *)
+ write_header machine.Diskimage.m_disks;
+
+ (* Iterate over the disks. *)
+ List.iteri (
+ fun disknum { 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 "Writing disk %s (%s sectors) ...\n%!"
+ disk#name (Int63.to_string nr_blocks);
+
+ (* Get the lookup function for this disk. *)
+ let lookup_offset =
+ Diskimage.get_owners_lookup machine ownership disk in
+
+ (* Convenience function to look up a block and test freeness. *)
+ let block_is_free blk =
+ let offset = blk *^ blocksize in
+ Diskimage.offset_is_free (lookup_offset offset)
+ in
+
+ (* Look up owners for each sector in turn. *)
+ let rec loop start_blk =
+ if start_blk < nr_blocks then (
+ (* The current sector (start_blk) is either free or not free.
+ * Look for a stretch of sectors which are the same.
+ *)
+ let current_free = block_is_free start_blk in
+ let rec find_end blk =
+ if blk < nr_blocks then (
+ if block_is_free blk = current_free then
+ find_end (Int63.succ blk)
+ else
+ blk
+ ) else
+ nr_blocks (* End of the disk image. *)
+ in
+ let end_blk = find_end (Int63.succ start_blk) in
+
+ let len_blks = end_blk -^ start_blk in
+
+ let start_offset = start_blk *^ blocksize in
+ let len_bytes = len_blks *^ blocksize in
+
+ (* Current stretch is from start_blk .. end_blk-1. *)
+ if !Diskimage.debug then
+ eprintf " %s stretch %s to %s-1 (%s bytes)\n%!"
+ (if current_free then "free" else "used")
+ (Int63.to_string start_blk) (Int63.to_string end_blk)
+ (Int63.to_string (len_blks *^ blocksize));
+
+ (* Write the stretch to stdout. *)
+ write_stretch_header disknum current_free start_offset len_bytes;
+
+ (* Write the data (note: we only need to write it if
+ * it's not marked as free!).
+ *)
+ if not current_free then write_stretch disk start_offset len_bytes;
+
+ loop end_blk
+ )
+ in
+ loop ~^0
+ ) machine.Diskimage.m_disks;
+
+ write_trailer ()
+