Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 107 lines (93 sloc) 4.446 kB
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 (* ftpClient: Simple read of file from FTP server.
19 *)
20 #<Debugvar:PROTOCOL_DEBUG>
21
22 module FCC = FtpClientCore
23 module List = Base.List
24 module String = Base.String
25 module Rc = Rcontent
26 let protocol = FCC.protocol
27
28 exception Bad_address of string
29
30 let _log sep code reason = Logger.warning "%d%s%s" code sep reason
31
32 let get_match str n = try (Some (Str.matched_group n str)) with Not_found -> None
33 let find_matches str cnt = let rec aux n l = if n > cnt then l else aux (n+1) (l@[get_match str n]) in aux 1 []
34
35 let ftpre =
36 Str.regexp
37 "\\(ftp://\\)?\\(\\([a-zA-Z0-9_-\\.]+\\)\\(:\\([a-zA-Z0-9_-\\.]+\\)\\)?@\\)?\\([a-zA-Z0-9_-\\.]+\\):?\\([0-9]+\\)?/\\(.*\\)"
38 let split_ftp user pass port s =
39 if Str.string_match ftpre s 0
40 then
41 match (get_match s 3, get_match s 5, get_match s 6, get_match s 7, get_match s 8) with
42 | (user_opt, pass_opt, Some domain, port_opt, Some path) ->
43 let port =
44 match port_opt with
45 | Some portstr -> (try int_of_string portstr with Failure "int_of_string" -> port)
46 | None -> port in
47 let user = Option.default user user_opt in
48 let pass = Option.default pass pass_opt in
49 (user, pass, domain, port, path)
50 | _ -> raise (Bad_address s)
51 else
52 raise (Bad_address s)
53
54 let get_ip name = (Unix.gethostbyname name).Unix.h_addr_list.(0)
55 let my_ip () = Unix.string_of_inet_addr(get_ip (Unix.gethostname()))
56
57 let dre = Str.regexp_string "."
58 let dataport () =
59 match Str.split dre (my_ip ()) with
60 | [h1;h2;h3;h4] ->
61 let dp = Random.int (65534-49152) + 49152 in
62 let p1, p2 = (dp land 0xff00) lsr 8, dp land 0xff in
63 let addr = Unix.inet_addr_of_string (Printf.sprintf "%s.%s.%s.%s" h1 h2 h3 h4) in
64 #<If$minlevel 2>Logger.debug "dataport: addr=%s\n" (Unix.string_of_inet_addr addr)#<End>;
65 let port_spec = Network.make_port_spec ~protocol addr dp in
66 port_spec, Printf.sprintf "%s,%s,%s,%s,%d,%d" h1 h2 h3 h4 p1 p2
67 | _ -> assert false
68
69 let receive_ftp_file sched url
70 ?(user="anonymous") ?(password="change.me@example.com") ?(ct=Rc.CT_BUFFER) ?(port=21)
71 ?(datablocksize=4096) ?(hint=4096)
72 cont =
73 let user, password, domain, port, filespec = split_ftp user password port url in
74 let pathname = Filename.dirname filespec in
75 let filename = Filename.basename filespec in
76 let dataportspec, dataportstr = dataport () in
77 let datasecuremode = Network.Unsecured in
78 #<If>Logger.debug "receive_ftp_file: domain=%s port=%d pathname=%s filename=%s dataportstr=%s\n"
79 domain port pathname filename dataportstr#<End>;
80 let ftp = { FCC.content_type=ct; content_hint=hint;
81 user=user; password=password;
82 domain=domain; pathname=pathname; filename=filename;
83 dataportstr=dataportstr; datasecuremode=datasecuremode;
84 dataportspec=dataportspec; datablocksize=datablocksize;
85 } in
86 let state = {
87 FCC.log = _log " ";
88 elog = _log "-";
89 cont = (function
90 | FCC.Error msg ->
91 (Logger.error "ERROR: %s\n" msg;
92 cont (FCC.Error msg))
93 | FCC.Ok res -> cont (FCC.Ok res));
94 } in
95 let client = { FCC.runtime = { FCC.rt_plim = 128;
96 rt_buf = Buffer.create 0;
97 rt_proto = { FCC.rt_block_size = 4096;
98 rt_backtrace = true;
99 rt_server_write_timeout = Time.seconds 36;
100 rt_payload = ();
101 };
102 };
103 err_cont = None;
104 extra_params = (state,ftp) } in
105 FCC.connect client sched domain port
106
Something went wrong with that request. Please try again.