Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 247 lines (218 sloc) 10.143 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_drop_privilege: bool;
72 opt_ssl_cert : string;
73 opt_ssl_key : string;
74 opt_ssl_pass : string;
75 opt_ssl_accept_fun : Ssl.certificate -> bool;
76 opt_ssl_always : bool;
77 opt_ssl_ca_file : string;
78 opt_ssl_ca_path : string;
79 opt_ssl_client_ca_file : string;
80 opt_ssl_client_cert_path : string;
81 opt_dialog: string;
82 opt_on_server_close : Scheduler.t -> unit;
83 opt_name: string;
84 }
85
86 let initDir = Filename.concat (Lazy.force File.mlstate_dir) "ftp"
87 let folder = Folder.empty initDir
88
89 let default_options =
90 { opt_version = version;
91 opt_hello_message = hello;
92 opt_goodbye_message = goodbye;
93 opt_is_admin = false;
94 opt_user = None;
95 opt_addr = "0.0.0.0";
96 opt_port = 2221;
97 opt_data_port_spec = Network.make_port_spec ~protocol Unix.inet_addr_loopback 2220;
98 opt_data_secure_mode = Network.Unsecured;
99 opt_passive = false;
100 opt_pasv_port_min = 49152; (*IANA-registered ephemeral port range*)
101 opt_pasv_port_max = 65534;
102 opt_pasv_port_spec = ref None;
103 opt_pasv_secure_mode = ref None;
104 opt_pasv_port_conn = ref None;
105 opt_local_ip_num = "127.0.0.1";
106 opt_data_conn = None;
107 opt_data_blocksize = 4096;
108 opt_data_type = FST.A (Some FST.N);
109 opt_binary = false;
110 opt_start_position = 0;
111 opt_structure_code = FST.F;
112 opt_transfer_mode = FST.S;
113 opt_folder = folder;
114 opt_default_folder = initDir;
115 opt_rename_string = None;
116 opt_timeout = Time.seconds 300;
117 opt_drop_privilege = true;
118 opt_ssl_cert = "";
119 opt_ssl_key = "";
120 opt_ssl_pass = "";
121 opt_ssl_accept_fun = (fun _ -> true);
122 opt_ssl_always = false;
123 opt_ssl_ca_file = "";
124 opt_ssl_ca_path = "";
125 opt_ssl_client_ca_file = "";
126 opt_ssl_client_cert_path = "";
127 opt_dialog = "default";
128 opt_on_server_close = (fun _ -> ());
129 opt_name = "ftpServerPort";
130 }
131
132 let prefixed_opt name opt = [Printf.sprintf "--%s-%s" name opt; Printf.sprintf "--%s" opt]
133
134 let spec_args name =
135 let p = prefixed_opt name in
136 [
137 (p"port")@["-p"],
138 ServerArg.func ServerArg.int
139 (fun o p -> if p > 0xffff then (Logger.error "Bad port number: %d" p; exit 1) else { o with opt_port = p }),
140 "<int>", "Sets the port on which the server should run";
141
142 (*p"no-flood-prevention",
143 ServerArg.func ServerArg.unit (fun o () -> { o with opt_dos_prevention = false }),
144 "", "Disable the built-in protection against Denial-of-Service attacks";*)
145
146 p"no-drop-privilege",
147 ServerArg.func ServerArg.unit (fun o () -> { o with opt_drop_privilege = false }),
148 "", "Disable the drop of privilege on server start";
149
150 p"ssl-cert",
151 ServerArg.func ServerArg.string (fun o s -> { o with opt_ssl_cert = s }),
152 "<file>", "Location of your SSL certificate (requires ssl-key)";
153
154 p"ssl-key",
155 ServerArg.func ServerArg.string (fun o s -> { o with opt_ssl_key = s }),
156 "<file>", "Location of your SSL key (requires ssl-cert)";
157
158 p"ssl-pass",
159 ServerArg.func ServerArg.string (fun o s -> { o with opt_ssl_pass = s }),
160 "<string>", "Password of your SSL certificate (requires ssl-cert and ssl-key options)";
161
162 p"dialog",
163 ServerArg.func ServerArg.string (fun o s -> { o with opt_dialog = s }),
164 "<string>", "Name of the ftp dialog to use"
165 ]
166
167 let make_ssl_cert opt =
168 if opt.opt_ssl_cert <> "" then
169 if opt.opt_ssl_key <> "" then
170 Some (SslAS.make_ssl_certificate opt.opt_ssl_cert opt.opt_ssl_key opt.opt_ssl_pass)
171 else begin
172 Logger.log "Error : ssl-cert option MUST be used with ssl-key option";
173 exit 1
174 end
175 else
176 None
177
178 let make_ssl_verify opt =
179 if opt.opt_ssl_ca_file <> "" || opt.opt_ssl_ca_path <> "" || opt.opt_ssl_client_cert_path <> "" then
180 Some (SslAS.make_ssl_verify_params ~client_ca_file:opt.opt_ssl_client_ca_file
181 ~accept_fun:opt.opt_ssl_accept_fun ~always:opt.opt_ssl_always
182 opt.opt_ssl_ca_file opt.opt_ssl_ca_path opt.opt_ssl_client_cert_path)
183 else
184 None
185
186 let make (_name:string) (opt:options) (_sched:Scheduler.t) : t =
187 if opt.opt_drop_privilege then Systools.change_user ();
188 let secure_mode = Network.secure_mode_from_params (make_ssl_cert opt) (make_ssl_verify opt) in
189 let runtime = { FSC.rt_plim = 128;
190 rt_dialog_name = opt.opt_dialog;
191 rt_on_close = opt.opt_on_server_close;
192 rt_proto = { FSC.rt_name = opt.opt_name;
193 rt_addr = opt.opt_addr;
194 rt_port = opt.opt_port;
195 rt_block_size = 4096;
196 rt_secure_mode = secure_mode;
197 rt_backtrace = true; (* FIXME: put this into options. *)
198 rt_server_write_timeout = Time.seconds 36;
199 rt_payload = ();
200 };
201 } in
202 let state = { FST.version = opt.opt_version;
203 hello_message = opt.opt_hello_message;
204 goodbye_message = opt.opt_goodbye_message;
205 is_admin = opt.opt_is_admin;
206 user = opt.opt_user;
207 data_port_spec = opt.opt_data_port_spec;
208 data_secure_mode = opt.opt_data_secure_mode;
209 passive = opt.opt_passive;
210 pasv_port_min = opt.opt_pasv_port_min;
211 pasv_port_max = opt.opt_pasv_port_max;
212 pasv_port_spec = opt.opt_pasv_port_spec;
213 pasv_secure_mode = opt.opt_pasv_secure_mode;
214 pasv_port_conn = opt.opt_pasv_port_conn;
215 local_ip_num = opt.opt_local_ip_num;
216 data_conn = opt.opt_data_conn;
217 data_blocksize = opt.opt_data_blocksize;
218 data_type = opt.opt_data_type;
219 binary = opt.opt_binary;
220 start_position = opt.opt_start_position;
221 structure_code = opt.opt_structure_code;
222 transfer_mode = opt.opt_transfer_mode;
223 folder = opt.opt_folder;
224 default_folder = opt.opt_default_folder;
225 rename_string = opt.opt_rename_string;
226 timeout = opt.opt_timeout;
227 drop_privilege = opt.opt_drop_privilege;
228 ssl_cert = opt.opt_ssl_cert;
229 ssl_key = opt.opt_ssl_key;
230 ssl_pass = opt.opt_ssl_pass;
231 } in
232 {
233 FSC.runtime = runtime;
234 err_cont = None;
235 extra_params = state;
236 }
237
238 let get_ports (server:t) (sched:Scheduler.t) = FSC.get_ports server sched
239
240 let get_description _ftp_server _sched = `FtpServer
241
242 let run ftp_server _sched = ftp_server
243
244 let close (ftp_server:t) sched = ftp_server.FSC.runtime.FSC.rt_on_close sched
245
246 (* End of file: ftpServer.ml *)
Something went wrong with that request. Please try again.