Mardi 31 janvier 2006 |
#!/bin/bash set -o noclobber NAME=tictac LOCK=/tmp/$NAME.lock error () { echo "$1" 1>&2 exit 1 } once () { if [ -f "$LOCK" ] then xterm -g 50x2 -e bash -c \ "echo -n 'Daemon '$NAME' running pid='; cat $LOCK; sleep 5" fi } launch () { while true do if sleep 60 then once else exit 1 fi done } usage () { error "Usage: $0 [ -launch | -kill ] " } if [ $# != 1 ] then usage fi case "$1" in -launch) if [ -f "$LOCK" ] then error "Daemon already running (not launched)!" else echo -n '' > "$LOCK" || error "Cannot write $LOCK" echo -n "Launching $NAME... " launch & echo $! >> "$LOCK" echo "done (pid=$!)" fi ;; -kill) if [ -f "$LOCK" ] then PID=$(cat "$LOCK") case "$PID" in [1-9][0-9]*) ;; *) error "$LOCK does not contain a pid";; esac echo -n "Killing daemon $PID... " if kill -KILL "$PID" then echo "Done" rm "$LOCK" else echo "Process $PID not running (cleaning $LOCK)!" 1>&2 rm "$LOCK" exit 1 fi else error "Daemon not running" fi ;; *) usage esac |
bash
, dans lequel il est possible de rechercher un mot
avec la touche / .Daemon tictac running pid=i
./tmp/tictac.lock
que le shell-script relit pour
pouvoir tuer le processus.kill -KILL
est égale à 0
.name
et lock
correspondant aux
constantes NAME
et LOCK
du script shell précédent, puis écrire
une fonction error
équivalente à la fonction error
du script
(1>&2
indique que l'affichage doit être effectué sur la sortie d'erreur).
let name = "tictac";; let lock = "/tmp/" ^ name ^ ".lock";; let error s = prerr_endline s; exit 1;; |
mon_execvp
telle que mon_execvp cmd argv
exécute la
commande cmd
(Unix.excevp
) dans un processus différent (Unix.fork
) avec les arguments présents dans le tableau de chaînes
de caractères argv
. La fonction attend la fin de la
commande cmd
(Unix.waitpid
) avant de se terminer.
La fonction retourne la valeur de retour
de la commande ou lève une exception. Attention, l'attente peut être intérompue par l'arrivée d'un signal
(levée de l'exception Unix_error(EINTR,_,_
), il faut alors relancer
l'attente.
open Sys;; open Unix;; let mon_execvp com argv = let com_argv = Array.concat [ [| com |]; argv ] in match fork() with | 0 -> handle_unix_error (fun _ -> execvp com com_argv) () | k -> let rec wait() = try snd (waitpid [] k) with Unix_error (EINTR, _, _) -> wait() in wait() |
mon_execvp
ne prend pas en compte tous les cas où des
signaux peuvent arriver. Modifier votre fonction pour que le signal SIGCHLD
soit bloqué (Unix.sigprocmask
) et les signaux SIGINT
et SIGQUIT
soient
ignorés (Sys.signal
avec Sys.Signal_ignore
). Pensez également à remettre
en place le comportement initial des signaux avant la fin de la commande
quelle que soit la façon dont elle se termine.
open Sys;; open Unix;; let try_finalize f x finally y = let res = try f x with exn -> finally y; raise exn in finally y; res let mon_execvp com argv = let com_argv = Array.concat [ [| com |]; argv ] in let old_mask = sigprocmask SIG_BLOCK [ sigchld ] in let old_int = signal sigint Signal_ignore in let old_quit = signal sigquit Signal_ignore in let reset() = ignore (signal sigint old_int); ignore (signal sigquit old_quit); ignore (sigprocmask SIG_SETMASK old_mask) in let system_call () = match fork() with | 0 -> reset(); handle_unix_error (fun _ -> execvp com com_argv) () | k -> let rec wait() = try snd (waitpid [] k) with Unix_error (EINTR, _, _) -> wait() in wait() in try_finalize system_call() reset() |
mon_execvp
, écrire une fonction
mon_system
qui exécute une commande passée en argument sous la
forme d'une chaîne de caractères en passant cette dernière en argument
de la commande /bin/sh -c
.
let mon_system args = mon_execvp "/bin/sh" [| "-c"; args |] ;; |
succeed
telle que succeed f x
appelle f x
et
retourne true
si f x
se termine normalement, false
si l'appel
a levé une exception de type Unix_error
(l'exception est alors
ignorée) et propage les exceptions différentes de Unix_error
.
let succeed f x = try ignore (f x); true with Unix_error(a,b,c) -> false |
succeed
précédente, écrire une fonction
file_exists
(correspondant à test -f
) qui retourne true
si le
fichier dont le nom est passé en argument existe. Pour cela, on pourra
utiliser la fonction Unix.access
. let file_exists name = succeed (fun name -> access name [ F_OK ]) name |
mon_execvp
et file_exists
écrire une
fonction once
équivalente à celle du shell-script précédent.
open Printf;; let once x = if file_exists lock then let command = sprintf "echo -n 'Daemon %s running pid='; cat %s; sleep 5" name lock in let status = mon_execvp "xterm" [| "-g"; "50x2"; "-e"; "bash"; "-c"; command |] in () |
mon_excevp
une fonction launch
qui a le même
comportement que celle du shell-script.
let launch() = while true do match mon_execvp "sleep" [| "60" |] with WEXITED 0 -> once () | _ -> exit 1 done;; |
background
telle que background lock f x
appelle f x
après avoir effectué un fork
, et qui utilise un
fichier de nom lock
pour s'assurer qu'il n'y ait qu'une exécution de
f x
à la fois. Pour cela, on ouvrira le fichier avec les attributs
O_EXCL
et O_CREAT
. Le fichier lock
devra contenir le numéro de
processus exécutant f x
.
let background lock f x = try let fd = openfile lock [O_WRONLY; O_EXCL; O_CREAT] 0o600 in printf "Launching %s... " name; flush Pervasives.stdout; match fork () with | 0 -> close fd; f x; exit 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) |
read_pid_from_file
qui retourne le numéro du
processus stocké dans le fichier dont le nom est passé en argument. On
pourra utiliser la fonction input_line
de Ocaml.
let read_pid_from_file name = let chan = open_in name in let doit () = int_of_string (input_line chan) in try_finalize doit () (fun _ -> close_in chan) () |
kill_daemon
telle que kill_daemon lock
termine
le processus dont le numéro est présent dans le fichier de nom lock
.
Comme dans le shell-script on fera attention à traiter tous les cas
d'erreurs possibles.
let kill_daemon lock = if file_exists lock then let pid = try read_pid_from_file lock with x -> error (lock ^ "does not contain a pid") in (* "%!" flushes the output in version 3.07 *) printf "Killing daemon %d... %!" pid; if succeed (fun _ -> kill pid sigkill) () then begin printf "Done!\n%!"; handle_unix_error (fun _ -> unlink lock) () end else begin eprintf "Process %d not running (cleaning %s)!\n%!" pid lock; handle_unix_error (fun _ -> unlink lock) (); exit 1 end else error "Daemon not running";; |
kill
a échoué parce que l'on n'avait pas les droits nécessaires pour arrêter le
processus. Modifier la fonction kill_daemon
en conséquence (il est
plus compliqué de le faire avec shell-script).
let kill_daemon lock = if file_exists lock then let pid = try read_pid_from_file lock with x -> error (lock ^ "does not contain a pid") in printf "Killing daemon %d... %!" pid; try kill pid sigkill; printf "Done!\n%!"; handle_unix_error (fun _ -> unlink lock) () with Unix_error (EPERM,_,_) -> eprintf "Killing %d not permitted!\n%!" pid; exit 2 | _ -> eprintf "Process %d not running (cleaning %s)!\n%!" pid lock; handle_unix_error (fun _ -> unlink lock) (); exit 1 else error "Daemon not running";; |
let usage () = error (sprintf "Usage: %s [ - launch | -kill ]" Sys.argv.(0));; let _ = if Array.length Sys.argv != 1 then match Sys.argv.(1) with | "-launch" -> background lock launch () | "-kill" -> kill_daemon lock | _ -> usage () else usage ();; |
Ce document a été traduit de LATEX par HEVEA