From: Sapan Bhatia Date: Wed, 1 Aug 2007 14:58:58 +0000 (+0000) Subject: *** empty log message *** X-Git-Tag: vsys-0.7-19~27 X-Git-Url: http://git.onelab.eu/?p=vsys.git;a=commitdiff_plain;h=892d26d4e05de55ae94d21a586e6a0bfa724e327 *** empty log message *** --- diff --git a/Makefile b/Makefile index 3bf56a6..1987754 100644 --- a/Makefile +++ b/Makefile @@ -24,7 +24,8 @@ include .dep ocamllex $< docs: *.ml - cd docs && ocamldoc -d . -html ../*.ml + ocamldoc -d . -html -o docs *.ml + mv *.html docs vsys: inotify.cmxa inotify.cmi globals.cmx fdwatcher.cmx dirwatcher.cmx fifowatcher.cmx frontend.cmx backend.cmx main.cmx docs 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 diff --git a/dirwatcher.ml b/dirwatcher.ml index 3808e8b..f01cb33 100644 --- a/dirwatcher.ml +++ b/dirwatcher.ml @@ -34,7 +34,7 @@ let asciiz s = 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 receive_event (eventdescriptor:fname_and_fd) (bla:fname_and_fd) = let (_,fd) = eventdescriptor in let evs = Inotify.read fd in List.iter (fun x-> diff --git a/fdwatcher.ml b/fdwatcher.ml index 3e31427..7761d30 100644 --- a/fdwatcher.ml +++ b/fdwatcher.ml @@ -9,7 +9,7 @@ let cbtable = Hashtbl.create 1024 * 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 add_fd (evpair:fname_and_fd) (fd_other:fname_and_fd) (callback:fname_and_fd->fname_and_fd->unit) = let (fname,fd) = evpair in fdset := (fd::!fdset); Hashtbl.replace cbtable fd (callback,(evpair,fd_other)) diff --git a/fifowatcher.ml b/fifowatcher.ml index 4dbd70a..7871821 100644 --- a/fifowatcher.ml +++ b/fifowatcher.ml @@ -1,26 +1,26 @@ +(** fifowatcher.ml: Routines for creating and managing fifos *) + open Inotify open Unix open Globals open Dirwatcher open Printf +(** A connected process, FIFO *) 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; +(** Receive an event from a running script. This event must be relayed to the + slice that invoked it + @param idesc fd/fname identifier for process + *) +let receive_process_event (idesc: fname_and_fd) (_: fname_and_fd) = let (_,ifd) = idesc in let cp = try Hashtbl.find open_fds ifd with Not_found-> @@ -35,7 +35,6 @@ let receive_process_event (idesc:fd_and_fname) (_:fd_and_fname) = 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,_,_)|Unix_error(EBADF,_,_) -> @@ -43,7 +42,7 @@ let receive_process_event (idesc:fd_and_fname) (_:fd_and_fname) = 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 + | e -> printf "Error - received unexpected event from file system !!!\n";raise e done | _ -> printf "Bug! Process fd received in the channel handler\n";raise Bug @@ -111,7 +110,7 @@ and receive_fifo_event eventdescriptor outdescriptor = printf "Race condition -> user deleted file before closing it. Clever ploy, but won't work.\n"; flush Pervasives.stdout ); - cont:=false + cont:=false |Sys_blocked_io ->printf "Sysblockedio\n";flush Pervasives.stdout; cont:=false | _ ->printf "Bug: unhandled exception\n";flush Pervasives.stdout;raise Bug @@ -134,7 +133,7 @@ let mkentry fqp abspath perm = with e->printf "Error creating FIFO: %s->%s,%o\n" fqp fifoout perm;flush Pervasives.stdout;raise e) - +(** Open fifos for a session *) let openentry fqp abspath perm = let fifoin = String.concat "." [fqp;"in"] in let fifoout = String.concat "." [fqp;"out"] in @@ -157,7 +156,5 @@ let sigchld_handle s = 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 index 77e5ffe..a3a557d 100644 --- a/frontend.ml +++ b/frontend.ml @@ -1,11 +1,22 @@ +(* frontend.ml: Routines that implement frontend actions, such as creating directories in a slice, creating pipes etc. *) + open Printf open Unix open Globals open Fifowatcher +(** frontendhandler class: Methods to create and unlink pipes and directories + @param root_dir vsys directory inside a slice + @param slice_name actual slice name - set with care, since the acl functionality refers to these names *) class frontendHandler (root_dir,slice_name) = object(this) method get_slice_name () = slice_name + + (** A new script was copied into the backend, make a corresponding entry in + the frontend. + @param rp Relative path of the entry in the backend + @param abspath Absolute path of the entry + @param perm Permissions of the entry at the frontend *) method mkentry (rp:relpath) abspath perm = let realperm = perm land (lnot 0o111) in match rp with Relpath(rel) -> @@ -13,6 +24,8 @@ object(this) Fifowatcher.mkentry fqp abspath realperm; Fifowatcher.openentry fqp (abspath,slice_name) realperm + (** A new directory was created at the backend, make a corresponding directory + at the frontend. Refer to mkentry for parameters *) method mkdir rp perm = match rp with Relpath(rel) -> let fqp = String.concat "/" [root_dir;rel] in @@ -33,15 +46,18 @@ object(this) with Unix.Unix_error(_,_,_) -> Unix.mkdir fqp perm + (** Functions corresponding to file deletion/directory removal *) + + (** *) method unlink rp = match rp with Relpath(rel) -> let fqp1 = String.concat "/" [root_dir;rel;".in"] in let fqp2 = String.concat "/" [root_dir;rel;".out"] in try - Unix.unlink fqp1; - Unix.unlink fqp2 + Unix.unlink fqp1; + Unix.unlink fqp2 with _ -> - printf "Hm. %s disappeared. Never mind\n" fqp1;flush Pervasives.stdout + printf "Hm. %s disappeared. Looks like slice %s shot itself in the foot\n" fqp1 (this#get_slice_name ());flush Pervasives.stdout method rmdir rp = match rp with Relpath(rel) -> @@ -49,5 +65,5 @@ object(this) try Unix.rmdir fqp with _ -> - printf "Hm. %s disappeared. Never mind\n" fqp;flush Pervasives.stdout + printf "Hm. %s disappeared. Looks like slice %s shot itself in the foot\n" fqp (this#get_slice_name ());flush Pervasives.stdout end diff --git a/globals.ml b/globals.ml index 8b006c3..4323b3a 100644 --- a/globals.ml +++ b/globals.ml @@ -2,7 +2,7 @@ let backend = ref "" let debug = ref true let vsys_version = "0.5" -type fd_and_fname = string option * Unix.file_descr +type fname_and_fd = string option * Unix.file_descr (* Relative path, never precededed by a '/' *) type relpath = Relpath of string diff --git a/vsys b/vsys index 506806e..dba9927 100755 Binary files a/vsys and b/vsys differ