let background lock f x =
  try
    let fd = openfile lock [O_WRONLYO_EXCLO_CREAT] 0o600 in
    printf "Launching %s... " nameflush Pervasives.stdout;
    match fork () with
    | 0 ->
        close fd;
        f xexit 0
    | pid ->
        let content = sprintf "%d\n" pid in
        try_finalize (fun _ ->
          ignore (write fd content 0 (String.length content))) ()
          close fd;
        printf "done (%d)\n" pid;
  with
    Unix_error (EEXIST,_,_) ->
      error "Daemond already running (not launch)"
  | Unix_error (EACCES,_,_) ->
      error (sprintf "Cannot write %s" lock)