[Date Prev][Date Next] [Thread Prev][Thread Next] [Date Index] [Thread Index]

Re: purge_ld_conf.pl [Was: Re: the move to stublib]



On Fri, Sep 06, 2002 at 07:15:14PM +0200, Sven LUTHER wrote:
> Mmm, does adding a dh_ocamlld -r do the thing we want ? I don't think
> so, we maybe need to call ocaml-ldconf -R -plibname-ocaml explicitly in
> a hand written postinst, until woody +1.

I now have a working -R option in the ocaml-ldconf program, see the
attached code.

Friendly,

Sven Luther
(*
 *  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"

let ocaml_dir = "/usr/lib/ocaml"
let local_ocaml_dir = "/usr/local/lib/ocaml/3.06"

(* 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.
# Syntax is :
#    directory command
# where directory is the directory to add and command is either :
#  add : to add a directory before the system ones (default).
#  addafter : to add a directory after the system ones.
#  remove : to remove one of the system directories.
# See the /usr/share/doc/ocaml/README.Debian file 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 the /usr/share/doc/ocaml/README.Debian file for more details.
#
" dpkg_ldconf user_ldconf ocaml_ldconf

let ocaml_ldconf_comment = Printf.sprintf
"#
# %s
# This is the ocaml ld.conf file and should not be edited by hand.
# 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 the /usr/share/doc/ocaml/README.Debian file for more details.
#
%s/stublibs
%s/stublibs
" ocaml_ldconf dpkg_ldconf user_ldconf local_ocaml_dir ocaml_dir


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/from %s for package PACKAGE.
  4) ocaml-ldconf [OPTIONS] [-p PACKAGE] -R
     removes all dirs from %s for package PACKAGE.

Options:" ocaml_ldconf user_ldconf dpkg_ldconf dpkg_ldconf dpkg_ldconf

type action = Add | Remove | Display | Update | RemoveAll
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";
  "-R", Arg.Unit (fun () -> action := RemoveAll),
    "remove all paths for a given package 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)

(* checks if the package part of a ld.conf entry corresponds,
 * spaces being considered as a single token *)
let is_package s p = 
  let ls = String.length s and lp = String.length p in
  let rec f i j c = 
    if j = lp then 
      if i = ls then true else is_space s.[i]
    else
    if i = ls then false else
    if is_space s.[i] then f (index_non_space_from s i) j c else 
    if c < 2 then f (index_space_from s i) j (c+1) else
    if s.[i] = p.[j] then f (i+1) (j+1) c  else
    false
  in
  f 0 0 0
    
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 (head::collected) tail in
  List.rev (f [] src)

(* suppress from a list all elements that match a condition *)
let sup_list_cond src cond =
  let rec f collected = function
    | [] -> collected
    | head::tail ->
      if cond head 
      then f collected tail
      else f (head::collected) tail
  in
  List.rev (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, Add_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 from %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

(* remove directories, if those exist for the given package *)
let action_remove_all package =
  if !verbose then Printf.printf "%s removes all paths from %s\n"
    package dpkg_ldconf;
  let contents = read_file_contents dpkg_ldconf in
  let condition s = is_package s package in
  let new_cont = sup_list_cond contents condition 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
  if Sys.command ("chmod u+w " ^ ocaml_ldconf) <> 0 then
    failwith (Printf.sprintf "Unable to change %s's permissions" ocaml_ldconf);
  write_file_contents ocaml_ldconf
    (ocaml_ldconf_comment::add_list@dpkg_list@addafter_list);
  if Sys.command ("chmod u-w " ^ ocaml_ldconf) <> 0 then
    failwith (Printf.sprintf "Unable to change %s's permissions" ocaml_ldconf)

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 ()
  | RemoveAll ->
    action_remove_all !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)
.\"                                      Hey, EMACS: -*- nroff -*-
.\" First parameter, NAME, should be all caps
.\" Second parameter, SECTION, should be 1-8, maybe w/ subsection
.\" other parameters are allowed: see man(7), man(1)
.TH OCAML SECTION "February 18, 2002"
.\" Please adjust this date whenever revising the manpage.
.\"
.\" Some roff macros, for reference:
.\" .nh        disable hyphenation
.\" .hy        enable hyphenation
.\" .ad l      left justify
.\" .ad b      justify to both left and right margins
.\" .nf        disable filling
.\" .fi        enable filling
.\" .br        insert line break
.\" .sp <n>    insert n+1 empty lines
.\" for manpage-specific macros, see man(7)
.SH NAME
ocaml-ldconf \- small utility to manage ocaml ld.conf path
.SH SYNOPSIS
.B ocaml-ldconf
.RI [ options ]
.br
.B ocaml-ldconf
.RI [ options ]
.BI \-l
.br
.B ocaml-ldconf
.RI [ options ]
.BI \-p package
.BI \-a/\-r " dirs ... "
.br
.B ocaml-ldconf
.RI [ options ]
.BI \-p package
.BI \-R 
.SH DESCRIPTION
This manual page documents briefly the
.B ocaml-ldconf
command.
This manual page was written for the Debian distribution
because the original program does not have a manual page.
.PP
.\" TeX users may be more comfortable with the \fB<whatever>\fP and
.\" \fI<whatever>\fP escape sequences to invode bold face and italics, 
.\" respectively.
\fBocaml-ldconf\fP is a program that handles the ocaml specific ld.conf paths.
It can be invoked in three different ways.
.PP
Without argument, it will generate a new /usr/lib/ocaml/ld.conf file using the
content of the system administrator defined /etc/ocaml/ld.conf and the dpkg
handled /var/lib/ocaml/ld.conf.
.PP
With the
.BI \-l 
argument, it will simply list the currently active path (well only those in
/usr/lib/ocaml/ld.conf for now).
.PP
In the
.BI \-a/\-r
variant,
.B ocaml-ldconf
will add or remove a list of directories to the dpkg handled
/var/lib/ocaml/ld.conf file for the package named with the
.BI \-p package
argument.
Finally, in the 
.BI \-R variant, 
.B ocaml-ldconf
removes all directories associated with package named with the 
.BI \-p package
argument from the dpkg handled /var/lib/ocaml/ld.conf file.
.PP
Notice that after having manually updated the /etc/ocaml/ld.conf file, the
system administrator should recreate the /usr/lib/ocaml/ld.conf file by
running ocaml-ldconf without arguments.

.SH OPTIONS
.TP
.B \-a
Adds given paths to the dynamic loading standard path
.TP
.B \-r
Removes given paths from the dynamic loading standard path
.TP
.B \-R
Removes all paths associated with the given package.
.TP
.B \-p
Gives the package name which adds/removes the paths
.TP
.B \-l
Displays the current dynamic loading paths
.TP
.B \-v
Display more verbose messages.
.TP
.B \-n
Don't update the /usr/lib/ocaml/ld.conf file 
.TP
.B \-help, \-\-help
Show summary of options.
.SH FILE FORMATS
All three handled files are a list of lines, each containing a directory (for
/usr/lib/ocaml/ld.conf) or a directory plus some other stuff, separated by a
space or tabulation (for the two other files). A line
begining by a # is considered a comment and ignored.
.PP
The /etc/ocaml/ld.conf file format is :
.TP
.B directory [command]
.PP
Where command can be one of :
.TP
.B add
Adds the directory before the dpkg managed ones (default command).
.TP
.B addafter
Adds the directory after the dpkg managed ones.
.TP
.B remove
If the directory is present in the dpkg managed file, then it get removed.
.PP
The /var/lib/ocaml/ld.conf file format is :
.TP
.B directory add package
.SH FILES
.PD 0
.TP 20
.B /etc/ocaml/ld.conf
The system administrator configuration file.
.TP 20
.B /var/lib/ocaml/ld.conf
The dpkg managed configuration file.
.TP 20
.B /usr/lib/ocaml/ld.conf
The true ld.conf file taken in account by the ocaml runtime system.
.SH SEE ALSO
.BR ocamlrun (1),
.br
.I The Objective Caml user's manual,
chapter "Runtime system".
.br
.I The /usr/share/doc/ocaml/README.Debian
.br
.SH AUTHOR
This manual page was written by Sven Luther <luther@debian.org>,
for the Debian GNU/Linux system (but may be used by others).


Reply to: