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
|
(*
* Copyright (C) 2006-2009 Citrix Systems Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published
* by the Free Software Foundation; version 2.1 only. with the special
* exception on linking described in file LICENSE.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*)
open Pervasiveext
(** Path to the gzip binary *)
let gzip = "/bin/gzip"
(** Helper function to prevent double-closes of file descriptors *)
let close to_close fd =
if List.mem fd !to_close then Unix.close fd;
to_close := List.filter (fun x -> fd <> x) !to_close
type zcat_mode = Compress | Decompress
type input_type =
| Active (** we provide a function which writes into the compressor and a fd output *)
| Passive (** we provide an fd input and a function which reads from the compressor *)
(* start cmd with lowest priority so that it doesn't
use up all cpu resources in dom0
*)
let lower_priority cmd args =
let ionice="/usr/bin/ionice" in
let ionice_args=["-c";"3"] in (*io idle*)
let nice="/usr/bin/nice" in
let nice_args=["-n";"19"] in (*lowest priority*)
let extra_args=nice_args@[ionice]@ionice_args in
let new_cmd=nice in
let new_args=extra_args@[cmd]@args in
(new_cmd,new_args)
(** Runs a zcat process which is either:
i) a compressor; or (ii) a decompressor
and which has either
i) an active input (ie a function and a pipe) + passive output (fd); or
ii) a passive input (fd) + active output (ie a function and a pipe)
*)
let go (mode: zcat_mode) (input: input_type) fd f =
let zcat_out, zcat_in = Unix.pipe() in
let to_close = ref [ zcat_in; zcat_out ] in
let close = close to_close in
finally
(fun () ->
let args = if mode = Compress then [] else ["--decompress"] @ [ "--stdout"; "--force" ] in
let stdin, stdout, close_now, close_later = match input with
| Active ->
Some zcat_out, (* input comes from the pipe+fn *)
Some fd, (* supplied fd is written to *)
zcat_out, (* we close this now *)
zcat_in (* close this before waitpid *)
| Passive ->
Some fd, (* supplied fd is read from *)
Some zcat_in, (* output goes into the pipe+fn *)
zcat_in, (* we close this now *)
zcat_out in (* close this before waitpid *)
let (gzip,args)=lower_priority gzip args in
let pid = Forkhelpers.safe_close_and_exec stdin stdout None [] gzip args in
close close_now;
finally
(fun () ->
f close_later
)
(fun () ->
let failwith_error s =
let mode = if mode = Compress then "Compression" else "Decompression" in
let msg = Printf.sprintf "%s via zcat failed: %s" mode s in
Printf.eprintf "%s" msg;
failwith msg
in
close close_later;
match snd (Forkhelpers.waitpid pid) with
| Unix.WEXITED 0 -> ();
| Unix.WEXITED i -> failwith_error (Printf.sprintf "exit code %d" i)
| Unix.WSIGNALED i -> failwith_error (Printf.sprintf "killed by signal %d" i)
| Unix.WSTOPPED i -> failwith_error (Printf.sprintf "stopped by signal %d" i)
)
) (fun () -> List.iter close !to_close)
let compress fd f = go Compress Active fd f
let decompress fd f = go Decompress Active fd f
let decompress_passive fd f = go Decompress Passive fd f
|
