src/networks/donkey/donkeySearch.ml

   1 (* Copyright 2001, 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 CommonGlobals
  21 open CommonTypes
  22
  23 open Options
  24 open DonkeyMftp
  25 open DonkeyProtoCom
  26 open DonkeyServers
  27 open BasicSocket
  28 open TcpBufferedSocket
  29 open DonkeyOneFile
  30 open DonkeyFiles
  31 open DonkeyComplexOptions
  32 open DonkeyTypes
  33 open DonkeyOptions
  34 open CommonOptions
  35 open DonkeyGlobals
  36 open DonkeyClient
  37
  38 module P = GuiProto
  39
  40 let local_search search =
  41   ()
  42   (*
  43   if !!local_index_find_cmd <> "" then
  44     try
  45       let (t_in, t_out) = exec_command !!local_index_find_cmd [||]
  46           (fun sock ev -> ()) in
  47       let lines = ref [] in
  48       set_reader t_in (fun t_in nread ->
  49           let buf = TcpBufferedSocket.buf t_in in
  50           let s = buf.buf in
  51           let rec iter () =
  52             let pos = buf.pos in
  53             let len = buf.len in
  54             try
  55               let pos2 = String.index_from s pos '\n' in
  56               let line = String.sub s pos (pos2 - pos) in
  57               buf_used t_in (pos2 - pos + 1);
  58               if line = "end result" then
  59                 let l = List.rev !lines in
  60                 lines := [];
  61
  62                 try
  63                   let r = {
  64                       result_names = [];
  65                       result_md4 = Md4.null;
  66                       result_size = Int32.zero;
  67                       result_format = "";
  68                       result_type = "";
  69                       result_tags = [];
  70                       result_comment = None;
  71                       result_done = false;
  72                     } in
  73                   List.iter (fun (name, value) ->
  74                       match name with
  75                         "name" -> r.result_names <- value :: r.result_names
  76                       | "md4" -> r.result_md4 <- Md4.of_string value
  77                       | "size" -> r.result_size <- Int32.of_string value
  78                       | "format" -> r.result_format <- value
  79                       | "type" -> r.result_type <- value
  80                       | "string_tag" ->
  81                           let name, v = String2.cut_at value ':' in
  82                           r.result_tags <- {
  83                             tag_name = name;
  84                             tag_value = String v;
  85                           } :: r.result_tags
  86                       | "int_tag" ->
  87                           let name, v = String2.cut_at value ':' in
  88                           r.result_tags <- {
  89                             tag_name = name;
  90                             tag_value = Uint32 (Int32.of_string v);
  91                           } :: r.result_tags
  92                       | _ ->
  93                           lprintf "discarding result line %s:%s" name value;
  94                           lprint_newline ();
  95                   ) l;
  96                   if r.result_md4 = Md4.null || r.result_size = Int32.zero then
  97                     failwith "Not enough information in result";
  98                   let doc = DonkeyIndexer.index_result r in
  99                   add_to_search search r doc
 100
 101                 with e ->
 102                     lprintf "result discarded for exn %s"
 103                       (Printexc2.to_string e); lprint_newline ()
 104               else begin
 105                   try
 106                     let pos = String.index line ':' in
 107                     let name = String.sub line 0 pos in
 108                     let value = String.sub line (pos+1)
 109                       (String.length line - pos - 1)
 110                     in
 111                     lines := (name, value) :: !lines
 112                   with e ->
 113                       lprintf "Discarding line %s" line; lprint_newline ();
 114                 end;
 115               iter ()
 116             with _ -> ()
 117           in
 118           iter ()
 119       );
 120       failwith "Translate query to OUT not implemented"
 121 (*
 122     let buf = Buffer.create 100 in
 123     let q = search.search_query in
 124     if q.search_words <> [] then
 125       Printf.bprintf buf "words:%s\n" (String2.unsplit q.search_words ' ');
 126     (match q.search_minsize with None -> () | Some size ->
 127           Printf.bprintf buf "minsize:%s\n" (Int32.to_string size));
 128     (match q.search_maxsize with None -> () | Some size ->
 129           Printf.bprintf buf "maxsize:%s\n" (Int32.to_string size));
 130     (match q.search_min_bitrate with None -> () | Some size ->
 131           Printf.bprintf buf "minrate:%s\n" (Int32.to_string size));
 132     (match q.search_media with None -> () | Some s ->
 133           Printf.bprintf buf "media:%s\n" s);
 134     (match q.search_format with None -> () | Some s ->
 135           Printf.bprintf buf "format:%s\n" s);
 136     (match q.search_title with None -> () | Some s ->
 137           Printf.bprintf buf "title:%s\n" s);
 138     (match q.search_album with None -> () | Some s ->
 139           Printf.bprintf buf "album:%s\n" s);
 140     (match q.search_artist with None -> () | Some s ->
 141           Printf.bprintf buf "artist:%s\n" s);
 142     Buffer.add_string buf "end query\n";
 143 TcpBufferedSocket.write_string t_out (Buffer.contents buf)
 144   *)
 145     with e ->
 146         lprintf "Exception %s while starting local_index_find\n"
 147           (Printexc2.to_string e)
 148
 149 *)
 150
 151 let send_search search query =
 152   List.iter (fun s ->
 153       do_if_connected s.server_sock (fun sock ->
 154           let module M = DonkeyProtoServer in
 155           let module Q = M.Query in
 156           server_send sock (M.QueryReq query);
 157           Fifo.put s.server_search_queries search
 158       )
 159   ) (connected_servers());
 160   DonkeyUdp.make_xs search;
 161   local_search search
 162
 163 let send_subscribe search query =
 164   xs_last_search := search.search_num;
 165   let module M = DonkeyProtoServer in
 166   let module Q = M.Query in
 167   List.iter (fun s ->
 168       do_if_connected  s.server_sock (fun sock ->
 169 (*          if s.server_mldonkey then
 170             server_send sock (
 171               M.Mldonkey_SubscribeReq (search.search_num, 3600, query))
 172           else *) begin
 173               server_send sock (M.QueryReq query);
 174               Fifo.put s.server_search_queries search
 175             end
 176       )
 177   ) (connected_servers());
 178   DonkeyUdp.make_xs search;
 179   local_search search
 180
 181 let new_search search =
 182   search.search_waiting <- search.search_waiting +
 183   List.length (connected_servers());
 184   search
 185
 186 let _ =
 187   network.op_network_search <- (fun ss buf ->
 188       let search = new_search ss in
 189       let query = search.search_query in
 190       match ss.search_type with
 191         RemoteSearch ->
 192           send_search search query;
 193           Printf.bprintf buf "Query %d sent to %d server(s)\n"
 194             ss.search_num (List.length (connected_servers()))
 195       | LocalSearch -> ()
 196       | SubscribeSearch ->
 197           send_subscribe search query;
 198           Printf.bprintf buf "Query %d sent to %d server(s)\n"
 199             search.search_num (List.length (connected_servers()))
 200   )