[lib/ocaml] use ocaml Http_client from netclient lib to download files

* used e.g. to dowload tiles
* raises Blocked if we get a 403 and raises Not_Found on a 404,
  only if we get a Not_Found we try the next zoom level
* in case we get blocked, it still tries the next tile...
  maybe we should stop trying to get tiles at all in that case
This commit is contained in:
Felix Ruess
2012-09-10 00:21:24 +02:00
parent 45ec0f1c16
commit 4cc11924e1
8 changed files with 79 additions and 37 deletions
+4 -4
View File
@@ -36,9 +36,9 @@ FPIC=-fPIC
OCAMLC=ocamlc
OCAMLOPT=ocamlopt
OCAMLOPTFLAGS=-thread
OCAMLNETINCLUDES=$(shell ocamlfind query -r -i-format netstring)
OCAMLNETCMA=$(shell ocamlfind query -r -a-format -predicates byte netstring)
INCLUDES= $(shell ocamlfind query -r -i-format lablgtk2) -I ../../lib/ocaml $(shell ocamlfind query -r -i-format xml-light) $(OCAMLNETINCLUDES)
OCAMLNETINCLUDES=$(shell ocamlfind query -r -i-format netstring) $(shell ocamlfind query -r -i-format netclient)
OCAMLNETCMA=$(shell ocamlfind query -r -a-format -predicates byte netstring) $(shell ocamlfind query -r -a-format -predicates byte netclient)
INCLUDES= $(shell ocamlfind query -r -i-format lablgtk2) -I ../../lib/ocaml $(shell ocamlfind query -r -i-format xml-light) $(shell ocamlfind query -r -i-format pcre) $(OCAMLNETINCLUDES)
LIBS=$(OCAMLNETCMA) glibivy-ocaml.cma lablgtk.cma lablglade.cma lib-pprz.cma lablgnomecanvas.cma xlib-pprz.cma
CMXA=$(LIBS:.cma=.cmxa)
@@ -53,7 +53,7 @@ opt : $(MAIN).opt
$(MAIN) : $(CMO) ../../lib/ocaml/xlib-pprz.cma ../../lib/ocaml/lib-pprz.cma
@echo OL $@
$(Q)$(OCAMLC) $(OCAMLCFLAGS) -custom $(INCLUDES) unix.cma str.cma xml-light.cma $(LIBS) threads.cma gtkThread.cmo myGtkInit.cmo $(CMO) -o $@
$(Q)$(OCAMLC) $(OCAMLCFLAGS) -custom $(INCLUDES) $(OCAMLNETINCLUDES) unix.cma str.cma netstring.cma netclient.cma xml-light.cma $(LIBS) threads.cma gtkThread.cmo myGtkInit.cmo $(CMO) -o $@
$(MAIN).opt : $(CMX)
@echo OOL $@
+6 -7
View File
@@ -1,4 +1,4 @@
#
#
# $Id$
# Copyright (C) 2003-2006 Pascal Brisset, Antoine Drouin
#
@@ -17,15 +17,15 @@
# You should have received a copy of the GNU General Public License
# along with paparazzi; see the file COPYING. If not, write to
# the Free Software Foundation, 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.
#
# Boston, MA 02111-1307, USA.
#
# Quiet
Q=@
LBITS := $(shell getconf LONG_BIT)
ifeq ($(LBITS),64)
FPIC = -fPIC
FPIC = -fPIC
else
FPIC =
endif
@@ -43,7 +43,7 @@ clean:
OCAMLC = ocamlc
OCAMLOPT = ocamlopt
OCAMLLIB = ../../lib/ocaml
OCAMLNETINCLUDES=$(shell ocamlfind query -r -i-format netstring)
OCAMLNETINCLUDES=$(shell ocamlfind query -r -i-format netstring) $(shell ocamlfind query -r -i-format netclient)
OCAMLNETCMA=$(shell ocamlfind query -r -a-format -predicates byte netstring)
INCLUDES= -I $(OCAMLLIB) -I ../multimon $(shell ocamlfind query -r -i-format lablgtk2) $(shell ocamlfind query -r -i-format xml-light) $(OCAMLNETINCLUDES)
LIBPPRZCMA=$(OCAMLLIB)/lib-pprz.cma
@@ -169,7 +169,6 @@ ivy_serial_bridge: ivy_serial_bridge.c
.depend: Makefile
ocamldep -I ../../lib/ocaml *.ml* > .depend
ifneq ($(MAKECMDGOALS),clean)
ifneq ($(MAKECMDGOALS),clean)
-include .depend
endif
+1 -1
View File
@@ -30,7 +30,7 @@ else
FPIC =
endif
INCLUDES= $(shell ocamlfind query -r -i-format xml-light) $(shell ocamlfind query -r -i-format netstring) $(shell ocamlfind query -r -i-format pcre)
INCLUDES= $(shell ocamlfind query -r -i-format xml-light) $(shell ocamlfind query -r -i-format netstring) $(shell ocamlfind query -r -i-format netclient) $(shell ocamlfind query -r -i-format pcre)
XINCLUDES= $(shell ocamlfind query -r -i-format lablgtk2) $(shell ocamlfind query -r -i-format xml-light)
OCAMLC=ocamlc
OCAMLOPT=ocamlopt
+21 -14
View File
@@ -244,20 +244,27 @@ let get_image = fun key ->
if !policy = NoCache then raise Not_found;
get_from_cache cache_dir key
with
Not_found ->
if !policy = NoHttp then raise Not_available;
let rec loop = fun k ->
if String.length k >= 1 then
let url = url_of_tile_key !maps_source k in
let jpg_file = cache_dir // (k ^ ".jpg") in
try
ignore (Http.file_of_url ~dest:jpg_file url);
tile_of_key k, jpg_file
with
Http.Failure _ -> loop (remove_last_char k)
else
raise Not_available in
loop key
Not_found ->
if !policy = NoHttp then raise Not_available;
let rec loop = fun k ->
if String.length k >= 1 then
let url = url_of_tile_key !maps_source k in
let jpg_file = cache_dir // (k ^ ".jpg") in
try
ignore (Http.file_of_url ~dest:jpg_file url);
tile_of_key k, jpg_file
with
Http.Not_Found _ -> loop (remove_last_char k)
| Http.Blocked _ ->
begin
prerr_endline (Printf.sprintf "Seem to be temporarily blocked, '%s'" url);
flush stderr;
raise Not_available
end
| _ -> raise Not_available
else
raise Not_available in
loop key
let rec get_tile = fun wgs84 zoom ->
+38 -8
View File
@@ -1,5 +1,8 @@
exception Failure of string
exception Not_Found of string
exception Blocked of string
open Http_client
let file_of_url = fun ?dest url ->
if String.sub url 0 7 = "file://" then
@@ -9,10 +12,37 @@ let file_of_url = fun ?dest url ->
match dest with
Some s -> s
| None -> Filename.temp_file "fp" ".wget" in
let c = Printf.sprintf "wget -nv --cache=off -O %s '%s'" tmp_file url in
if Sys.command c = 0 then
tmp_file
else begin
Sys.remove tmp_file;
raise (Failure url)
end
let call = new Http_client.get url in
call#set_response_body_storage (`File (fun () -> tmp_file));
let pipeline = new Http_client.pipeline in
pipeline#add call;
pipeline#run ();
match call#status with
| `Successful ->
(*
prerr_endline (Printf.sprintf "file sucessfull: %s, '%s'" tmp_file url);
flush stderr;
*)
tmp_file
| `Client_error ->
begin
(*
prerr_endline (Printf.sprintf "getting file '%s', client error: %d" url call#response_status_code);
flush stderr;
*)
Sys.remove tmp_file;
match call#response_status_code with
404 -> raise (Not_Found url)
| 403 ->
begin
(*
prerr_endline (Printf.sprintf "Blocked!!!");
flush stderr;
*)
raise (Blocked url)
end
| _ -> raise (Failure url)
end
| _ ->
Sys.remove tmp_file;
raise (Failure url)
+2
View File
@@ -1,4 +1,6 @@
exception Failure of string
exception Not_Found of string
exception Blocked of string
val file_of_url : ?dest:string -> string -> string
(** [file_of_url ?dest url] Downloads a given document and returns
the place where it is stored. Default [dest] is in [/tmp]. *)
+6 -2
View File
@@ -25,8 +25,8 @@ Q=@
OCAML=ocaml
OCAMLC=ocamlc
INCLUDES=-I ../lib/ocaml $(shell ocamlfind query -r -i-format xml-light) -I .
OCAMLNETINCLUDES=$(shell ocamlfind query -r -i-format netstring)
OCAMLNETCMA=$(shell ocamlfind query -r -a-format -predicates byte netstring)
OCAMLNETINCLUDES=$(shell ocamlfind query -r -i-format netstring) $(shell ocamlfind query -r -i-format netclient)
OCAMLNETCMA=$(shell ocamlfind query -r -a-format -predicates byte netstring) $(shell ocamlfind query -r -a-format -predicates byte netclient)
OCAMLLEX=ocamllex
OCAMLYACC=ocamlyacc
@@ -44,6 +44,10 @@ gen_flight_plan.cmo : fp_proc.cmi
gen_common.cmo : gen_common.cmi
gen_srtm.out : ../lib/ocaml/lib-pprz.cma
@echo OC $@
$(Q)$(OCAMLC) $(INCLUDES) $(OCAMLNETINCLUDES) -custom -o $@ unix.cma str.cma netstring.cma netclient.cma xml-light.cma ivy-ocaml.cma lib-pprz.cma gen_common.cmo $^
mergelogs: mergelogs.c
gcc mergelogs.c -o mergelogs
+1 -1
View File
@@ -14,7 +14,7 @@ Q=@
OCAML=ocaml
OCAMLC=ocamlc
INCLUDES=-I ../../lib/ocaml $(shell ocamlfind query -r -i-format xml-light)
OCAMLNETINCLUDES=$(shell ocamlfind query -r -i-format netstring)
OCAMLNETINCLUDES=$(shell ocamlfind query -r -i-format netstring) $(shell ocamlfind query -r -i-format netclient)
OCAMLNETCMA=$(shell ocamlfind query -r -a-format -predicates byte netstring)