Http_client infinite loop

Dear ocamlnet users,

I've had an intermittent problem with Http_client.  Sometimes my
program goes into an infinite loop, although not predictably and never
on the same iteration of the program, so it's very hard to reproduce.

The actual code which is running is attached below.  It goes into
the infinite loop somewhere between printing out:
  recommends: get recommendation
and the next print statement (which isn't printed).  So somewhere
in the section commented below as (* Get the recommendation *)

Between there, is the call to the Unixqueue main loop:
    while not msg#is_served do connection#run () done;
and it seems like the infinite loop must be happening here -- At least
I can't see where else it could happen.

I wonder if someone could glance over the code below and tell me if
I'm doing something obviously stupid.

Thanks,

Rich.

----------------------------------------------------------------------
(* Mini library for querying Google recommended budgets.  There is
 * no API for this, so we have to do it the old fashioned way.
 * $Id: google_recommends.ml,v 1.4 2005/07/05 13:11:25 rich Exp $
 *)

open Printf
open ExtString

open Merjis

let recommends =
  let budget_is_ok = Pcre.regexp "Budget is OK" in
  let try_budget = Pcre.regexp "Try\\s*£([0-9.,]+)" in

  let parse_price price =
    if price = "-" || price = "" then 0. else (
      (* Remove commas from large prices. *)
      let price =
	String.replace_chars
	  (function ',' -> "" | c -> String.make 1 c) price in
      float_of_string price
    )
  in

  fun ?(verbose = false) (connection : Http_client.pipeline)
      client_id campaign_id username password ->
    (* Log in. *)
    if verbose then eprintf "recommends: log in\n%!";
    let url =
      sprintf "http://adwords.google.com/select/LoginValidation?login.userid=%s&login.password=%s&login=Login&hl=en_GB&mkc=0&resendemail=false&javascriptEnabled=true"
	(* XXX Really these ought to be escaped. *)
	username password in
    let msg = new Http_client.get url in
    connection#add msg;
    while not msg#is_served do connection#run () done;

    (* Grab the Set-Cookie headers, and the cookies from these. *)
    let cookies = msg#assoc_multi_resp_header "set-cookie" in
    let cookies = List.map (
      fun cookie ->
	let i = String.find cookie "; " in
	String.sub cookie 0 i
    ) cookies in

    (* Get the client link. *)
    if verbose then eprintf "recommends: client identity\n%!";
    let url =
      sprintf "http://adwords.google.com/select/ccidentity?ca=%ld" client_id in
    let msg = new Http_client.get url in
    msg#set_req_header "Host" "adwords.google.com:80";
    msg#set_req_header "Cookie" (String.concat "; " cookies);
    connection#add msg;
    while not msg#is_served do connection#run () done;

    (* Get the recommendation. *)
    if verbose then eprintf "recommends: get recommendation\n%!";
    let url =
      sprintf "http://adwords.google.com/select/wantmoreclicks?align=left&isEditSettingsPage=true&getsuggestion=true&campaignid=%ld"
	campaign_id in
    let msg = new Http_client.get url in
    msg#set_req_header "Host" "adwords.google.com:80";
    msg#set_req_header "Cookie" (String.concat "; " cookies);
    connection#add msg;
    while not msg#is_served do connection#run () done;

    (* Get the response. *)
    let data = msg#get_resp_body () in

    if verbose then eprintf "recommends: parse response\n%!";

    if Pcre.pmatch ~rex:budget_is_ok data then (
      None				(* Google says budget is OK. *)
    ) else (
      try
	let subs = Pcre.exec ~rex:try_budget data in
	Some (parse_price (Pcre.get_substring subs 1)) (* Recommendation *)
      with
	  Not_found -> None		(* No recommendation / error. *)
    )


-- 
Richard Jones, CTO Merjis Ltd.
Merjis - web marketing and technology - http://merjis.com
Team Notepad - intranets and extranets for business - http://team-notepad.com


-------------------------------------------------------
SF.Net email is sponsored by: Discover Easy Linux Migration Strategies
from IBM. Find simple to follow Roadmaps, straightforward articles,
informative Webcasts and more! Get everything you need to get up to
speed, fast. http://ads.osdn.com/?ad_id=7477&alloc_id=16492&op=click