Skip to content
Newer
Older
100644 239 lines (211 sloc) 9.58 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 (* ftpServer:
19 FTP server.
20 *)
21 module FSCp = FtpServerCore_parse
22 module FSC = FtpServerCore
23 module FST = FtpServerType
24 let protocol = FST.protocol
25
26 #<Debugvar:HTTP_DEBUG>
27
28 let hello =
29 ["";
30 "Welcome to the MLstate experimental FTP service";
31 "";
32 " - write access to user admin only";
33 " - log in as user anonymous, give your email address as password";
34 ""]
35
36 let goodbye = "Mlstate hopes you enjoyed the FTP experience. Goodbye."
37
38 let name = "ftpServer"
39 let version = "1.0beta"
40
41 type t = FSC.t
42
43 type options =
44 { opt_version: string; (** ftpServer version string *)
45 opt_hello_message: string list; (** Message for new connection *)
46 opt_goodbye_message: string; (** End of connection message *)
47 opt_is_admin: bool; (** admin mode *)
48 opt_user: string option; (** current user *)
49 opt_addr: string;
50 opt_port: int;
51 opt_data_port_spec: Network.port_spec; (** current data channel port spec *)
52 opt_data_secure_mode: Network.secure_mode; (** current data channel secure mode *)
53 opt_passive : bool; (** passive mode *)
54 opt_pasv_port_min:int; (** minimum port for passive connection *)
55 opt_pasv_port_max:int; (** maximum port for passive connection *)
56 opt_pasv_port_spec: Network.port_spec option ref; (** passive mode port spec *)
57 opt_pasv_secure_mode: Network.secure_mode option ref; (** passive mode secure mode *)
58 opt_pasv_port_conn: Scheduler.connection_info option ref; (** the passive port connection *)
59 opt_local_ip_num:string; (** string of server's IP number *)
60 opt_data_conn: Scheduler.connection_info option; (** [Some] if currently open *)
61 opt_data_blocksize: int; (** blocksize for transfers *)
62 opt_data_type: FST.type_code; (** FTP data transfer type *)
63 opt_binary: bool; (** transfer binary mode flag *)
64 opt_start_position: int; (** marker for REST verb *)
65 opt_structure_code: FST.structure_code; (** FTP data structure *)
66 opt_transfer_mode: FST.transfer_mode; (** FTP transfer mode *)
67 opt_folder: Folder.folder; (** restricted filespace, see folder.mli *)
68 opt_default_folder: string; (** starting folder for new connections *)
69 opt_rename_string: string option; (** from path for RNFR verb *)
70 opt_timeout: Time.t; (** global connection timeout *)
71 opt_ssl_cert : string;
72 opt_ssl_key : string;
73 opt_ssl_pass : string;
74 opt_ssl_accept_fun : Ssl.certificate -> bool;
75 opt_ssl_always : bool;
76 opt_ssl_ca_file : string;
77 opt_ssl_ca_path : string;
78 opt_ssl_client_ca_file : string;
79 opt_ssl_client_cert_path : string;
80 opt_dialog: string;
81 opt_on_server_close : Scheduler.t -> unit;
82 opt_name: string;
83 }
84
c8d0ae8 @Aqua-Ye [fix] libnet: removed the creation of .mlstate at runtime
Aqua-Ye authored
85 let initDir = "./ftp" (* Filename.concat (Lazy.force File.mlstate_dir) "ftp" *)
fccc685 Initial open-source release
MLstate authored
86 let folder = Folder.empty initDir
87
88 let default_options =
89 { opt_version = version;
90 opt_hello_message = hello;
91 opt_goodbye_message = goodbye;
92 opt_is_admin = false;
93 opt_user = None;
94 opt_addr = "0.0.0.0";
95 opt_port = 2221;
96 opt_data_port_spec = Network.make_port_spec ~protocol Unix.inet_addr_loopback 2220;
97 opt_data_secure_mode = Network.Unsecured;
98 opt_passive = false;
99 opt_pasv_port_min = 49152; (*IANA-registered ephemeral port range*)
100 opt_pasv_port_max = 65534;
101 opt_pasv_port_spec = ref None;
102 opt_pasv_secure_mode = ref None;
103 opt_pasv_port_conn = ref None;
104 opt_local_ip_num = "127.0.0.1";
105 opt_data_conn = None;
106 opt_data_blocksize = 4096;
107 opt_data_type = FST.A (Some FST.N);
108 opt_binary = false;
109 opt_start_position = 0;
110 opt_structure_code = FST.F;
111 opt_transfer_mode = FST.S;
112 opt_folder = folder;
113 opt_default_folder = initDir;
114 opt_rename_string = None;
115 opt_timeout = Time.seconds 300;
116 opt_ssl_cert = "";
117 opt_ssl_key = "";
118 opt_ssl_pass = "";
119 opt_ssl_accept_fun = (fun _ -> true);
120 opt_ssl_always = false;
121 opt_ssl_ca_file = "";
122 opt_ssl_ca_path = "";
123 opt_ssl_client_ca_file = "";
124 opt_ssl_client_cert_path = "";
125 opt_dialog = "default";
126 opt_on_server_close = (fun _ -> ());
127 opt_name = "ftpServerPort";
128 }
129
130 let prefixed_opt name opt = [Printf.sprintf "--%s-%s" name opt; Printf.sprintf "--%s" opt]
131
132 let spec_args name =
133 let p = prefixed_opt name in
134 [
135 (p"port")@["-p"],
136 ServerArg.func ServerArg.int
137 (fun o p -> if p > 0xffff then (Logger.error "Bad port number: %d" p; exit 1) else { o with opt_port = p }),
138 "<int>", "Sets the port on which the server should run";
139
140 (*p"no-flood-prevention",
141 ServerArg.func ServerArg.unit (fun o () -> { o with opt_dos_prevention = false }),
142 "", "Disable the built-in protection against Denial-of-Service attacks";*)
143
144 p"ssl-cert",
145 ServerArg.func ServerArg.string (fun o s -> { o with opt_ssl_cert = s }),
146 "<file>", "Location of your SSL certificate (requires ssl-key)";
147
148 p"ssl-key",
149 ServerArg.func ServerArg.string (fun o s -> { o with opt_ssl_key = s }),
150 "<file>", "Location of your SSL key (requires ssl-cert)";
151
152 p"ssl-pass",
153 ServerArg.func ServerArg.string (fun o s -> { o with opt_ssl_pass = s }),
154 "<string>", "Password of your SSL certificate (requires ssl-cert and ssl-key options)";
155
156 p"dialog",
157 ServerArg.func ServerArg.string (fun o s -> { o with opt_dialog = s }),
158 "<string>", "Name of the ftp dialog to use"
159 ]
160
161 let make_ssl_cert opt =
162 if opt.opt_ssl_cert <> "" then
163 if opt.opt_ssl_key <> "" then
164 Some (SslAS.make_ssl_certificate opt.opt_ssl_cert opt.opt_ssl_key opt.opt_ssl_pass)
165 else begin
166 Logger.log "Error : ssl-cert option MUST be used with ssl-key option";
167 exit 1
168 end
169 else
170 None
171
172 let make_ssl_verify opt =
173 if opt.opt_ssl_ca_file <> "" || opt.opt_ssl_ca_path <> "" || opt.opt_ssl_client_cert_path <> "" then
174 Some (SslAS.make_ssl_verify_params ~client_ca_file:opt.opt_ssl_client_ca_file
175 ~accept_fun:opt.opt_ssl_accept_fun ~always:opt.opt_ssl_always
176 opt.opt_ssl_ca_file opt.opt_ssl_ca_path opt.opt_ssl_client_cert_path)
177 else
178 None
179
180 let make (_name:string) (opt:options) (_sched:Scheduler.t) : t =
181 let secure_mode = Network.secure_mode_from_params (make_ssl_cert opt) (make_ssl_verify opt) in
182 let runtime = { FSC.rt_plim = 128;
183 rt_dialog_name = opt.opt_dialog;
184 rt_on_close = opt.opt_on_server_close;
185 rt_proto = { FSC.rt_name = opt.opt_name;
186 rt_addr = opt.opt_addr;
187 rt_port = opt.opt_port;
188 rt_block_size = 4096;
189 rt_secure_mode = secure_mode;
190 rt_backtrace = true; (* FIXME: put this into options. *)
191 rt_server_write_timeout = Time.seconds 36;
192 rt_payload = ();
193 };
194 } in
195 let state = { FST.version = opt.opt_version;
196 hello_message = opt.opt_hello_message;
197 goodbye_message = opt.opt_goodbye_message;
198 is_admin = opt.opt_is_admin;
199 user = opt.opt_user;
200 data_port_spec = opt.opt_data_port_spec;
201 data_secure_mode = opt.opt_data_secure_mode;
202 passive = opt.opt_passive;
203 pasv_port_min = opt.opt_pasv_port_min;
204 pasv_port_max = opt.opt_pasv_port_max;
205 pasv_port_spec = opt.opt_pasv_port_spec;
206 pasv_secure_mode = opt.opt_pasv_secure_mode;
207 pasv_port_conn = opt.opt_pasv_port_conn;
208 local_ip_num = opt.opt_local_ip_num;
209 data_conn = opt.opt_data_conn;
210 data_blocksize = opt.opt_data_blocksize;
211 data_type = opt.opt_data_type;
212 binary = opt.opt_binary;
213 start_position = opt.opt_start_position;
214 structure_code = opt.opt_structure_code;
215 transfer_mode = opt.opt_transfer_mode;
216 folder = opt.opt_folder;
217 default_folder = opt.opt_default_folder;
218 rename_string = opt.opt_rename_string;
219 timeout = opt.opt_timeout;
220 ssl_cert = opt.opt_ssl_cert;
221 ssl_key = opt.opt_ssl_key;
222 ssl_pass = opt.opt_ssl_pass;
223 } in
224 {
225 FSC.runtime = runtime;
226 err_cont = None;
227 extra_params = state;
228 }
229
230 let get_ports (server:t) (sched:Scheduler.t) = FSC.get_ports server sched
231
232 let get_description _ftp_server _sched = `FtpServer
233
234 let run ftp_server _sched = ftp_server
235
236 let close (ftp_server:t) sched = ftp_server.FSC.runtime.FSC.rt_on_close sched
237
238 (* End of file: ftpServer.ml *)
Something went wrong with that request. Please try again.