cduce_netclient.ml 956 Bytes
Newer Older
1 2 3
let error msg =
  Value.failwith' (Printf.sprintf "Netclient error. %s" msg)

4 5 6 7 8 9
let load_url s =
  match  Neturl.extract_url_scheme s with
    | "http" -> 
	(try Http_client.Convenience.http_get s
	 with 
	   | Http_client.Bad_message s ->
10 11
	       let msg = Printf.sprintf "Bad HTTP answer: %s" s in
	       error msg
12
	   | Http_client.Http_error (n,s) ->
13 14
	       let msg = Printf.sprintf "HTTP error %i: %s" n s in
	       error msg
15
	   | Http_client.No_reply ->
16
	       error "No reply"
17
	   | Http_client.Http_protocol exn ->
18 19
	       let msg = Printexc.to_string exn in
	       error msg
20 21
	)
    | "file" ->
22 23 24
	error
	  "FIXME: write in url.ml the code so that netclient \
                    handle file:// protocol"
25 26
    | sc -> 
	let msg = 
27
	  Printf.sprintf "Netclient does not handle the %s protocol" sc
28
	in
29
	error msg
30 31

let () = 
32
  Cduce_config.register 
33 34
    "netclient" 
    "Load external URLs with netclient"
35
    (fun () -> Url.url_loader := load_url)