Checking in daemonization, writing to a logfile, and saving the pid

diff --git a/backend.ml b/backend.ml
index 2f373c0..690f1c6 100644 (file)
--- a/backend.ml
+++ b/backend.ml
@@ -63,7 +63,7 @@ class backendHandler dir_root (frontend_lst: frontendHandler list) =
                 Dirwatcher.add_watch fqp [S_Create;S_Delete] (Some(func)) 
               end
               with _ ->
-                printf "Could not create %s. Looks like a slice shot itself in the foot\n" fqp;flush Pervasives.stdout;
+                fprintf logfd "Could not create %s. Looks like a slice shot itself in the foot\n" fqp;flush logfd;
            )
            slice_list
 
@@ -171,7 +171,7 @@ class backendHandler dir_root (frontend_lst: frontendHandler list) =
                        | S_REG ->
                            this#new_script slice_list fqp
                        | _ ->
-                           printf "Don't know what to do with %s\n" curfile;flush Pervasives.stdout
+                           fprintf logfd "Don't know what to do with %s\n" curfile;flush logfd
                    end
            with 
                _->cont:=false;()

diff --git a/conffile.ml b/conffile.ml
index d7b8715..21175e9 100644 (file)
--- a/conffile.ml
+++ b/conffile.ml
@@ -1,12 +1,12 @@
 open Printf
+open Globals
 open Scanf
 
 let split_conf_line s =
   sscanf s "%s %s" (fun s1 s2->(s1,s2))
 
 let read_frontends f =
-  let f_file = try open_in f with e -> printf "Could not open config
-                                         file\n";flush Pervasives.stdout;raise e
+  let f_file = try open_in f with e -> fprintf logfd "Could not open config file\n";flush logfd;raise e
   in
   let rec read_conf_file cur_list =
     let next_line = try Some(input_line f_file) with _ -> None in

diff --git a/dirwatcher.ml b/dirwatcher.ml
index b33b890..fed87d4 100644 (file)
--- a/dirwatcher.ml
+++ b/dirwatcher.ml
@@ -15,14 +15,14 @@ let fd = Inotify.init ()
 
 let handle_dir_event dirname evlist str = 
     let fname = String.concat "/" [dirname;str] in
-        printf "File: %s. " fname;List.iter 
+        fprintf logfd "File: %s. " fname;List.iter 
                   (fun e -> 
-                     printf "Event: %s\n" (string_of_event e)) 
+                     fprintf logfd "Event: %s\n" (string_of_event e)) 
                   evlist;
-        flush Pervasives.stdout
+        flush logfd
 
 let add_watch dir events handler =
-  printf "Adding watch for %s\n" dir;flush Pervasives.stdout;
+  fprintf logfd "Adding watch for %s\n" dir;flush logfd;
   let wd = Inotify.add_watch fd dir events in
       Hashtbl.add wdmap wd (dir,handler)
 
