1%%--------------------------------------------------------------------
2%%
3%% %CopyrightBegin%
4%%
5%% Copyright Ericsson AB 2000-2015. All Rights Reserved.
6%%
7%% Licensed under the Apache License, Version 2.0 (the "License");
8%% you may not use this file except in compliance with the License.
9%% You may obtain a copy of the License at
10%%
11%%     http://www.apache.org/licenses/LICENSE-2.0
12%%
13%% Unless required by applicable law or agreed to in writing, software
14%% distributed under the License is distributed on an "AS IS" BASIS,
15%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
16%% See the License for the specific language governing permissions and
17%% limitations under the License.
18%%
19%% %CopyrightEnd%
20%%
21%%
22%%----------------------------------------------------------------------
23%% File    : cosFileTransferApp.erl
24%% Purpose :
25%% Created : 25 Aug 2000
26%%----------------------------------------------------------------------
27-module(cosFileTransferApp).
28
29
30%%--------------- INCLUDES -----------------------------------
31-include("cosFileTransferApp.hrl").
32
33%%--------------- EXPORTS-------------------------------------
34%% cosFileTransferApp API external
35-export([start/0, stop/0, install/0, uninstall/0, create_VFS/4, create_VFS/5,
36	 get_buffert_size/0]).
37
38%% cosFileTransferApp API internal
39-export([create_link/3, get_option/3, type_check/2, configure/2]).
40
41%% Application callbacks
42-export([start/2, init/1, stop/1]).
43
44%% INTERNAL EXPORTS!! DO NOT USE THESE!!
45-export([create_dir/2, create_dir/3, create_file/2, create_file/3, split_paths/1,
46	 create_name/1]).
47
48-export([ssl_server_certfile/0, ssl_client_certfile/0, ssl_port/0,
49	 ssl_server_verify/0,
50	 ssl_client_verify/0,
51	 ssl_server_depth/0, ssl_client_depth/0,
52	 ssl_server_cacertfile/0,
53	 ssl_client_cacertfile/0]).
54
55
56%%--------------- DEFINES ------------------------------------
57-define(SUPERVISOR_NAME, oe_cosFileTransferSup).
58-define(SUP_FLAG,        {simple_one_for_one,50,10}).
59-define(SUP_DIRECTORY_SPEC(Name, Args),
60        ['CosFileTransfer_Directory',Args,
61         [{sup_child, true}, {regname, {global, Name}}]]).
62-define(SUP_CHILD,
63        {"oe_FileTransferChild",
64         {cosFileTransfer,create_link, []},
65	 transient,100000,worker,
66         []}).
67
68%%------------------------------------------------------------
69%% function : install
70%% Arguments: -
71%% Returns  : ok | EXIT | EXCEPTION
72%% Effect   : Install necessary data in the IFR DB
73%%------------------------------------------------------------
74install() ->
75    oe_CosFileTransfer:oe_register().
76
77%%------------------------------------------------------------
78%% function : uninstall
79%% Arguments: -
80%% Returns  : ok | EXIT | EXCEPTION
81%% Effect   : Remove data related to cosFileTransfer from the IFR DB
82%%------------------------------------------------------------
83uninstall() ->
84    oe_CosFileTransfer:oe_unregister().
85
86
87%%------------------------------------------------------------
88%% function : start/stop
89%% Arguments:
90%% Returns  :
91%% Effect   : Starts or stops the cosFileTransfer application.
92%%------------------------------------------------------------
93start() ->
94    application:start(cosFileTransfer).
95stop() ->
96    application:stop(cosFileTransfer).
97
98%%------------------------------------------------------------
99%% function : start
100%% Arguments: Type - see module application
101%%            Arg  - see module application
102%% Returns  :
103%% Effect   : Module callback for application
104%%------------------------------------------------------------
105start(_, _) ->
106    supervisor:start_link({local, ?SUPERVISOR_NAME}, cosFileTransferApp, app_init).
107
108
109%%------------------------------------------------------------
110%% function : stop
111%% Arguments: Arg - see module application
112%% Returns  :
113%% Effect   : Module callback for application
114%%------------------------------------------------------------
115stop(_) ->
116    ok.
117
118%%-----------------------------------------------------------%
119%% function : init
120%% Arguments:
121%% Returns  :
122%% Effect   :
123%%------------------------------------------------------------
124%% Starting using create_factory/X
125init(own_init) ->
126    {ok,{?SUP_FLAG, [?SUP_CHILD]}};
127%% When starting as an application.
128init(app_init) ->
129    {ok,{?SUP_FLAG, [?SUP_CHILD]}}.
130
131%%------------------------------------------------------------
132%% function : create_VFS
133%% Arguments:
134%% Returns  :
135%% Effect   :
136%%------------------------------------------------------------
137create_VFS(Type, Content, Host, Port) ->
138    create_VFS(Type, Content, Host, Port, []).
139
140create_VFS('FTP', Content, Host, Port, Options)
141  when is_list(Host) andalso is_integer(Port) andalso is_list(Options) ->
142    'CosFileTransfer_VirtualFileSystem':oe_create(['FTP', Content, Host, Port,
143						   Options],
144						  [{pseudo, true}]);
145create_VFS({'NATIVE', Mod}, Content, Host, Port, Options)
146  when is_list(Host) andalso is_integer(Port) andalso is_list(Options) ->
147    'CosFileTransfer_VirtualFileSystem':oe_create([{'NATIVE', Mod}, Content,
148						   Host, Port, Options],
149						  [{pseudo, true}]);
150create_VFS(_, _, _, _, _) ->
151    corba:raise(#'BAD_PARAM'{completion_status=?COMPLETED_NO}).
152
153%%-----------------------------------------------------------%
154%% function : create_link
155%% Arguments: Module - which Module to call
156%%            Env/ArgList - ordinary oe_create arguments.
157%% Returns  :
158%% Exception:
159%% Effect   : Necessary since we want the supervisor to be a
160%%            'simple_one_for_one'. Otherwise, using for example,
161%%            'one_for_one', we have to call supervisor:delete_child
162%%            to remove the childs startspecification from the
163%%            supervisors internal state.
164%%------------------------------------------------------------
165create_link(Module, Env, ArgList) ->
166    Module:oe_create_link(Env, ArgList).
167
168%%-----------------------------------------------------------%
169%% function : get_option
170%% Arguments:
171%% Returns  :
172%% Exception:
173%% Effect   :
174%%------------------------------------------------------------
175get_option(Key, OptionList, DefaultList) ->
176    case lists:keysearch(Key, 1, OptionList) of
177        {value,{Key,Value}} ->
178            Value;
179        _ ->
180            case lists:keysearch(Key, 1, DefaultList) of
181                {value,{Key,Value}} ->
182                    Value;
183                _->
184                    {error, "Invalid option"}
185            end
186    end.
187
188%%-----------------------------------------------------------%
189%% function : type_check
190%% Arguments: Obj  - objectrefernce to test.
191%%            Mod  - Module which contains typeID/0.
192%% Returns  : 'ok' or raises exception.
193%% Effect   :
194%%------------------------------------------------------------
195type_check(Obj, Mod) ->
196    case catch corba_object:is_a(Obj,Mod:typeID()) of
197        true ->
198            ok;
199        _ ->
200	    corba:raise(#'BAD_PARAM'{minor=700, completion_status=?COMPLETED_NO})
201    end.
202
203
204%%-----------------------------------------------------------%
205%% function : create_name/1
206%% Arguments:
207%% Returns  :
208%% Exception:
209%% Effect   :
210%%------------------------------------------------------------
211create_name(Type) ->
212    Time = erlang:system_time(),
213    Unique = erlang:unique_integer([positive]),
214    lists:concat(['oe_',node(),'_',Type,'_',Time,'_',Unique]).
215
216
217%%-----------------------------------------------------------%
218%% function : get_buffert_size/0
219%% Arguments:
220%% Returns  :
221%% Exception:
222%% Effect   : Lookup the configuration variable 'buffert_size'
223%%------------------------------------------------------------
224get_buffert_size() ->
225    case application:get_env(cosFileTransfer, buffert_size) of
226	{ok, Size}  when is_integer(Size) ->
227	    Size;
228	_ ->
229	    ?DEFAULT_BUFSIZE
230    end.
231
232%%-----------------------------------------------------------%
233%% function : configure/1
234%% Arguments:
235%% Returns  :
236%% Exception:
237%% Effect   :
238%%------------------------------------------------------------
239configure(buffert_size, Value) when is_integer(Value) ->
240    do_configure(buffert_size, Value);
241configure(ssl_port, Value) when is_integer(Value) ->
242    do_safe_configure(ssl_port, Value);
243configure(ssl_server_certfile, Value) when is_list(Value) ->
244    do_safe_configure(ssl_server_certfile, Value);
245configure(ssl_server_certfile, Value) when is_atom(Value) ->
246    do_safe_configure(ssl_server_certfile, atom_to_list(Value));
247configure(ssl_client_certfile, Value) when is_list(Value) ->
248    do_safe_configure(ssl_client_certfile, Value);
249configure(ssl_client_certfile, Value) when is_atom(Value) ->
250    do_safe_configure(ssl_client_certfile, atom_to_list(Value));
251configure(ssl_server_verify, Value) when is_integer(Value) ->
252    do_safe_configure(ssl_server_verify, Value);
253configure(ssl_client_verify, Value) when is_integer(Value) ->
254    do_safe_configure(ssl_client_verify, Value);
255configure(ssl_server_depth, Value) when is_integer(Value) ->
256    do_safe_configure(ssl_server_depth, Value);
257configure(ssl_client_depth, Value) when is_integer(Value) ->
258    do_safe_configure(ssl_client_depth, Value);
259configure(ssl_server_cacertfile, Value) when is_list(Value) ->
260    do_safe_configure(ssl_server_cacertfile, Value);
261configure(ssl_server_cacertfile, Value) when is_atom(Value) ->
262    do_safe_configure(ssl_server_cacertfile, atom_to_list(Value));
263configure(ssl_client_cacertfile, Value) when is_list(Value) ->
264    do_safe_configure(ssl_client_cacertfile, Value);
265configure(ssl_client_cacertfile, Value) when is_atom(Value) ->
266    do_safe_configure(ssl_client_cacertfile, atom_to_list(Value));
267configure(_, _) ->
268    exit({error, "Bad configure parameter(s)"}).
269
270%% This function may be used as long as it is safe to change a value at any time.
271do_configure(Key, Value) ->
272    case is_loaded() of
273	false ->
274	    application:load(cosFileTransfer),
275	    application_controller:set_env(cosFileTransfer, Key, Value);
276	true ->
277	    application_controller:set_env(cosFileTransfer, Key, Value)
278    end.
279
280
281%% This function MUST(!!) be used when we cannot change a value if cosFileTransfer
282%% is running.
283do_safe_configure(Key, Value) ->
284    case is_loaded() of
285	false ->
286	    application:load(cosFileTransfer),
287	    application_controller:set_env(cosFileTransfer, Key, Value);
288	true ->
289	    case is_running() of
290		false ->
291		    application_controller:set_env(cosFileTransfer, Key, Value);
292		true ->
293		    exit("cosFileTransfer already running, the given key may not be updated!")
294	    end
295    end.
296
297%%-----------------------------------------------------------%
298%% function : SSL parameter access functions
299%% Arguments:
300%% Returns  :
301%% Exception:
302%% Effect   :
303%%------------------------------------------------------------
304ssl_port() ->
305    case application:get_env(cosFileTransfer, ssl_port) of
306	{ok, Port} when is_integer(Port) ->
307	    Port;
308	_ ->
309	    -1
310    end.
311
312ssl_server_certfile() ->
313    case application:get_env(cosFileTransfer, ssl_server_certfile) of
314	{ok, V1}  when is_list(V1) ->
315	    V1;
316	{ok, V2}  when is_atom(V2) ->
317	    atom_to_list(V2);
318	_What ->
319	    {ok, Cwd} = file:get_cwd(),
320	    filename:join(Cwd,"ssl_server_cert.pem")
321    end.
322
323
324ssl_client_certfile() ->
325    case application:get_env(cosFileTransfer, ssl_client_certfile) of
326	{ok, V1}  when is_list(V1) ->
327	    V1;
328	{ok, V2}  when is_atom(V2) ->
329	    atom_to_list(V2);
330	_ ->
331	    {ok, Cwd} = file:get_cwd(),
332	    filename:join(Cwd,"ssl_client_cert.pem")
333    end.
334
335ssl_server_verify() ->
336    Verify = case application:get_env(cosFileTransfer, ssl_server_verify) of
337		 {ok, V} when is_integer(V) ->
338		     V;
339		 _ ->
340		     0
341	     end,
342    if
343	Verify =< 2, Verify >= 0 ->
344	    Verify;
345	true ->
346	   0
347    end.
348
349ssl_client_verify() ->
350    Verify = case application:get_env(cosFileTransfer, ssl_client_verify) of
351		 {ok, V1} when is_integer(V1) ->
352		     V1;
353		 _ ->
354		     0
355	     end,
356    if
357	Verify =< 2, Verify >= 0 ->
358	    Verify;
359	true ->
360	    0
361    end.
362
363ssl_server_depth() ->
364    case application:get_env(cosFileTransfer, ssl_server_depth) of
365	{ok, V1} when is_integer(V1) ->
366	    V1;
367	_ ->
368	    1
369    end.
370
371ssl_client_depth() ->
372    case application:get_env(cosFileTransfer, ssl_client_depth) of
373	{ok, V1} when is_integer(V1) ->
374	    V1;
375	_ ->
376	    1
377    end.
378
379
380ssl_server_cacertfile() ->
381    case application:get_env(cosFileTransfer, ssl_server_cacertfile) of
382	{ok, V1}  when is_list(V1) ->
383	    V1;
384	{ok, V2}  when is_atom(V2) ->
385	    atom_to_list(V2);
386	_ ->
387	    []
388    end.
389
390ssl_client_cacertfile() ->
391    case application:get_env(cosFileTransfer, ssl_client_cacertfile) of
392	{ok, V1}  when is_list(V1) ->
393	    V1;
394	{ok, V2}  when is_atom(V2) ->
395	    atom_to_list(V2);
396	_ ->
397	    []
398    end.
399
400
401%%============================================================
402%% Internal functions
403%%============================================================
404%%-----------------------------------------------------------%
405%% function : is_loaded/0
406%% Arguments:
407%% Returns  :
408%% Exception:
409%% Effect   : Check if the application is loaded
410%%------------------------------------------------------------
411is_loaded() ->
412    is_loaded(application:loaded_applications()).
413
414is_running() ->
415    is_loaded(application:which_applications()).
416
417is_loaded([]) ->
418    false;
419is_loaded([{cosFileTransfer, _, _} |_As]) ->
420     true;
421is_loaded([_ |As]) ->
422    is_loaded(As).
423
424
425
426
427%%-----------------------------------------------------------%
428%% function : create_dir/3/4
429%% Arguments:
430%% Returns  :
431%% Exception:
432%% Effect   :
433%%------------------------------------------------------------
434create_dir(Session, FileNameList) ->
435    create_dir(Session, FileNameList, corba:create_nil_objref()).
436create_dir(Session, FileNameList, Parent) ->
437    'CosFileTransfer_Directory':oe_create([lists:last(FileNameList), FileNameList,
438					   Parent, Session],
439					  [{pseudo, true}]).
440
441%%-----------------------------------------------------------%
442%% function : create_file/2/3
443%% Arguments:
444%% Returns  :
445%% Exception:
446%% Effect   :
447%%------------------------------------------------------------
448create_file(Session, FileNameList) ->
449    create_file(Session, FileNameList, corba:create_nil_objref()).
450create_file(Session, FileNameList, Parent) ->
451    'CosFileTransfer_File':oe_create([lists:last(FileNameList), FileNameList,
452				      Parent, Session], [{pseudo, true}]).
453
454%%-----------------------------------------------------------%
455%% function : split_paths
456%% Arguments:
457%% Returns  :
458%% Exception:
459%% Effect   :
460%%------------------------------------------------------------
461split_paths(Listing) ->
462    split_paths(string:tokens(Listing, ?SEPARATOR), []).
463split_paths([], Acc) ->
464    Acc;
465split_paths([H|T], Acc) ->
466     split_paths(T, [filename:split(H)|Acc]).
467
468
469%%--------------- END OF MODULE ------------------------------
470
471
472