Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 248 lines (219 sloc) 9.309 kB
fccc685 Initial open-source release
MLstate authored
1 % -*-erlang-*-
2
3 %
4 % Copyright © 2011 MLstate
5 %
6 % This file is part of OPA.
7 %
8 % OPA is free software: you can redistribute it and/or modify it under the
9 % terms of the GNU Affero General Public License, version 3, as published by
10 % the Free Software Foundation.
11 %
12 % OPA is distributed in the hope that it will be useful, but WITHOUT ANY
13 % WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
14 % FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
15 % more details.
16 %
17 % You should have received a copy of the GNU Affero General Public License
18 % along with OPA. If not, see <http://www.gnu.org/licenses/>.
19 %
20 -generate client
21 -debugvar PROTOCOL_DEBUG
22 -protocol FTP
23
24 -open Printf
25 -open Rcontent
26
27 -type ftp = {
28 user:string;
29 password:string;
30 domain:string;
31 pathname:string;
32 filename:string;
33 dataportstr:string;
34 dataportspec:Network.port_spec;
35 datasecuremode:Network.secure_mode;
36 datablocksize:int;
37 content_type:content_type;
38 content_hint:int
39 }
40
41 -type result =
42 | Ok of content
43 | Error of string
44
45 -type state = {
46 log : int -> string -> unit ;
47 elog : int -> string -> unit ;
48 cont : result -> unit
49 }
50
51 -type payload = unit
52 -type rt_proto = {
53 rt_block_size : int;
54 rt_backtrace : bool;
55 rt_server_write_timeout : Time.t;
56 rt_payload : payload;
57 }
58
59 -type runtime = {
60 rt_plim : int;
61 rt_buf : Buffer.t;
62 rt_proto : rt_proto;
63 }
64
65 -define (ENs0 (num : int)) = num "-\r\n"
66 -define (Ns0 (num : int)) = num " \r\n"
67 -define (ENs (num : int, str)) = num "-" str "\r\n"
68 -define (Ns (num : int, str)) = num " " str "\r\n"
69
70 -include "libnet/ftpMessages.proto"
71
72 {{
73 let dlog sep code _msg = Logger.debug "<<< %d%s%s" code sep _msg
74 let eilog = dlog "-"
75 let ilog = dlog " "
76 let olog str = Logger.debug ">>> %s" str
77 let mlog _msg = olog (String.escaped (string_of_msg _msg))
78 }}
79
80 +on_connection(state:state, ftp:ftp):
81 debug 2 {{ Logger.debug "on_connection" }}
82 debug 2 {{ Logger.debug "FtpClientCore: pathname=%s filename=%s" ftp.pathname ftp.filename }}
83 debug {{ Printexc.record_backtrace true }}
84 read_welcome_message(state, ftp)
85
86 read_welcome_message(state, ftp):
87 receive
88 | ENs0 220 -> debug {{ eilog 220 "" }} read_welcome_message(state, ftp)
89 | ENs (220, _msg) -> debug {{ eilog 220 _msg }} read_welcome_message(state, ftp)
90 | Ns0 220 -> debug {{ ilog 220 "" }} send_login(state, ftp)
91 | Ns (220, _msg) -> debug {{ ilog 220 _msg }} send_login(state, ftp)
92 | ENs (code, _msg) -> {{ state.elog code _msg }} finish_error(state, {{"read_welcome_message"}})
93 | Ns (code, _msg) -> {{ state.log code _msg }} handle_error(state, code, _msg)
94 | err -> handle_unknown(state, {{"read_welcome_message"}}, err)
95 catch
96 | exn -> handle_exception(state, {{"read_welcome_message"}}, exn)
97
98 send_login(state, ftp):
99 debug 2 {{ Logger.debug "send_login" }}
100 send(User ftp.user);
101 debug {{ mlog(User ftp.user) }}
102 receive
103 | Ns0 230 -> debug {{ ilog 230 "" }} send_cwd(state, ftp)
104 | Ns (230, _msg) -> debug {{ ilog 230 _msg }} send_cwd(state, ftp)
105 | Ns0 331 -> debug {{ ilog 331 "" }} send_password(state, ftp)
106 | Ns (331, _msg) -> debug {{ ilog 331 _msg }} send_password(state, ftp)
107 | ENs (code, _msg) -> {{ state.elog code _msg }} finish_error(state, {{"send_login"}})
108 | Ns (code, _msg) -> {{ state.log code _msg }} handle_error(state, code, _msg)
109 | err -> handle_unknown(state, {{"send_login"}}, err)
110 catch
111 | exn -> handle_exception(state, {{"send_login"}}, exn)
112
113 send_password(state, ftp):
114 debug 2 {{ Logger.debug "send_password" }}
115 send(Pass ftp.password);
116 debug {{ mlog(Pass ftp.password) }}
117 receive
118 | Ns0 230 -> debug {{ ilog 230 "" }} send_cwd(state, ftp)
119 | Ns (230, _msg) -> debug {{ ilog 230 _msg }} send_cwd(state, ftp)
120 | ENs (code, _msg) -> {{ state.elog code _msg }} finish_error(state, {{"send_password"}})
121 | Ns (code, _msg) -> {{ state.log code _msg }} handle_error(state, code, _msg)
122 | err -> handle_unknown(state, {{"send_password"}}, err)
123 catch
124 | exn -> handle_exception(state, {{"send_password"}}, exn)
125
126 send_cwd(state, ftp):
127 debug 2 {{ Logger.debug "send_cwd" }}
128 send(Cwd ftp.pathname);
129 debug {{ mlog(Cwd ftp.pathname) }}
130 receive
131 | Ns0 250 -> debug {{ ilog 250 "" }} send_port(state, ftp)
132 | Ns (250, _msg) -> debug {{ ilog 250 _msg }} send_port(state, ftp)
133 | ENs (code, _msg) -> {{ state.elog code _msg }} finish_error(state, {{"send_cwd"}})
134 | Ns (code, _msg) -> {{ state.log code _msg }} handle_error(state, code, _msg)
135 | err -> handle_unknown(state, {{"send_cwd"}}, err)
136 catch
137 | exn -> handle_exception(state, {{"send_cwd"}}, exn)
138
139 send_port(state, ftp):
140 debug 2 {{ Logger.debug "send_port" }}
141 send(Port ftp.dataportstr);
142 debug {{ mlog(Port ftp.dataportstr) }}
143 receive
144 | Ns0 200 -> debug {{ ilog 200 "" }} send_retrieve(state, ftp)
145 | Ns (200, _msg) -> debug {{ ilog 200 _msg }} send_retrieve(state, ftp)
146 | ENs (code, _msg) -> {{ state.elog code _msg }} finish_error(state, {{"send_port"}})
147 | Ns (code, _msg) -> {{ state.log code _msg }} handle_error(state, code, _msg)
148 | err -> handle_unknown(state, {{"send_port"}}, err)
149 catch
150 | exn -> handle_exception(state, {{"send_port"}}, exn)
151
152 send_retrieve(state, ftp):
153 debug 2 {{ Logger.debug "send_retrieve" }}
154 let content = {{ ref (content_make ftp.content_type ~hint:ftp.content_hint) }}
155 let key = listen({{(ftp.dataportspec,ftp.datasecuremode)}},input_ascii_file,state,ftp,content)
156 send(Retr ftp.filename);
157 debug {{ mlog(Port ftp.dataportstr) }}
158 receive
159 | Ns0 150 -> debug {{ ilog 150 "" }} get_file(state, content, key)
160 | Ns (150, _msg) -> debug {{ ilog 150 _msg }} get_file(state, content, key)
161 | ENs (code, _msg) -> {{ state.elog code _msg }} finish_error(state, {{"send_retrieve"}})
162 | Ns (code, _msg) -> {{ state.log code _msg }} handle_error(state, code, _msg)
163 | err -> handle_unknown(state, {{"send_retrieve"}}, err)
164 catch
165 | exn -> handle_exception(state, {{"send_retrieve"}}, exn)
166
167 get_file(state, content, key):
168 debug 2 {{ Logger.debug "get_file" }}
169 %sleep {{ Time.milliseconds 100 }}
170 receive
171 | Ns0 226 -> debug {{ ilog 226 "" }} {{ key () }} quit(state, content)
172 | Ns (226, _msg) -> debug {{ ilog 226 _msg }} {{ key () }} quit(state, content)
173 | ENs (code, _msg) -> {{ state.elog code _msg }} {{ key () }} finish_error(state, {{"get_file"}})
174 | Ns (code, _msg) -> {{ state.log code _msg }} {{ key () }} handle_error(state, code, _msg)
175 | err -> {{ key () }} handle_unknown(state, {{"get_file"}}, err)
176 catch
177 | exn -> {{ key () }} handle_exception(state, {{"get_file"}}, exn)
178
179 input_ascii_file(state, ftp, content_ref):
180 debug 2 {{ Logger.debug "input_ascii_file" }}
181 %input_ascii_file_n(state, ftp, content)
182 %fixed {{ ftp.datablocksize }} % <-- for some reason we don't get a connection close with this.
183 rawread
184 | cnt_buff ->
185 let buff = {{ snd cnt_buff }}
186 debug 2 {{ Logger.debug "input_ascii_file: got data '%s'" (String.escaped (String.limit 50 buff)) }}
187 % TODO: crlf conversion??? (BIN mode).
188 let buff = {{ FtpServerType.crlf2cr buff }}
189 {{ content_ref := content_add buff (!content_ref) }}
190 input_ascii_file(state, ftp, content_ref)
191
192 %% read_content {{ !content_ref }}
193 %% | cnt_content ->
194 %% {{ content_ref := snd cnt_content }}
195 %% debug 2 {{ Logger.debug "input_ascii_file: got %d bytes" (fst cnt_content) }}
196 %% % TODO: crlf conversion??? (BIN mode).
197 %% %let buff = {{ FtpServerType.crlf2cr buff }}
198 %% input_ascii_file(state, ftp, content_ref)
199
200
201 %% input_ascii_file_n(state, ftp, content):
202 %% debug 2 {{ Logger.debug "input_ascii_file_n" }}
203 %% let cnt_buff = readconn(conn,ftp.datablocksize);
204 %% debug 2 {{ Logger.debug "input_ascii_file_n: got data '%s'" (String.escaped (String.limit 50 (snd cnt_buff))) }}
205 %% if {{ fst cnt_buff > 0 }}
206 %% then
207 %% % TODO: crlf conversion??? (BIN mode).
208 %% let buff = {{ FtpServerType.crlf2cr (snd cnt_buff) }}
209 %% {{ content := content_add buff (!content) }}
210 %% input_ascii_file_n(state, ftp, content)
211 %% else
212 %% input_ascii_file_n(state, ftp, content)
213
214 quit(state, content):
215 debug 2 {{ Logger.debug "quit" }}
216 send Quit;
217 debug {{ mlog Quit }}
218 -!-
219 {{ state.cont (Ok (!content)) }}
220
221 finish_error(state, from):
222 receive
223 | ENs (code, _msg) -> {{ state.elog code _msg }} finish_error(state, from)
224 | Ns (code, _msg) -> {{ state.log code _msg }} handle_error(state, code, _msg)
225 | err -> handle_unknown(state, {{"finish_error"}}, err)
226 catch
227 | exn -> handle_exception(state, from, exn)
228
229 handle_error(state, code, err):
230 let _msg = {{ sprintf "%d %s" code err }}
231 debug {{ Logger.debug "handle_error: %s" _msg; Pervasives.flush stderr }}
232 error(state, _msg)
233
234 handle_exception(state, from, exn):
235 let _msg = {{ sprintf "FtpClientCore.%s: exn=%s" from (Printexc.to_string exn) }}
236 debug {{ Printexc.print_backtrace stderr; Pervasives.flush stderr }}
237 error(state, _msg)
238
239 handle_unknown(state, from, err):
240 let _msg = {{ sprintf "FtpClientCore.%s: unknown message='%s'" from (String.escaped (string_of_msg err)) }}
241 error(state, _msg)
242
243 error(state, _msg):
244 -!-
245 debug {{ Logger.debug "Error: %s" _msg; Pervasives.flush stderr }}
246 {{ Logger.error "Error: %s" _msg }}
247 {{ state.cont (Error _msg) }}
Something went wrong with that request. Please try again.