@@ -44,7 +44,7 @@ let receive_event (eventdescriptor:fname_and_fd) (bla:fname_and_fd) =
                   | (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
+                        try Hashtbl.find wdmap wd with Not_found->fprintf logfd "Unknown watch descriptor\n";raise Not_found
                       in
                         (
                         match handler with

diff --git a/fdwatcher.ml b/fdwatcher.ml
index eb9559c..3453d54 100644 (file)
--- a/fdwatcher.ml
+++ b/fdwatcher.ml
@@ -18,7 +18,7 @@ let add_fd (evpair:fname_and_fd) (fd_other:fname_and_fd) (callback:fname_and_fd-
 
 let del_fd fd =
   fdset:=List.filter (fun l->l<>fd) !fdset;
-  flush Pervasives.stdout
+  flush logfd
 
 let start_watch () =
     while (true)
@@ -31,4 +31,3 @@ let start_watch () =
                              let (func,(evd,fd_other)) = Hashtbl.find cbtable elt in
                                func evd fd_other) fds
     done
-

diff --git a/fifowatcher.ml b/fifowatcher.ml
index dc79dad..9b42a51 100644 (file)
--- a/fifowatcher.ml
+++ b/fifowatcher.ml
@@ -29,7 +29,7 @@ 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->
-        printf "Fifo fd disappeared\n";flush Pervasives.stdout;raise Bug
+        fprintf logfd "Fifo fd disappeared\n";flush logfd;raise Bug
   in
     match (cp) with 
       | Fifo(fifo_outchan) ->
@@ -44,17 +44,17 @@ let receive_process_event (idesc: fname_and_fd) (_: fname_and_fd) =
                     begin
                       cont:=false
                     end
-                | Unix_error(_,s1,s2) -> printf "Unix error %s - %s\n" s1 s2;flush Pervasives.stdout;cont:=false
+                | Unix_error(_,s1,s2) -> fprintf logfd "Unix error %s - %s\n" s1 s2;flush logfd;cont:=false
                 | Sys_error(s) -> (* We get this error if the EPIPE comes before the EOF marker*) cont:=false
-                | e -> printf "Error - received unexpected event from file system !!!\n";raise e
+                | e -> fprintf logfd "Error - received unexpected event from file system !!!\n";raise e
             done
-      | _ -> printf "Bug! Process fd received in the channel handler\n";flush Pervasives.stdout;raise Bug
+      | _ -> fprintf logfd "Bug! Process fd received in the channel handler\n";flush logfd;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
+        e->fprintf logfd "Error opening and connecting FIFO: %s,%o\n" fifoin 0o777;flush logfd;raise e
   in
     Hashtbl.replace fdmap fdin abspath;
     Fdwatcher.add_fd (Some(fifoin),fdin) (Some(fifoout),stdout) receive_fifo_event
@@ -62,7 +62,7 @@ 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
+      Hashtbl.find fdmap fdin with _ -> fprintf logfd "Bug: Phantom pipe\n";flush logfd;raise Bug
     in
       openentry_int fifoin fifoout abspath
 (** receive an event from a fifo and connect to the corresponding service, or to
@@ -79,9 +79,9 @@ and receive_fifo_event eventdescriptor outdescriptor =
       | Some(str)->
           (
             try openfile str [O_WRONLY;O_NONBLOCK] 0o777 with
-                _->printf "Output pipe not open, using stdout in place of %s\n" str;flush Pervasives.stdout;stdout
+                _->fprintf logfd "Output pipe not open, using stdout in place of %s\n" str;flush logfd;stdout
           )
-      | None-> printf "Bug, nameless pipe\n";flush Pervasives.stdout;raise Bug
+      | None-> fprintf logfd "Bug, nameless pipe\n";flush logfd;raise Bug
   in
   (* Check if the input descriptor is already registered (=> a session is open).
    If not, register it and start a new session.*)
@@ -92,7 +92,7 @@ and receive_fifo_event eventdescriptor outdescriptor =
         let (script_infd,pout) = Unix.pipe () in
         let (pin,script_outfd) = Unix.pipe () in
           set_nonblock script_infd;
-          let rpid = try Some(create_process execpath [|execpath;slice_name|] pin pout pout) with e -> printf "Error executing service: %s\n" execpath;flush Pervasives.stdout;None
+          let rpid = try Some(create_process execpath [|execpath;slice_name|] pin pout pout) with e -> fprintf logfd "Error executing service: %s\n" execpath;flush logfd;None
           in
             match rpid with
               | None-> BrokenPipe
@@ -120,7 +120,7 @@ and receive_fifo_event eventdescriptor outdescriptor =
           let cont = ref true in
             while (!cont) do
               try 
-                printf "Reading...\n";flush Pervasives.stdout;
+                fprintf logfd "Reading...\n";flush logfd;
                 let curline = input_line inchan_fd in
                   fprintf out_channel "%s\n" curline;flush out_channel 
               with 
@@ -128,26 +128,26 @@ and receive_fifo_event eventdescriptor outdescriptor =
                     (
                       match (evfname,fname_other) with
                         | Some(str1),Some(str2)->
-                            printf "Reopening entry\n";flush Pervasives.stdout;
+                            fprintf logfd "Reopening entry\n";flush logfd;
                             reopenentry_int evfd str1 str2
                         | Some(str1),None ->
-                            printf "Bug, nameless pipe\n";flush Pervasives.stdout;raise Bug
+                            fprintf logfd "Bug, nameless pipe\n";flush logfd;raise Bug
                         | None,_ ->
-                            printf "Race condition -> user deleted file before closing it. Clever ploy, but won't work.\n";
-                            flush Pervasives.stdout
+                            fprintf logfd "Race condition -> user deleted file before closing it. Clever ploy, but won't work.\n";
+                            flush logfd
                     );
                     cont:=false
-                |Sys_blocked_io ->printf "Sysblockedio\n";flush Pervasives.stdout;
+                |Sys_blocked_io ->fprintf logfd "Sysblockedio\n";flush logfd;
                                   cont:=false
-                | _ ->printf "Bug: unhandled exception\n";flush Pervasives.stdout;raise Bug
+                | _ ->fprintf logfd "Bug: unhandled exception\n";flush logfd;raise Bug
             done
       | BrokenPipe -> ()
-      | Fifo(_) -> printf "BUG! received process event from fifo\n";raise Bug
+      | Fifo(_) -> fprintf logfd "BUG! received process event from fifo\n";raise Bug
 
 
 (** Make a pair of fifo entries *)
 let mkentry fqp abspath perm uname = 
-  printf "Making entry %s->%s\n" fqp abspath;flush Pervasives.stdout;
+  fprintf logfd "Making entry %s->%s\n" fqp abspath;flush logfd;
   let fifoin=sprintf "%s.in" fqp in
   let fifoout=sprintf "%s.out" fqp in
     (try Unix.unlink fifoin with _ -> ());
@@ -165,7 +165,7 @@ let mkentry fqp abspath perm uname =
          );
          Success
      with 
-         e->printf "Error creating FIFO: %s->%s. May be something wrong at the frontend.\n" fqp fifoout;flush Pervasives.stdout;Failed)
+         e->fprintf logfd "Error creating FIFO: %s->%s. May be something wrong at the frontend.\n" fqp fifoout;flush logfd;Failed)
 
 (** Open fifos for a session. Will shutdown vsys if the fifos don't exist *)
 let openentry fqp abspath perm =

diff --git a/frontend.ml b/frontend.ml
index 7cc0c16..3946736 100644 (file)
--- a/frontend.ml
+++ b/frontend.ml
@@ -41,8 +41,8 @@ object(this)
                 end
               else if (s.st_perm <> perm) then
                 begin
-                        printf "Removing directory %s\n" fqp;
-                        flush Pervasives.stdout;
+                        fprintf logfd "Removing directory %s\n" fqp;
+                        flush logfd;
                         Unix.rmdir fqp;
                         Unix.mkdir fqp perm
                 end
@@ -60,7 +60,7 @@ object(this)
         Unix.unlink fqp1;
         Unix.unlink fqp2
       with _ ->
-        printf "Hm. %s disappeared. Looks like slice %s shot itself in the foot\n" fqp1 (this#get_slice_name ());flush Pervasives.stdout
+        fprintf logfd "Hm. %s disappeared. Looks like slice %s shot itself in the foot\n" fqp1 (this#get_slice_name ());flush logfd
 
   method rmdir rp =
     match rp with Relpath(rel) ->
@@ -68,5 +68,5 @@ object(this)
       try
       Unix.rmdir fqp
       with _ ->
-        printf "Hm. %s disappeared. Looks like slice %s shot itself in the foot\n" fqp (this#get_slice_name ());flush Pervasives.stdout
+        fprintf logfd "Hm. %s disappeared. Looks like slice %s shot itself in the foot\n" fqp (this#get_slice_name ());flush logfd
 end

diff --git a/globals.ml b/globals.ml
index 4e2d332..e8dca75 100644 (file)
--- a/globals.ml
+++ b/globals.ml
@@ -4,7 +4,10 @@ let debug = ref true
 let vsys_version = "0.5"
 let nochroot = ref false
 let conffile = ref ""
+let pid_filepath = ref "/var/run/vsys.pid"
+let log_filepath = ref "/var/log/vsys"
 
+let logfd = open_out_gen [Open_append;Open_creat] 0o644 !log_filepath
 type result = Success | Failed
 
 type fname_and_fd = string option * Unix.file_descr

diff --git a/main.ml b/main.ml
index 391074d..5ec2952 100644 (file)
--- a/main.ml
+++ b/main.ml
@@ -10,9 +10,11 @@ open Conffile
 let input_file_list = ref []
 let cur_dir = ref ""
 let cur_slice = ref ""
+let daemonize = ref false
 
 let cmdspeclist =
   [
+    ("-daemon",Arg.Set(daemonize), "Daemonize");
     ("-conffile",Arg.Set_string(Globals.conffile), "Config file");
     ("-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");
@@ -28,13 +30,28 @@ let _ =
       printf "Try vsys --help\n"
   else
     begin
-    Dirwatcher.initialize ();
-    Fifowatcher.initialize ();
-    if (!Globals.conffile != "") then
-      let frontends = Conffile.read_frontends !Globals.conffile in
-        input_file_list:=List.concat [!input_file_list;frontends];
+      if (!daemonize) then
+        begin
+          printf "Daemonizing\n";flush Pervasives.stdout;
+        let child = Unix.fork () in
+          if (child <> 0) then
+            begin
+                let pidfile = open_out !Globals.pid_filepath in
+                  fprintf pidfile "%d" child;
+                    close_out pidfile;
+                    exit(0)
+            end
+          end;
 
-    let felst = List.map (fun lst->let (x,y)=lst in printf "Slice %s (%s)\n" x y;flush Pervasives.stdout;new frontendHandler lst) !input_file_list in
-        let _ = new backendHandler !Globals.backend felst in
-         Fdwatcher.start_watch ()
+            Dirwatcher.initialize ();
+            Fifowatcher.initialize ();
+            if (!Globals.conffile <> "") then
+              begin
+              let frontends = Conffile.read_frontends !Globals.conffile in
+                input_file_list:=List.concat [!input_file_list;frontends]
+              end;
+
+            let felst = List.map (fun lst->let (x,y)=lst in printf "Slice %s (%s)\n" x y;flush logfd;new frontendHandler lst) !input_file_list in
+                let _ = new backendHandler !Globals.backend felst in
+                 Fdwatcher.start_watch ()
     end