backend.ml

   1 open Unix
   2 open Globals
   3 open Dirwatcher
   4 open Inotify
   5 open Fifowatcher
   6 open Frontend
   7 open Printf
   8
   9 let delete_prefix prefix str =
  10   let len = String.length str in
  11   let plen = String.length prefix in
  12     if (String.sub str 0 plen <> prefix)
  13     then
  14       raise Bad_path
  15     else
  16       Relpath(String.sub str (plen+1) (len-plen-1))
  17
  18 let rec list_check lst elt =
  19   match lst with
  20     | [] -> false
  21     | car::cdr -> if (car==elt) then true else list_check cdr elt
  22
  23
  24                                                  (*
  25                                                   * One backendHandler class for each
  26                                                   * backend. Builds the initial
  27                                                   * tree for the frontend and
  28                                                   * watches for directory
  29                                                   * events.
  30                                                   *)
  31
  32 class backendHandler dir_root (frontend_lst: frontendHandler list) =
  33         let mk_rel_path = delete_prefix dir_root in object(this)
  34
  35   val file_regexp = ref (Str.regexp "[a-zA-Z][a-zA-Z0-9_-'.']*")
  36
  37   method new_dir fqp func =
  38     let s = Unix.stat fqp in
  39       List.iter
  40         (fun frontend->
  41            frontend#mkdir (mk_rel_path fqp) (s.st_perm);
  42            Dirwatcher.add_watch fqp [S_Create;S_Delete] (Some(func)))
  43         frontend_lst;
  44
  45   method new_script fqp =
  46     let s = Unix.stat fqp in
  47       List.iter (fun frontend->
  48                    frontend#mkentry (mk_rel_path fqp) fqp (s.st_perm)) frontend_lst
  49
  50   val dir_regexp = Str.regexp "^dir_";
  51
  52   method handle_dir_event dirname evlist fname =
  53     let fqp = String.concat "/" [dirname;fname] in
  54       if (Str.string_match !file_regexp fname 0) then
  55         begin
  56           let is_event = list_check evlist in
  57             if (is_event Create) then
  58               begin
  59                 if (is_event Isdir) then
  60                   begin
  61                     this#new_dir fqp this#handle_dir_event
  62                   end
  63                 else
  64                   (* It's a new script *)
  65                   begin
  66                     (*
  67                      if (Str.string_match dir_regexp fname 0) then
  68                      let fqp = String.concat "/" [dirname;String.sub fname 4 ((String.length fname)-4+1)]  in
  69                      let real_fqp = String.concat "/" [dirname;fname]  in
  70                      this#new_dir fqp this#handle_spool_event;
  71                      Hashtbl.add spools fqp real_fqp
  72                      else*)
  73                     this#new_script fqp
  74                   end
  75               end
  76             else if (is_event Delete) then
  77               begin
  78                 if (is_event Isdir) then
  79                   begin
  80                     (*this#rm_watch fqp;*)
  81                     List.iter (fun frontend->
  82                                  frontend#rmdir (mk_rel_path fqp)) frontend_lst
  83                   end
  84                 else List.iter (fun frontend ->
  85                                   frontend#unlink (mk_rel_path fqp)) frontend_lst
  86               end
  87         end
  88       else (* regex not matched *)
  89         ()
  90
  91   initializer
  92   let rec build_initial_tree dir =
  93     let dir_handle = opendir dir in
  94     let cont = ref true in
  95       while (!cont) do
  96         try
  97           let curfile = readdir dir_handle  in
  98           let fqp = String.concat "/" [dir;curfile] in
  99             if (Str.string_match !file_regexp curfile 0) then
 100               let s = Unix.stat fqp in
 101                 begin
 102                   match s.st_kind with
 103                     | S_DIR ->
 104                         this#new_dir fqp this#handle_dir_event;
 105                         build_initial_tree fqp;
 106                     | S_REG ->
 107                         this#new_script fqp
 108                     | _ ->
 109                         printf "Don't know what to do with %s\n" curfile;flush Pervasives.stdout
 110                 end
 111         with
 112             _->cont:=false;()
 113       done
 114   in
 115     begin
 116       build_initial_tree dir_root;
 117       Dirwatcher.add_watch dir_root [S_Create;S_Delete] (Some(this#handle_dir_event));
 118     end
 119 end