mirror of
https://github.com/paparazzi/paparazzi.git
synced 2026-05-23 04:45:37 +08:00
[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:
@@ -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 $@
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
@@ -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
@@ -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)
|
||||
|
||||
@@ -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
@@ -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
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user