X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=diskzip%2Fdiskzip.ml;h=b4a0a5ab2f41673bcd3a7d638b6b3f7c5aa3aaf7;hb=2971bd66df63a8cf8d011abf6126c7bddc90f5ff;hp=f8d58b411adb9e8a26797858bd190fb7d83979a2;hpb=94b4d762109604f4fafface50c44baf3f70a4034;p=virt-df.git diff --git a/diskzip/diskzip.ml b/diskzip/diskzip.ml index f8d58b4..b4a0a5a 100644 --- a/diskzip/diskzip.ml +++ b/diskzip/diskzip.ml @@ -134,6 +134,49 @@ OPTIONS" in else go_decompress ?output extcompress args +(* 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 + + (* 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 + ) + ) + + + + + + + + + + and go_decompress ?output extcompress args = (* Read the input, which may be a single named file, or a series of * files (we just concatenate them). We may have to feed the input @@ -195,47 +238,6 @@ and go_decompress ?output extcompress args = -(* 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 - - (* 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 - ) - ) - - - - - - - - (* (* Since we have the wonderful pa_bitmatch, might as well use it to * define a robust binary format for the compressed files.