mirror of
https://github.com/paparazzi/paparazzi.git
synced 2026-05-28 18:07:25 +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
|
OCAMLC=ocamlc
|
||||||
OCAMLOPT=ocamlopt
|
OCAMLOPT=ocamlopt
|
||||||
OCAMLOPTFLAGS=-thread
|
OCAMLOPTFLAGS=-thread
|
||||||
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)
|
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) $(OCAMLNETINCLUDES)
|
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
|
LIBS=$(OCAMLNETCMA) glibivy-ocaml.cma lablgtk.cma lablglade.cma lib-pprz.cma lablgnomecanvas.cma xlib-pprz.cma
|
||||||
CMXA=$(LIBS:.cma=.cmxa)
|
CMXA=$(LIBS:.cma=.cmxa)
|
||||||
|
|
||||||
@@ -53,7 +53,7 @@ opt : $(MAIN).opt
|
|||||||
|
|
||||||
$(MAIN) : $(CMO) ../../lib/ocaml/xlib-pprz.cma ../../lib/ocaml/lib-pprz.cma
|
$(MAIN) : $(CMO) ../../lib/ocaml/xlib-pprz.cma ../../lib/ocaml/lib-pprz.cma
|
||||||
@echo OL $@
|
@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)
|
$(MAIN).opt : $(CMX)
|
||||||
@echo OOL $@
|
@echo OOL $@
|
||||||
|
|||||||
@@ -1,4 +1,4 @@
|
|||||||
#
|
#
|
||||||
# $Id$
|
# $Id$
|
||||||
# Copyright (C) 2003-2006 Pascal Brisset, Antoine Drouin
|
# Copyright (C) 2003-2006 Pascal Brisset, Antoine Drouin
|
||||||
#
|
#
|
||||||
@@ -17,15 +17,15 @@
|
|||||||
# You should have received a copy of the GNU General Public License
|
# You should have received a copy of the GNU General Public License
|
||||||
# along with paparazzi; see the file COPYING. If not, write to
|
# along with paparazzi; see the file COPYING. If not, write to
|
||||||
# the Free Software Foundation, 59 Temple Place - Suite 330,
|
# the Free Software Foundation, 59 Temple Place - Suite 330,
|
||||||
# Boston, MA 02111-1307, USA.
|
# Boston, MA 02111-1307, USA.
|
||||||
#
|
#
|
||||||
|
|
||||||
# Quiet
|
# Quiet
|
||||||
Q=@
|
Q=@
|
||||||
|
|
||||||
LBITS := $(shell getconf LONG_BIT)
|
LBITS := $(shell getconf LONG_BIT)
|
||||||
ifeq ($(LBITS),64)
|
ifeq ($(LBITS),64)
|
||||||
FPIC = -fPIC
|
FPIC = -fPIC
|
||||||
else
|
else
|
||||||
FPIC =
|
FPIC =
|
||||||
endif
|
endif
|
||||||
@@ -43,7 +43,7 @@ clean:
|
|||||||
OCAMLC = ocamlc
|
OCAMLC = ocamlc
|
||||||
OCAMLOPT = ocamlopt
|
OCAMLOPT = ocamlopt
|
||||||
OCAMLLIB = ../../lib/ocaml
|
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)
|
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)
|
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
|
LIBPPRZCMA=$(OCAMLLIB)/lib-pprz.cma
|
||||||
@@ -169,7 +169,6 @@ ivy_serial_bridge: ivy_serial_bridge.c
|
|||||||
.depend: Makefile
|
.depend: Makefile
|
||||||
ocamldep -I ../../lib/ocaml *.ml* > .depend
|
ocamldep -I ../../lib/ocaml *.ml* > .depend
|
||||||
|
|
||||||
ifneq ($(MAKECMDGOALS),clean)
|
ifneq ($(MAKECMDGOALS),clean)
|
||||||
-include .depend
|
-include .depend
|
||||||
endif
|
endif
|
||||||
|
|
||||||
|
|||||||
@@ -30,7 +30,7 @@ else
|
|||||||
FPIC =
|
FPIC =
|
||||||
endif
|
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)
|
XINCLUDES= $(shell ocamlfind query -r -i-format lablgtk2) $(shell ocamlfind query -r -i-format xml-light)
|
||||||
OCAMLC=ocamlc
|
OCAMLC=ocamlc
|
||||||
OCAMLOPT=ocamlopt
|
OCAMLOPT=ocamlopt
|
||||||
|
|||||||
+21
-14
@@ -244,20 +244,27 @@ let get_image = fun key ->
|
|||||||
if !policy = NoCache then raise Not_found;
|
if !policy = NoCache then raise Not_found;
|
||||||
get_from_cache cache_dir key
|
get_from_cache cache_dir key
|
||||||
with
|
with
|
||||||
Not_found ->
|
Not_found ->
|
||||||
if !policy = NoHttp then raise Not_available;
|
if !policy = NoHttp then raise Not_available;
|
||||||
let rec loop = fun k ->
|
let rec loop = fun k ->
|
||||||
if String.length k >= 1 then
|
if String.length k >= 1 then
|
||||||
let url = url_of_tile_key !maps_source k in
|
let url = url_of_tile_key !maps_source k in
|
||||||
let jpg_file = cache_dir // (k ^ ".jpg") in
|
let jpg_file = cache_dir // (k ^ ".jpg") in
|
||||||
try
|
try
|
||||||
ignore (Http.file_of_url ~dest:jpg_file url);
|
ignore (Http.file_of_url ~dest:jpg_file url);
|
||||||
tile_of_key k, jpg_file
|
tile_of_key k, jpg_file
|
||||||
with
|
with
|
||||||
Http.Failure _ -> loop (remove_last_char k)
|
Http.Not_Found _ -> loop (remove_last_char k)
|
||||||
else
|
| Http.Blocked _ ->
|
||||||
raise Not_available in
|
begin
|
||||||
loop key
|
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 ->
|
let rec get_tile = fun wgs84 zoom ->
|
||||||
|
|||||||
+38
-8
@@ -1,5 +1,8 @@
|
|||||||
|
|
||||||
exception Failure of string
|
exception Failure of string
|
||||||
|
exception Not_Found of string
|
||||||
|
exception Blocked of string
|
||||||
|
|
||||||
|
open Http_client
|
||||||
|
|
||||||
let file_of_url = fun ?dest url ->
|
let file_of_url = fun ?dest url ->
|
||||||
if String.sub url 0 7 = "file://" then
|
if String.sub url 0 7 = "file://" then
|
||||||
@@ -9,10 +12,37 @@ let file_of_url = fun ?dest url ->
|
|||||||
match dest with
|
match dest with
|
||||||
Some s -> s
|
Some s -> s
|
||||||
| None -> Filename.temp_file "fp" ".wget" in
|
| None -> Filename.temp_file "fp" ".wget" in
|
||||||
let c = Printf.sprintf "wget -nv --cache=off -O %s '%s'" tmp_file url in
|
let call = new Http_client.get url in
|
||||||
if Sys.command c = 0 then
|
call#set_response_body_storage (`File (fun () -> tmp_file));
|
||||||
tmp_file
|
let pipeline = new Http_client.pipeline in
|
||||||
else begin
|
pipeline#add call;
|
||||||
Sys.remove tmp_file;
|
pipeline#run ();
|
||||||
raise (Failure url)
|
match call#status with
|
||||||
end
|
| `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 Failure of string
|
||||||
|
exception Not_Found of string
|
||||||
|
exception Blocked of string
|
||||||
val file_of_url : ?dest:string -> string -> string
|
val file_of_url : ?dest:string -> string -> string
|
||||||
(** [file_of_url ?dest url] Downloads a given document and returns
|
(** [file_of_url ?dest url] Downloads a given document and returns
|
||||||
the place where it is stored. Default [dest] is in [/tmp]. *)
|
the place where it is stored. Default [dest] is in [/tmp]. *)
|
||||||
|
|||||||
+6
-2
@@ -25,8 +25,8 @@ Q=@
|
|||||||
OCAML=ocaml
|
OCAML=ocaml
|
||||||
OCAMLC=ocamlc
|
OCAMLC=ocamlc
|
||||||
INCLUDES=-I ../lib/ocaml $(shell ocamlfind query -r -i-format xml-light) -I .
|
INCLUDES=-I ../lib/ocaml $(shell ocamlfind query -r -i-format xml-light) -I .
|
||||||
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)
|
OCAMLNETCMA=$(shell ocamlfind query -r -a-format -predicates byte netstring) $(shell ocamlfind query -r -a-format -predicates byte netclient)
|
||||||
OCAMLLEX=ocamllex
|
OCAMLLEX=ocamllex
|
||||||
OCAMLYACC=ocamlyacc
|
OCAMLYACC=ocamlyacc
|
||||||
|
|
||||||
@@ -44,6 +44,10 @@ gen_flight_plan.cmo : fp_proc.cmi
|
|||||||
|
|
||||||
gen_common.cmo : gen_common.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
|
mergelogs: mergelogs.c
|
||||||
gcc mergelogs.c -o mergelogs
|
gcc mergelogs.c -o mergelogs
|
||||||
|
|
||||||
|
|||||||
@@ -14,7 +14,7 @@ Q=@
|
|||||||
OCAML=ocaml
|
OCAML=ocaml
|
||||||
OCAMLC=ocamlc
|
OCAMLC=ocamlc
|
||||||
INCLUDES=-I ../../lib/ocaml $(shell ocamlfind query -r -i-format xml-light)
|
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)
|
OCAMLNETCMA=$(shell ocamlfind query -r -a-format -predicates byte netstring)
|
||||||
|
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user