which included commits to RCS files with non-trunk default branches.
--- /dev/null
+backend.cmo: inotify.cmi globals.cmo frontend.cmo fifowatcher.cmo \
+ dirwatcher.cmo
+backend.cmx: inotify.cmi globals.cmx frontend.cmx fifowatcher.cmx \
+ dirwatcher.cmx
+dirwatcher.cmo: inotify.cmi globals.cmo fdwatcher.cmo
+dirwatcher.cmx: inotify.cmi globals.cmx fdwatcher.cmx
+fdwatcher.cmo: globals.cmo
+fdwatcher.cmx: globals.cmx
+fifowatcher.cmo: inotify.cmi globals.cmo fdwatcher.cmo dirwatcher.cmo
+fifowatcher.cmx: inotify.cmi globals.cmx fdwatcher.cmx dirwatcher.cmx
+frontend.cmo: globals.cmo fifowatcher.cmo
+frontend.cmx: globals.cmx fifowatcher.cmx
+main.cmo: inotify.cmi globals.cmo frontend.cmo fifowatcher.cmo fdwatcher.cmo \
+ dirwatcher.cmo backend.cmo
+main.cmx: inotify.cmi globals.cmx frontend.cmx fifowatcher.cmx fdwatcher.cmx \
+ dirwatcher.cmx backend.cmx
--- /dev/null
+all: vsys
+
+include .dep
+
+.SUFFIXES: .ml .cmo
+.SUFFIXES: .mli .cmi
+.SUFFIXES: .ml .cmx
+.SUFFIXES: .mll .ml
+.SUFFIXES: .mly .ml
+
+.ml.cmo:
+ ocamlc -g -c $(INCLUDEDIR) $<
+
+.mli.cmi:
+ ocamlopt -c $<
+
+.ml.cmx:
+ ocamlopt $(CFLAGS) -c $(INCLUDEDIR) $<
+
+.mly.ml:
+ ocamlyacc $<
+
+.mll.ml:
+ ocamllex $<
+
+vsys: inotify.cmxa inotify.cmi globals.cmx fdwatcher.cmx dirwatcher.cmx fifowatcher.cmx frontend.cmx backend.cmx main.cmx
+ ocamlopt str.cmxa unix.cmxa inotify.cmxa globals.cmx fdwatcher.cmx dirwatcher.cmx fifowatcher.cmx frontend.cmx backend.cmx str.cmxa main.cmx -o vsys
+
+vsys.b: inotify.cma inotify.cmi globals.cmo fdwatcher.cmo dirwatcher.cmo fifowatcher.cmo frontend.cmo backend.cmo main.cmo
+ ocamlc -g str.cmxa unix.cma inotify.cma globals.cmo fdwatcher.cmo dirwatcher.cmo fifowatcher.cmo frontend.cmo backend.cmo str.cma main.cmo -o vsys.b
+
+dep:
+ ocamldep *.ml > .dep
+
+clean:
+ rm -fR *.cmi *.cmx sys usys
--- /dev/null
+vsys v0.1
+---------
+
--- /dev/null
+1. The executable doesn't get read values
+2. Watch for created files to compile
--- /dev/null
+open Unix
+open Globals
+open Dirwatcher
+open Inotify
+open Fifowatcher
+open Frontend
+open Printf
+
+let delete_prefix prefix str =
+ let len = String.length str in
+ let plen = String.length prefix in
+ if (String.sub str 0 plen <> prefix)
+ then
+ raise Bad_path
+ else
+ Relpath(String.sub str (plen+1) (len-plen-1))
+
+let rec list_check lst elt =
+ match lst with
+ | [] -> false
+ | car::cdr -> if (car==elt) then true else list_check cdr elt
+
+
+ (*
+ * One backendHandler class for each
+ * backend. Builds the initial
+ * tree for the frontend and
+ * watches for directory
+ * events.
+ *)
+
+class backendHandler dir_root (frontend_lst: frontendHandler list) =
+ let mk_rel_path = delete_prefix dir_root in object(this)
+
+ val file_regexp = ref (Str.regexp "[a-zA-Z][a-zA-Z0-9_-'.']*")
+
+ method new_dir fqp func =
+ let s = Unix.stat fqp in
+ List.iter
+ (fun frontend->
+ frontend#mkdir (mk_rel_path fqp) (s.st_perm);
+ Dirwatcher.add_watch fqp [S_Create;S_Delete] (Some(func)))
+ frontend_lst;
+
+ method new_script fqp =
+ let s = Unix.stat fqp in
+ List.iter (fun frontend->
+ frontend#mkentry (mk_rel_path fqp) fqp (s.st_perm)) frontend_lst
+
+ val dir_regexp = Str.regexp "^dir_";
+
+ method handle_dir_event dirname evlist fname =
+ let fqp = String.concat "/" [dirname;fname] in
+ if (Str.string_match !file_regexp fname 0) then
+ begin
+ let is_event = list_check evlist in
+ if (is_event Create) then
+ begin
+ if (is_event Isdir) then
+ begin
+ this#new_dir fqp this#handle_dir_event
+ end
+ else
+ (* It's a new script *)
+ begin
+ (*
+ if (Str.string_match dir_regexp fname 0) then
+ let fqp = String.concat "/" [dirname;String.sub fname 4 ((String.length fname)-4+1)] in
+ let real_fqp = String.concat "/" [dirname;fname] in
+ this#new_dir fqp this#handle_spool_event;
+ Hashtbl.add spools fqp real_fqp
+ else*)
+ this#new_script fqp
+ end
+ end
+ else if (is_event Delete) then
+ begin
+ if (is_event Isdir) then
+ begin
+ (*this#rm_watch fqp;*)
+ List.iter (fun frontend->
+ frontend#rmdir (mk_rel_path fqp)) frontend_lst
+ end
+ else List.iter (fun frontend ->
+ frontend#unlink (mk_rel_path fqp)) frontend_lst
+ end
+ end
+ else (* regex not matched *)
+ ()
+
+ initializer
+ let rec build_initial_tree dir =
+ let dir_handle = opendir dir in
+ let cont = ref true in
+ while (!cont) do
+ try
+ let curfile = readdir dir_handle in
+ let fqp = String.concat "/" [dir;curfile] in
+ if (Str.string_match !file_regexp curfile 0) then
+ let s = Unix.stat fqp in
+ begin
+ match s.st_kind with
+ | S_DIR ->
+ this#new_dir fqp this#handle_dir_event;
+ build_initial_tree fqp;
+ | S_REG ->
+ this#new_script fqp
+ | _ ->
+ printf "Don't know what to do with %s\n" curfile;flush Pervasives.stdout
+ end
+ with
+ _->cont:=false;()
+ done
+ in
+ begin
+ build_initial_tree dir_root;
+ Dirwatcher.add_watch dir_root [S_Create;S_Delete] (Some(this#handle_dir_event));
+ end
+end
--- /dev/null
+open Inotify
+open Fdwatcher
+open Printf
+open Globals
+
+(* I don't know if a wd corresponding to a deleted directory is evicted or just
+ * leaks - fix implementation of rmdir accordingly
+ *)
+
+let wdmap = Hashtbl.create 1024
+
+let fd = Inotify.init ()
+
+let handle_dir_event dirname evlist str =
+ let fname = String.concat "/" [dirname;str] in
+ printf "File: %s. " fname;List.iter
+ (fun e ->
+ printf "Event: %s\n" (string_of_event e))
+ evlist;
+ flush Pervasives.stdout
+
+let add_watch dir events handler =
+ printf "Adding watch for %s\n" dir;
+ let wd = Inotify.add_watch fd dir events in
+ Hashtbl.add wdmap wd (dir,handler)
+
+let asciiz s =
+ let rec findfirstnul str idx len =
+ if ((idx==len) ||
+ (str.[idx]==(char_of_int 0))) then idx
+ else
+ findfirstnul str (idx+1) len
+ in
+ let nulterm = findfirstnul s 0 (String.length s) in
+ String.sub s 0 nulterm
+
+let receive_event (eventdescriptor:fd_and_fname) (bla:fd_and_fname) =
+ let (_,fd) = eventdescriptor in
+ let evs = Inotify.read fd in
+ List.iter (fun x->
+ match x with
+ | (wd,evlist,_,Some(str)) ->
+ let purestr = asciiz(str) in
+ let (dirname,handler) =
+ try Hashtbl.find wdmap wd with Not_found->printf "Unknown watch descriptor\n";raise Not_found
+ in
+ (
+ match handler with
+ | None->handle_dir_event dirname evlist purestr
+ | Some(handler)->handler dirname evlist purestr
+ )
+ | _ -> ())
+ evs
+
+let initialize () =
+ Fdwatcher.add_fd (None,fd) (None,fd) receive_event
--- /dev/null
+open Printf
+open Globals
+
+let fdset = ref []
+let cbtable = Hashtbl.create 1024
+
+(* The in descriptor is always open. Thanks to the broken semantics of
+ * fifo outputs, the out descriptor must be opened a nouveau whenever we
+ * want to send out data, and so we keep the associated filename as well.
+ * Same with input fifos. Yipee.*)
+
+let add_fd (evpair:fd_and_fname) (fd_other:fd_and_fname) (callback:fd_and_fname->fd_and_fname->unit) =
+ let (fname,fd) = evpair in
+ fdset := (fd::!fdset);
+ Hashtbl.replace cbtable fd (callback,(evpair,fd_other))
+
+let del_fd fd =
+ fdset:=List.filter (fun l->l<>fd) !fdset;
+ flush Pervasives.stdout
+
+let start_watch () =
+ while (true)
+ do
+ let (fds,_,_) = try Unix.select !fdset [] [] (-1.)
+ with e->
+ ([],[],[])
+ in
+ List.iter (fun elt->
+ let (func,(evd,fd_other)) = Hashtbl.find cbtable elt in
+ func evd fd_other) fds
+ done
+
--- /dev/null
+open Inotify
+open Unix
+open Globals
+open Dirwatcher
+open Printf
+
+type channel_pipe = Process of out_channel | Fifo of out_channel
+type signed_fd = Infd of Unix.file_descr | Outfd of Unix.file_descr
+
+(* (1) fdmap maps fifo fds -> service names, for initial read events
+ * (2) pidmap maps pids of currently executing services into fds for sigchlds to
+ * prevent the appearence of zombies and to define the end of a session.
+ * (3) open_fds maps read events into active services
+ *)
+let fdmap: (Unix.file_descr,string*string) Hashtbl.t = Hashtbl.create 1024
+let pidmap: (int,signed_fd*signed_fd*Unix.file_descr) Hashtbl.t = Hashtbl.create 1024
+let backend_prefix = ref ""
+let open_fds: (Unix.file_descr,channel_pipe) Hashtbl.t = Hashtbl.create 1024
+
+
+
+let receive_process_event (idesc:fd_and_fname) (_:fd_and_fname) =
+ printf "Process event\n";flush Pervasives.stdout;
+ let (_,ifd) = idesc in
+ let cp = try Hashtbl.find open_fds ifd with
+ Not_found->
+ printf "Fifo fd disappeared\n";raise Bug
+ in
+ match (cp) with
+ | Fifo(fifo_outchan) ->
+ let process_inchan = in_channel_of_descr ifd in
+ let cont = ref true in
+ let count = ref 0 in
+ count:=!count + 1;
+ while (!cont) do
+ try
+ let curline = input_line process_inchan in
+ printf "Here: %d %s\n" !count curline;flush Pervasives.stdout;
+ fprintf fifo_outchan "%s\n" curline;flush fifo_outchan
+ with
+ | End_of_file|Sys_blocked_io|Unix_error(EPIPE,_,_) ->
+ begin
+ cont:=false
+ end
+ | Unix_error(_,s1,s2) -> printf "Unix error %s - %s\n" s1 s2;flush Pervasives.stdout;cont:=false
+ | e -> printf "Error!!!\n";raise e
+ done
+ | _ -> printf "Bug! Process fd received in the channel handler\n";raise Bug
+
+
+let rec openentry_int fifoin fifoout (abspath:string*string) =
+ let fdin =
+ try openfile fifoin [O_RDONLY;O_NONBLOCK] 0o777 with
+ e->printf "Error opening and connecting FIFO: %s,%o\n" fifoin 0o777;flush Pervasives.stdout;raise e
+ in
+ Hashtbl.replace fdmap fdin abspath;
+ Fdwatcher.add_fd (Some(fifoin),fdin) (Some(fifoout),stdout) receive_fifo_event
+and reopenentry_int fdin fifoin fifoout =
+ close fdin;
+ Fdwatcher.del_fd fdin;
+ let abspath = try
+ Hashtbl.find fdmap fdin with _ -> printf "Bug: Phantom pipe\n";flush Pervasives.stdout;raise Bug
+ in
+ openentry_int fifoin fifoout abspath
+and receive_fifo_event eventdescriptor outdescriptor =
+ let evfname,evfd = eventdescriptor in
+ let (fname_other,fd_other) = outdescriptor in
+ let outfd =
+ match (fname_other) with
+ | Some(str)->
+ (
+ try openfile str [O_WRONLY;O_NONBLOCK] 0o777 with
+ _->printf "Problemo:%s\n" str;flush Pervasives.stdout;stdout
+ )
+ | None-> printf "Bug, nameless pipe\n";raise Bug
+ in
+ let pipe = try Hashtbl.find open_fds evfd with
+ | Not_found ->
+ (* This is a fifo fd for sure *)
+ let execpath,slice_name = Hashtbl.find fdmap evfd in
+ (* Spawn server. We assume that the fd is one fifo opened RW *)
+ let (myinfd,pout) = Unix.pipe () in
+ let (pin,myoutfd) = Unix.pipe () in
+ set_nonblock myinfd;
+ let pid = try create_process execpath [|execpath;slice_name|] pin pout pout with e -> printf "Error executing service: %s\n" execpath;flush Pervasives.stdout;raise e
+ in
+ Hashtbl.add pidmap pid (Infd(myinfd),Outfd(myoutfd),evfd);
+ Hashtbl.add open_fds evfd (Process(out_channel_of_descr myoutfd));
+ Hashtbl.add open_fds myinfd (Fifo(out_channel_of_descr outfd));
+ Fdwatcher.add_fd (None,myinfd) (None,myinfd) receive_process_event;
+ (Process(out_channel_of_descr myoutfd))
+ in
+ let inchan_fd = in_channel_of_descr evfd in
+ match (pipe) with
+ | Process(out_channel) ->
+ let cont = ref true in
+ while (!cont) do
+ try
+ printf "Reading...\n";flush Pervasives.stdout;
+ let curline = input_line inchan_fd in
+ fprintf out_channel "%s\n" curline;flush out_channel
+ with
+ |End_of_file->
+ (
+ match (evfname,fname_other) with
+ | Some(str1),Some(str2)->
+ reopenentry_int evfd str1 str2
+ | Some(str1),None ->
+ printf "Bug, nameless pipe\n";flush Pervasives.stdout;raise Bug
+ | None,_ ->
+ printf "Race condition -> user deleted file before closing it. Clever ploy, but won't work.\n";
+ flush Pervasives.stdout
+ );
+ cont:=false
+ |Sys_blocked_io ->printf "Sysblockedio\n";flush Pervasives.stdout;
+ cont:=false
+ | _ ->printf "Bug: unhandled exception\n";flush Pervasives.stdout;raise Bug
+ done
+ | _ -> printf "BUG! received process event from fifo\n";raise Bug
+
+
+let mkentry fqp abspath perm =
+ printf "Making entry %s->%s\n" fqp abspath;flush Pervasives.stdout;
+ let fifoin=sprintf "%s.in" fqp in
+ let fifoout=sprintf "%s.out" fqp in
+ (try Unix.unlink fifoin with _ -> ());
+ (try Unix.unlink fifoout with _ -> ());
+ (try
+ Unix.mkfifo (sprintf "%s.in" fqp) 0o666
+ with
+ e->printf "Error creating FIFO: %s->%s,%o\n" fqp fifoin perm;flush Pervasives.stdout;raise e);
+ (try
+ Unix.mkfifo (sprintf "%s.out" fqp) 0o666
+ with
+ e->printf "Error creating FIFO: %s->%s,%o\n" fqp fifoout perm;flush Pervasives.stdout;raise e)
+
+
+let openentry fqp abspath perm =
+ let fifoin = String.concat "." [fqp;"in"] in
+ let fifoout = String.concat "." [fqp;"out"] in
+ openentry_int fifoin fifoout abspath
+
+let sigchld_handle s =
+ let pid,_=Unix.waitpid [Unix.WNOHANG] 0 in
+ try
+ let value = Hashtbl.find pidmap pid in
+ match value with
+ | (Infd(ifd),Outfd(ofd),fd) ->
+ close(ifd);close(ofd);
+ Hashtbl.remove open_fds fd;
+ Fdwatcher.del_fd ifd;
+ Hashtbl.remove pidmap pid
+ | _ -> printf "BUG! Got fds in the wrong order\n";
+ flush Pervasives.stdout;
+ raise Bug
+ with
+ Not_found-> (* Do nothing, probably a grandchild *)
+ ()
+
+
+
+let initialize () =
+ Sys.set_signal Sys.sigchld (Sys.Signal_handle sigchld_handle)
--- /dev/null
+open Printf
+open Unix
+open Globals
+open Fifowatcher
+
+class frontendHandler (root_dir,slice_name) =
+object(this)
+ method mkentry (rp:relpath) abspath perm =
+ let realperm = perm land (lnot 0o111) in
+ match rp with Relpath(rel) ->
+ let fqp = String.concat "/" [root_dir;rel] in
+ Fifowatcher.mkentry fqp abspath realperm;
+ Fifowatcher.openentry fqp (abspath,slice_name) realperm
+
+ method mkdir rp perm =
+ match rp with Relpath(rel) ->
+ let fqp = String.concat "/" [root_dir;rel] in
+ try
+ let s = Unix.stat fqp in
+ if (s.st_kind<>S_DIR) then
+ begin
+ Unix.unlink fqp;
+ Unix.mkdir fqp perm
+ end
+ else if (s.st_perm <> perm) then
+ begin
+ printf "Removing directory %s\n" fqp;
+ flush Pervasives.stdout;
+ Unix.rmdir fqp;
+ Unix.mkdir fqp perm
+ end
+ with Unix.Unix_error(_,_,_) ->
+ Unix.mkdir fqp perm
+
+ method unlink rp =
+ match rp with Relpath(rel) ->
+ let fqp = String.concat "/" [root_dir;rel] in
+ Unix.unlink fqp
+
+ method rmdir rp =
+ match rp with Relpath(rel) ->
+ let fqp = String.concat "/" [root_dir;rel] in
+ Unix.rmdir fqp
+end
--- /dev/null
+let frontend = ref ""
+let backend = ref ""
+let debug = ref true
+
+type fd_and_fname = string option * Unix.file_descr
+type relpath = Relpath of string
+
+exception Bad_path
+exception Bug
--- /dev/null
+(*
+ * Copyright (C) 2006 Vincent Hanquez <vincent@snarc.org>
+ *
+ * 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 only.
+ *
+ * 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.
+ *
+ * Inotify OCaml binding
+ *)
+
+type select_event =
+| S_Access
+| S_Attrib
+| S_Close_write
+| S_Close_nowrite
+| S_Create
+| S_Delete
+| S_Delete_self
+| S_Modify
+| S_Move_self
+| S_Moved_from
+| S_Moved_to
+| S_Open
+| S_Dont_follow
+| S_Mask_add
+| S_Oneshot
+| S_Onlydir
+| S_Move
+| S_Close
+| S_All
+
+type type_event =
+| Access
+| Attrib
+| Close_write
+| Close_nowrite
+| Create
+| Delete
+| Delete_self
+| Modify
+| Move_self
+| Moved_from
+| Moved_to
+| Open
+| Ignored
+| Isdir
+| Q_overflow
+| Unmount
+
+type wd
+type event = wd * type_event list * int32 * string option
+
+val int_of_wd : wd -> int
+val string_of_event : type_event -> string
+
+val init : unit -> Unix.file_descr
+val add_watch : Unix.file_descr -> string -> select_event list -> wd
+val rm_watch : Unix.file_descr -> wd -> unit
+val read : Unix.file_descr -> event list
--- /dev/null
+open Globals
+open Printf
+open Inotify
+open Backend
+open Frontend
+open Fifowatcher
+
+let input_file_list = ref []
+let cur_dir = ref ""
+let cur_slice = ref ""
+
+let cmdspeclist =
+ [
+ ("-backend",Arg.Set_string(Globals.backend), "Backend directory");
+ ("-frontend",Arg.Tuple[Arg.String(fun s->cur_dir:=s);Arg.String(fun s->cur_slice:=s;input_file_list:=(!cur_dir,!cur_slice)::!input_file_list)], "frontendN,slicenameN")
+ ]
+
+let cont = ref true
+
+let _ =
+ printf "Vsys v0.3\n";flush stdout;
+ Arg.parse cmdspeclist (fun x->()) "Usage: vsys <list of mount points>";
+ if (!Globals.backend == "" || !input_file_list == []) then
+ printf "Try vsys --help\n"
+ else
+ begin
+ Dirwatcher.initialize ();
+ Fifowatcher.initialize ();
+ let felst = List.map (fun lst->new frontendHandler lst) !input_file_list in
+ let _ = new backendHandler !Globals.backend felst in
+ Fdwatcher.start_watch ()
+ end
--- /dev/null
+When an executable
git://git.onelab.eu / vsys.git / commitdiff