Merge branch 'master' of git@github.com:klacke/yaws

Author: Claes Wikstrom

.gitignore

@@ -0,0 +1,16 @@
+*.beam
+*.o
+*.so
+yaws.pc
+bin/yaws
+config.log
+config.status
+ebin/yaws.app
+include.mk
+priv/epam
+scripts/yaws.conf
+src/charset.def
+src/mime_types.erl
+src/yaws_configure.hrl
+test/support/include.mk
+test/support/include.sh

include/yaws.hrl

@@ -32,8 +32,6 @@
         ((GC#gconf.flags band ?GC_AUTH_LOG) /= 0)).
 -define(gc_has_copy_errlog(GC), 
         ((GC#gconf.flags band ?GC_COPY_ERRLOG) /= 0)).
--define(gc_has_backwards_compat_parse(GC), 
-        ((GC#gconf.flags band ?GC_BACKWARDS_COMPAT_PARSE) /= 0)).
 -define(gc_log_has_resolve_hostname(GC), 
         ((GC#gconf.flags band ?GC_LOG_RESOLVE_HOSTNAME) /= 0)).
 -define(gc_fail_on_bind_err(GC), 
@@ -53,9 +51,6 @@
         GC#gconf{flags = yaws:flag(GC#gconf.flags, ?GC_AUTH_LOG, Bool)}).
 -define(gc_set_copy_errlog(GC, Bool), 
         GC#gconf{flags = yaws:flag(GC#gconf.flags, ?GC_COPY_ERRLOG, Bool)}).
--define(gc_set_backwards_compat_parse(GC, Bool), 
-        GC#gconf{flags = yaws:flag(GC#gconf.flags, 
-                                   ?GC_BACKWARDS_COMPAT_PARSE, Bool)}).
 -define(gc_log_set_resolve_hostname(GC, Bool), 
         GC#gconf{flags = yaws:flag(GC#gconf.flags, 
                                    ?GC_LOG_RESOLVE_HOSTNAME, Bool)}).

man/yaws.conf.5

@@ -137,15 +137,6 @@ erlang errorlog written to a report.log file.
 Default value is true.
 
 
-.TP
-\fBbackwards_compat_parse  = true | false\fR
-Versions of Yaws > than 1.41 changes the return value
-of the parse_query and parse_post functions. Earlier versions
-used {Key, Val} where Key was an atom. This made Yaws vulnerable
-for DOS attacks. Set this flag to keep the old deprecated 
-and vulnerable behaviour. In versions >  1.41 the Key is a list/string.
-
-
 .TP
 \fBrunmod = ModuleName \fR
 At startup yaws will invoke \fIModuleName:start()\fR in a separate

src/yaws.erl

@@ -140,8 +140,7 @@ start_embedded(DocRoot, SL, GL, Id) when is_list(DocRoot),is_list(SL),is_list(GL
     GC = setup_gconf(GL, yaws_config:make_default_gconf(false, Id)),
     SC = setup_sconf(DocRoot, #sconf{}, SL),
     yaws_config:add_yaws_soap_srv(GC),
-    SCs = yaws_config:add_yaws_auth([SC]),
-    yaws_api:setconf(GC, [SCs]).
+    yaws_api:setconf(GC, [SC]).
 
 add_server(DocRoot, SL) when is_list(DocRoot),is_list(SL) ->
     SC = setup_sconf(DocRoot, #sconf{}, SL),
@@ -1785,11 +1784,17 @@ http_get_headers(CliSock, SSL) ->
         GC#gconf.trace == false ->
             Res;
         is_tuple(Res) ->
-            {Request, Headers} = Res,
-            ReqStr = yaws_api:reformat_request(Request),
+            {RoR, Headers} = Res,
+            {RoRStr, From} = case element(1, RoR) of
+                                 http_request ->
+                                     {yaws_api:reformat_request(RoR),
+                                      from_client};
+                                 http_response ->
+                                     {yaws_api:reformat_response(RoR),
+                                      from_server}
+                             end,
             HStr = headers_to_str(Headers),
-            yaws_log:trace_traffic(from_client, 
-                                   ?F("~n~s~n~s~n",[ReqStr, HStr])),
+            yaws_log:trace_traffic(From, ?F("~n~s~n~s~n",[RoRStr, HStr])),
             Res;
         Res == closed ->
             yaws_log:trace_traffic(from_client, "closed\n"),

src/yaws_api.erl

@@ -351,7 +351,7 @@ do_header(Head) ->
         {value, {_,"form-data"++Line}} ->
             Parameters = parse_arg_line(Line),
             {value, {_,Name}} = lists:keysearch(name, 1, Parameters),
-            {mkkey(Name), Parameters};
+            {lists:reverse(Name), Parameters};
         _ ->
             {Header}
     end.
@@ -408,7 +408,7 @@ do_parse_spec(<<$%, Hi:8, Lo:8, Tail/binary>>, Spec, Last, Cur, State)
     do_parse_spec(Tail, Spec, Last, [ Hex | Cur],  State);
 
 do_parse_spec(<<$&, Tail/binary>>, Spec, _Last , Cur,  key) ->
-    [{mkkey_reverse(Cur), undefined} |
+    [{lists:reverse(Cur), undefined} |
      do_parse_spec(Tail, Spec, nokey, [], key)];  %% cont keymode
 
 do_parse_spec(<<$&, Tail/binary>>, Spec, Last, Cur, value) ->
@@ -420,7 +420,7 @@ do_parse_spec(<<$+, Tail/binary>>, Spec, Last, Cur,  State) ->
     do_parse_spec(Tail, Spec, Last, [$\s|Cur], State);
 
 do_parse_spec(<<$=, Tail/binary>>, Spec, _Last, Cur, key) ->
-    do_parse_spec(Tail, Spec, mkkey_reverse(Cur), [], value); %% change mode
+    do_parse_spec(Tail, Spec, lists:reverse(Cur), [], value); %% change mode
 
 do_parse_spec(<<$%, $u, A:8, B:8,C:8,D:8, Tail/binary>>, 
 	       Spec, Last, Cur, State) ->
@@ -431,7 +431,7 @@ do_parse_spec(<<$%, $u, A:8, B:8,C:8,D:8, Tail/binary>>,
 do_parse_spec(<<H:8, Tail/binary>>, Spec, Last, Cur, State) ->
     do_parse_spec(Tail, Spec, Last, [H|Cur], State);
 do_parse_spec(<<>>, _Spec, nokey, Cur, _State) ->
-    [{mkkey_reverse(Cur), undefined}];
+    [{lists:reverse(Cur), undefined}];
 do_parse_spec(<<>>, Spec, Last, Cur, _State) ->
     [S|_Ss] = tail_spec(Spec),
     [{Last, coerce_type(S, Cur)}];
@@ -463,19 +463,6 @@ coerce_type(ip, _Str) ->
 coerce_type(binary, Str) ->
     list_to_binary(lists:reverse(Str)).
 
-mkkey_reverse(S) ->
-    mkkey(lists:reverse(S)).
-mkkey(S) ->
-    GC=get(gc),
-    if
-        ?gc_has_backwards_compat_parse(GC) ->
-            list_to_atom(S);
-        true ->
-            S
-    end.
-
-
-
 
 code_to_phrase(100) -> "Continue";
 code_to_phrase(101) -> "Switching Protocols ";
@@ -1022,14 +1009,16 @@ reformat_header(H) ->
 
 
 
+reformat_request(#http_request{method = bad_request}) ->
+    ["Bad request"];
 reformat_request(Req) ->
     Path = case Req#http_request.path of
-	       {abs_path, AbsPath} ->
-		   AbsPath;
-	       {absoluteURI, _Scheme, _Host0, _Port, RawPath} ->
-		   RawPath
-	   end,
-    {Maj,Min} = Req#http_request.version,
+               {abs_path, AbsPath} ->
+                   AbsPath;
+               {absoluteURI, _Scheme, _Host0, _Port, RawPath} ->
+                   RawPath
+           end,
+    {Maj, Min} = Req#http_request.version,
     [yaws:to_list(Req#http_request.method), " ", Path," HTTP/",
      integer_to_list(Maj),".", integer_to_list(Min)].
 
@@ -1780,14 +1769,16 @@ setconf(GC0, Groups0, CheckCertsChanged) ->
         true ->
             ok
     end,
-    {GC, Groups} = yaws_config:verify_upgrade_args(GC0, Groups0),
+    
+    {GC, Groups1} = yaws_config:verify_upgrade_args(GC0, Groups0),
+    Groups2 = lists:map(fun(X) -> yaws_config:add_yaws_auth(X) end, Groups1),
     {ok, OLDGC, OldGroups} = yaws_api:getconf(),
     case {yaws_config:can_hard_gc(GC, OLDGC),
-          yaws_config:can_soft_setconf(GC, Groups, OLDGC, OldGroups)} of
+          yaws_config:can_soft_setconf(GC, Groups2, OLDGC, OldGroups)} of
         {true, true} ->
-            yaws_config:soft_setconf(GC, Groups, OLDGC, OldGroups);
+            yaws_config:soft_setconf(GC, Groups2, OLDGC, OldGroups);
         {true, false} when OLDGC == undefined -> 
-            yaws_config:hard_setconf(GC, Groups);
+            yaws_config:hard_setconf(GC, Groups2);
         _ ->
             {error, need_restart}
     end.

src/yaws_config.erl

@@ -100,16 +100,63 @@ add_yaws_auth(SCs) ->
       end, SCs).
 
 
-%% we search and setup www authenticate for each directory
-%% specified as an auth directory. These are merged with server conf.
+%% We search and setup www authenticate for each directory
+%% specified as an auth directory or containing a .yaws_auth file. 
+%% These are merged with server conf.
 
 setup_auth(SC) ->
-    lists:flatten(
-      lists:map(fun(Auth) ->
-                        add_yaws_auth(SC, Auth#auth.dir, Auth)
-                end, SC#sconf.authdirs)).
+    Auth_dirs0 = get_yaws_auth_dirs(SC#sconf.docroot),
+
+    %% create new auth records
+    Auth_dirs1 = [#auth{dir = [X]} || X <- Auth_dirs0],
+    Auth_dirs2 = Auth_dirs1 ++ SC#sconf.authdirs,
+    
+    %% load the .yaws_auth files and parse them
+    Auth_dirs3 = load_yaws_auth_file(SC, Auth_dirs2, []),
+
+    start_pam(Auth_dirs3),
+    Auth_dirs3.
+
+    
+
+%% Call get_yaws_auth_dirs/3 with default values and then
+%% strip leading docroot from dir
+get_yaws_auth_dirs(undefined) ->
+    [];
+get_yaws_auth_dirs(Docroot) ->
+    {ok, FileList} = file:list_dir(Docroot),
+    Auth_dirs = get_yaws_auth_dirs(Docroot ++ "/", FileList, []),
+    Len = string:len(Docroot),
+    [string:sub_string(X, Len+1) || X <- Auth_dirs].
+    
+    
+
+%% Bottom of recursion, we have searched all the entries in this directory
+get_yaws_auth_dirs(_Docroot, [], AuthDirs) ->
+    AuthDirs;
+
+%% Recursivly search the docroot for any dir that contains .yaws_auth 
+%% and return it
+get_yaws_auth_dirs(Docroot, [File|T], AuthDirs0) ->
+    Path = string:concat(Docroot, File),
+    case filelib:is_dir(Path) of
+	true ->
+	    {ok, FileList} = file:list_dir(Path),
+	    AuthDirs1 = get_yaws_auth_dirs(Path ++ "/", FileList, AuthDirs0),
+	    get_yaws_auth_dirs(Docroot, T, AuthDirs1);
+	false ->
+	    case File of
+		".yaws_auth" ->
+		    get_yaws_auth_dirs(Docroot, T, [Docroot|AuthDirs0]);
+		_ ->
+		    get_yaws_auth_dirs(Docroot, T, AuthDirs0)
+	    end
+    end.
 
-add_yaws_auth(SC, Dirs, A) ->
+start_pam([]) ->
+    ok;
+
+start_pam([{_Dir, A}|T]) ->
     PamStarted = whereis(yaws_pam) /= undefined,
     if
         A#auth.pam == false ->
@@ -124,28 +171,75 @@ add_yaws_auth(SC, Dirs, A) ->
         true ->
             ok
     end,
-
-    lists:map(
-      fun(Dir) ->
-              FN=[SC#sconf.docroot , [$/|Dir], [$/|".yaws_auth"]],
-              case file:consult(FN) of
-                  {ok, [{realm, Realm} |TermList]} ->
-                      error_logger:info_msg("Reading .yaws_auth ~s~n",[FN]),
-                      {Dir, A#auth{realm = Realm,
-                                   users = TermList++A#auth.users}};
-                  {ok, TermList} ->
-                      error_logger:info_msg("Reading .yaws_auth ~s~n",[FN]),
-                      {Dir, A#auth{users = TermList++A#auth.users}};
-                  {error, enoent} ->
-                      {Dir, A};
-                  _Err ->
-                      error_logger:format("Bad .yaws_auth file in dir ~p~n", 
-                                          [Dir]),
-                      {Dir, A}
-              end
-      end, Dirs).
-
-
+    start_pam(T).
+
+
+
+load_yaws_auth_file(_SC, [], Acc) ->
+    Acc;
+
+%% Load the .yaws_auth file if it exists and parse it, 
+%% adding the result to the record
+load_yaws_auth_file(SC, [A|T], Acc) ->
+    [Dir] = A#auth.dir,
+    FN0=[SC#sconf.docroot, [$/|Dir], [$/|".yaws_auth"]],
+    FN1 = remove_multiple_slash(lists:flatten(FN0)),
+    A2 = case file:consult(FN1) of
+	     {ok, TermList} ->
+		 error_logger:info_msg("Reading .yaws_auth ~s~n",[FN1]),
+		 Auth = parse_yaws_auth_file(TermList, A),
+		 [Dir1] = Auth#auth.dir,
+		 {Dir1, Auth};
+	     {error, enoent} ->
+		 {Dir, A};
+	     _Err ->
+		 error_logger:format("Bad .yaws_auth file in dir ~p~n", 
+				     [Dir]),
+		 {Dir, A}
+	 end,
+    load_yaws_auth_file(SC, T, [A2|Acc]). 
+
+parse_yaws_auth_file([], Auth0) ->
+    Realm = Auth0#auth.realm,
+    Headers = Auth0#auth.headers ++ yaws:make_www_authenticate_header({realm, Realm}),
+    Auth0#auth{headers = Headers};
+
+parse_yaws_auth_file([{realm, Realm}|T], Auth0) ->
+    parse_yaws_auth_file(T, Auth0#auth{realm = Realm});
+
+parse_yaws_auth_file([{pam, Pam}|T], Auth0) 
+  when is_atom(Pam) ->
+    parse_yaws_auth_file(T, Auth0#auth{pam = Pam});
+
+parse_yaws_auth_file([{authmod, Authmod0}|T], Auth0) 
+  when is_atom(Authmod0)->
+    code:ensure_loaded(Authmod0),
+    %% Add the auth header for the mod
+    Headers = Authmod0:get_header() ++ Auth0#auth.headers,
+    parse_yaws_auth_file(T, Auth0#auth{mod = Authmod0, headers = Headers});
+
+parse_yaws_auth_file([{file, File}|T], Auth0) ->
+    [Dir] = Auth0#auth.dir,
+    New_dir = [Dir ++ File],
+    parse_yaws_auth_file(T, Auth0#auth{dir = New_dir});
+
+parse_yaws_auth_file([{User, Password}|T], Auth0) 
+  when is_list(User), is_list(Password) ->
+    Users = [{User, Password}|Auth0#auth.users],
+    parse_yaws_auth_file(T, Auth0#auth{users = Users}).
+
+
+%% Replace all "//" and "///" with "/"
+%% Might be a better way to do this
+remove_multiple_slash(L) ->
+    remove_multiple_slash(L, []).
+
+remove_multiple_slash([], Acc)->
+    lists:reverse(Acc);
+remove_multiple_slash("//" ++ T, Acc) ->
+    remove_multiple_slash([$/|T], Acc);
+remove_multiple_slash([H|T], Acc) ->    
+    remove_multiple_slash(T, [H|Acc]).
 
 %% This is the function that arranges sconfs into
 %% different server groups
@@ -584,14 +678,6 @@ fload(FD, globals, GC, C, Cs, Lno, Chars) ->
                     {error, ?F("Expect true|false at line ~w", [Lno])}
             end;
 
-        ["backwards_compat_parse", '=', Bool] ->
-            case is_bool(Bool) of
-                {true, Val} ->
-                    fload(FD, globals, ?gc_set_backwards_compat_parse(GC, Val),
-                          C, Cs, Lno+1, Next);
-                false ->
-                    {error, ?F("Expect true|false at line ~w", [Lno])}
-            end;
 
         ["auth_log", '=', Bool] ->
             case is_bool(Bool) of
@@ -1060,9 +1146,9 @@ fload(FD, server_auth, GC, C, Cs, Lno, Chars, Auth) ->
             A2 = Auth#auth{realm = Realm},
             fload(FD, server_auth, GC, C, Cs, Lno+1, Next, A2);
         ["authmod", '=', Mod] ->
-	    %% Add the auth header for the mod
 	    Mod2 = list_to_atom(Mod),
 	    code:ensure_loaded(Mod2),
+	    %% Add the auth header for the mod
 	    H = Mod2:get_header() ++ Auth#auth.headers,
             A2 = Auth#auth{mod = Mod2, headers = H},
             fload(FD, server_auth, GC, C, Cs, Lno+1, Next, A2);
@@ -1560,9 +1646,6 @@ find_sc(_SC,[]) ->
     false.
 
 
-
-
-
 verify_upgrade_args(GC, Groups0) when is_record(GC, gconf) ->
     case is_groups(Groups0) of
         true ->