1 (* Copyright 2001, 2002 b8_bavard, b8_fee_carabine, INRIA *)
3 This file is part of mldonkey.
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.
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.
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
28 open TcpBufferedSocket
31 open DonkeyComplexOptions
40 let local_search search
=
43 if !!local_index_find_cmd <> "" then
45 let (t_in, t_out) = exec_command !!local_index_find_cmd [||]
46 (fun sock ev -> ()) in
48 set_reader t_in (fun t_in nread ->
49 let buf = TcpBufferedSocket.buf t_in in
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
65 result_md4 = Md4.null;
66 result_size = Int32.zero;
70 result_comment = None;
73 List.iter (fun (name, value) ->
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
81 let name, v = String2.cut_at value ':' in
87 let name, v = String2.cut_at value ':' in
90 tag_value = Uint32 (Int32.of_string v);
93 lprintf "discarding result line %s:%s" name value;
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
102 lprintf "result discarded for exn %s"
103 (Printexc2.to_string e); lprint_newline ()
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)
111 lines := (name, value) :: !lines
113 lprintf "Discarding line %s" line; lprint_newline ();
120 failwith "Translate query to OUT not implemented"
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)
146 lprintf
"Exception %s while starting local_index_find\n"
147 (Printexc2.to_string e
)
151 let send_search search query
=
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
159 ) (connected_servers
());
160 DonkeyUdp.make_xs search
;
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
168 do_if_connected
s.server_sock
(fun sock
->
169 (* if s.server_mldonkey then
171 M.Mldonkey_SubscribeReq (search.search_num, 3600, query))
173 server_send sock
(M.QueryReq query
);
174 Fifo.put
s.server_search_queries search
177 ) (connected_servers
());
178 DonkeyUdp.make_xs search
;
181 let new_search search
=
182 search
.search_waiting
<- search
.search_waiting
+
183 List.length
(connected_servers
());
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
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
()))
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
()))