Re: Buglet in ocaml-ldconf
On Sun, May 12, 2002 at 06:55:33PM +0200, Denis Barbier wrote:
> Hi,
>
> when ocaml-ldconf is called with -r flag (to remove paths),
> /var/lib/ocaml/ld.conf is written top-down; as a workaround,
> I suggest to call it twice, so that paths order is preserved.
... and here is a modified version to fix this problem.
As it is my first program with ocaml, I had to incorporate comments
in order to read it. Some functions and variables are also renamed,
and constructs have been reorganized.
Sven, if I am doing something wrong (conceptually or stylistically),
please let me know.
Denis
(*
* ocaml-ldconf : A ocaml ld.conf handling scheme for Debian
* Copyright (C) 2002 Sven LUTHER
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2 of the License, or
* (at your option) any later version.
*
* 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 General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*
* Thanks go to Stefano "Zack" Zacchiroli <zack@debian.org> and Denis Barbier
* <barbier@debian.org> for help and thoughts on this issue.
*)
let user_ldconf = "/etc/ocaml/ld.conf"
let dpkg_ldconf = "/var/lib/ocaml/ld.conf"
let ocaml_ldconf = "/usr/lib/ocaml/ld.conf"
(* Syntax of the various files:
ocaml_ldconf :
* lines beginning with # are ignored
* one directory per line
dpkg_ldconf and user_ldconf:
* lines beginning with # are ignored
* "directory command package" per line
where
+ command can be either add, remove or addafter for user_ldconf
and add for dpkg_ldconf
+ package is optional
*)
let user_ldconf_comment = Printf.sprintf
"#
# %s
# This is the system administrator ld.conf file for ocaml
# On Debian systems, this file is read by the ocaml-ldconf
# tool, together with %s, to generate
# the standard ocaml %s file.
# See ocaml-ldconf(1) for more details.
#
" user_ldconf dpkg_ldconf ocaml_ldconf
let dpkg_ldconf_comment = Printf.sprintf
"#
# %s
# This is the dpkg handled ld.conf file for ocaml
# On Debian systems, this file is read by the ocaml-ldconf
# tool, together with %s to generate
# the standard ocaml %s file.
# See ocaml-ldconf(1) for more details.
#
" dpkg_ldconf user_ldconf ocaml_ldconf
let ocaml_ldconf_comment = Printf.sprintf
"#
# %s
# This is the ocaml ld.conf file.
# On Debian systems, this file is automatically generated by
# the ocaml-ldconf tool, from the dpkg handled %s file
# and the system administrator handled %s file.
# See ocaml-ldconf(1) for more details.
#
" ocaml_ldconf dpkg_ldconf user_ldconf
let help_string = Printf.sprintf "
Usage:
1) ocaml-ldconf [OPTIONS]
update %s from %s and %s.
2) ocaml-ldconf [OPTIONS] -l
show the current dll paths.
3) ocaml-ldconf [OPTIONS] [-p PACKAGE] -a/-r DIR
add/remove DIR to %s for package PACKAGE.
Options:" ocaml_ldconf user_ldconf dpkg_ldconf dpkg_ldconf
type action = Add | Remove | Display | Update
let path = ref ([] : string list)
let action = ref Update
let package = ref ""
let verbose = ref false
let update = ref true
let _ = Arg.parse [
"-a", Arg.Unit(fun () -> action := Add),
"add given path to the dynamic loading standard path";
"-r", Arg.Unit (fun () -> action := Remove),
"remove the given path from the dynamic loading standard path";
"-p", Arg.String (fun s -> package := s),
"gives the package name which adds/removes the path";
"-l", Arg.Unit (fun () -> action := Display; update := false),
"displays the current dynamic loading paths";
"-v", Arg.Set verbose,
"display more verbose messages";
"-n", Arg.Clear update,
"don't update the dll paths";
] (fun s -> path := s::!path) help_string
(* convert a list into a string *)
let rec string_of_list = function
| [] -> ""
| head::[] -> head
| head::tail -> head ^ " " ^ (string_of_list tail)
let is_space = function ' ' | '\t' -> true | _ -> false
(* return index of first non-space character from position i *)
let rec index_non_space_from a i = try
if is_space a.[i] then index_non_space_from a (i+1) else i
with Invalid_argument _ | Invalid_argument("String.get") -> i
(* return index of first space character from position i *)
let rec index_space_from a i = try
if is_space a.[i] then i else index_space_from a (i+1)
with Invalid_argument _ | Invalid_argument("String.get") -> i
(* compare 2 strings, spaces being considered as a single token *)
let eq_line a b =
(* FIXME: should trailing spaces be removed? *)
let la = String.length a and lb = String.length b in
let rec f i j =
if i = la && j = lb then true
else if i = la || j = lb then false
else if is_space a.[i] && is_space b.[j] then f (index_non_space_from a i) (index_non_space_from b j)
else if a.[i] = b.[j] then f (i+1) (j+1)
else false in
f 0 0
let neq_line a b = not (eq_line a b)
let addpath path package =
let pkg = if String.length package = 0 then "" else "\t" ^ package in
let f s = Printf.sprintf "%s\tadd%s" s pkg in
List.map f path
type dir_action =
Add_action | Addafter_action | Remove_action | Comment_action | Bad_action
(* suppress from a list all elements found in another list *)
let sup_list src remove =
let rec f collected = function
| [] -> collected
| head::tail -> if List.exists (eq_line head) remove then f collected tail else f (collected@[head]) tail in
f [] src
let parse_line a =
let la = String.length a in
if la = 0 || a.[0] = '#' || index_non_space_from a 0 = la then "", Comment_action else
let i = index_non_space_from a 0 in
if i = la then "", Bad_action else
let j = index_space_from a i in
let l = j - i in
let j = index_non_space_from a j in
let k = index_space_from a j in
let dir = String.sub a i l in
match String.sub a j (k-j) with
| "add" -> dir, Add_action
| "addafter" -> dir, Addafter_action
| "remove" -> dir, Remove_action
| _ -> dir, Bad_action
(* create file and write some lines *)
let create_file f c =
let d = Filename.dirname f in
if Sys.command ("mkdir -p " ^ d) <> 0 then
failwith ("Unable to create dir %s" ^ d);
try let fd = open_out_gen [Open_creat; Open_text; Open_wronly] 0o644 f in
output_string fd c;
close_out fd
with Sys_error s -> failwith
(Printf.sprintf "Unable to create file %s (%s)" f s)
let init_files () =
if not (Sys.file_exists user_ldconf)
then create_file user_ldconf user_ldconf_comment;
if not (Sys.file_exists dpkg_ldconf)
then create_file dpkg_ldconf dpkg_ldconf_comment;
if not (Sys.file_exists ocaml_ldconf)
then create_file ocaml_ldconf ocaml_ldconf_comment
(* get file contents and return an array of lines *)
let read_file_contents name =
let rec f fd c = try
let l = input_line fd in
f fd (c@[l])
with End_of_file -> close_in fd; c in try
let fd = open_in name in f fd []
with Sys_error s -> begin
if !verbose then Printf.eprintf "Warning, %s not accesible: %s" name s
end; []
(* print an array into file, which must exist *)
let write_file_contents name c =
let rec f fd = function
| [] -> close_out fd
| head::tail -> output_string fd (head ^ "\n"); f fd tail in try
let fd = open_out_gen [Open_trunc; Open_text; Open_wronly] 644 name in
f fd c
with Sys_error s -> if !verbose then Printf.eprintf "Warning, %s not accesible: %s"
name s
(* add directories, if those don't already exist for the given package *)
let action_add path package =
if !verbose then Printf.printf "%s adds path %s to %s\n" package (string_of_list path) dpkg_ldconf;
let add_list = addpath path package in
let contents = read_file_contents dpkg_ldconf in
let new_list = sup_list add_list contents in
write_file_contents dpkg_ldconf (contents@new_list)
(* remove directories, if those exist for the given package *)
let action_remove path package =
if !verbose then Printf.printf "%s removes path %s to %s\n" package (string_of_list path) dpkg_ldconf;
let remove_list = addpath path package in
let contents = read_file_contents dpkg_ldconf in
let new_cont = sup_list contents remove_list in
write_file_contents dpkg_ldconf new_cont
(* display the list of ld.conf directories if those exist *)
let action_display () =
if !verbose then Printf.printf "paths found in %s:\n" ocaml_ldconf;
let contents = read_file_contents ocaml_ldconf in
let f l =
if String.length l > 0 && l.[0] <> '#' then Printf.printf "\t%s\n" l; in
List.iter f contents
(* update the ocaml_ldconf file *)
let action_update () =
if !verbose then Printf.printf "updating %s\n" ocaml_ldconf;
let rec f fd lineno add_list addafter_list ignore_list =
let f = f fd (lineno+1) in try
let l = input_line fd in
match parse_line l with
| dir, Add_action -> f (add_list@[dir]) addafter_list ignore_list
| dir, Addafter_action -> f add_list (addafter_list@[dir]) ignore_list
| dir, Remove_action -> f add_list addafter_list (ignore_list@[dir])
| _, Comment_action -> f add_list addafter_list ignore_list
| _, _ ->
begin if !verbose then Printf.eprintf "%s:%d: ignore wrong formatted line:\n %s\n"
user_ldconf lineno l end;
f add_list addafter_list ignore_list
with End_of_file -> close_in fd; add_list, addafter_list, ignore_list in
let add_list, addafter_list, ignore_list = try
let fd = open_in user_ldconf in f fd 1 [] [] []
with Sys_error s ->
begin if !verbose then Printf.eprintf "Warning, %s not accesible: %s"
user_ldconf s end; [], [], [] in
let rec f fd lineno dpkg_list =
let f = f fd (lineno+1) in try
let l = input_line fd in
match parse_line l with
| _, Comment_action -> f dpkg_list
| dir, Add_action -> f (dpkg_list@[dir])
| _, _ ->
begin if !verbose then Printf.eprintf "%s:%d: ignore wrong formatted line:\n %s\n"
dpkg_ldconf lineno l end;
f dpkg_list
with End_of_file -> close_in fd; dpkg_list in
let dpkg_list = try
let fd = open_in dpkg_ldconf in sup_list (f fd 1 []) ignore_list
with Sys_error s ->
begin if !verbose then Printf.eprintf "Warning, %s not accesible: %s"
dpkg_ldconf s end; [] in
write_file_contents ocaml_ldconf (ocaml_ldconf_comment::add_list@dpkg_list@addafter_list)
let () = try
init_files ();
match !action with
| Add ->
action_add !path !package;
if !update then action_update ()
| Remove ->
action_remove !path !package;
if !update then action_update ()
| Display -> action_display ()
| Update -> action_update ()
with s -> Printf.eprintf
"ocaml-ldconf failed with exception %s" (Printexc.to_string s)
Reply to: