From: Sapan Bhatia Date: Thu, 17 May 2007 17:24:33 +0000 (+0000) Subject: This commit was generated by cvs2svn to compensate for changes in r2, X-Git-Tag: vsys-0.7-19~33 X-Git-Url: http://git.onelab.eu/?p=vsys.git;a=commitdiff_plain;h=2955cde23cac50c0ad569745974746993b171524 This commit was generated by cvs2svn to compensate for changes in r2, which included commits to RCS files with non-trunk default branches. --- diff --git a/.dep b/.dep new file mode 100644 index 0000000..63f8791 --- /dev/null +++ b/.dep @@ -0,0 +1,16 @@ +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 diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..893aa9a --- /dev/null +++ b/Makefile @@ -0,0 +1,36 @@ +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 diff --git a/README b/README new file mode 100644 index 0000000..3c00c50 --- /dev/null +++ b/README @@ -0,0 +1,3 @@ +vsys v0.1 +--------- + diff --git a/TODO b/TODO new file mode 100644 index 0000000..05b542c --- /dev/null +++ b/TODO @@ -0,0 +1,2 @@ +1. The executable doesn't get read values +2. Watch for created files to compile diff --git a/a.out b/a.out new file mode 100755 index 0000000..fece834 Binary files /dev/null and b/a.out differ diff --git a/backend.ml b/backend.ml new file mode 100644 index 0000000..a1e86fe --- /dev/null +++ b/backend.ml @@ -0,0 +1,119 @@ +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 diff --git a/bal b/bal new file mode 100644 index 0000000..e69de29 diff --git a/dirwatcher.ml b/dirwatcher.ml new file mode 100644 index 0000000..5bd4d6c --- /dev/null +++ b/dirwatcher.ml @@ -0,0 +1,56 @@ +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 diff --git a/fdwatcher.ml b/fdwatcher.ml new file mode 100644 index 0000000..3e31427 --- /dev/null +++ b/fdwatcher.ml @@ -0,0 +1,32 @@ +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 + diff --git a/fifowatcher.ml b/fifowatcher.ml new file mode 100644 index 0000000..803ee5e --- /dev/null +++ b/fifowatcher.ml @@ -0,0 +1,163 @@ +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) diff --git a/frontend.ml b/frontend.ml new file mode 100644 index 0000000..fc7a88f --- /dev/null +++ b/frontend.ml @@ -0,0 +1,44 @@ +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 diff --git a/globals.ml b/globals.ml new file mode 100644 index 0000000..26230b8 --- /dev/null +++ b/globals.ml @@ -0,0 +1,9 @@ +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 diff --git a/inotify.cma b/inotify.cma new file mode 100644 index 0000000..2ce5647 Binary files /dev/null and b/inotify.cma differ diff --git a/inotify.cmxa b/inotify.cmxa new file mode 100644 index 0000000..08e6335 Binary files /dev/null and b/inotify.cmxa differ diff --git a/inotify.mli b/inotify.mli new file mode 100644 index 0000000..413e143 --- /dev/null +++ b/inotify.mli @@ -0,0 +1,64 @@ +(* + * Copyright (C) 2006 Vincent Hanquez + * + * 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 diff --git a/main.ml b/main.ml new file mode 100644 index 0000000..2bf4c8c --- /dev/null +++ b/main.ml @@ -0,0 +1,32 @@ +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 "; + 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 diff --git a/mar2007.tex b/mar2007.tex new file mode 100644 index 0000000..d618337 --- /dev/null +++ b/mar2007.tex @@ -0,0 +1 @@ +When an executable diff --git a/vsys b/vsys new file mode 100755 index 0000000..b5df79e Binary files /dev/null and b/vsys differ diff --git a/vsys.b b/vsys.b new file mode 100755 index 0000000..d3547f2 Binary files /dev/null and b/vsys.b differ