1%%%----------------------------------------------------------------------
2%%% File    : yaws.erl
3%%% Author  : Claes Wikstrom <klacke@bluetail.com>
4%%% Purpose :
5%%% Created : 16 Jan 2002 by Claes Wikstrom <klacke@bluetail.com>
6%%%----------------------------------------------------------------------
7
8-module(yaws).
9-author('klacke@bluetail.com').
10
11-include("../include/yaws.hrl").
12-include("../include/yaws_api.hrl").
13-include("yaws_appdeps.hrl").
14-include("yaws_debug.hrl").
15
16-include_lib("kernel/include/file.hrl").
17-export([start/0, stop/0, hup/0, hup/1, restart/0, modules/0, load/0]).
18-export([start_embedded/1, start_embedded/2, start_embedded/3, start_embedded/4,
19         add_server/2, create_gconf/2, create_sconf/2, setup_sconf/2]).
20
21-export([gconf_yaws_dir/1, gconf_trace/1, gconf_flags/1, gconf_logdir/1,
22         gconf_ebin_dir/1, gconf_src_dir/1, gconf_runmods/1,
23         gconf_keepalive_timeout/1, gconf_keepalive_maxuses/1,
24         gconf_max_num_cached_files/1, gconf_max_num_cached_bytes/1,
25         gconf_max_size_cached_file/1, gconf_max_connections/1,
26         gconf_process_options/1, gconf_large_file_chunk_size/1,
27         gconf_mnesia_dir/1, gconf_log_wrap_size/1, gconf_cache_refresh_secs/1,
28         gconf_include_dir/1, gconf_phpexe/1, gconf_yaws/1, gconf_id/1,
29         gconf_enable_soap/1, gconf_soap_srv_mods/1,
30         gconf_acceptor_pool_size/1, gconf_mime_types_info/1,
31         gconf_nslookup_pref/1,
32         gconf_ysession_mod/1, gconf_ysession_cookiegen/1,
33         gconf_ysession_idle_timeout/1, gconf_ysession_long_timeout/1,
34         gconf_sni/1]).
35
36-export([gconf_yaws_dir/2, gconf_trace/2, gconf_flags/2, gconf_logdir/2,
37         gconf_ebin_dir/2, gconf_src_dir/2, gconf_runmods/2,
38         gconf_keepalive_timeout/2, gconf_keepalive_maxuses/2,
39         gconf_max_num_cached_files/2, gconf_max_num_cached_bytes/2,
40         gconf_max_size_cached_file/2, gconf_max_connections/2,
41         gconf_process_options/2, gconf_large_file_chunk_size/2,
42         gconf_mnesia_dir/2, gconf_log_wrap_size/2, gconf_cache_refresh_secs/2,
43         gconf_include_dir/2, gconf_phpexe/2, gconf_yaws/2, gconf_id/2,
44         gconf_enable_soap/2, gconf_soap_srv_mods/2,
45         gconf_acceptor_pool_size/2, gconf_mime_types_info/2,
46         gconf_nslookup_pref/2,
47         gconf_ysession_mod/2,  gconf_ysession_cookiegen/2,
48         gconf_ysession_idle_timeout/2, gconf_ysession_long_timeout/2,
49         gconf_sni/2]).
50
51-export([sconf_port/1, sconf_flags/1, sconf_redirect_map/1, sconf_rhost/1,
52         sconf_rmethod/1, sconf_docroot/1, sconf_xtra_docroots/1,
53         sconf_listen/1, sconf_servername/1, sconf_serveralias/1, sconf_yaws/1,
54         sconf_ets/1, sconf_ssl/1, sconf_authdirs/1, sconf_partial_post_size/1,
55         sconf_appmods/1, sconf_expires/1, sconf_errormod_401/1,
56         sconf_errormod_404/1, sconf_arg_rewrite_mode/1, sconf_logger_mod/1,
57         sconf_opaque/1, sconf_start_mod/1, sconf_allowed_scripts/1,
58         sconf_tilde_allowed_scripts/1, sconf_index_files/1, sconf_revproxy/1,
59         sconf_spotions/1, sconf_extra_cgi_vars/1, sconf_stats/1,
60         sconf_fcgi_app_server/1, sconf_php_handler/1, sconf_shaper/1,
61         sconf_deflate_options/1, sconf_mime_types_info/1,
62         sconf_dispatch_mod/1]).
63
64-export([sconf_port/2, sconf_flags/2, sconf_redirect_map/2, sconf_rhost/2,
65         sconf_rmethod/2, sconf_docroot/2, sconf_xtra_docroots/2,
66         sconf_listen/2, sconf_servername/2, sconf_serveralias/2, sconf_yaws/2,
67         sconf_ets/2, sconf_ssl/2, sconf_authdirs/2, sconf_partial_post_size/2,
68         sconf_appmods/2, sconf_expires/2, sconf_errormod_401/2,
69         sconf_errormod_404/2, sconf_arg_rewrite_mode/2, sconf_logger_mod/2,
70         sconf_opaque/2, sconf_start_mod/2, sconf_allowed_scripts/2,
71         sconf_tilde_allowed_scripts/2, sconf_index_files/2, sconf_revproxy/2,
72         sconf_spotions/2, sconf_extra_cgi_vars/2, sconf_stats/2,
73         sconf_fcgi_app_server/2, sconf_php_handler/2, sconf_shaper/2,
74         sconf_deflate_options/2, sconf_mime_types_info/2,
75         sconf_dispatch_mod/2]).
76
77-export([new_auth/0,
78         auth_dir/1, auth_dir/2,
79         auth_docroot/1, auth_docroot/2,
80         auth_files/1, auth_files/2,
81         auth_realm/1, auth_realm/2,
82         auth_type/1, auth_type/2,
83         auth_headers/1, auth_headers/2,
84         auth_users/1, auth_users/2,
85         auth_acl/1, auth_acl/2,
86         auth_mod/1, auth_mod/2,
87         auth_outmod/1, auth_outmod/2,
88         auth_pam/1, auth_pam/2]).
89
90-export([new_ssl/0,
91         ssl_keyfile/1, ssl_keyfile/2,
92         ssl_certfile/1, ssl_certfile/2,
93         ssl_verify/1, ssl_verify/2,
94         ssl_fail_if_no_peer_cert/1, ssl_fail_if_no_peer_cert/2,
95         ssl_depth/1, ssl_depth/2,
96         ssl_password/1, ssl_password/2,
97         ssl_cacertfile/1, ssl_cacertfile/2,
98         ssl_dhfile/1, ssl_dhfile/2,
99         ssl_ciphers/1, ssl_ciphers/2,
100         ssl_cachetimeout/1, ssl_cachetimeout/2,
101         ssl_secure_renegotiate/1, ssl_secure_renegotiate/2,
102         ssl_client_renegotiation/1, ssl_client_renegotiation/2,
103         ssl_protocol_version/1, ssl_protocol_version/2,
104         ssl_honor_cipher_order/1, ssl_honor_cipher_order/2,
105         ssl_require_sni/1, ssl_require_sni/2]).
106
107-export([new_deflate/0,
108         deflate_min_compress_size/1, deflate_min_compress_size/2,
109         deflate_compression_level/1, deflate_compression_level/2,
110         deflate_window_size/1, deflate_window_size/2,
111         deflate_mem_level/1, deflate_mem_level/2,
112         deflate_strategy/1, deflate_strategy/2,
113         deflate_use_gzip_static/1, deflate_use_gzip_static/2,
114         deflate_mime_types/1, deflate_mime_types/2]).
115
116-export([new_mime_types_info/0,
117         mime_types_info_mime_types_file/1, mime_types_info_mime_types_file/2,
118         mime_types_info_types/1, mime_types_info_types/2,
119         mime_types_info_charsets/1, mime_types_info_charsets/2,
120         mime_types_info_default_type/1, mime_types_info_default_type/2,
121         mime_types_info_default_charset/1, mime_types_info_default_charset/2]).
122
123-export([first/2, elog/2, filesize/1, upto/2, to_string/1, to_list/1,
124         integer_to_hex/1, hex_to_integer/1, string_to_hex/1, hex_to_string/1,
125         is_modified_p/2, flag/3, dohup/1, is_ssl/1, address/0, is_space/1,
126         setopts/3, eat_crnl/2, get_chunk_num/2, get_chunk_header/2,
127         get_chunk/4, get_chunk_trailer/2, list_to_uue/1, uue_to_list/1,
128         printversion/0, strip_spaces/1, strip_spaces/2,
129         month/1, mk2/1, home/0, arg_rewrite/1, to_lowerchar/1, to_lower/1,
130         funreverse/2, is_prefix/2, split_sep/2, join_sep/2, accepts_gzip/2,
131         upto_char/2, deepmap/2, ticker/2, ticker/3, unique_triple/0, get_time_tuple/0,
132         parse_qvalue/1, parse_auth/1]).
133
134-export([outh_set_status_code/1,
135         outh_set_non_cacheable/1,
136         outh_set_content_type/1,
137         outh_set_content_encoding/1,
138         outh_set_cookie/1,
139         outh_set_static_headers/3, outh_set_static_headers/4,
140         outh_set_304_headers/3,
141         outh_set_dyn_headers/3,
142         outh_set_connection/1,
143         outh_set_content_length/1,
144         outh_set_dcc/2,
145         outh_set_transfer_encoding_off/0,
146         outh_set_auth/1,
147         outh_set_vary/1,
148         outh_clear_headers/0,
149         outh_fix_doclose/0,
150         dcc/2]).
151
152-export([make_allow_header/0, make_allow_header/1,
153         make_server_header/0,
154         make_last_modified_header/1,
155         make_location_header/1,
156         make_etag_header/1,
157         make_content_range_header/1,
158         make_content_length_header/1,
159         make_content_encoding_header/1,
160         make_connection_close_header/1,
161         make_transfer_encoding_chunked_header/1,
162         make_www_authenticate_header/1,
163         make_etag/1,
164         make_content_type_header/1,
165         make_date_header/0,
166         make_vary_header/1]).
167
168-export([outh_get_status_code/0,
169         outh_get_contlen/0,
170         outh_get_act_contlen/0,
171         outh_inc_act_contlen/1,
172         outh_get_doclose/0,
173         outh_get_chunked/0,
174         outh_get_content_encoding/0,
175         outh_get_content_encoding_header/0,
176         outh_get_content_type/0,
177         outh_get_vary_fields/0,
178         outh_serialize/0]).
179
180-export([accumulate_header/1, headers_to_str/1,
181         getuid/0,
182         user_to_home/1,
183         uid_to_name/1,
184         exists/1,
185         mkdir/1]).
186
187-export([tcp_connect/3, tcp_connect/4, ssl_connect/3, ssl_connect/4]).
188
189-export([do_recv/3, do_recv/4, cli_recv/3,
190         gen_tcp_send/2,
191         http_get_headers/2]).
192
193-export([sconf_to_srvstr/1,
194         redirect_host/2, redirect_port/1,
195         redirect_scheme_port/1, redirect_scheme/1,
196         tmpdir/0, tmpdir/1, mktemp/1, split_at/2, insert_at/3,
197         id_dir/1, ctl_file/1]).
198
199-export([parse_ipmask/1, match_ipmask/2, find_private_port/0]).
200
201-export([get_app_dir/0, get_ebin_dir/0, get_priv_dir/0,
202         get_inc_dir/0]).
203
204%% Internal
205-export([local_time_as_gmt_string/1, universal_time_as_string/1,
206         stringdate_to_datetime/1]).
207
208start() ->
209    ok = start_app_deps(),
210    application:start(yaws, permanent).
211
212stop() ->
213    application:stop(yaws).
214
215
216%%% Quick and easy way of starting Yaws in embedded mode.  No need for any
217%%% start-script switches and no dependencies to Yaws header files. Just call
218%%% start_embedded/N and you are in the air.
219start_embedded(DocRoot) ->
220    start_embedded(DocRoot, []).
221
222start_embedded(DocRoot, SL) when is_list(DocRoot),is_list(SL) ->
223    start_embedded(DocRoot, SL, []).
224
225start_embedded(DocRoot, SL, GL) when is_list(DocRoot),is_list(SL),is_list(GL) ->
226    start_embedded(DocRoot, SL, GL, "default").
227start_embedded(DocRoot, SL, GL, Id)
228  when is_list(DocRoot), is_list(SL), is_list(GL) ->
229    ok = start_app_deps(),
230    {ok, SCList, GC, _} = yaws_api:embedded_start_conf(DocRoot, SL, GL, Id),
231    ok = application:start(yaws, permanent),
232    yaws_config:add_yaws_soap_srv(GC),
233    yaws_api:setconf(GC, SCList),
234    ok.
235
236add_server(DocRoot, SL) when is_list(DocRoot),is_list(SL) ->
237    SC  = create_sconf(DocRoot, SL),
238    %% Change #auth in authdirs to {Dir, #auth} if needed
239    Fun = fun
240              (A = #auth{dir = [Dir]}, Acc) -> [{Dir, A}| Acc];
241              (A, Acc)                      -> [A| Acc]
242          end,
243    Authdirs = lists:foldr(Fun, [], SC#sconf.authdirs),
244    SC1 = yaws_config:add_yaws_auth(SC#sconf{authdirs = Authdirs}),
245    yaws_config:add_sconf(SC1).
246
247create_gconf(GL, Id) when is_list(GL) ->
248    Debug = case application:get_env(yaws, debug) of
249                undefined -> false;
250                {ok, D}   -> D
251            end,
252    setup_gconf(GL, yaws_config:make_default_gconf(Debug, Id)).
253
254create_sconf(DocRoot, SL) when is_list(DocRoot), is_list(SL) ->
255    SC = yaws_config:make_default_sconf(DocRoot,
256                                        lkup(servername, SL, undefined),
257                                        lkup(port, SL, undefined)),
258    SL1 = lists:keydelete(port, 1, lists:keydelete(servername, 1, SL)),
259    setup_sconf(SL1, SC).
260
261start_app_deps() ->
262    Deps = split_sep(?YAWS_APPDEPS, $,),
263    catch lists:foldl(fun(App0, Acc) ->
264                              App = list_to_existing_atom(App0),
265                              case application:start(App, permanent) of
266                                  ok -> Acc;
267                                  {error,{already_started,App}} -> Acc;
268                                  Else -> throw(Else)
269                              end
270                      end, ok, Deps).
271
272%%% Access functions for the GCONF and SCONF records.
273%% Getters
274gconf_yaws_dir             (#gconf{yaws_dir              = X}) -> X.
275gconf_trace                (#gconf{trace                 = X}) -> X.
276gconf_flags                (#gconf{flags                 = X}) -> X.
277gconf_logdir               (#gconf{logdir                = X}) -> X.
278gconf_ebin_dir             (#gconf{ebin_dir              = X}) -> X.
279gconf_src_dir              (#gconf{src_dir               = X}) -> X.
280gconf_runmods              (#gconf{runmods               = X}) -> X.
281gconf_keepalive_timeout    (#gconf{keepalive_timeout     = X}) -> X.
282gconf_keepalive_maxuses    (#gconf{keepalive_maxuses     = X}) -> X.
283gconf_max_num_cached_files (#gconf{max_num_cached_files  = X}) -> X.
284gconf_max_num_cached_bytes (#gconf{max_num_cached_bytes  = X}) -> X.
285gconf_max_size_cached_file (#gconf{max_size_cached_file  = X}) -> X.
286gconf_max_connections      (#gconf{max_connections       = X}) -> X.
287gconf_process_options      (#gconf{process_options       = X}) -> X.
288gconf_large_file_chunk_size(#gconf{large_file_chunk_size = X}) -> X.
289gconf_mnesia_dir           (#gconf{mnesia_dir            = X}) -> X.
290gconf_log_wrap_size        (#gconf{log_wrap_size         = X}) -> X.
291gconf_cache_refresh_secs   (#gconf{cache_refresh_secs    = X}) -> X.
292gconf_include_dir          (#gconf{include_dir           = X}) -> X.
293gconf_phpexe               (#gconf{phpexe                = X}) -> X.
294gconf_yaws                 (#gconf{yaws                  = X}) -> X.
295gconf_id                   (#gconf{id                    = X}) -> X.
296gconf_enable_soap          (#gconf{enable_soap           = X}) -> X.
297gconf_soap_srv_mods        (#gconf{soap_srv_mods         = X}) -> X.
298gconf_acceptor_pool_size   (#gconf{acceptor_pool_size    = X}) -> X.
299gconf_mime_types_info      (#gconf{mime_types_info       = X}) -> X.
300gconf_nslookup_pref        (#gconf{nslookup_pref         = X}) -> X.
301gconf_ysession_mod         (#gconf{ysession_mod          = X}) -> X.
302gconf_ysession_cookiegen   (#gconf{ysession_cookiegen    = X}) -> X.
303gconf_ysession_idle_timeout(#gconf{ysession_idle_timeout = X}) -> X.
304gconf_ysession_long_timeout(#gconf{ysession_long_timeout = X}) -> X.
305gconf_sni                  (#gconf{sni                   = X}) -> X.
306
307%% Setters
308gconf_yaws_dir             (S, X) -> S#gconf{yaws_dir              = X}.
309gconf_trace                (S, X) -> S#gconf{trace                 = X}.
310gconf_flags                (S, X) -> S#gconf{flags                 = X}.
311gconf_logdir               (S, X) -> S#gconf{logdir                = X}.
312gconf_ebin_dir             (S, X) -> S#gconf{ebin_dir              = X}.
313gconf_src_dir              (S, X) -> S#gconf{src_dir               = X}.
314gconf_runmods              (S, X) -> S#gconf{runmods               = X}.
315gconf_keepalive_timeout    (S, X) -> S#gconf{keepalive_timeout     = X}.
316gconf_keepalive_maxuses    (S, X) -> S#gconf{keepalive_maxuses     = X}.
317gconf_max_num_cached_files (S, X) -> S#gconf{max_num_cached_files  = X}.
318gconf_max_num_cached_bytes (S, X) -> S#gconf{max_num_cached_bytes  = X}.
319gconf_max_size_cached_file (S, X) -> S#gconf{max_size_cached_file  = X}.
320gconf_max_connections      (S, X) -> S#gconf{max_connections       = X}.
321gconf_process_options      (S, X) -> S#gconf{process_options       = X}.
322gconf_large_file_chunk_size(S, X) -> S#gconf{large_file_chunk_size = X}.
323gconf_mnesia_dir           (S, X) -> S#gconf{mnesia_dir            = X}.
324gconf_log_wrap_size        (S, X) -> S#gconf{log_wrap_size         = X}.
325gconf_cache_refresh_secs   (S, X) -> S#gconf{cache_refresh_secs    = X}.
326gconf_include_dir          (S, X) -> S#gconf{include_dir           = X}.
327gconf_phpexe               (S, X) -> S#gconf{phpexe                = X}.
328gconf_yaws                 (S, X) -> S#gconf{yaws                  = X}.
329gconf_id                   (S, X) -> S#gconf{id                    = X}.
330gconf_enable_soap          (S, X) -> S#gconf{enable_soap           = X}.
331gconf_soap_srv_mods        (S, X) -> S#gconf{soap_srv_mods         = X}.
332gconf_acceptor_pool_size   (S, X) -> S#gconf{acceptor_pool_size    = X}.
333gconf_mime_types_info      (S, X) -> S#gconf{mime_types_info       = X}.
334gconf_nslookup_pref        (S, X) -> S#gconf{nslookup_pref         = X}.
335gconf_ysession_mod         (S, X) -> S#gconf{ysession_mod          = X}.
336gconf_ysession_cookiegen   (S, X) -> S#gconf{ysession_cookiegen    = X}.
337gconf_ysession_idle_timeout(S, X) -> S#gconf{ysession_idle_timeout = X}.
338gconf_ysession_long_timeout(S, X) -> S#gconf{ysession_long_timeout = X}.
339gconf_sni                  (S, X) -> S#gconf{sni                   = X}.
340
341%% Getters
342sconf_port                 (#sconf{port                  = X}) -> X.
343sconf_flags                (#sconf{flags                 = X}) -> X.
344sconf_redirect_map         (#sconf{redirect_map          = X}) -> X.
345sconf_rhost                (#sconf{rhost                 = X}) -> X.
346sconf_rmethod              (#sconf{rmethod               = X}) -> X.
347sconf_docroot              (#sconf{docroot               = X}) -> X.
348sconf_xtra_docroots        (#sconf{xtra_docroots         = X}) -> X.
349sconf_listen               (#sconf{listen                = X}) -> X.
350sconf_servername           (#sconf{servername            = X}) -> X.
351sconf_serveralias          (#sconf{serveralias           = X}) -> X.
352sconf_yaws                 (#sconf{yaws                  = X}) -> X.
353sconf_ets                  (#sconf{ets                   = X}) -> X.
354sconf_ssl                  (#sconf{ssl                   = X}) -> X.
355sconf_authdirs             (#sconf{authdirs              = X}) -> X.
356sconf_partial_post_size    (#sconf{partial_post_size     = X}) -> X.
357sconf_appmods              (#sconf{appmods               = X}) -> X.
358sconf_expires              (#sconf{expires               = X}) -> X.
359sconf_errormod_401         (#sconf{errormod_401          = X}) -> X.
360sconf_errormod_404         (#sconf{errormod_404          = X}) -> X.
361sconf_arg_rewrite_mode     (#sconf{arg_rewrite_mod       = X}) -> X.
362sconf_logger_mod           (#sconf{logger_mod            = X}) -> X.
363sconf_opaque               (#sconf{opaque                = X}) -> X.
364sconf_start_mod            (#sconf{start_mod             = X}) -> X.
365sconf_allowed_scripts      (#sconf{allowed_scripts       = X}) -> X.
366sconf_tilde_allowed_scripts(#sconf{tilde_allowed_scripts = X}) -> X.
367sconf_index_files          (#sconf{index_files           = X}) -> X.
368sconf_revproxy             (#sconf{revproxy              = X}) -> X.
369sconf_spotions             (#sconf{soptions              = X}) -> X.
370sconf_extra_cgi_vars       (#sconf{extra_cgi_vars        = X}) -> X.
371sconf_stats                (#sconf{stats                 = X}) -> X.
372sconf_fcgi_app_server      (#sconf{fcgi_app_server       = X}) -> X.
373sconf_php_handler          (#sconf{php_handler           = X}) -> X.
374sconf_shaper               (#sconf{shaper                = X}) -> X.
375sconf_deflate_options      (#sconf{deflate_options       = X}) -> X.
376sconf_mime_types_info      (#sconf{mime_types_info       = X}) -> X.
377sconf_dispatch_mod         (#sconf{dispatch_mod          = X}) -> X.
378
379%% Setters
380sconf_port                 (S, X) -> S#sconf{port                  = X}.
381sconf_flags                (S, X) -> S#sconf{flags                 = X}.
382sconf_redirect_map         (S, X) -> S#sconf{redirect_map          = X}.
383sconf_rhost                (S, X) -> S#sconf{rhost                 = X}.
384sconf_rmethod              (S, X) -> S#sconf{rmethod               = X}.
385sconf_docroot              (S, X) -> S#sconf{docroot               = X}.
386sconf_xtra_docroots        (S, X) -> S#sconf{xtra_docroots         = X}.
387sconf_listen               (S, X) -> S#sconf{listen                = X}.
388sconf_servername           (S, X) -> S#sconf{servername            = X}.
389sconf_serveralias          (S, X) -> S#sconf{serveralias           = X}.
390sconf_yaws                 (S, X) -> S#sconf{yaws                  = X}.
391sconf_ets                  (S, X) -> S#sconf{ets                   = X}.
392sconf_ssl                  (S, X) -> S#sconf{ssl                   = X}.
393sconf_authdirs             (S, X) -> S#sconf{authdirs              = X}.
394sconf_partial_post_size    (S, X) -> S#sconf{partial_post_size     = X}.
395sconf_appmods              (S, X) -> S#sconf{appmods               = X}.
396sconf_expires              (S, X) -> S#sconf{expires               = X}.
397sconf_errormod_401         (S, X) -> S#sconf{errormod_401          = X}.
398sconf_errormod_404         (S, X) -> S#sconf{errormod_404          = X}.
399sconf_arg_rewrite_mode     (S, X) -> S#sconf{arg_rewrite_mod       = X}.
400sconf_logger_mod           (S, X) -> S#sconf{logger_mod            = X}.
401sconf_opaque               (S, X) -> S#sconf{opaque                = X}.
402sconf_start_mod            (S, X) -> S#sconf{start_mod             = X}.
403sconf_allowed_scripts      (S, X) -> S#sconf{allowed_scripts       = X}.
404sconf_tilde_allowed_scripts(S, X) -> S#sconf{tilde_allowed_scripts = X}.
405sconf_index_files          (S, X) -> S#sconf{index_files           = X}.
406sconf_revproxy             (S, X) -> S#sconf{revproxy              = X}.
407sconf_spotions             (S, X) -> S#sconf{soptions              = X}.
408sconf_extra_cgi_vars       (S, X) -> S#sconf{extra_cgi_vars        = X}.
409sconf_stats                (S, X) -> S#sconf{stats                 = X}.
410sconf_fcgi_app_server      (S, X) -> S#sconf{fcgi_app_server       = X}.
411sconf_php_handler          (S, X) -> S#sconf{php_handler           = X}.
412sconf_shaper               (S, X) -> S#sconf{shaper                = X}.
413sconf_deflate_options      (S, X) -> S#sconf{deflate_options       = X}.
414sconf_mime_types_info      (S, X) -> S#sconf{mime_types_info       = X}.
415sconf_dispatch_mod         (S, X) -> S#sconf{dispatch_mod          = X}.
416
417
418%% Access functions for the AUTH record.
419new_auth() -> #auth{}.
420
421auth_dir    (#auth{dir     = X}) -> X.
422auth_docroot(#auth{docroot = X}) -> X.
423auth_files  (#auth{files   = X}) -> X.
424auth_realm  (#auth{realm   = X}) -> X.
425auth_type   (#auth{type    = X}) -> X.
426auth_headers(#auth{headers = X}) -> X.
427auth_users  (#auth{users   = X}) -> X.
428auth_acl    (#auth{acl     = X}) -> X.
429auth_mod    (#auth{mod     = X}) -> X.
430auth_outmod (#auth{outmod  = X}) -> X.
431auth_pam    (#auth{pam     = X}) -> X.
432
433auth_dir    (A, Dir)     -> A#auth{dir     = Dir}.
434auth_docroot(A, DocRoot) -> A#auth{docroot = DocRoot}.
435auth_files  (A, Files)   -> A#auth{files   = Files}.
436auth_realm  (A, Realm)   -> A#auth{realm   = Realm}.
437auth_type   (A, Type)    -> A#auth{type    = Type}.
438auth_headers(A, Headers) -> A#auth{headers = Headers}.
439auth_users  (A, Users)   -> A#auth{users   = Users}.
440auth_acl    (A, Acl)     -> A#auth{acl     = Acl}.
441auth_mod    (A, Mod)     -> A#auth{mod     = Mod}.
442auth_outmod (A, Outmod)  -> A#auth{outmod  = Outmod}.
443auth_pam    (A, Pam)     -> A#auth{pam     = Pam}.
444
445
446setup_authdirs(SL, DefaultAuthDirs) ->
447    case [A || {auth, A} <- SL] of
448        [] -> DefaultAuthDirs;
449        As -> [setup_auth(A) || A <- As]
450    end.
451
452setup_auth(#auth{}=Auth) ->
453    Auth;
454setup_auth(AuthProps) ->
455    Auth = #auth{},
456    #auth{dir     = lkup(dir,     AuthProps, Auth#auth.dir),
457          docroot = lkup(docroot, AuthProps, Auth#auth.docroot),
458          files   = lkup(files,   AuthProps, Auth#auth.files),
459          realm   = lkup(realm,   AuthProps, Auth#auth.realm),
460          type    = lkup(type,    AuthProps, Auth#auth.type),
461          headers = lkup(headers, AuthProps, Auth#auth.headers),
462          users   = lkup(users,   AuthProps, Auth#auth.users),
463          acl     = lkup(acl,     AuthProps, Auth#auth.acl),
464          mod     = lkup(mod,     AuthProps, Auth#auth.mod),
465          outmod  = lkup(outmod,  AuthProps, Auth#auth.outmod),
466          pam     = lkup(pam,     AuthProps, Auth#auth.pam)}.
467
468
469%% Access functions for the SSL record.
470new_ssl() -> #ssl{}.
471
472ssl_keyfile             (#ssl{keyfile              = X}) -> X.
473ssl_certfile            (#ssl{certfile             = X}) -> X.
474ssl_verify              (#ssl{verify               = X}) -> X.
475ssl_fail_if_no_peer_cert(#ssl{fail_if_no_peer_cert = X}) -> X.
476ssl_depth               (#ssl{depth                = X}) -> X.
477ssl_password            (#ssl{password             = X}) -> X.
478ssl_cacertfile          (#ssl{cacertfile           = X}) -> X.
479ssl_dhfile              (#ssl{dhfile               = X}) -> X.
480ssl_ciphers             (#ssl{ciphers              = X}) -> X.
481ssl_cachetimeout        (#ssl{cachetimeout         = X}) -> X.
482ssl_secure_renegotiate  (#ssl{secure_renegotiate   = X}) -> X.
483ssl_client_renegotiation(#ssl{client_renegotiation = X}) -> X.
484ssl_protocol_version    (#ssl{protocol_version     = X}) -> X.
485ssl_honor_cipher_order  (#ssl{honor_cipher_order   = X}) -> X.
486ssl_require_sni         (#ssl{require_sni          = X}) -> X.
487
488ssl_keyfile             (S, File)    -> S#ssl{keyfile              = File}.
489ssl_certfile            (S, File)    -> S#ssl{certfile             = File}.
490ssl_verify              (S, Verify)  -> S#ssl{verify               = Verify}.
491ssl_fail_if_no_peer_cert(S, Bool)    -> S#ssl{fail_if_no_peer_cert = Bool}.
492ssl_depth               (S, Depth)   -> S#ssl{depth                = Depth}.
493ssl_password            (S, Pass)    -> S#ssl{password             = Pass}.
494ssl_cacertfile          (S, File)    -> S#ssl{cacertfile           = File}.
495ssl_dhfile              (S, File)    -> S#ssl{dhfile               = File}.
496ssl_ciphers             (S, Ciphers) -> S#ssl{ciphers              = Ciphers}.
497ssl_cachetimeout        (S, Timeout) -> S#ssl{cachetimeout         = Timeout}.
498ssl_secure_renegotiate  (S, Bool)    -> S#ssl{secure_renegotiate   = Bool}.
499ssl_protocol_version    (S, Vsns)    -> S#ssl{protocol_version     = Vsns}.
500ssl_require_sni         (S, Bool)    -> S#ssl{require_sni          = Bool}.
501ssl_honor_cipher_order  (S, Bool) ->
502    case yaws_dynopts:have_ssl_honor_cipher_order() of
503        true  -> S#ssl{honor_cipher_order   = Bool};
504        false -> S
505    end.
506ssl_client_renegotiation(S, Bool) ->
507    case yaws_dynopts:have_ssl_client_renegotiation() of
508        true  -> S#ssl{client_renegotiation = Bool};
509        false -> S
510    end.
511
512setup_ssl(SL, DefaultSSL) ->
513    case lkup(ssl, SL, undefined) of
514        undefined ->
515            DefaultSSL;
516        SSL when is_record(SSL, ssl) ->
517            SSL;
518        SSLProps when is_list(SSLProps) ->
519            SSL = #ssl{},
520            #ssl{keyfile              = lkup(keyfile, SSLProps,
521                                             SSL#ssl.keyfile),
522                 certfile             = lkup(certfile, SSLProps,
523                                             SSL#ssl.certfile),
524                 verify               = lkup(verify, SSLProps, SSL#ssl.verify),
525                 fail_if_no_peer_cert = lkup(fail_if_no_peer_cert, SSLProps,
526                                             SSL#ssl.fail_if_no_peer_cert),
527                 depth                = lkup(depth, SSLProps, SSL#ssl.depth),
528                 password             = lkup(password, SSLProps,
529                                             SSL#ssl.password),
530                 cacertfile           = lkup(cacertfile, SSLProps,
531                                             SSL#ssl.cacertfile),
532                 dhfile               = lkup(dhfile, SSLProps,
533                                             SSL#ssl.dhfile),
534                 ciphers              = lkup(ciphers, SSLProps,
535                                             SSL#ssl.ciphers),
536                 cachetimeout         = lkup(cachetimeout, SSLProps,
537                                             SSL#ssl.cachetimeout),
538                 secure_renegotiate   = lkup(secure_renegotiate, SSLProps,
539                                             SSL#ssl.secure_renegotiate),
540                 client_renegotiation = lkup(client_renegotiation, SSLProps,
541                                             SSL#ssl.client_renegotiation),
542                 honor_cipher_order   = lkup(honor_cipher_order, SSLProps,
543                                             SSL#ssl.honor_cipher_order),
544                 protocol_version     = lkup(protocol_version, SSLProps,
545                                             undefined),
546                 require_sni          = lkup(require_sni, SSLProps,
547                                             SSL#ssl.require_sni)}
548    end.
549
550
551%% Access functions for the DEFLATE record.
552new_deflate() -> #deflate{}.
553
554deflate_min_compress_size(#deflate{min_compress_size = X}) -> X.
555deflate_compression_level(#deflate{compression_level = X}) -> X.
556deflate_window_size      (#deflate{window_size       = X}) -> X.
557deflate_mem_level        (#deflate{mem_level         = X}) -> X.
558deflate_strategy         (#deflate{strategy          = X}) -> X.
559deflate_use_gzip_static  (#deflate{use_gzip_static   = X}) -> X.
560deflate_mime_types       (#deflate{mime_types        = X}) -> X.
561
562deflate_min_compress_size(D, Min)   -> D#deflate{min_compress_size = Min}.
563deflate_compression_level(D, Level) -> D#deflate{compression_level = Level}.
564deflate_window_size      (D, Size)  -> D#deflate{window_size       = Size}.
565deflate_mem_level        (D, Level) -> D#deflate{mem_level         = Level}.
566deflate_strategy         (D, Strat) -> D#deflate{strategy          = Strat}.
567deflate_use_gzip_static  (D, Bool)  -> D#deflate{use_gzip_static   = Bool}.
568deflate_mime_types       (D, Types) -> D#deflate{mime_types        = Types}.
569
570
571setup_deflate(SL, DefaultDeflate) ->
572    case lkup(deflate_options, SL, undefined) of
573        undefined ->
574            DefaultDeflate;
575        D when is_record(D, deflate) ->
576            D;
577        DProps when is_list(DProps) ->
578            D = #deflate{},
579            #deflate{min_compress_size = lkup(min_compress_size, DProps,
580                                              D#deflate.min_compress_size),
581                     compression_level = lkup(compression_level, DProps,
582                                              D#deflate.compression_level),
583                     window_size       = lkup(window_size, DProps,
584                                              D#deflate.window_size),
585                     mem_level         = lkup(mem_level, DProps,
586                                              D#deflate.mem_level),
587                     strategy          = lkup(strategy, DProps,
588                                              D#deflate.strategy),
589                     use_gzip_static   = lkup(use_gzip_static, DProps,
590                                              D#deflate.use_gzip_static),
591                     mime_types        = lkup(mime_types, DProps,
592                                              D#deflate.mime_types)}
593    end.
594
595%% Access functions to MIME_TYPES_INFO record.
596new_mime_types_info() -> #mime_types_info{}.
597
598mime_types_info_mime_types_file(#mime_types_info{mime_types_file = X}) -> X.
599mime_types_info_types          (#mime_types_info{types           = X}) -> X.
600mime_types_info_charsets       (#mime_types_info{charsets        = X}) -> X.
601mime_types_info_default_type   (#mime_types_info{default_type    = X}) -> X.
602mime_types_info_default_charset(#mime_types_info{default_charset = X}) -> X.
603
604mime_types_info_mime_types_file(M, File) ->
605    M#mime_types_info{mime_types_file = File}.
606mime_types_info_types(M, Types) ->
607    M#mime_types_info{types = Types}.
608mime_types_info_charsets(M, Charsets) ->
609    M#mime_types_info{charsets = Charsets}.
610mime_types_info_default_type(M, Type) ->
611    M#mime_types_info{default_type = Type}.
612mime_types_info_default_charset(M, Charset) ->
613    M#mime_types_info{default_charset = Charset}.
614
615
616setup_mime_types_info(SL, DefaultMTI) ->
617    case lkup(mime_types_info, SL, undefined) of
618        undefined ->
619            DefaultMTI;
620        M when is_record(M, mime_types_info) ->
621            M;
622        MProps when is_list(MProps) ->
623            M = #mime_types_info{},
624            #mime_types_info{mime_types_file =
625                                 lkup(mime_types_file, MProps,
626                                      M#mime_types_info.mime_types_file),
627                             types           = lkup(types, MProps,
628                                                    M#mime_types_info.types),
629                             charsets        = lkup(charsets, MProps,
630                                                    M#mime_types_info.charsets),
631                             default_type    =
632                                 lkup(default_type, MProps,
633                                      M#mime_types_info.default_type),
634                             default_charset =
635                                 lkup(default_charset, MProps,
636                                      M#mime_types_info.default_charset)}
637    end.
638
639
640%% Setup global configuration
641setup_gconf([], GC) -> GC;
642setup_gconf(GL, GC) ->
643    #gconf{yaws_dir              = lkup(yaws_dir, GL, GC#gconf.yaws_dir),
644           trace                 = lkup(trace, GL, GC#gconf.trace),
645           flags                 = set_gc_flags(lkup(flags, GL, []),
646                                                GC#gconf.flags),
647           logdir                = lkup(logdir, GL, GC#gconf.logdir),
648           ebin_dir              = lkup(ebin_dir, GL, GC#gconf.ebin_dir),
649           src_dir               = lkup(src_dir, GL, GC#gconf.src_dir),
650           runmods               = lkup(runmods, GL, GC#gconf.runmods),
651           keepalive_timeout     = lkup(keepalive_timeout, GL,
652                                        GC#gconf.keepalive_timeout),
653           keepalive_maxuses     = lkup(keepalive_maxuses, GL,
654                                        GC#gconf.keepalive_maxuses),
655           max_num_cached_files  = lkup(max_num_cached_files, GL,
656                                        GC#gconf.max_num_cached_files),
657           max_num_cached_bytes  = lkup(max_num_cached_bytes, GL,
658                                        GC#gconf.max_num_cached_bytes),
659           max_size_cached_file  = lkup(max_size_cached_file, GL,
660                                        GC#gconf.max_size_cached_file),
661           max_connections       = lkup(max_connections, GL,
662                                        GC#gconf.max_connections),
663           process_options       = lkup(process_options, GL,
664                                        GC#gconf.process_options),
665           large_file_chunk_size = lkup(large_file_chunk_size, GL,
666                                        GC#gconf.large_file_chunk_size),
667           mnesia_dir            = lkup(mnesia_dir, GL, GC#gconf.mnesia_dir),
668           log_wrap_size         = lkup(log_wrap_size, GL,
669                                        GC#gconf.log_wrap_size),
670           cache_refresh_secs    = lkup(cache_refresh_secs, GL,
671                                        GC#gconf.cache_refresh_secs),
672           include_dir           = lkup(include_dir, GL, GC#gconf.include_dir),
673           phpexe                = lkup(phpexe, GL, GC#gconf.phpexe),
674           yaws                  = lkup(yaws, GL, GC#gconf.yaws),
675           id                    = lkup(id, GL, GC#gconf.id),
676           enable_soap           = lkup(enable_soap, GL, GC#gconf.enable_soap),
677           soap_srv_mods         = lkup(soap_srv_mods, GL,
678                                        GC#gconf.soap_srv_mods),
679           acceptor_pool_size    = lkup(acceptor_pool_size, GL,
680                                        GC#gconf.acceptor_pool_size),
681           mime_types_info       = setup_mime_types_info(
682                                     GL, GC#gconf.mime_types_info
683                                    ),
684           nslookup_pref         = lkup(nslookup_pref, GL,
685                                        GC#gconf.nslookup_pref),
686           ysession_mod          = lkup(ysession_mod, GL,
687                                        GC#gconf.ysession_mod),
688           ysession_cookiegen    = lkup(ysession_cookiegen, GL,
689                                        GC#gconf.ysession_cookiegen),
690           ysession_idle_timeout = lkup(ysession_idle_timeout, GL,
691                                        GC#gconf.ysession_idle_timeout),
692           ysession_long_timeout = lkup(ysession_long_timeout, GL,
693                                        GC#gconf.ysession_long_timeout),
694           sni                   = lkup(sni, GL, GC#gconf.sni)
695          }.
696
697set_gc_flags([{tty_trace, Bool}|T], Flags) ->
698    set_gc_flags(T, flag(Flags,?GC_TTY_TRACE, Bool));
699set_gc_flags([{debug, Bool}|T], Flags) ->
700    set_gc_flags(T, flag(Flags, ?GC_DEBUG, Bool));
701set_gc_flags([{copy_errlog, Bool}|T], Flags) ->
702    set_gc_flags(T, flag(Flags, ?GC_COPY_ERRLOG, Bool));
703set_gc_flags([{copy_error_log, Bool}|T], Flags) ->
704    set_gc_flags(T, flag(Flags, ?GC_COPY_ERRLOG, Bool));
705set_gc_flags([{backwards_compat_parse, Bool}|T], Flags) ->
706    set_gc_flags(T, flag(Flags, ?GC_BACKWARDS_COMPAT_PARSE, Bool));
707set_gc_flags([{log_resolve_hostname, Bool}|T], Flags) ->
708    set_gc_flags(T, flag(Flags, ?GC_LOG_RESOLVE_HOSTNAME, Bool));
709set_gc_flags([{fail_on_bind_err, Bool}|T], Flags) ->
710    set_gc_flags(T, flag(Flags,?GC_FAIL_ON_BIND_ERR,Bool));
711set_gc_flags([{pick_first_virthost_on_nomatch, Bool}|T], Flags) ->
712    set_gc_flags(T, flag(Flags, ?GC_PICK_FIRST_VIRTHOST_ON_NOMATCH,Bool));
713set_gc_flags([{use_erlang_sendfile, Bool}|T], Flags) ->
714    set_gc_flags(T, flag(Flags,?GC_USE_ERLANG_SENDFILE,Bool));
715set_gc_flags([{use_yaws_sendfile, Bool}|T], Flags) ->
716    set_gc_flags(T, flag(Flags,?GC_USE_YAWS_SENDFILE,Bool));
717set_gc_flags([_|T], Flags) ->
718    set_gc_flags(T, Flags);
719set_gc_flags([], Flags) ->
720    Flags.
721
722
723%% Setup vhost configuration
724setup_sconf(SL, SC) ->
725    #sconf{port                  = lkup(port, SL, SC#sconf.port),
726           flags                 = set_sc_flags(lkup(flags, SL, []),
727                                                SC#sconf.flags),
728           redirect_map          = lkup(redirect_map, SL,
729                                        SC#sconf.redirect_map),
730           rhost                 = lkup(rhost, SL, SC#sconf.rhost),
731           rmethod               = lkup(rmethod, SL, SC#sconf.rmethod),
732           docroot               = lkup(docroot, SL, SC#sconf.docroot),
733           xtra_docroots         = lkup(xtra_docroots, SL,
734                                        SC#sconf.xtra_docroots),
735           listen                = lkup(listen, SL, SC#sconf.listen),
736           servername            = lkup(servername, SL, SC#sconf.servername),
737           serveralias           = lkup(serveralias, SL, SC#sconf.serveralias),
738           yaws                  = lkup(yaws, SL, SC#sconf.yaws),
739           ets                   = lkup(ets, SL, SC#sconf.ets),
740           ssl                   = setup_ssl(SL, SC#sconf.ssl),
741           authdirs              = setup_authdirs(SL, SC#sconf.authdirs),
742           partial_post_size     = lkup(partial_post_size, SL,
743                                        SC#sconf.partial_post_size),
744           appmods               = lkup(appmods, SL, SC#sconf.appmods),
745           expires               = lkup(expires, SL, SC#sconf.expires),
746           errormod_401          = lkup(errormod_401, SL,
747                                        SC#sconf.errormod_401),
748           errormod_404          = lkup(errormod_404, SL,
749                                        SC#sconf.errormod_404),
750           errormod_crash        = lkup(errormod_crash, SL,
751                                        SC#sconf.errormod_crash),
752           arg_rewrite_mod       = lkup(arg_rewrite_mod, SL,
753                                        SC#sconf.arg_rewrite_mod),
754           logger_mod            = lkup(logger_mod, SL, SC#sconf.logger_mod),
755           opaque                = lkup(opaque, SL, SC#sconf.opaque),
756           start_mod             = lkup(start_mod, SL, SC#sconf.start_mod),
757           allowed_scripts       = lkup(allowed_scripts, SL,
758                                        SC#sconf.allowed_scripts),
759           tilde_allowed_scripts = lkup(tilde_allowed_scripts, SL,
760                                        SC#sconf.tilde_allowed_scripts),
761           index_files           = lkup(index_files, SL, SC#sconf.index_files),
762           revproxy              = lkup(revproxy, SL, SC#sconf.revproxy),
763           soptions              = lkup(soptions, SL, SC#sconf.soptions),
764           extra_cgi_vars        = lkup(extra_cgi_vars, SL,
765                                        SC#sconf.extra_cgi_vars),
766           stats                 = lkup(stats, SL, SC#sconf.stats),
767           fcgi_app_server       = lkup(fcgi_app_server, SL,
768                                        SC#sconf.fcgi_app_server),
769           php_handler           = lkup(php_handler, SL, SC#sconf.php_handler),
770           shaper                = lkup(shaper, SL, SC#sconf.shaper),
771           deflate_options       = setup_deflate(SL, SC#sconf.deflate_options),
772           mime_types_info       = setup_mime_types_info(
773                                     SL, SC#sconf.mime_types_info
774                                    ),
775           dispatch_mod          = lkup(dispatchmod, SL, SC#sconf.dispatch_mod)
776          }.
777
778set_sc_flags([{access_log, Bool}|T], Flags) ->
779    set_sc_flags(T, flag(Flags, ?SC_ACCESS_LOG, Bool));
780set_sc_flags([{auth_log, Bool}|T], Flags) ->
781    set_sc_flags(T, flag(Flags, ?SC_AUTH_LOG, Bool));
782set_sc_flags([{add_port, Bool}|T], Flags) ->
783    set_sc_flags(T, flag(Flags, ?SC_ADD_PORT, Bool));
784set_sc_flags([{statistics, Bool}|T], Flags) ->
785    set_sc_flags(T, flag(Flags, ?SC_STATISTICS, Bool));
786set_sc_flags([{tilde_expand, Bool}|T], Flags) ->
787    set_sc_flags(T, flag(Flags, ?SC_TILDE_EXPAND, Bool));
788set_sc_flags([{dir_listings, Bool}|T], Flags) ->
789    set_sc_flags(T, flag(Flags, ?SC_DIR_LISTINGS, Bool));
790set_sc_flags([{deflate, Bool}|T], Flags) ->
791    set_sc_flags(T, flag(Flags, ?SC_DEFLATE, Bool));
792set_sc_flags([{dir_all_zip, Bool}|T], Flags) ->
793    set_sc_flags(T, flag(Flags, ?SC_DIR_ALL_ZIP, Bool));
794set_sc_flags([{dav, Bool}|T], Flags) ->
795    set_sc_flags(T, flag(Flags, ?SC_DAV, Bool));
796set_sc_flags([{fcgi_trace_protocol, Bool}|T], Flags) ->
797    set_sc_flags(T, flag(Flags, ?SC_FCGI_TRACE_PROTOCOL, Bool));
798set_sc_flags([{fcgi_log_app_error, Bool}|T], Flags) ->
799    set_sc_flags(T, flag(Flags, ?SC_FCGI_LOG_APP_ERROR, Bool));
800set_sc_flags([{forward_proxy, Bool}|T], Flags) ->
801    set_sc_flags(T, flag(Flags, ?SC_FORWARD_PROXY, Bool));
802set_sc_flags([{auth_skip_docroot, Bool}|T], Flags) ->
803    set_sc_flags(T, flag(Flags, ?SC_AUTH_SKIP_DOCROOT, Bool));
804set_sc_flags([_Unknown|T], Flags) ->
805    error_logger:format("Unknown and unhandled flag ~p~n", [_Unknown]),
806    set_sc_flags(T, Flags);
807set_sc_flags([], Flags) ->
808    Flags.
809
810lkup(Key, List, Def) ->
811    case lists:keyfind(Key, 1, List) of
812        {_,Value} -> Value;
813        _         -> Def
814    end.
815
816
817
818hup() ->
819    dohup(undefined).
820
821hup(Sock) ->
822    spawn(fun() ->
823                  group_leader(whereis(user), self()),
824                  dohup(Sock)
825          end).
826
827dohup(Sock) ->
828    Env = yaws_sup:get_app_args(),
829    Res = try yaws_config:load(Env) of
830              {ok, Gconf, Sconfs} -> yaws_api:setconf(Gconf, Sconfs);
831              Err                 -> Err
832          catch
833              _:X ->
834                  X
835          end,
836    gen_event:notify(yaws_event_manager, {yaws_hupped, Res}),
837    yaws_log:rotate(Res),
838    case Sock of
839        undefined ->
840            {yaws_hupped, Res};
841        _  ->
842            gen_tcp:send(Sock, io_lib:format("hupped: ~p~n", [Res])),
843            gen_tcp:close(Sock)
844    end.
845
846
847
848%%% misc funcs
849first(_F, []) ->
850    false;
851first(F, [H|T]) ->
852    case F(H) of
853        {ok, Val} -> {ok, Val, H};
854        ok        -> {ok, ok, H};
855        _         -> first(F, T)
856    end.
857
858
859elog(F, As) ->
860    error_logger:format(F, As).
861
862
863filesize(Fname) ->
864    case file:read_file_info(Fname) of
865        {ok, FI} when FI#file_info.type == regular ->
866            {ok, FI#file_info.size};
867        {ok, FI} ->
868            {error,  FI#file_info.type};
869        Err ->
870            Err
871    end.
872
873
874upto(_I, [])    -> [];
875upto(0,  _)     -> " ....";
876upto(_I, [0|_]) -> " ....";
877upto(I,  [H|T]) -> [H|upto(I-1, T)].
878
879
880to_string(X) when is_float(X)   -> io_lib:format("~.2.0f",[X]);
881to_string(X) when is_integer(X) -> erlang:integer_to_list(X);
882to_string(X) when is_atom(X)    -> atom_to_list(X);
883to_string(X)                    -> lists:concat([X]).
884
885
886to_list(L) when is_list(L) -> L;
887to_list(A) when is_atom(A) -> atom_to_list(A).
888
889
890integer_to_hex(I) ->
891    case catch erlang:integer_to_list(I, 16) of
892        {'EXIT', _} -> old_integer_to_hex(I);
893        Int         -> Int
894    end.
895
896
897old_integer_to_hex(I) when I < 10 ->
898    integer_to_list(I);
899old_integer_to_hex(I) when I < 16 ->
900    [I-10+$A];
901old_integer_to_hex(I) when I >= 16 ->
902    N = trunc(I/16),
903    old_integer_to_hex(N) ++ old_integer_to_hex(I rem 16).
904
905
906hex_to_integer(Hex) ->
907    erlang:list_to_integer(Hex, 16).
908
909
910string_to_hex(String) ->
911    HEXC = fun (D) when D > 9 -> $a + D - 10;
912               (D)            -> $0 + D
913           end,
914    lists:foldr(fun(E, Acc) -> [HEXC(E div 16),HEXC(E rem 16)|Acc] end,
915                [], String).
916
917
918hex_to_string(Hex) ->
919    DEHEX = fun (H) when H >= $a -> H - $a + 10;
920                (H) when H >= $A -> H - $A + 10;
921                (H) ->              H - $0
922            end,
923    {String, _} =
924        lists:foldr(fun (E, {Acc, nolow}) -> {Acc, DEHEX(E)};
925                        (E, {Acc, LO})    -> {[DEHEX(E)*16+LO|Acc], nolow}
926                    end, {[], nolow}, Hex),
927    String.
928
929
930
931universal_time_as_string() ->
932    universal_time_as_string(calendar:universal_time()).
933universal_time_as_string(UTime) ->
934    time_to_string(UTime, "GMT").
935local_time_as_gmt_string(LocalTime) ->
936    time_to_string(erlang:localtime_to_universaltime(LocalTime), "GMT").
937
938
939time_to_string({{Year, Month, Day}, {Hour, Min, Sec}}, Zone) ->
940    [day(Year, Month, Day), ", ",
941     mk2(Day), " ", month(Month), " ", erlang:integer_to_list(Year), " ",
942     mk2(Hour), ":", mk2(Min), ":", mk2(Sec), " ", Zone].
943
944mk2(I) when I < 10 -> [$0 | erlang:integer_to_list(I)];
945mk2(I)             -> erlang:integer_to_list(I).
946
947day(Year, Month, Day) ->
948    int_to_wd(calendar:day_of_the_week(Year, Month, Day)).
949
950int_to_wd(1) -> "Mon";
951int_to_wd(2) -> "Tue";
952int_to_wd(3) -> "Wed";
953int_to_wd(4) -> "Thu";
954int_to_wd(5) -> "Fri";
955int_to_wd(6) -> "Sat";
956int_to_wd(7) -> "Sun".
957
958month(1)  -> "Jan";
959month(2)  -> "Feb";
960month(3)  -> "Mar";
961month(4)  -> "Apr";
962month(5)  -> "May";
963month(6)  -> "Jun";
964month(7)  -> "Jul";
965month(8)  -> "Aug";
966month(9)  -> "Sep";
967month(10) -> "Oct";
968month(11) -> "Nov";
969month(12) -> "Dec".
970
971month_str_to_int("Jan") -> 1;
972month_str_to_int("Feb") -> 2;
973month_str_to_int("Mar") -> 3;
974month_str_to_int("Apr") -> 4;
975month_str_to_int("May") -> 5;
976month_str_to_int("Jun") -> 6;
977month_str_to_int("Jul") -> 7;
978month_str_to_int("Aug") -> 8;
979month_str_to_int("Sep") -> 9;
980month_str_to_int("Oct") -> 10;
981month_str_to_int("Nov") -> 11;
982month_str_to_int("Dec") -> 12.
983
984
985stringdate_to_datetime([$ |T]) ->
986    stringdate_to_datetime(T);
987stringdate_to_datetime([_D1, _D2, _D3, $\,, $ |Tail]) ->
988    stringdate_to_datetime1(Tail).
989
990stringdate_to_datetime1([A, B, $\s |T]) ->
991    stringdate_to_datetime2(T, erlang:list_to_integer([A,B]));
992stringdate_to_datetime1([A, $\s |T]) ->
993    stringdate_to_datetime2(T, erlang:list_to_integer([A])).
994
995stringdate_to_datetime2([M1, M2, M3, $\s , Y1, Y2, Y3, Y4, $\s,
996                         H1, H2, $:, Min1, Min2,$:,
997                         S1, S2,$\s ,$G, $M, $T|_], Day) ->
998    {{erlang:list_to_integer([Y1,Y2,Y3,Y4]),
999      month_str_to_int([M1, M2, M3]), Day},
1000     {erlang:list_to_integer([H1, H2]),
1001      erlang:list_to_integer([Min1, Min2]),
1002      erlang:list_to_integer([S1, S2])}}.
1003
1004
1005%% used by If-Modified-Since header code
1006is_modified_p(FI, UTC_string) ->
1007    case catch stringdate_to_datetime(UTC_string) of
1008        {'EXIT', _ } ->
1009            true;
1010        UTC ->
1011            MtimeUTC = erlang:localtime_to_universaltime(FI#file_info.mtime),
1012            (MtimeUTC > UTC)
1013    end.
1014
1015
1016ticker(Time, Msg) ->
1017    ticker(Time, self(), Msg).
1018ticker(Time, To, Msg ) ->
1019    spawn_link(fun() ->
1020                       process_flag(trap_exit, true),
1021                       yaws_ticker:ticker(Time, To, Msg)
1022               end).
1023
1024
1025address() ->
1026    Sc = get(sc),
1027    ?F("<address> ~s Server at ~s </address>",
1028       [case Sc#sconf.yaws of
1029            undefined -> (get(gc))#gconf.yaws;
1030            Signature -> Signature
1031        end, Sc#sconf.servername]).
1032
1033
1034is_space($\s) -> true;
1035is_space($\r) -> true;
1036is_space($\n) -> true;
1037is_space($\t) -> true;
1038is_space(_)   -> false.
1039
1040
1041strip_spaces(String) ->
1042    strip_spaces(String, both).
1043
1044strip_spaces(String, left) ->
1045    drop_spaces(String);
1046strip_spaces(String, right) ->
1047    lists:reverse(drop_spaces(lists:reverse(String)));
1048strip_spaces(String, both) ->
1049    strip_spaces(drop_spaces(String), right).
1050
1051drop_spaces([]) ->
1052    [];
1053drop_spaces(YS=[X|XS]) ->
1054    case is_space(X) of
1055        true  -> drop_spaces(XS);
1056        false -> YS
1057    end.
1058
1059
1060%%% basic uuencode and decode functionality
1061list_to_uue(L) -> list_to_uue(L, []).
1062
1063list_to_uue([], Out) ->
1064    lists:reverse([$\n,enc(0)|Out]);
1065list_to_uue(L, Out) ->
1066    {L45, L1} = get_45(L),
1067    Encoded = encode_line(L45),
1068    list_to_uue(L1, lists:reverse(Encoded, Out)).
1069
1070uue_to_list(L) ->
1071    uue_to_list(L, []).
1072
1073uue_to_list([], Out) ->
1074    lists:reverse(Out);
1075uue_to_list(L, Out) ->
1076    {Decoded, L1} = decode_line(L),
1077    uue_to_list(L1, lists:reverse(Decoded, Out)).
1078
1079encode_line(L) ->
1080    [enc(length(L))|encode_line1(L)].
1081
1082encode_line1([C0, C1, C2|T]) ->
1083    Char1 = enc(C0 bsr 2),
1084    Char2 = enc((C0 bsl 4) band 8#60 bor (C1 bsr 4) band 8#17),
1085    Char3 = enc((C1 bsl 2) band 8#74 bor (C2 bsr 6) band 8#3),
1086    Char4 = enc(C2 band 8#77),
1087    [Char1,Char2,Char3,Char4|encode_line1(T)];
1088encode_line1([C1, C2]) ->
1089    encode_line1([C1, C2, 0]);
1090encode_line1([C]) ->
1091    encode_line1([C,0,0]);
1092encode_line1([]) ->
1093    [$\n].
1094
1095decode_line([H|T]) ->
1096    case dec(H) of
1097        0   -> {[], []};
1098        Len -> decode_line(T, Len, [])
1099    end.
1100
1101decode_line([P0,P1,P2,P3|T], N, Out) when N >= 3->
1102    Char1 = 16#FF band ((dec(P0) bsl 2) bor (dec(P1) bsr 4)),
1103    Char2 = 16#FF band ((dec(P1) bsl 4) bor (dec(P2) bsr 2)),
1104    Char3 = 16#FF band ((dec(P2) bsl 6) bor dec(P3)),
1105    decode_line(T, N-3, [Char3,Char2,Char1|Out]);
1106decode_line([P0,P1,P2,_|T], 2, Out) ->
1107    Char1  = 16#FF band ((dec(P0) bsl 2) bor (dec(P1) bsr 4)),
1108    Char2  = 16#FF band ((dec(P1) bsl 4) bor (dec(P2) bsr 2)),
1109    {lists:reverse([Char2,Char1|Out]), tl(T)};
1110decode_line([P0,P1,_,_|T], 1, Out) ->
1111    Char1  = 16#FF band ((dec(P0) bsl 2) bor (dec(P1) bsr 4)),
1112    {lists:reverse([Char1|Out]), tl(T)};
1113decode_line(T, 0, Out) ->
1114    {lists:reverse(Out), tl(T)}.
1115
1116get_45(L) -> get_45(L, 45, []).
1117
1118get_45(L, 0, F)     -> {lists:reverse(F), L};
1119get_45([], _N, L)   -> {lists:reverse(L), []};
1120get_45([H|T], N, L) -> get_45(T, N-1, [H|L]).
1121
1122
1123%% enc/1 is the basic 1 character encoding function to make a char printing
1124%% dec/1 is the inverse
1125enc(0) -> $`;
1126enc(C) -> (C band 8#77) + $ .
1127
1128dec(Char) -> (Char - $ ) band 8#77.
1129
1130
1131printversion() ->
1132    io:format("Yaws ~s~n", [yaws_generated:version()]),
1133    init:stop().
1134
1135%% our default arg rewriter does of course nothing
1136arg_rewrite(A) ->
1137    A.
1138
1139is_ssl(#sconf{ssl = undefined})                -> nossl;
1140is_ssl(#sconf{ssl = S}) when is_record(S, ssl) -> ssl.
1141
1142
1143to_lowerchar(C) when C >= $A, C =< $Z -> C+($a-$A);
1144to_lowerchar(C)                       -> C.
1145
1146to_lower([])                           -> [];
1147to_lower([C|Cs]) when C >= $A, C =< $Z -> [C+($a-$A)|to_lower(Cs)];
1148to_lower([C|Cs])                       -> [C|to_lower(Cs)];
1149to_lower(A) when is_atom(A)            -> to_lower(atom_to_list(A)).
1150
1151
1152funreverse(List, Fun) ->
1153    funreverse(List, Fun, []).
1154
1155funreverse([H|T], Fun, Ack) -> funreverse(T, Fun, [Fun(H)|Ack]);
1156funreverse([], _Fun, Ack)   -> Ack.
1157
1158%% is arg1 a prefix of arg2
1159is_prefix([H|T1], [H|T2]) -> is_prefix(T1, T2);
1160is_prefix([], T)          -> {true, T};
1161is_prefix(_,_)            -> false.
1162
1163
1164%% Split a string of words separated by Sep into a list of words and
1165%% strip off white space.
1166%%
1167%% HTML semantics are used, such that empty words are omitted.
1168split_sep(undefined, _Sep) ->
1169    [];
1170split_sep(L, Sep) ->
1171    case drop_spaces(L) of
1172        []      -> [];
1173        [Sep|T] -> split_sep(T, Sep);
1174        [C|T]   -> split_sep(T, Sep, [C], [])
1175    end.
1176
1177split_sep([], _Sep, AccL) ->
1178    lists:reverse(AccL);
1179split_sep([Sep|T], Sep, AccL) ->
1180    split_sep(T, Sep, AccL);
1181split_sep([C|T], Sep, AccL) ->
1182    split_sep(T, Sep, [C], AccL).
1183
1184split_sep([], _Sep, AccW, AccL) ->
1185    lists:reverse([lists:reverse(drop_spaces(AccW))|AccL]);
1186split_sep([Sep|Tail], Sep, AccW, AccL) ->
1187    split_sep(drop_spaces(Tail), Sep, [lists:reverse(drop_spaces(AccW))|AccL]);
1188split_sep([C|Tail], Sep, AccW, AccL) ->
1189    split_sep(Tail, Sep, [C|AccW], AccL).
1190
1191
1192%% Join strings with separator. Same as string:join in later
1193%% versions of Erlang. Separator is expected to be a list.
1194join_sep([], Sep) when is_list(Sep) ->
1195    [];
1196join_sep([H|T], Sep) ->
1197    H ++ lists:append([Sep ++ X || X <- T]).
1198
1199%% Provide a unique 3-tuple of positive integers.
1200unique_triple() -> yaws_dynopts:unique_triple().
1201
1202%% Get a current time 3-tuple.
1203get_time_tuple() -> yaws_dynopts:get_time_tuple().
1204
1205%% header parsing
1206parse_qval(S) ->
1207    parse_qval([], S).
1208
1209parse_qval(A, ";q="++Q) -> {lists:reverse(A), parse_qvalue(Q)};
1210parse_qval(A, "")       -> {lists:reverse(A), 1000};
1211parse_qval(A, [C|T])    -> parse_qval([C|A], T).
1212
1213parse_qvalue("0")              -> 0;
1214parse_qvalue("0.")             -> 0;
1215parse_qvalue("1")              -> 1000;
1216parse_qvalue("1.")             -> 1000;
1217parse_qvalue("1.0")            -> 1000;
1218parse_qvalue("1.00")           -> 1000;
1219parse_qvalue("1.000")          -> 1000;
1220parse_qvalue("0."++[D1])       -> three_digits_to_integer(D1,$0,$0);
1221parse_qvalue("0."++[D1,D2])    -> three_digits_to_integer(D1,D2,$0);
1222parse_qvalue("0."++[D1,D2,D3]) -> three_digits_to_integer(D1,D2,D3);
1223parse_qvalue(_)                -> 0. %% error
1224
1225three_digits_to_integer(D1, D2, D3) ->
1226    100*(D1-$0)+10*(D2-$0)+D3-$0.
1227
1228
1229%% Gzip encoding
1230accepts_gzip(H, Mime) ->
1231    case [Val || {_,_,'Accept-Encoding',_,Val}<- H#headers.other] of
1232        [] ->
1233            false;
1234        [_|_]=AcceptEncoding0 ->
1235            AcceptEncoding = join_sep(AcceptEncoding0, ","),
1236            EncList = [parse_qval(X) || X <- split_sep(AcceptEncoding, $,)],
1237            case [Q || {"gzip",Q} <- EncList] ++ [Q || {"*",Q} <- EncList] of
1238                [] ->
1239                    false;
1240                [Q|_] ->
1241                    (Q > 100) %% just for fun
1242                        and not has_buggy_gzip(H#headers.user_agent, Mime)
1243            end
1244    end.
1245
1246%%% Advice partly taken from Apache's documentation of `mod_deflate'.
1247
1248%% Only Netscape 4.06-4.08 is really broken.
1249has_buggy_gzip("Mozilla/4.06"++_, _) ->
1250    true;
1251has_buggy_gzip("Mozilla/4.07"++_, _) ->
1252    true;
1253has_buggy_gzip("Mozilla/4.08"++_, _) ->
1254    true;
1255
1256%% Everything else handles at least HTML.
1257has_buggy_gzip(_, "text/html") ->
1258    false;
1259has_buggy_gzip(UserAgent, Mime) ->
1260    UA = parse_ua(UserAgent),
1261    in_ua(fun("Mozilla/4"++_) ->
1262                  %% Netscape 4.x may choke on anything not HTML.
1263                  case Mime of
1264                      %% IE doesn't, but some versions are said to have issues
1265                      %% with plugins.
1266                      "application/pdf" ->
1267                          true;
1268                      _ -> not in_comment(
1269                                 fun("MSIE"++_) -> true;
1270                                    (_)         -> false
1271                                 end, UA)
1272                  end;
1273             ("w3m"++_) ->
1274                  %% W3m does not decompress when saving.
1275                  true;
1276             ("Opera") ->
1277                  %% Opera 6 does not uncompress downloads.
1278                  in_ua(fun("6."++_) -> true;
1279                           (_)       -> false
1280                        end, UA);
1281             ("Opera/6."++_) ->
1282                  true;
1283             (_) ->
1284                  false
1285          end, UA).
1286
1287
1288%%% Parsing of User-Agent header.
1289%%% Yes, this looks a bit like overkill.
1290tokenize_ua([], Acc) ->
1291    lists:reverse(Acc);
1292tokenize_ua([$\\ , C|T], Acc) ->
1293    tokenize_ua(T, [C|Acc]);
1294tokenize_ua([$(|T], Acc) ->
1295    tokenize_ua(T, [popen | Acc]);
1296tokenize_ua([$)|T], Acc) ->
1297    tokenize_ua(T, [pclose | Acc]);
1298tokenize_ua([C|T], Acc) ->
1299    tokenize_ua(T, [C|Acc]).
1300
1301parse_ua(Line) ->
1302    case catch parse_ua_l(tokenize_ua(Line, [])) of
1303        {'EXIT', _} -> [];
1304        Res         -> Res
1305    end.
1306
1307parse_ua_l(Line) ->
1308    case drop_spaces(Line) of
1309        [] ->
1310            [];
1311        [popen|T] ->
1312            {Comment, Tail} = parse_comment(T),
1313            [Comment | parse_ua_l(Tail)];
1314        [pclose|T] ->
1315            %% Error, ignore
1316            parse_ua_l(T);
1317        L ->
1318            {UA, Tail} = parse_ua1(L),
1319            [UA | parse_ua_l(Tail)]
1320    end.
1321
1322parse_comment(L) ->
1323    parse_comment(L, [], []).
1324
1325parse_comment([], _, _) ->
1326    %% Error
1327    {error, []};
1328parse_comment([pclose|T], CAcc, CsAcc) ->
1329    {{comment, lists:reverse([lists:reverse(CAcc)|CsAcc])}, T};
1330parse_comment([popen|T], CAcc, CsAcc) ->
1331    {Comment, Tail} = parse_comment(T),
1332    parse_comment(drop_spaces(Tail), [], [Comment, lists:reverse(CAcc)|CsAcc]);
1333parse_comment([$;|T], CAcc, CsAcc) ->
1334    parse_comment(drop_spaces(T), [], [lists:reverse(CAcc)|CsAcc]);
1335parse_comment([C|T], CAcc, CsAcc) ->
1336    parse_comment(T, [C|CAcc], CsAcc).
1337
1338
1339parse_ua1(L) ->
1340    parse_ua1(L, []).
1341
1342parse_ua1([], Acc) ->
1343    {{ua,lists:reverse(Acc)}, []};
1344parse_ua1([popen|T], Acc) ->
1345    {{ua, lists:reverse(Acc)}, [popen|T]};
1346parse_ua1([pclose|T], _Acc) ->
1347    {error, T};
1348parse_ua1([$ |T], Acc) ->
1349    {{ua, lists:reverse(Acc)}, T};
1350parse_ua1([C|T], Acc) ->
1351    parse_ua1(T, [C|Acc]).
1352
1353
1354in_ua(Pred, L) ->
1355    lists:any(fun({ua, UA}) -> Pred(UA);
1356                 (_)        -> false
1357              end, L).
1358
1359in_comment(_Pred, []) ->
1360    false;
1361in_comment(Pred, [{comment, Cs}|T]) ->
1362    case in_comment_l(Pred, Cs) of
1363        true  -> true;
1364        false -> in_comment(Pred, T)
1365    end;
1366in_comment(Pred, [_|T]) ->
1367    in_comment(Pred, T).
1368
1369
1370in_comment_l(Pred, Cs) ->
1371    lists:any(fun({comment, Cs1}) -> in_comment_l(Pred, Cs1);
1372                 (error)          -> false;
1373                 (L)              -> Pred(L)
1374              end, Cs).
1375
1376
1377%% imperative out header management
1378outh_set_status_code(Code) ->
1379    put(outh, (get(outh))#outh{status = Code}),
1380    ok.
1381
1382outh_set_non_cacheable(_Version) ->
1383    put(outh, (get(outh))#outh{cache_control = "Cache-Control: no-cache\r\n"}),
1384    ok.
1385
1386outh_set_content_type(Mime) ->
1387    put(outh, (get(outh))#outh{content_type = make_content_type_header(Mime)}),
1388    ok.
1389
1390outh_set_content_encoding(Encoding) ->
1391    ContentEncoding = case Encoding of
1392                          identity -> undefined;
1393                          deflate  -> make_content_encoding_header(Encoding)
1394                      end,
1395    put(outh, (get(outh))#outh{encoding         = Encoding,
1396                               content_encoding = ContentEncoding}),
1397    ok.
1398
1399outh_set_cookie(C) ->
1400    put(outh, (get(outh))#outh{set_cookie = ["Set-Cookie: ", C, "\r\n"]}),
1401    ok.
1402
1403
1404outh_clear_headers() ->
1405    H = get(outh),
1406    put(outh, #outh{status     = H#outh.status,
1407                    doclose    = true,
1408                    chunked    = false,
1409                    connection = make_connection_close_header(true)}),
1410    ok.
1411
1412
1413outh_set_static_headers(Req, UT, Headers) ->
1414    outh_set_static_headers(Req, UT, Headers, all).
1415
1416outh_set_static_headers(Req, UT, Headers, Range) ->
1417    H = get(outh),
1418    FIL = (UT#urltype.finfo)#file_info.size,
1419    {DoClose0, Chunked0} = dcc(Req, Headers),
1420    {DoDeflate, Length}
1421        = case Range of
1422              all ->
1423                  case UT#urltype.deflate of
1424                      DB when is_binary(DB) -> % cached
1425                          %% Remove charset
1426                          [Mime|_] = yaws:split_sep(UT#urltype.mime, $;),
1427                          case accepts_gzip(Headers, Mime) of
1428                              true  -> {true, size(DB)};
1429                              false -> {false, FIL}
1430                          end;
1431                      undefined ->
1432                          {false, FIL};
1433                      dynamic ->
1434                          %% Remove charset
1435                          [Mime|_] = yaws:split_sep(UT#urltype.mime, $;),
1436                          case accepts_gzip(Headers, Mime) of
1437                              true  -> {true, undefined};
1438                              false -> {false, FIL}
1439                          end
1440                  end;
1441              {fromto, From, To, _} ->
1442                  {false, To - From + 1}
1443          end,
1444    Encoding = case DoDeflate of
1445                   true  -> decide;
1446                   false -> identity
1447               end,
1448    Chunked = Chunked0 and (Length == undefined),
1449    DoClose = if
1450                  DoClose0 == true ->
1451                      true;
1452                  ((Length == undefined) and not Chunked) ->
1453                      %% We cannot keep the connection alive, because the client
1454                      %% has no way of knowing the end of the content data.
1455                      true;
1456                  DoClose0 == keep_alive ->
1457                      keep_alive;
1458                  true ->
1459                      DoClose0
1460              end,
1461
1462    H2 = H#outh{
1463           status            = case Range of
1464                                   all               -> 200;
1465                                   {fromto, _, _, _} -> 206
1466                               end,
1467           chunked           = Chunked,
1468           encoding          = Encoding,
1469           date              = make_date_header(),
1470           server            = make_server_header(),
1471           last_modified     = make_last_modified_header(UT#urltype.finfo),
1472           etag              = make_etag_header(UT#urltype.finfo),
1473           content_range     = make_content_range_header(Range),
1474           content_length    = make_content_length_header(Length),
1475           content_type      = make_content_type_header(UT#urltype.mime),
1476           content_encoding  = make_content_encoding_header(Encoding),
1477           transfer_encoding = make_transfer_encoding_chunked_header(Chunked),
1478           connection        = make_connection_close_header(DoClose),
1479           doclose           = DoClose,
1480           contlen           = Length
1481          },
1482    %% store finfo to set last_modified, expires and cache_control headers
1483    %% during #outh{} serialization.
1484    put(file_info, UT#urltype.finfo),
1485    put(outh, H2).
1486
1487outh_set_304_headers(Req, UT, Headers) ->
1488    H = get(outh),
1489    {DoClose, _Chunked} = dcc(Req, Headers),
1490    H2 = H#outh{
1491           status         = 304,
1492           chunked        = false,
1493           date           = make_date_header(),
1494           server         = make_server_header(),
1495           last_modified  = make_last_modified_header(UT#urltype.finfo),
1496           etag           = make_etag_header(UT#urltype.finfo),
1497           content_length = make_content_length_header(0),
1498           connection     = make_connection_close_header(DoClose),
1499           doclose        = DoClose,
1500           contlen        = 0
1501          },
1502    %% store finfo to set last_modified, expires and cache_control headers
1503    %% during #outh{} serialization.
1504    put(file_info, UT#urltype.finfo),
1505    put(outh, H2).
1506
1507outh_set_dyn_headers(Req, Headers, UT) ->
1508    H = get(outh),
1509    {DoClose, Chunked} = dcc(Req, Headers),
1510    H2 = H#outh{
1511           status            = 200,
1512           date              = make_date_header(),
1513           server            = make_server_header(),
1514           connection        = make_connection_close_header(DoClose),
1515           content_type      = make_content_type_header(UT#urltype.mime),
1516           doclose           = DoClose,
1517           chunked           = Chunked,
1518           transfer_encoding = make_transfer_encoding_chunked_header(Chunked)},
1519    %% store finfo to set last_modified, expires and cache_control headers
1520    %% during #outh{} serialization.
1521    put(file_info, UT#urltype.finfo),
1522    put(outh, H2).
1523
1524
1525outh_set_connection(What) ->
1526    H = get(outh),
1527    H2 = H#outh{connection = make_connection_close_header(What),
1528                doclose    = What},
1529    put(outh, H2),
1530    ok.
1531
1532
1533outh_set_content_length(Int) ->
1534    H  = get(outh),
1535    H2 = H#outh{
1536           content_length = make_content_length_header(Int),
1537           contlen        = Int
1538          },
1539    put(outh, H2).
1540
1541
1542
1543outh_set_dcc(Req, Headers) ->
1544    H = get(outh),
1545    {DoClose, Chunked} = dcc(Req, Headers),
1546    H2 = H#outh{
1547           connection        = make_connection_close_header(DoClose),
1548           doclose           = DoClose,
1549           chunked           = Chunked,
1550           transfer_encoding = make_transfer_encoding_chunked_header(Chunked)
1551          },
1552    put(outh, H2).
1553
1554
1555%% can only turn if off, not on.
1556%% if it allready is off, it's off because the cli headers forced us.
1557outh_set_transfer_encoding_off() ->
1558    H  = get(outh),
1559    H2 = H#outh{
1560           chunked           = false,
1561           transfer_encoding = make_transfer_encoding_chunked_header(false)
1562          },
1563    put(outh, H2).
1564
1565outh_set_auth([]) ->
1566    ok;
1567
1568outh_set_auth(Headers) ->
1569    H  = get(outh),
1570    H2 = case H#outh.www_authenticate of
1571             undefined ->
1572                 H#outh{www_authenticate = Headers};
1573             _ ->
1574                 H#outh{www_authenticate = H#outh.www_authenticate ++ Headers}
1575         end,
1576    put(outh, H2).
1577
1578outh_set_vary(Fields) ->
1579    put(outh, (get(outh))#outh{vary = make_vary_header(Fields)}),
1580    ok.
1581
1582outh_fix_doclose() ->
1583    H = get(outh),
1584    if
1585        (H#outh.doclose /= true)    andalso
1586        (H#outh.contlen==undefined) andalso
1587        (H#outh.chunked == false) ->
1588            put(outh, H#outh{doclose    = true,
1589                             connection = make_connection_close_header(true)});
1590        true ->
1591            ok
1592    end.
1593
1594
1595dcc(Req, Headers) ->
1596    H = get(outh),
1597    DoClose = case Req#http_request.version of
1598                  _ when H#outh.exceedmaxuses == true ->
1599                      true; %% too many keepalives
1600                  {1, 0} ->
1601                      case Headers#headers.connection of
1602                          "close"      -> true;
1603                          "Keep-Alive" -> keep_alive;
1604                          _            -> true
1605                      end;
1606                  {1, 1} ->
1607                      Headers#headers.connection == "close";
1608                  {0,9} ->
1609                      true
1610              end,
1611    Chunked = case Req#http_request.version of
1612                  {1, 0} -> false;
1613                  {1,1}  -> true;
1614                  {0,9}  ->  false
1615              end,
1616    {DoClose, Chunked}.
1617
1618
1619
1620
1621
1622%%
1623%% The following all make_ function return an actual header string
1624%%
1625make_allow_header() ->
1626    make_allow_header([]).
1627make_allow_header(Options) ->
1628    case Options of
1629        [] ->
1630            ["Allow: GET, POST, OPTIONS, HEAD\r\n"];
1631        _ ->
1632            ["Allow: ",
1633             lists:foldl(fun(M, "") -> atom_to_list(M);
1634                            (M, Acc) -> atom_to_list(M) ++ ", " ++ Acc
1635                         end, "", lists:reverse(Options)),
1636             "\r\n"]
1637    end.
1638make_server_header() ->
1639    Sc = get(sc),
1640    Signature = case Sc#sconf.yaws of
1641                    undefined -> (get(gc))#gconf.yaws;
1642                    S         -> S
1643                end,
1644    case Signature of
1645        "" ->
1646            [];
1647        _ ->
1648            ["Server: ", Signature, "\r\n"]
1649    end.
1650
1651make_last_modified_header(FI) ->
1652    Then = FI#file_info.mtime,
1653    ["Last-Modified: ", local_time_as_gmt_string(Then), "\r\n"].
1654
1655
1656make_expires_header(all, FI) ->
1657    SC = get(sc),
1658    case lists:keyfind(all, 1, SC#sconf.expires) of
1659        {_, EType, TTL} -> make_expires_header(EType, TTL, FI);
1660        false           -> {undefined, undefined}
1661    end;
1662make_expires_header({Type,all}, FI) ->
1663    SC = get(sc),
1664    case lists:keyfind({Type,all}, 1, SC#sconf.expires) of
1665        {_, EType, TTL} -> make_expires_header(EType, TTL, FI);
1666        false           -> make_expires_header(all, FI)
1667    end;
1668make_expires_header({Type,SubType}, FI) ->
1669    SC = get(sc),
1670    case lists:keyfind({Type,SubType}, 1, SC#sconf.expires) of
1671        {_, EType, TTL} -> make_expires_header(EType, TTL, FI);
1672        false           -> make_expires_header({Type,all}, FI)
1673    end;
1674make_expires_header(MT0, FI) ->
1675    SC = get(sc),
1676    %% Use split_sep to remove charset
1677    case yaws:split_sep(MT0, $;) of
1678        [] -> {undefined, undefined};
1679        [MT1|_] ->
1680            case lists:keyfind(MT1, 1, SC#sconf.expires) of
1681                {_, EType, TTL} ->
1682                    make_expires_header(EType, TTL, FI);
1683                false ->
1684                    case split_sep(MT1, $/) of
1685                        [Type, SubType] ->
1686                            make_expires_header({Type,SubType}, FI);
1687                        false ->
1688                            make_expires_header(all, FI)
1689                    end
1690            end
1691    end.
1692
1693
1694make_expires_header(always, _TTL, _FI) ->
1695    {["Expires: ", "Thu, 01 Jan 1970 00:00:00 GMT\r\n"],
1696     ["Cache-Control: ", "private, no-cache, no-store, must-revalidate, max-age=0, proxy-revalidate, s-maxage=0\r\n"]};
1697make_expires_header(access, TTL, _FI) ->
1698    Secs = calendar:datetime_to_gregorian_seconds(erlang:universaltime()),
1699    ExpireTime = calendar:gregorian_seconds_to_datetime(Secs+TTL),
1700    {["Expires: ", universal_time_as_string(ExpireTime), "\r\n"],
1701     ["Cache-Control: ", "max-age=", erlang:integer_to_list(TTL), "\r\n"]};
1702make_expires_header(modify, TTL, FI) ->
1703    %% mtime is local here
1704    Secs1 = calendar:datetime_to_gregorian_seconds(FI#file_info.mtime),
1705    Secs2 = calendar:datetime_to_gregorian_seconds(erlang:localtime()),
1706    ExpireTime = calendar:gregorian_seconds_to_datetime(Secs1+TTL),
1707    MaxAge     = erlang:max(0, TTL - (Secs2 - Secs1)),
1708    {["Expires: ", local_time_as_gmt_string(ExpireTime), "\r\n"],
1709     ["Cache-Control: ", "max-age=", erlang:integer_to_list(MaxAge), "\r\n"]}.
1710
1711
1712make_location_header(Where) ->
1713    ["Location: ", Where, "\r\n"].
1714
1715
1716make_etag_header(FI) ->
1717    ETag = make_etag(FI),
1718    ["Etag: ", ETag, "\r\n"].
1719
1720make_etag(FI) ->
1721    Stamp = {FI#file_info.size, FI#file_info.mtime},
1722    ETag = integer_to_list(erlang:phash2(Stamp, 16#100000000), 19),
1723    lists:flatten([$", ETag, $"]).
1724
1725
1726make_content_type_header(no_content_type) ->
1727    undefined;
1728make_content_type_header(MimeType) ->
1729    ["Content-Type: ", MimeType, "\r\n"].
1730
1731
1732make_content_range_header(all) ->
1733    undefined;
1734make_content_range_header({fromto, From, To, Tot}) ->
1735    ["Content-Range: bytes ",
1736     erlang:integer_to_list(From), $-, erlang:integer_to_list(To),
1737     $/, erlang:integer_to_list(Tot), $\r, $\n].
1738
1739make_content_length_header(Size) when is_integer(Size) ->
1740    ["Content-Length: ", erlang:integer_to_list(Size), "\r\n"];
1741make_content_length_header(FI) when is_record(FI, file_info) ->
1742    Size = FI#file_info.size,
1743    ["Content-Length: ", erlang:integer_to_list(Size), "\r\n"];
1744make_content_length_header(_) ->
1745    undefined.
1746
1747make_content_encoding_header(deflate) ->
1748    "Content-Encoding: gzip\r\n";
1749make_content_encoding_header(_) ->
1750    undefined.
1751
1752make_connection_close_header(true) ->
1753    "Connection: close\r\n";
1754make_connection_close_header(false) ->
1755    undefined;
1756make_connection_close_header(keep_alive) ->
1757    "Connection: Keep-Alive\r\n".
1758
1759make_transfer_encoding_chunked_header(true) ->
1760    "Transfer-Encoding: chunked\r\n";
1761make_transfer_encoding_chunked_header(false) ->
1762    undefined.
1763
1764make_www_authenticate_header({realm, Realm}) ->
1765    ["WWW-Authenticate: Basic realm=\"", Realm, ["\"\r\n"]];
1766
1767make_www_authenticate_header(Method) ->
1768    ["WWW-Authenticate: ", Method, ["\r\n"]].
1769
1770make_date_header() ->
1771    N = element(2, os:timestamp()),
1772    case get(date_header) of
1773        {_Str, Secs} when (Secs+10) < N ->
1774            H = ["Date: ", universal_time_as_string(), "\r\n"],
1775            put(date_header, {H, N}),
1776            H;
1777        {Str, _Secs} ->
1778            Str;
1779        undefined ->
1780            H = ["Date: ", universal_time_as_string(), "\r\n"],
1781            put(date_header, {H, N}),
1782            H
1783    end.
1784
1785make_vary_header(Fields) ->
1786    case lists:member("*", Fields) of
1787        true  -> ["Vary: ", "*", "\r\n"];
1788        false -> ["Vary: ", join_sep(Fields, ", "), "\r\n"]
1789    end.
1790
1791
1792
1793%% access functions into the outh record
1794outh_get_status_code() ->
1795    (get(outh))#outh.status.
1796
1797outh_get_contlen() ->
1798    (get(outh))#outh.contlen.
1799
1800outh_get_act_contlen() ->
1801    (get(outh))#outh.act_contlen.
1802
1803outh_inc_act_contlen(Int) ->
1804    O = get(outh),
1805    L = case O#outh.act_contlen of
1806            undefined -> Int;
1807            Len       -> Len+Int
1808        end,
1809    put(outh, O#outh{act_contlen = L}),
1810    L.
1811
1812outh_get_doclose() ->
1813    (get(outh))#outh.doclose.
1814
1815outh_get_chunked() ->
1816    (get(outh))#outh.chunked.
1817
1818outh_get_content_encoding() ->
1819    (get(outh))#outh.encoding.
1820
1821outh_get_content_encoding_header() ->
1822    (get(outh))#outh.content_encoding.
1823
1824outh_get_content_type() ->
1825    case (get(outh))#outh.content_type of
1826        undefined    -> undefined;
1827        [_, Mime, _] -> Mime
1828    end.
1829
1830outh_get_vary_fields() ->
1831    case (get(outh))#outh.vary of
1832        undefined      -> [];
1833        [_, Fields, _] -> split_sep(Fields, $,)
1834    end.
1835
1836outh_serialize() ->
1837    H = get(outh),
1838    Code = case H#outh.status of
1839               undefined -> 200;
1840               Int       -> Int
1841           end,
1842    StatusLine = ["HTTP/1.1 ", erlang:integer_to_list(Code), " ",
1843                  yaws_api:code_to_phrase(Code), "\r\n"],
1844    GC=get(gc),
1845    if ?gc_has_debug(GC) -> yaws_debug:check_headers(H);
1846       true              -> ok
1847    end,
1848    ContentEnc = case H#outh.content_encoding of
1849                     undefined -> make_content_encoding_header(H#outh.encoding);
1850                     CE        -> CE
1851                 end,
1852    {Expires, CacheControl} =
1853        case erase(file_info) of
1854            undefined ->
1855                {H#outh.expires, H#outh.cache_control};
1856            FI ->
1857                {E, CC} = case {H#outh.expires, H#outh.cache_control} of
1858                              {undefined, undefined} ->
1859                                  CT = outh_get_content_type(),
1860                                  make_expires_header(CT, FI);
1861                              _ ->
1862                                  {H#outh.expires, H#outh.cache_control}
1863                          end,
1864                {E, CC}
1865        end,
1866
1867    %% Add 'Accept-Encoding' in the 'Vary:' header if the compression is enabled
1868    %% or if the response is compressed _AND_ if the response has a non-empty
1869    %% body.
1870    Vary = case get(sc) of
1871               undefined -> undefined;
1872               SC ->
1873                   case (?sc_has_deflate(SC) orelse H#outh.encoding == deflate) of
1874                       true when H#outh.contlen /= undefined, H#outh.contlen /= 0;
1875                                 H#outh.act_contlen /= undefined,
1876                                 H#outh.act_contlen /= 0 ->
1877                           Fields = outh_get_vary_fields(),
1878                           Fun    = fun("*") -> true;
1879                                       (F)   -> (to_lower(F) == "accept-encoding")
1880                                    end,
1881                           case lists:any(Fun, Fields) of
1882                               true  -> H#outh.vary;
1883                               false -> make_vary_header(["Accept-Encoding"|Fields])
1884                           end;
1885                       _ ->
1886                           H#outh.vary
1887                   end
1888           end,
1889
1890    Headers = [noundef(H#outh.connection),
1891               noundef(H#outh.server),
1892               noundef(H#outh.location),
1893               noundef(H#outh.date),
1894               noundef(H#outh.allow),
1895               noundef(H#outh.last_modified),
1896               noundef(Expires),
1897               noundef(CacheControl),
1898               noundef(H#outh.etag),
1899               noundef(H#outh.content_range),
1900               noundef(H#outh.content_length),
1901               noundef(H#outh.content_type),
1902               noundef(ContentEnc),
1903               noundef(H#outh.set_cookie),
1904               noundef(H#outh.transfer_encoding),
1905               noundef(H#outh.www_authenticate),
1906               noundef(Vary),
1907               noundef(H#outh.other)],
1908    {StatusLine, Headers}.
1909
1910
1911noundef(undefined) -> [];
1912noundef(Str)       -> Str.
1913
1914
1915
1916accumulate_header({X, erase}) when is_atom(X) ->
1917    erase_header(X);
1918
1919
1920%% special headers
1921accumulate_header({connection, What}) ->
1922    DC = case What of
1923             "close" -> true;
1924             _       -> false
1925         end,
1926    H = get(outh),
1927    put(outh, H#outh{connection = ["Connection: ", What, "\r\n"],
1928                     doclose    = DC});
1929accumulate_header({"Connection", What}) ->
1930    accumulate_header({connection, What});
1931
1932accumulate_header({server, What}) ->
1933    put(outh, (get(outh))#outh{server = ["Server: ", What, "\r\n"]});
1934accumulate_header({"Server", What}) ->
1935    accumulate_header({server, What});
1936
1937accumulate_header({location, What}) ->
1938    put(outh, (get(outh))#outh{location = ["Location: ", What, "\r\n"]});
1939accumulate_header({"Location", What}) ->
1940    accumulate_header({location, What});
1941
1942accumulate_header({cache_control, What}) ->
1943    put(outh, (get(outh))#outh{cache_control = ["Cache-Control: ", What,
1944                                                "\r\n"]});
1945accumulate_header({"Cache-Control", What}) ->
1946    accumulate_header({cache_control, What});
1947
1948accumulate_header({expires, What}) ->
1949    put(outh, (get(outh))#outh{expires = ["Expires: ", What, "\r\n"]});
1950accumulate_header({"Expires", What}) ->
1951    accumulate_header({expires, What});
1952
1953accumulate_header({date, What}) ->
1954    put(outh, (get(outh))#outh{date = ["Date: ", What, "\r\n"]});
1955accumulate_header({"Date", What}) ->
1956    accumulate_header({date, What});
1957
1958accumulate_header({allow, What}) ->
1959    put(outh, (get(outh))#outh{allow = ["Allow: ", What, "\r\n"]});
1960accumulate_header({"Allow", What}) ->
1961    accumulate_header({allow, What});
1962
1963accumulate_header({last_modified, What}) ->
1964    put(outh, (get(outh))#outh{last_modified = ["Last-Modified: ", What,
1965                                                "\r\n"]});
1966accumulate_header({"Last-Modified", What}) ->
1967    accumulate_header({last_modified, What});
1968
1969accumulate_header({etag, What}) ->
1970    put(outh, (get(outh))#outh{etag = ["Etag: ", What, "\r\n"]});
1971accumulate_header({"Etag", What}) ->
1972    accumulate_header({etag, What});
1973
1974accumulate_header({set_cookie, What}) ->
1975    O = get(outh),
1976    Old = case O#outh.set_cookie of
1977              undefined -> "";
1978              X         -> X
1979          end,
1980    put(outh, O#outh{set_cookie = ["Set-Cookie: ", What, "\r\n"|Old]});
1981accumulate_header({"Set-Cookie", What}) ->
1982    accumulate_header({set_cookie, What});
1983
1984accumulate_header({content_range, What}) ->
1985    put(outh, (get(outh))#outh{content_range = ["Content-Range: ", What,
1986                                                "\r\n"]});
1987accumulate_header({"Content-Range", What}) ->
1988    accumulate_header({content_range, What});
1989
1990accumulate_header({content_type, What}) ->
1991    put(outh, (get(outh))#outh{content_type = ["Content-Type: ", What,
1992                                               "\r\n"]});
1993accumulate_header({"Content-Type", What}) ->
1994    accumulate_header({content_type, What});
1995
1996accumulate_header({content_encoding, What}) ->
1997    case What of
1998        "identity" ->
1999            put(outh, (get(outh))#outh{encoding         = identity,
2000                                       content_encoding = undefined});
2001        _ ->
2002            put(outh, (get(outh))#outh{encoding         = deflate,
2003                                       content_encoding = ["Content-Encoding: ",
2004                                                           What, "\r\n"]})
2005    end;
2006accumulate_header({"Content-Encoding", What}) ->
2007    accumulate_header({content_encoding, What});
2008
2009accumulate_header({content_length, Len}) when is_integer(Len) ->
2010    H = get(outh),
2011    put(outh, H#outh{
2012                chunked           = false,
2013                transfer_encoding = undefined,
2014                contlen           = Len,
2015                act_contlen       = 0,
2016                content_length    = make_content_length_header(Len)});
2017accumulate_header({"Content-Length", Len}) ->
2018    case Len of
2019        I when is_integer(I) ->
2020            accumulate_header({content_length, I});
2021        L when is_list(L) ->
2022            accumulate_header({content_length, erlang:list_to_integer(L)})
2023    end;
2024
2025accumulate_header({transfer_encoding, What}) ->
2026    put(outh, (get(outh))#outh{chunked           = true,
2027                               contlen           = 0,
2028                               transfer_encoding = ["Transfer-Encoding: ", What,
2029                                                    "\r\n"]});
2030accumulate_header({"Transfer-Encoding", What}) ->
2031    accumulate_header({transfer_encoding, What});
2032
2033accumulate_header({www_authenticate, What}) ->
2034    put(outh, (get(outh))#outh{www_authenticate = ["WWW-Authenticate: ", What,
2035                                                   "\r\n"]});
2036accumulate_header({"WWW-Authenticate", What}) ->
2037    accumulate_header({www_authenticate, What});
2038
2039accumulate_header({vary, What}) ->
2040    put(outh, (get(outh))#outh{vary = ["Vary: ", What, "\r\n"]});
2041accumulate_header({"Vary", What}) ->
2042    accumulate_header({vary, What});
2043
2044%% non-special headers (which may be special in a future Yaws version)
2045accumulate_header({Name, What}) when is_list(Name) ->
2046    H = get(outh),
2047    Old = case H#outh.other of
2048              undefined -> [];
2049              V         -> V
2050          end,
2051    H2 = H#outh{other = [Name, ": ", What, "\r\n", Old]},
2052    put(outh, H2);
2053
2054
2055
2056%% backwards compatible clause
2057accumulate_header(Data) when is_list(Data) ->
2058    Str = lists:flatten(Data),
2059    accumulate_header(split_header(Str)).
2060
2061split_header(Str)           ->
2062    split_header(Str, []).
2063
2064split_header([], A)         -> {lists:reverse(A), ""};
2065split_header([$:, $ |W], A) -> {lists:reverse(A), W};
2066split_header([$:|W], A)     -> {lists:reverse(A), W};
2067split_header([C|S], A)      -> split_header(S, [C|A]).
2068
2069
2070erase_header(connection) ->
2071    put(outh, (get(outh))#outh{connection=undefined, doclose=false});
2072erase_header(server) ->
2073    put(outh, (get(outh))#outh{server=undefined});
2074erase_header(cache_control) ->
2075    put(outh, (get(outh))#outh{cache_control=undefined});
2076erase_header(expires) ->
2077    put(outh, (get(outh))#outh{expires=undefined});
2078erase_header(date) ->
2079    put(outh, (get(outh))#outh{date=undefined});
2080erase_header(allow) ->
2081    put(outh, (get(outh))#outh{allow=undefined});
2082erase_header(last_modified) ->
2083    put(outh, (get(outh))#outh{last_modified=undefined});
2084erase_header(etag) ->
2085    put(outh, (get(outh))#outh{etag=undefined});
2086erase_header(set_cookie) ->
2087    put(outh, (get(outh))#outh{set_cookie=undefined});
2088erase_header(content_range) ->
2089    put(outh, (get(outh))#outh{content_range=undefined});
2090erase_header(content_length) ->
2091    put(outh, (get(outh))#outh{contlen=0, content_length=undefined});
2092erase_header(content_type) ->
2093    put(outh, (get(outh))#outh{content_type=undefined});
2094erase_header(content_encoding) ->
2095    put(outh, (get(outh))#outh{encoding=decide, content_encoding=undefined});
2096erase_header(transfer_encoding) ->
2097    put(outh, (get(outh))#outh{chunked           = false,
2098                               act_contlen       = 0,
2099                               transfer_encoding = undefined});
2100erase_header(www_authenticate) ->
2101    put(outh, (get(outh))#outh{www_authenticate=undefined});
2102erase_header(location) ->
2103    put(outh, (get(outh))#outh{location=undefined});
2104erase_header(vary) ->
2105    put(outh, (get(outh))#outh{vary=undefined}).
2106
2107getuid() ->
2108    case os:type() of
2109        {win32, _} ->
2110            {ok, "0"};
2111        _ ->
2112            load_setuid_drv(),
2113            P = open_port({spawn, "setuid_drv g"},[]),
2114            receive
2115                {P, {data, "ok " ++ IntList}} ->
2116                    {ok, IntList}
2117            end
2118    end.
2119
2120user_to_home(User) ->
2121    case os:type() of
2122        {win32, _} ->
2123            ".";
2124        _ ->
2125            load_setuid_drv(),
2126            P = open_port({spawn, "setuid_drv " ++ [$h|User]}, []),
2127            receive
2128                {P, {data, "ok " ++ Home}} ->
2129                    Home
2130            end
2131    end.
2132
2133
2134uid_to_name(Uid) ->
2135    load_setuid_drv(),
2136    P = open_port({spawn, "setuid_drv " ++
2137                       [$n|erlang:integer_to_list(Uid)]}, []),
2138    receive
2139        {P, {data, "ok " ++ Name}} ->
2140            Name
2141    end.
2142
2143load_setuid_drv() ->
2144    Path = filename:join(get_priv_dir(), "lib"),
2145    case erl_ddll:load_driver(Path, "setuid_drv") of
2146        ok ->
2147            ok;
2148        {error, Reason} ->
2149            error_logger:format("Failed to load setuid_drv (from ~p) : ~p",
2150                                [Path, erl_ddll:format_error(Reason)]),
2151            exit(normal)
2152    end.
2153
2154exists(F) ->
2155    case file:open(F, [read, raw]) of
2156        {ok, Fd} ->
2157            file:close(Fd),
2158            ok;
2159        _ ->
2160            false
2161    end.
2162
2163
2164mkdir(Path) ->
2165    [Hd|Parts] = filename:split(Path),
2166    mkdir([Hd], Parts).
2167mkdir(Ack, []) ->
2168    ensure_exist(filename:join(Ack));
2169mkdir(Ack, [H|T]) ->
2170    ensure_exist(filename:join(Ack ++ [H])),
2171    mkdir(Ack ++ [H], T).
2172
2173ensure_exist(Path) ->
2174    case file:read_file_info(Path) of
2175        {ok, _} ->
2176            ok;
2177        _ ->
2178            case file:make_dir(Path) of
2179                ok ->
2180                    ok;
2181                ERR ->
2182                    error_logger:format("Failed to mkdir ~p: ~p~n", [Path, ERR])
2183            end
2184    end.
2185
2186%%
2187%%
2188%% TCP/SSL connection with a configurable IPv4/IPv6 preference on NS lookup.
2189%%
2190%%
2191
2192tcp_connect(Host, Port, Options) ->
2193    tcp_connect(Host, Port, Options, infinity).
2194
2195tcp_connect(Host, Port, Options, Timeout) ->
2196    parse_ipaddr_and_connect(tcp, Host, Port, Options, Timeout).
2197
2198ssl_connect(Host, Port, Options) ->
2199    ssl_connect(Host, Port, Options, infinity).
2200
2201ssl_connect(Host, Port, Options, Timeout) ->
2202    parse_ipaddr_and_connect(ssl, Host, Port, Options, Timeout).
2203
2204parse_ipaddr_and_connect(Proto, IP, Port, Options, Timeout)
2205when is_tuple(IP) ->
2206    %% The caller handled name resolution himself.
2207    filter_tcpoptions_and_connect(Proto, undefined,
2208      IP, Port, Options, Timeout);
2209parse_ipaddr_and_connect(Proto, [$[ | Rest], Port, Options, Timeout) ->
2210    %% yaws_api:parse_url/1 keep the "[...]" enclosing an IPv6 address.
2211    %% Remove them now, and parse the address.
2212    IP = string:strip(Rest, right, $]),
2213    parse_ipaddr_and_connect(Proto, IP, Port, Options, Timeout);
2214parse_ipaddr_and_connect(Proto, Host, Port, Options, Timeout) ->
2215    %% First, try to parse an IP address, because inet:getaddr/2 could
2216    %% return nxdomain if the family doesn't match the IP address
2217    %% format.
2218    case inet:parse_strict_address(Host) of
2219        {ok, IP} ->
2220            filter_tcpoptions_and_connect(Proto, undefined,
2221                                          IP, Port, Options, Timeout);
2222        {error, einval} ->
2223            NsLookupPref = get_nslookup_pref(Options),
2224            filter_tcpoptions_and_connect(Proto, NsLookupPref,
2225                                          Host, Port, Options, Timeout)
2226    end.
2227
2228filter_tcpoptions_and_connect(Proto, NsLookupPref,
2229  Host, Port, Options, Timeout) ->
2230    %% Now that we have IP addresses, remove family from the TCP options,
2231    %% because calling gen_tcp:connect/3 with {127,0,0,1} and [inet6]
2232    %% would return {error, nxdomain otherwise}.
2233    OptionsWithoutFamily = lists:filter(fun
2234          (inet)  -> false;
2235          (inet6) -> false;
2236          (_)     -> true
2237      end, Options),
2238    resolve_and_connect(Proto, NsLookupPref, Host, Port, OptionsWithoutFamily, Timeout).
2239
2240resolve_and_connect(Proto, _, IP, Port, Options, Timeout)
2241when is_tuple(IP) ->
2242    do_connect(Proto, IP, Port, Options, Timeout);
2243resolve_and_connect(Proto, [Family | Rest], Host, Port, Options, Timeout) ->
2244    Result = case inet:getaddr(Host, Family) of
2245        {ok, IP} -> do_connect(Proto, IP, Port, Options, Timeout);
2246        R        -> R
2247    end,
2248    case Result of
2249        {ok, Socket} ->
2250            {ok, Socket};
2251        {error, _} when length(Rest) >= 1 ->
2252            %% If the connection fails here, ignore the error and
2253            %% continue with the next address family.
2254            resolve_and_connect(Proto, Rest, Host, Port, Options, Timeout);
2255        {error, Reason} ->
2256            %% This was the last IP address in the list, return the
2257            %% connection error.
2258            {error, Reason}
2259    end.
2260
2261do_connect(Proto, IP, Port, Options, Timeout) ->
2262    case Proto of
2263        tcp -> gen_tcp:connect(IP, Port, Options, Timeout);
2264        ssl -> ssl:connect(IP, Port, Options, Timeout)
2265    end.
2266
2267%% If the caller specified inet or inet6 in the TCP options, prefer
2268%% this to the global nslookup_pref parameter.
2269%%
2270%% This can be used in processes which can't use get(gc) to get the
2271%% global conf: if they are given the global conf, they can get
2272%% nslookup_pref value and add it the TCP options.
2273%%
2274%% If neither TCP options specify the family, nor the global conf is
2275%% accessible, use default value declared in #gconf definition.
2276get_nslookup_pref(TcpOptions) ->
2277    get_nslookup_pref(TcpOptions, []).
2278
2279get_nslookup_pref([inet | Rest], Result) ->
2280    get_nslookup_pref(Rest, [inet | Result]);
2281get_nslookup_pref([inet6 | Rest], Result) ->
2282    get_nslookup_pref(Rest, [inet6 | Result]);
2283get_nslookup_pref([_ | Rest], Result) ->
2284    get_nslookup_pref(Rest, Result);
2285get_nslookup_pref([], []) ->
2286    case get(gc) of
2287        undefined -> gconf_nslookup_pref(#gconf{});
2288        GC        -> gconf_nslookup_pref(GC)
2289    end;
2290get_nslookup_pref([], Result) ->
2291    lists:reverse(Result).
2292
2293%%
2294%%
2295%% http/tcp send receive functions
2296%%
2297%%
2298do_recv(Sock, Num, nossl) ->
2299    gen_tcp:recv(Sock, Num, (get(gc))#gconf.keepalive_timeout);
2300do_recv(Sock, Num, ssl) ->
2301    ssl:recv(Sock, Num, (get(gc))#gconf.keepalive_timeout).
2302do_recv(Sock, Num, nossl, Timeout) ->
2303    gen_tcp:recv(Sock, Num, Timeout);
2304do_recv(Sock, Num, ssl, Timeout) ->
2305    ssl:recv(Sock, Num, Timeout).
2306
2307cli_recv(S, Num, SslBool) ->
2308    Res = do_recv(S, Num, SslBool),
2309    cli_recv_trace(yaws_trace:get_type(get(gc)), Res),
2310    Res.
2311
2312cli_recv_trace(undefined, _) ->
2313    ok;
2314cli_recv_trace(Trace, Res) ->
2315    case Res of
2316        {ok, Val} when is_tuple(Val) ->
2317            yaws_trace:write(from_client, ?F("~p~n", [Val]));
2318        {error, What} ->
2319            yaws_trace:write(from_client, ?F("~p~n", [What]));
2320        {ok, http_eoh} ->
2321            ok;
2322        {ok, Val} when Trace == traffic ->
2323            yaws_trace:write(from_client, Val);
2324        _ ->
2325            ok
2326    end.
2327
2328
2329
2330gen_tcp_send(S, Data) ->
2331    SC = get(sc),
2332    Res = case SC of
2333              undefined ->
2334                  case catch ssl:sockname(S) of
2335                      {ok, _} -> ssl:send(S, Data);
2336                      _ -> gen_tcp:send(S, Data)
2337                  end;
2338              _ ->
2339                  case SC#sconf.ssl of
2340                      undefined -> gen_tcp:send(S, Data);
2341                      _SSL      -> ssl:send(S, Data)
2342                  end
2343          end,
2344    case ?gc_has_debug((get(gc))) of
2345        false ->
2346            case Res of
2347                ok ->
2348                    case SC of
2349                        undefined -> ok;
2350                        _ ->
2351                            yaws_stats:sent(iolist_size(Data))
2352                    end,
2353                    ok;
2354                _Err ->
2355                    exit(normal)   %% keep quiet
2356            end;
2357        true ->
2358            case Res of
2359                ok ->
2360                    case SC of
2361                        undefined -> ok;
2362                        _ ->
2363                            yaws_stats:sent(iolist_size(Data))
2364                    end,
2365                    ?Debug("Sent ~p~n", [yaws_debug:nobin(Data)]),
2366                    ok;
2367                Err ->
2368                    {B2, Size} = strip(Data),
2369                    yaws_debug:derror("Failed to send ~w bytes:~n~p "
2370                                      "on socket ~p: ~p~n~p~n",
2371                                      [Size, B2, S, Err,
2372                                       yaws_debug:nobin(Data)]),
2373                    erlang:error(Err)
2374            end
2375    end.
2376
2377
2378strip(Data) ->
2379    L = list_to_binary([Data]),
2380    case L of
2381        <<Head:50/binary, _/binary>> ->
2382            {binary_to_list(<<Head/binary, ".....">>), size(L)};
2383        _ ->
2384            {binary_to_list(L), size(L)}
2385    end.
2386
2387
2388
2389%% This is the api function
2390%% return {Req, Headers}
2391%%     or closed
2392http_get_headers(CliSock, SSL) ->
2393    do_http_get_headers(CliSock, SSL).
2394
2395
2396headers_to_str(Headers) ->
2397    lists:map(fun(H) -> [H, "\r\n"] end, yaws_api:reformat_header(Headers)).
2398
2399
2400setopts(Sock, Opts, nossl) ->
2401    ok = inet:setopts(Sock, Opts);
2402setopts(Sock, Opts, ssl) ->
2403    ok = ssl:setopts(Sock, Opts).
2404
2405do_http_get_headers(CliSock, SSL) ->
2406    case http_recv_request(CliSock,SSL) of
2407        bad_request ->
2408            {#http_request{method=bad_request, version={0,9}}, #headers{}};
2409        closed ->
2410            closed;
2411        R ->
2412            %% Http request received. Store the current time. it will be usefull
2413            %% to get the time taken to serve the request.
2414            put(request_start_time, os:timestamp()),
2415            case http_collect_headers(CliSock, R,  #headers{}, SSL, 0) of
2416                {error, _}=Error ->
2417                    Error;
2418                H ->
2419                    {R, H}
2420            end
2421    end.
2422
2423
2424http_recv_request(CliSock, SSL) ->
2425    setopts(CliSock, [{packet, http}, {packet_size, 16#4000}], SSL),
2426    case do_recv(CliSock, 0,  SSL) of
2427        {ok, R} when is_record(R, http_request) ->
2428            R;
2429        {ok, R} when is_record(R, http_response) ->
2430            R;
2431        {_, {http_error, "\r\n"}} ->
2432            http_recv_request(CliSock, SSL);
2433        {_, {http_error, "\n"}} ->
2434            http_recv_request(CliSock,SSL);
2435        {_, {http_error, _}} ->
2436            bad_request;
2437        {error, closed} ->
2438            closed;
2439        {error, timeout} ->
2440            closed;
2441        _Other ->
2442            error_logger:format("Unhandled reply fr. do_recv() ~p~n", [_Other]),
2443            exit(normal)
2444    end.
2445
2446http_collect_headers(CliSock, Req, H, SSL, Count) when Count < 1000 ->
2447    setopts(CliSock, [{packet, httph}, {packet_size, 16#4000}], SSL),
2448    Recv = do_recv(CliSock, 0, SSL),
2449    case Recv of
2450        {ok, {http_header,  _Num, 'Host', _, Host}} ->
2451            NewHostH = case H#headers.host of
2452                           undefined ->
2453                               H#headers{host = Host};
2454                           {Hosts} ->
2455                               H#headers{host = {[Host | Hosts]}};
2456                           CurrentHost ->
2457                               H#headers{host = {[Host, CurrentHost]}}
2458                       end,
2459            http_collect_headers(CliSock, Req, NewHostH, SSL, Count+1);
2460        {ok, {http_header, _Num, 'Connection', _, Conn}} ->
2461            http_collect_headers(CliSock, Req,
2462                                 H#headers{connection = Conn},SSL, Count+1);
2463        {ok, {http_header, _Num, 'Accept', _, Accept}} ->
2464            http_collect_headers(CliSock, Req, H#headers{accept = Accept},
2465                                 SSL, Count+1);
2466        {ok, {http_header, _Num, 'If-Modified-Since', _, X}} ->
2467            http_collect_headers(CliSock, Req,
2468                                 H#headers{if_modified_since = X},SSL, Count+1);
2469        {ok, {http_header, _Num, 'If-Match', _, X}} ->
2470            http_collect_headers(CliSock, Req, H#headers{if_match = X},
2471                                 SSL, Count+1);
2472        {ok, {http_header, _Num, 'If-None-Match', _, X}} ->
2473            http_collect_headers(CliSock, Req,
2474                                 H#headers{if_none_match = X},SSL, Count+1);
2475        {ok, {http_header, _Num, 'If-Range', _, X}} ->
2476            http_collect_headers(CliSock, Req, H#headers{if_range = X},
2477                                 SSL, Count+1);
2478        {ok, {http_header, _Num, 'If-Unmodified-Since', _, X}} ->
2479            http_collect_headers(CliSock, Req,
2480                                 H#headers{if_unmodified_since = X},SSL,
2481                                 Count+1);
2482        {ok, {http_header, _Num, 'Range', _, X}} ->
2483            http_collect_headers(CliSock, Req, H#headers{range = X},
2484                                 SSL, Count+1);
2485        {ok, {http_header, _Num, 'Referer',_, X}} ->
2486            http_collect_headers(CliSock, Req, H#headers{referer = X},
2487                                 SSL, Count+1);
2488        {ok, {http_header, _Num, 'User-Agent', _, X}} ->
2489            http_collect_headers(CliSock, Req, H#headers{user_agent = X},
2490                                 SSL, Count+1);
2491        {ok, {http_header, _Num, 'Accept-Ranges', _, X}} ->
2492            http_collect_headers(CliSock, Req,
2493                                 H#headers{accept_ranges = X},SSL, Count+1);
2494        {ok, {http_header, _Num, 'Cookie', _, X}} ->
2495            http_collect_headers(CliSock, Req,
2496                                 H#headers{cookie = [X|H#headers.cookie]},
2497                                 SSL, Count+1);
2498        {ok, {http_header, _Num, 'Keep-Alive', _, X}} ->
2499            http_collect_headers(CliSock, Req, H#headers{keep_alive = X},
2500                                 SSL, Count+1);
2501        {ok, {http_header, _Num, 'Content-Length', _, X}} ->
2502            http_collect_headers(CliSock, Req,
2503                                 H#headers{content_length = X},SSL,
2504                                 Count+1);
2505        {ok, {http_header, _Num, 'Content-Type', _, X}} ->
2506            http_collect_headers(CliSock, Req,
2507                                 H#headers{content_type = X},SSL, Count+1);
2508        {ok, {http_header, _Num, 'Content-Encoding', _, X}} ->
2509            http_collect_headers(CliSock, Req,
2510                                 H#headers{content_encoding = X},SSL, Count+1);
2511        {ok, {http_header, _Num, 'Transfer-Encoding', _, X}} ->
2512            http_collect_headers(CliSock, Req,
2513                                 H#headers{transfer_encoding=X},SSL, Count+1);
2514        {ok, {http_header, _Num, 'Location', _, X}} ->
2515            http_collect_headers(CliSock, Req, H#headers{location=X},
2516                                 SSL, Count+1);
2517        {ok, {http_header, _Num, 'Authorization', _, X}} ->
2518            http_collect_headers(CliSock, Req,
2519                                 H#headers{authorization = parse_auth(X)},
2520                                 SSL, Count+1);
2521        {ok, {http_header, _Num, 'X-Forwarded-For', _, X}} ->
2522            case H#headers.x_forwarded_for of
2523                undefined ->
2524                    http_collect_headers(CliSock, Req, H#headers{x_forwarded_for=X},
2525                                         SSL, Count+1);
2526                PrevXF ->
2527                    NewXF = join_sep([PrevXF,X], ", "),
2528                    http_collect_headers(CliSock, Req, H#headers{x_forwarded_for=NewXF},
2529                                         SSL, Count+1)
2530            end;
2531        {ok, http_eoh} ->
2532            H;
2533
2534        %% these are here to be a little forgiving to
2535        %% bad (typically test script) clients
2536        {_, {http_error, "\r\n"}} ->
2537            http_collect_headers(CliSock, Req, H,SSL, Count+1);
2538        {_, {http_error, "\n"}} ->
2539            http_collect_headers(CliSock, Req, H,SSL, Count+1);
2540
2541        %% auxiliary headers we don't have builtin support for
2542        {ok, X} ->
2543            ?Debug("OTHER header ~p~n", [X]),
2544            http_collect_headers(CliSock, Req,
2545                                 H#headers{other=[X|H#headers.other]},
2546                                 SSL, Count+1);
2547        _Err ->
2548            exit(normal)
2549
2550    end;
2551http_collect_headers(_CliSock, Req, _H, _SSL, _Count)  ->
2552    {error, {too_many_headers, Req}}.
2553
2554
2555
2556parse_auth(Orig = "Basic " ++ Auth64) ->
2557    case decode_base64(Auth64) of
2558        {error, _Err} ->
2559            {undefined, undefined, Orig};
2560        Auth ->
2561            case string:tokens(Auth, ":") of
2562                [User, Pass ] ->
2563                    {User, Pass, Orig};
2564                [User, Pass0 | Extra] ->
2565                    %% password can contain :
2566                    Pass = join_sep([Pass0 | Extra], ":"),
2567                    {User, Pass, Orig};
2568                _ ->
2569                    {undefined, undefined, Orig}
2570            end
2571    end;
2572parse_auth(Orig = "Negotiate " ++ _Auth64) ->
2573    {undefined, undefined, Orig};
2574parse_auth(Orig) ->
2575    {undefined, undefined, Orig}.
2576
2577
2578decode_base64([]) ->
2579    [];
2580decode_base64(Auth64) ->
2581    decode_base64(Auth64, []).
2582decode_base64([], Acc) ->
2583    lists:reverse(Acc);
2584decode_base64([Sextet1,Sextet2,$=,$=|Rest], Acc) ->
2585    Bits2x6 =
2586        (d(Sextet1) bsl 18) bor
2587        (d(Sextet2) bsl 12),
2588    Octet1 = Bits2x6 bsr 16,
2589    decode_base64(Rest, [Octet1|Acc]);
2590decode_base64([Sextet1,Sextet2,Sextet3,$=|Rest], Acc) ->
2591    Bits3x6 =
2592        (d(Sextet1) bsl 18) bor
2593        (d(Sextet2) bsl 12) bor
2594        (d(Sextet3) bsl 6),
2595    Octet1 = Bits3x6 bsr 16,
2596    Octet2 = (Bits3x6 bsr 8) band 16#ff,
2597    decode_base64(Rest, [Octet2,Octet1|Acc]);
2598decode_base64([Sextet1,Sextet2,Sextet3,Sextet4|Rest], Acc) ->
2599    Bits4x6 =
2600        (d(Sextet1) bsl 18) bor
2601        (d(Sextet2) bsl 12) bor
2602        (d(Sextet3) bsl 6) bor
2603        d(Sextet4),
2604    Octet1 = Bits4x6 bsr 16,
2605    Octet2 = (Bits4x6 bsr 8) band 16#ff,
2606    Octet3 = Bits4x6 band 16#ff,
2607    decode_base64(Rest, [Octet3,Octet2,Octet1|Acc]);
2608decode_base64(_CatchAll, _Acc) ->
2609    {error, bad_base64}.
2610
2611d(X) when X >= $A, X =<$Z -> X-65;
2612d(X) when X >= $a, X =<$z -> X-71;
2613d(X) when X >= $0, X =<$9 -> X+4;
2614d($+)                     -> 62;
2615d($/)                     -> 63;
2616d(_)                      -> 63.
2617
2618
2619flag(CurFlag, Bit, true)  -> CurFlag bor Bit;
2620flag(CurFlag, Bit, false) -> CurFlag band (bnot Bit).
2621
2622
2623%% misc debug funcs .... use from cli only
2624restart() ->
2625    stop(),
2626    load(),
2627    start().
2628
2629
2630modules() ->
2631    application:load(yaws),
2632    M = case application:get_all_key(yaws) of
2633            {ok, L} ->
2634                case lists:keysearch(modules, 1, L) of
2635                    {value, {modules, Mods}} -> Mods;
2636                    _                        -> []
2637                end;
2638            _ ->
2639                []
2640        end,
2641    M.
2642
2643
2644load() ->
2645    load(modules()).
2646load(M) ->
2647    lists:foreach(fun(Mod) ->
2648                          ?Debug("Load ~p~n", [Mod]),
2649                          c:l(Mod)
2650                  end, M).
2651
2652
2653
2654upto_char(Char, [Char|_]) ->
2655    [];
2656upto_char(Char, [H|T]) when is_integer(H) ->
2657    [H|upto_char(Char, T)];
2658upto_char(_, []) ->
2659    [];
2660%% deep lists
2661upto_char(Char, [H|T]) when is_list(H) ->
2662    case lists:member(Char ,H) of
2663        true  -> upto_char(Char, H);
2664        false -> [H, upto_char(Char, T)]
2665    end.
2666
2667
2668%% map over deep list and maintain
2669%% list structure as is
2670deepmap(Fun, [H|T]) when is_list(H) ->
2671    [deepmap(Fun, H) | deepmap(Fun, T)];
2672deepmap(Fun, [H|T]) ->
2673    [Fun(H) | deepmap(Fun,T)];
2674deepmap(_Fun, []) ->
2675    [].
2676
2677
2678sconf_to_srvstr(SC) ->
2679    redirect_scheme(SC) ++ redirect_host(SC,undefined).
2680
2681redirect_scheme(SC) ->
2682    case {SC#sconf.ssl,SC#sconf.rmethod} of
2683        {_, Method} when is_list(Method) -> Method++"://";
2684        {undefined, _}                   -> "http://";
2685        {_SSl, _}                        -> "https://"
2686    end.
2687
2688redirect_host(SC, HostHdr) ->
2689    case SC#sconf.rhost of
2690        undefined ->
2691            if HostHdr == undefined ->
2692                    ServerName  = SC#sconf.servername,
2693                    SnameNoPort = case string:chr(ServerName, $:) of
2694                                      0 -> ServerName;
2695                                      N -> lists:sublist(ServerName, N-1)
2696                                  end,
2697                    SnameNoPort ++ redirect_port(SC);
2698               true ->
2699                    HostHdr
2700            end;
2701        _ ->
2702            SC#sconf.rhost
2703    end.
2704
2705redirect_port(SC) ->
2706    case {SC#sconf.rmethod, SC#sconf.ssl, SC#sconf.port} of
2707        {"https", _, 443}    -> "";
2708        {"http", _, 80}      -> "";
2709        {_, undefined, 80}   -> "";
2710        {_, undefined, Port} -> [$:|erlang:integer_to_list(Port)];
2711        {_, _SSL, 443}       -> "";
2712        {_, _SSL, Port}      -> [$:|erlang:integer_to_list(Port)]
2713    end.
2714
2715redirect_scheme_port(SC) ->
2716    Scheme   = redirect_scheme(SC),
2717    PortPart = redirect_port(SC),
2718    {Scheme, PortPart}.
2719
2720tmpdir() ->
2721    tmpdir(filename:join([home(), ".yaws"])).
2722tmpdir(DefaultTmpDir) ->
2723    case os:type() of
2724        {win32,_} ->
2725            case os:getenv("TEMP") of
2726                false ->
2727                    case os:getenv("TMP") of
2728                        %%
2729                        %% No temporary path set?
2730                        %% Then try standard paths.
2731                        %%
2732                        false ->
2733                            case file:read_file_info("C:/WINNT/Temp") of
2734                                {error, _} -> "C:/WINDOWS/Temp";
2735                                {ok, _}    -> "C:/WINNT/Temp"
2736                            end;
2737                        PathTMP ->
2738                            PathTMP
2739                    end;
2740                PathTEMP ->
2741                    PathTEMP
2742            end;
2743        _ ->
2744            DefaultTmpDir
2745    end.
2746
2747%% mktemp function borrowed from Klacke's misc module
2748%% Modified to use tmpdir/1 so it works on Windows too.
2749%% Note that mktemp/2 could be exported too, but no Yaws
2750%% code needs it, yet anyway.
2751mktemp(Template) ->
2752    mktemp(Template, file).
2753
2754mktemp(Template, Ret) ->
2755    Tdir = tmpdir("/tmp"),
2756    Max = 1000,
2757    mktemp(Tdir, Template, Ret, 0, Max, "").
2758
2759mktemp(Dir, Template, Ret, I, Max, Suffix) when I < Max ->
2760    {X,Y,Z} = unique_triple(),
2761    PostFix = erlang:integer_to_list(X) ++ "-" ++
2762        erlang:integer_to_list(Y) ++ "-" ++
2763        erlang:integer_to_list(Z),
2764    F = filename:join(Dir, Template ++ [$_ | PostFix] ++ Suffix),
2765    filelib:ensure_dir(F),
2766    case file:open(F, [read, raw]) of
2767        {error, enoent} when Ret == file ->
2768            {ok, F};
2769        {error, enoent} when Ret == fd ->
2770            case file:open(F, [read, write, raw]) of
2771                {ok, Fd} ->
2772                    file:delete(F),
2773                    {ok, Fd};
2774                Err ->
2775                    Err
2776            end;
2777        {error, enoent} when Ret == binfd ->
2778            case file:open(F, [read, write, raw, binary]) of
2779                {ok, Fd} ->
2780                    file:delete(F),
2781                    {ok, Fd};
2782                Err ->
2783                    Err
2784            end;
2785        {ok, Fd} ->
2786            file:close(Fd),
2787            mktemp(Dir, Template, Ret, I+1, Max, Suffix);
2788        _Err ->
2789            mktemp(Dir, Template, Ret, I+1, Max, Suffix)
2790    end;
2791mktemp(_Dir, _Template, _Ret, _I, _Max, _Suffix) ->
2792    {error, too_many}.
2793
2794
2795%% This feature is usable together with
2796%% privbind and authbind on linux
2797home() ->
2798    case os:getenv("YAWSHOME") of
2799        false -> os:getenv("HOME");
2800        DIR   -> DIR
2801    end.
2802
2803id_dir(Id) ->
2804    filename:join([tmpdir(), "yaws", to_list(Id)]).
2805
2806ctl_file(Id) ->
2807    filename:join([id_dir(Id), "CTL"]).
2808
2809
2810eat_crnl(Fd,SSL) ->
2811    setopts(Fd, [{packet, line}],SSL),
2812    case do_recv(Fd,0, SSL) of
2813        {ok, <<13,10>>} -> ok;
2814        {ok, [13,10]}   -> ok;
2815        _               -> exit(normal)
2816    end.
2817
2818
2819get_chunk_num(Fd, SSL) ->
2820    {N, _} = get_chunk_header(Fd, SSL),
2821    N.
2822
2823get_chunk_header(Fd, SSL) ->
2824    case do_recv(Fd, 0, SSL) of
2825        {ok, Data} ->
2826            Line = if is_binary(Data) -> binary_to_list(Data);
2827                      true            -> Data
2828                   end,
2829            ?Debug("Get chunk num from line ~p~n",[Line]),
2830            {N, Exts} = split_at(Line, $;),
2831            {erlang:list_to_integer(strip_spaces(N),16), strip_spaces(Exts)};
2832        {error, _Rsn} ->
2833            exit(normal)
2834    end.
2835
2836
2837get_chunk(_Fd, N, N, _) ->
2838    [];
2839get_chunk(Fd, N, Asz,SSL) ->
2840    case do_recv(Fd, N, SSL) of
2841        {ok, Bin} ->
2842            SZ = size(Bin),
2843            [Bin|get_chunk(Fd, N, SZ+Asz,SSL)];
2844        _ ->
2845            exit(normal)
2846    end.
2847
2848get_chunk_trailer(Fd, SSL) ->
2849    Hdrs = #headers{},
2850    case http_collect_headers(Fd, undefined, Hdrs, SSL, 0) of
2851        {error,_} -> exit(normal);
2852        Hdrs      -> <<>>;
2853        NewHdrs   -> {<<>>, NewHdrs}
2854    end.
2855
2856%% split inputstring at first occurrence of Char
2857split_at(String, Char) ->
2858    split_at(String, Char, []).
2859split_at([H|T], H, Ack) ->
2860    {lists:reverse(Ack), T};
2861split_at([H|T], Char, Ack) ->
2862    split_at(T, Char, [H|Ack]);
2863split_at([], _Char, Ack) ->
2864    {lists:reverse(Ack), []}.
2865
2866%% insert an elemant at a given position into a list
2867insert_at(Elm, 0, Ls) ->
2868    Ls ++ [Elm];
2869insert_at(Elm, Pos, Ls) ->
2870    insert_at(Elm, Pos, Ls, []).
2871
2872insert_at(Elm, _, [], Res) ->
2873    lists:reverse([Elm|Res]);
2874insert_at(Elm, 1, Ls, Res) ->
2875    lists:reverse([Elm|Res]) ++ Ls;
2876insert_at(Elm, Pos, [H|T], Res) ->
2877    insert_at(Elm, Pos-1, T, [H|Res]).
2878
2879
2880
2881%% Parse an Ip address or an Ip address range
2882%% Return Ip || {IpMin, IpMax} where:
2883%%     Ip, IpMin, IpMax ::= ip_address()
2884parse_ipmask(Str) when is_list(Str) ->
2885    case string:tokens(Str, [$/]) of
2886        [IpStr] ->
2887            case inet_parse:address(IpStr) of
2888                {ok, Ip}        -> Ip;
2889                {error, Reason} -> throw({error, Reason})
2890            end;
2891        [IpStr, NetMask] ->
2892            {Type, IpInt} = ip_to_integer(IpStr),
2893            MaskInt       = netmask_to_integer(Type, NetMask),
2894            case netmask_to_wildcard(Type, MaskInt) of
2895                0 ->
2896                    integer_to_ip(Type, IpInt);
2897                Wildcard when Type =:= ipv4 ->
2898                    NetAddr   = (IpInt band MaskInt),
2899                    Broadcast = NetAddr + Wildcard,
2900                    IpMin     = NetAddr + 1,
2901                    IpMax     = Broadcast - 1,
2902                    {integer_to_ip(ipv4, IpMin), integer_to_ip(ipv4, IpMax)};
2903                Wildcard when Type =:= ipv6 ->
2904                    NetAddr   = (IpInt band MaskInt),
2905                    IpMin = NetAddr,
2906                    IpMax = NetAddr + Wildcard,
2907                    {integer_to_ip(ipv6, IpMin), integer_to_ip(ipv6, IpMax)}
2908            end;
2909        _ ->
2910            throw({error, einval})
2911    end;
2912parse_ipmask(_) ->
2913    throw({error, einval}).
2914
2915
2916-define(MAXBITS_IPV4, 32).
2917-define(MASK_IPV4,    16#FFFFFFFF).
2918-define(MAXBITS_IPV6, 128).
2919-define(MASK_IPV6,    16#FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF).
2920
2921ip_to_integer(Str) when is_list(Str) ->
2922    case inet_parse:address(Str) of
2923        {ok, Ip}        -> ip_to_integer(Ip);
2924        {error, Reason} -> throw({error, Reason})
2925    end;
2926ip_to_integer({N1,N2,N3,N4}) ->
2927    <<Int:32>> = <<N1:8, N2:8, N3:8, N4:8>>,
2928    if
2929        (Int bsr ?MAXBITS_IPV4) == 0 -> {ipv4, Int};
2930        true -> throw({error, einval})
2931    end;
2932ip_to_integer({N1,N2,N3,N4,N5,N6,N7,N8}) ->
2933    <<Int:128>> = <<N1:16, N2:16, N3:16, N4:16, N5:16, N6:16, N7:16, N8:16>>,
2934    if
2935        (Int bsr ?MAXBITS_IPV6) == 0 -> {ipv6, Int};
2936        true -> throw({error, einval})
2937    end;
2938ip_to_integer(_) ->
2939    throw({error, einval}).
2940
2941integer_to_ip(ipv4, I) when is_integer(I), I =< ?MASK_IPV4 ->
2942    <<N1:8, N2:8, N3:8, N4:8>> = <<I:32>>,
2943    {N1, N2, N3, N4};
2944integer_to_ip(ipv6, I) when is_integer(I), I =< ?MASK_IPV6 ->
2945    <<N1:16, N2:16, N3:16, N4:16, N5:16, N6:16, N7:16, N8:16>> = <<I:128>>,
2946    {N1, N2, N3, N4, N5, N6, N7, N8};
2947integer_to_ip(_, _) ->
2948    throw({error, einval}).
2949
2950netmask_to_integer(Type, NetMask) ->
2951    case catch erlang:list_to_integer(NetMask) of
2952        I when is_integer(I) ->
2953            case Type of
2954                ipv4 -> (1 bsl ?MAXBITS_IPV4) - (1 bsl (?MAXBITS_IPV4 - I));
2955                ipv6 -> (1 bsl ?MAXBITS_IPV6) - (1 bsl (?MAXBITS_IPV6 - I))
2956            end;
2957        _ ->
2958            case ip_to_integer(NetMask) of
2959                {Type, MaskInt} -> MaskInt;
2960                _               -> throw({error, einval})
2961            end
2962    end.
2963
2964netmask_to_wildcard(ipv4, Mask) -> ((1 bsl ?MAXBITS_IPV4) - 1) bxor Mask;
2965netmask_to_wildcard(ipv6, Mask) -> ((1 bsl ?MAXBITS_IPV6) - 1) bxor Mask.
2966
2967
2968%% Compare an ip to another ip or a range of ips
2969match_ipmask(Ip, Ip) ->
2970    true;
2971match_ipmask(Ip, {IpMin, IpMax}) ->
2972    case compare_ips(Ip, IpMin) of
2973        error -> false;
2974        less  -> false;
2975        _ ->
2976            case compare_ips(Ip, IpMax) of
2977                error   -> false;
2978                greater -> false;
2979                _       -> true
2980            end
2981    end;
2982match_ipmask(_, _) ->
2983    false.
2984
2985compare_ips({A,B,C,D},          {A,B,C,D})                       -> equal;
2986compare_ips({A,B,C,D,E,F,G,H},  {A,B,C,D,E,F,G,H})               -> equal;
2987compare_ips({A,B,C,D1},         {A,B,C,D2})         when D1 < D2 -> less;
2988compare_ips({A,B,C,D1},         {A,B,C,D2})         when D1 > D2 -> greater;
2989compare_ips({A,B,C1,_},         {A,B,C2,_})         when C1 < C2 -> less;
2990compare_ips({A,B,C1,_},         {A,B,C2,_})         when C1 > C2 -> greater;
2991compare_ips({A,B1,_,_},         {A,B2,_,_})         when B1 < B2 -> less;
2992compare_ips({A,B1,_,_},         {A,B2,_,_})         when B1 > B2 -> greater;
2993compare_ips({A1,_,_,_},         {A2,_,_,_})         when A1 < A2 -> less;
2994compare_ips({A1,_,_,_},         {A2,_,_,_})         when A1 > A2 -> greater;
2995compare_ips({A,B,C,D,E,F,G,H1}, {A,B,C,D,E,F,G,H2}) when H1 < H2 -> less;
2996compare_ips({A,B,C,D,E,F,G,H1}, {A,B,C,D,E,F,G,H2}) when H1 > H2 -> greater;
2997compare_ips({A,B,C,D,E,F,G1,_}, {A,B,C,D,E,F,G2,_}) when G1 < G2 -> less;
2998compare_ips({A,B,C,D,E,F,G1,_}, {A,B,C,D,E,F,G2,_}) when G1 > G2 -> greater;
2999compare_ips({A,B,C,D,E,F1,_,_}, {A,B,C,D,E,F2,_,_}) when F1 < F2 -> less;
3000compare_ips({A,B,C,D,E,F1,_,_}, {A,B,C,D,E,F2,_,_}) when F1 > F2 -> greater;
3001compare_ips({A,B,C,D,E1,_,_,_}, {A,B,C,D,E2,_,_,_}) when E1 < E2 -> less;
3002compare_ips({A,B,C,D,E1,_,_,_}, {A,B,C,D,E2,_,_,_}) when E1 > E2 -> greater;
3003compare_ips({A,B,C,D1,_,_,_,_}, {A,B,C,D2,_,_,_,_}) when D1 < D2 -> less;
3004compare_ips({A,B,C,D1,_,_,_,_}, {A,B,C,D2,_,_,_,_}) when D1 > D2 -> greater;
3005compare_ips({A,B,C1,_,_,_,_,_}, {A,B,C2,_,_,_,_,_}) when C1 < C2 -> less;
3006compare_ips({A,B,C1,_,_,_,_,_}, {A,B,C2,_,_,_,_,_}) when C1 > C2 -> greater;
3007compare_ips({A,B1,_,_,_,_,_,_}, {A,B2,_,_,_,_,_,_}) when B1 < B2 -> less;
3008compare_ips({A,B1,_,_,_,_,_,_}, {A,B2,_,_,_,_,_,_}) when B1 > B2 -> greater;
3009compare_ips({A1,_,_,_,_,_,_,_}, {A2,_,_,_,_,_,_,_}) when A1 < A2 -> less;
3010compare_ips({A1,_,_,_,_,_,_,_}, {A2,_,_,_,_,_,_,_}) when A1 > A2 -> greater;
3011compare_ips(_,                  _)                               -> error.
3012
3013
3014%% Find a free port, so that it can be stored during the configuration parsing.
3015%% This is not perfect, as the port could be taken by another application
3016%% before the next call of gen_tcp:listen/2, but works well enough if the
3017%% dynamic port range of the system is large enough.
3018find_private_port() ->
3019    case gen_tcp:listen(0, [{ip, {0,0,0,0}}]) of
3020        {ok, Sock} ->
3021            Result = inet:port(Sock),
3022            gen_tcp:close(Sock),
3023            Result;
3024        {error, _} = Error ->
3025            Error
3026    end.
3027
3028%% ----
3029get_app_subdir(SubDir) when is_atom(SubDir) ->
3030    filename:join(get_app_dir(), atom_to_list(SubDir)).
3031
3032get_app_dir() ->
3033    case application:get_env(yaws, app_dir) of
3034        {ok, AppDir} ->
3035            AppDir;
3036        undefined ->
3037            Path = case code:which(?MODULE) of
3038                       cover_compiled -> code:where_is_file("yaws.beam");
3039                       Dir            -> Dir
3040                   end,
3041            AppDir = filename:absname(filename:dirname(filename:dirname(Path))),
3042            application:set_env(yaws, app_dir, AppDir),
3043            AppDir
3044    end.
3045
3046get_ebin_dir() ->
3047    get_app_subdir(ebin).
3048
3049get_priv_dir() ->
3050    get_app_subdir(priv).
3051
3052get_inc_dir() ->
3053    get_app_subdir(include).
3054