src/networks/server/serverLog.ml

   1 (* Copyright 2002 b8_bavard, b8_fee_carabine, INRIA *)
   2 (*
   3     This file is part of mldonkey.
   4
   5     mldonkey is free software; you can redistribute it and/or modify
   6     it under the terms of the GNU General Public License as published by
   7     the Free Software Foundation; either version 2 of the License, or
   8     (at your option) any later version.
   9
  10     mldonkey is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13     GNU General Public License for more details.
  14
  15     You should have received a copy of the GNU General Public License
  16     along with mldonkey; if not, write to the Free Software
  17     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18 *)
  19
  20 open DonkeyProtoServer
  21 open Ip
  22 open Md4
  23 open ServerGlobals
  24 open BasicSocket
  25 open Options
  26 open ServerOptions
  27
  28
  29 module ServerLog = struct
  30
  31 type stand_by_log = {
  32         mutable ip : Ip.t;
  33         mutable md4 : Md4.t;
  34         mutable time : float;
  35         mutable req : DonkeyProtoServer.t list;
  36         mutable results : CommonTypes.tagged_file list;
  37         mutable note : string;
  38 }
  39
  40
  41
  42 type t = {
  43        mutable oc : out_channel;
  44        mutable liste : stand_by_log list;
  45 }
  46
  47
  48
  49 let nlog = ref 1
  50
  51 let log = ref {
  52               oc = open_out "log.0";
  53               liste = [];
  54       }
  55
  56
  57
  58 let tmp = ref { ip = Ip.null;
  59                 md4 = Md4.null;
  60                 time = 0.;
  61                 req = [];
  62                 results = [];
  63                 note = "";
  64               }
  65
  66
  67
  68
  69 let put_rep msg =
  70         !tmp.req <- !tmp.req @ [msg]
  71
  72 let put_results l =
  73         !tmp.results <- l
  74
  75 let print t  =
  76         (*lprintf "*********ADD to log at %f\n" t.time;*)
  77         Printf.fprintf !log.oc "<REQ>\n";
  78         Printf.fprintf !log.oc "%f\n" t.time;
  79         Printf.fprintf !log.oc "%s\n" (Ip.to_string t.ip);
  80         Printf.fprintf !log.oc "%s\n" (Md4.to_string t.md4);
  81         if (List.length t.req) >0 then
  82           DonkeyProtoServer.fprint !log.oc (List.hd t.req);
  83        (* with _ -> lprintf "vraiment pas cool";*)
  84         if (List.length t.req) >1 then
  85                 begin
  86                  Printf.fprintf !log.oc "<REP>\n";
  87                  DonkeyProtoServer.fprint !log.oc (List.nth t.req 2)
  88                 end;
  89         if (List.length t.results) <> 0 then
  90                 DonkeyProtoServer.QueryReply.fprint !log.oc t.results;
  91         if t.note <> "" then Printf.fprintf !log.oc "%s\n" t.note;
  92         ()
  93
  94 let rec save liste =
  95         match liste with
  96         [] -> ()
  97         | hd::tl ->   print hd;
  98                       save tl
  99
 100
 101 let add_to_liste () =
 102           (*lprintf "//////// Add to list \n";*)
 103           (*lprintf " Already Cool new t %s\n" (Ip.to_string !tmp.ip);*)
 104           !log.liste <- !log.liste @ [!tmp]
 105
 106
 107
 108
 109 let add_note s =
 110         !tmp.note <- s
 111
 112 let new_log_req ip md4 msg =
 113         tmp := {
 114                 ip = ip;
 115                 md4 = md4;
 116                 time = Unix.time();
 117                 req = [msg];
 118                 results = [];
 119                 note = "";
 120         }
 121         (*lprintf "Cool new t %s at time %f\n" (Ip.to_string !tmp.ip) (!tmp.time)*)
 122
 123 let something_append ip md4 what =
 124   tmp := {
 125                 ip = ip;
 126                 md4 = md4;
 127                 time = Unix.time();
 128                 req = [];
 129                 results = [];
 130                 note = what;
 131         }
 132
 133
 134 let initialized () =
 135       lprintf "INITIALISATION DU LOG "; lprint_newline();
 136       Printf.fprintf !log.oc "<LOGNUM>\n%d\n<SERVER STAT>\n%d\n%d\n%f\n" (!nlog) !nconnected_clients !nshared_md4 (Unix.time());
 137       add_infinite_option_timer log_time_out (fun timer ->
 138               save !log.liste;
 139               !log.liste <- [];
 140               flush !log.oc;
 141               lprintf "LOGS SAVED ON DISQUE\n"
 142       );
 143       add_infinite_option_timer change_log_file (fun timer ->
 144               save !log.liste;
 145               Printf.fprintf !log.oc "<SERVER STAT>\n%d\n%d\n%f\n <ENDOFFILE>" !nconnected_clients !nshared_md4 (Unix.time());
 146               close_out !log.oc;
 147               !log.liste <- [];
 148               !log.oc <- open_out ("log."^(string_of_int !nlog));
 149               Printf.fprintf !log.oc "<LOGNUM>\n%d\n<SERVER STAT>\n%d\n%d\n%f\n" !nlog !nconnected_clients !nshared_md4 (Unix.time());
 150               incr nlog
 151                                   )
 152
 153
 154
 155 end