1-module(yaws_dynopts).
2
3-include("../include/yaws.hrl").
4-include("../include/yaws_api.hrl").
5
6-export([
7         have_ssl_honor_cipher_order/0,
8         have_ssl_client_renegotiation/0,
9         have_ssl_sni/0,
10         have_ssl_log_alert/0,
11         have_ssl_handshake/0,
12         have_erlang_sendfile/0,
13         have_erlang_now/0,
14         have_rand/0,
15         have_start_error_logger/0,
16
17         unique_triple/0,
18         get_time_tuple/0,
19         now_secs/0,
20         random_seed/3,
21         random_uniform/1,
22         connection_information/2,
23         ssl_handshake/2,
24         start_error_logger/0,
25
26         generate/1,
27         purge_old_code/0,
28         is_generated/0
29        ]).
30
31-export([is_greater/2, is_less/2,
32         is_greater_or_equal/2, is_less_or_equal/2]).
33
34%% SSL option honor_cipher_order was added in release 17 (ERTS >= 6.0)
35have_ssl_honor_cipher_order() ->
36    is_greater_or_equal(erlang:system_info(version), "6.0").
37
38%% SSL option client_renegotiation was added in release 18 (ERTS >= 7.0)
39have_ssl_client_renegotiation() ->
40    is_greater_or_equal(erlang:system_info(version), "7.0").
41
42%% SSL sni support was added in release 18  (ERTS >= 7.0)
43have_ssl_sni() ->
44    is_greater_or_equal(erlang:system_info(version), "7.0").
45
46%% SSL option log_alert SSL was added in R16B02 (ERTS >= 5.10.3)
47have_ssl_log_alert() ->
48    is_greater_or_equal(erlang:system_info(version), "5.10.3").
49
50%% ssl:ssl_accept/2 is deprecated since release 21 (ERTS >= 10.0)
51have_ssl_handshake() ->
52    is_greater_or_equal(erlang:system_info(version), "10.0").
53
54%% erlang:sendfile/5 is buggy for R15 & R16 releases (ERTS < 6.0)
55have_erlang_sendfile() ->
56    is_greater_or_equal(erlang:system_info(version), "6.0").
57
58%% erlang:now/0 is deprecated since releases 18 (ERTS >= 7.0)
59have_erlang_now() ->
60    is_less(erlang:system_info(version), "7.0").
61
62%% random module is deprecated since releases 19 (ERTS >= 8.0)
63have_rand() ->
64    (code:which(rand) /= non_existing).
65
66%% error_logger is legacy as of release 21 (ERTS >= 10.0)
67have_start_error_logger() ->
68    is_greater_or_equal(erlang:system_info(version), "10.0").
69
70unique_triple() ->
71    case have_erlang_now() of
72        true ->
73            (fun erlang:now/0)();
74        false ->
75            F = fun erlang:unique_integer/1,
76            {F([positive]), F([positive]), F([positive])}
77    end.
78
79get_time_tuple() ->
80    case have_erlang_now() of
81        true  -> (fun erlang:now/0)();
82        false -> (fun erlang:timestamp/0)()
83    end.
84
85now_secs() ->
86    {M,S,_} = case have_erlang_now() of
87                  true  -> (fun erlang:now/0)();
88                  false -> (fun erlang:timestamp/0)()
89              end,
90    (M*1000000)+S.
91
92random_seed(A,B,C) ->
93    case have_rand() of
94        true  -> rand:seed(exsplus, {A,B,C});
95        false -> (fun random:seed/3)(A,B,C)
96    end.
97
98random_uniform(N) ->
99    case have_rand() of
100        true  -> rand:uniform(N);
101        false -> (fun random:uniform/1)(N)
102    end.
103
104connection_information(Sock, Items) ->
105    case have_ssl_sni() of
106        true  -> (fun ssl:connection_information/2)(Sock, Items);
107        false -> undefined
108    end.
109
110ssl_handshake(Sock, Timeout) ->
111    case have_ssl_handshake() of
112        true -> (fun ssl:handshake/2)(Sock, Timeout);
113        false ->
114            case (fun ssl:ssl_accept/2)(Sock, Timeout) of
115                ok -> {ok, Sock};
116                Error -> Error
117            end
118    end.
119
120start_error_logger() ->
121    case have_start_error_logger() of
122        true ->
123            case (fun logger:get_handler_config/1)(error_logger) of
124                {ok, _} -> ok;
125                {error, _} ->
126                    LoggerArgs = (fun maps:from_list/1)([{level, info},
127                                                         {filter_default, log},
128                                                         {filters, []}]),
129                    (fun logger:add_handler/3)(error_logger, error_logger,
130                                               LoggerArgs)
131            end;
132        false ->
133            ok
134    end.
135
136is_greater         (Vsn1, Vsn2) -> compare_version(Vsn1, Vsn2) == greater.
137is_less            (Vsn1, Vsn2) -> compare_version(Vsn1, Vsn2) == less.
138is_greater_or_equal(Vsn1, Vsn2) -> not is_less(Vsn1, Vsn2).
139is_less_or_equal   (Vsn1, Vsn2) -> not is_greater(Vsn1, Vsn2).
140
141compare_version(Vsn, Vsn) ->
142    equal;
143compare_version(Vsn1, Vsn2) ->
144    compare_version1(string:tokens(Vsn1, "."), string:tokens(Vsn2, ".")).
145
146compare_version1([], []) ->
147    equal;
148compare_version1(_X, []) ->
149    greater;
150compare_version1([], _X) ->
151    less;
152compare_version1([X1], [X2]) ->
153    %% For last digit ignore everything after the "-", if any
154    Y1 = lists:takewhile(fun(X) -> X /= $- end, X1),
155    Y2 = lists:takewhile(fun(X) -> X /= $- end, X2),
156    compare_digit(Y1, Y2);
157compare_version1([X1], [X2|_]) ->
158    %% For last digit ignore everything after the "-", if any
159    Y1 = lists:takewhile(fun(X) -> X /= $- end, X1),
160    case compare_digit(Y1, X2) of
161        equal -> less;
162        Else  -> Else
163    end;
164compare_version1([X1|_], [X2]) ->
165    %% For last digit ignore everything after the "-", if any
166    Y2 = lists:takewhile(fun(X) -> X /= $- end, X2),
167    case compare_digit(X1, Y2) of
168        equal -> greater;
169        Else  -> Else
170    end;
171compare_version1([X|Rest1], [X|Rest2]) ->
172    compare_version1(Rest1, Rest2);
173compare_version1([X1|Rest1], [X2|Rest2]) ->
174    case compare_digit(X1, X2) of
175        equal -> compare_version1(Rest1, Rest2);
176        Else  -> Else
177    end.
178
179compare_digit(X, X) ->
180    equal;
181compare_digit(X1, X2) when length(X1) > length(X2) ->
182    greater;
183compare_digit(X1, X2) when length(X1) < length(X2) ->
184    less;
185compare_digit(X1, X2) ->
186    case X1 > X2 of
187        true  -> greater;
188        false -> less
189    end.
190
191%% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
192is_generated() -> false.
193
194purge_old_code() -> not_necessary.
195
196generate(GC) ->
197    code:ensure_loaded(crypto),
198    code:ensure_loaded(inet),
199    case {filelib:is_dir(yaws:id_dir(GC#gconf.id)),
200          filelib:is_dir(yaws:tmpdir("/tmp"))} of
201        {true, _} ->
202            File = filename:join(yaws:id_dir(GC#gconf.id), "yaws_dynopts.erl"),
203            generate1(File);
204        {_, true} ->
205            File = filename:join(yaws:tmpdir("/tmp"), "yaws_dynopts.erl"),
206            generate1(File);
207        _ ->
208            start_error_logger(),
209            error_logger:format("Cannot write yaws_dynopts.erl~n"
210                                "Use the default version~n", [])
211    end.
212
213generate1(ModFile) ->
214    case write_module(ModFile) of
215        ok ->
216            Opts = compile_options(),
217            case compile:file(ModFile, Opts) of
218                {ok, ModName, Binary} ->
219                    case code:load_binary(ModName, [], Binary) of
220                        {module, ModName} ->
221                            ok;
222                        {error, What} ->
223                            start_error_logger(),
224                            error_logger:format(
225                              "Cannot load module '~p': ~p~n"
226                              "Use the default version~n",
227                              [ModName, What]
228                             )
229                    end;
230                _ ->
231                    start_error_logger(),
232                    error_logger:format("Compilation of '~p' failed: ~p~n"
233                                        "Use the default version~n",
234                                        [ModFile])
235            end;
236        {error, Reason} ->
237            start_error_logger(),
238            error_logger:format("Cannot write ~p: ~p~n"
239                                "Use the default version~n", [ModFile, Reason])
240    end.
241
242write_module(ModFile) ->
243    file:write_file(ModFile, source()).
244
245compile_options() ->
246    [binary, report,
247     {d, 'HAVE_SSL_HONOR_CIPHER_ORDER',    have_ssl_honor_cipher_order()},
248     {d, 'HAVE_SSL_CLIENT_RENEGOTIATION',  have_ssl_client_renegotiation()},
249     {d, 'HAVE_SSL_SNI',                   have_ssl_sni()},
250     {d, 'HAVE_SSL_LOG_ALERT',             have_ssl_log_alert()},
251     {d, 'HAVE_SSL_HANDSHAKE',             have_ssl_handshake()},
252     {d, 'HAVE_ERLANG_SENDFILE',           have_erlang_sendfile()},
253     {d, 'HAVE_START_ERROR_LOGGER',        have_start_error_logger()}
254    ]
255        ++
256        case have_erlang_now() of
257            true  -> [{d, 'HAVE_ERLANG_NOW'}];
258            false -> []
259        end
260        ++
261        case have_rand() of
262            true  -> [{d, 'HAVE_RAND'}];
263            false -> []
264        end.
265
266source() ->
267    IncDir  = yaws:get_inc_dir(),
268    Src = [
269           "-module(yaws_dynopts).",
270           "",
271           "-include(\"" ++ filename:join(IncDir, "yaws.hrl") ++ "\").",
272           "-include(\"" ++ filename:join(IncDir, "yaws_api.hrl") ++ "\").",
273           "",
274           "-export([",
275           "    have_ssl_honor_cipher_order/0,",
276           "    have_ssl_client_renegotiation/0,",
277           "    have_ssl_sni/0,",
278           "    have_ssl_log_alert/0,",
279           "    have_ssl_handshake/0,",
280           "    have_erlang_sendfile/0,",
281           "    have_erlang_now/0,",
282           "    have_rand/0,"
283           "    have_start_error_logger/0,"
284           "",
285           "    unique_triple/0,",
286           "    get_time_tuple/0,",
287           "    now_secs/0,",
288           "    random_seed/3,",
289           "    random_uniform/1,",
290           "    connection_information/2,",
291           "    ssl_handshake/2,"
292           "    start_error_logger/0,",
293           "",
294           "    generate/1,",
295           "    purge_old_code/0,",
296           "    is_generated/0",
297           "   ]).",
298           "",
299           "",
300           "generate(_) -> ok.",
301           "purge_old_code() -> code:soft_purge(?MODULE).",
302           "is_generated() -> true.",
303           "",
304           "have_ssl_honor_cipher_order()   -> ?HAVE_SSL_HONOR_CIPHER_ORDER.",
305           "have_ssl_client_renegotiation() -> ?HAVE_SSL_CLIENT_RENEGOTIATION.",
306           "have_ssl_sni()                  -> ?HAVE_SSL_SNI.",
307           "have_ssl_log_alert()            -> ?HAVE_SSL_LOG_ALERT.",
308           "have_ssl_handshake()            -> ?HAVE_SSL_HANDSHAKE.",
309           "have_erlang_sendfile()          -> ?HAVE_ERLANG_SENDFILE.",
310           "have_start_error_logger()       -> ?HAVE_START_ERROR_LOGGER.",
311           "",
312           "-ifdef(HAVE_ERLANG_NOW).",
313           "have_erlang_now() -> true.",
314           "unique_triple() ->",
315           "    now().",
316           "get_time_tuple() ->",
317           "    now().",
318           "now_secs() ->",
319           "    {M,S,_} = now(),",
320           "    (M*1000000)+S.",
321           "-else.",
322           "have_erlang_now() -> false.",
323           "unique_triple() ->",
324           "    {erlang:unique_integer([positive]),",
325           "     erlang:unique_integer([positive]),",
326           "     erlang:unique_integer([positive])}.",
327           "get_time_tuple() ->",
328           "    erlang:timestamp().",
329           "now_secs() ->",
330           "    {M,S,_} = erlang:timestamp(),",
331           "    (M*1000000)+S.",
332           "-endif.",
333           "",
334           "-ifdef(HAVE_RAND).",
335           "have_rand() -> true.",
336           "random_seed(A,B,C) -> rand:seed(exsplus, {A,B,C}).",
337           "random_uniform(N)  -> rand:uniform(N).",
338           "-else.",
339           "have_rand() -> false.",
340           "random_seed(A,B,C) -> random:seed(A,B,C).",
341           "random_uniform(N)  -> random:uniform(N).",
342           "-endif.",
343           "",
344           "-ifdef(HAVE_SSL_SNI).",
345           "connection_information(Sock, Items) -> ",
346           "    ssl:connection_information(Sock, Items).",
347           "-else.",
348           "connection_information(_, _) -> undefined.",
349           "-endif.",
350           "",
351           "-ifdef(HAVE_SSL_HANDSHAKE).",
352           "ssl_handshake(Sock, Timeout) ->",
353           "    ssl:handshake(Sock, Timeout).",
354           "-else.",
355           "ssl_handshake(Sock, Timeout) ->",
356           "    case ssl:ssl_accept(Sock, Timeout) of"
357           "        ok -> {ok, Sock};",
358           "        Error -> Error",
359           "    end.",
360           "-endif.",
361           "-ifdef(HAVE_ERROR_LOGGER_START).",
362           "start_error_logger() ->",
363           "    case logger:get_handler_config(error_logger) of",
364           "        {ok, _} -> ok;",
365           "        {error, _} ->",
366           "            logger:add_handler(error_logger, error_logger,",
367           "                               #{level => info, filter_default => log,"
368           "                                 filters => []})",
369           "    end.",
370           "-else.",
371           "start_error_logger() -> ok.",
372           "-endif."
373          ],
374    string:join(Src, "\n").
375