1%% ``Licensed under the Apache License, Version 2.0 (the "License");
2%% you may not use this file except in compliance with the License.
3%% You may obtain a copy of the License at
4%%
5%%     http://www.apache.org/licenses/LICENSE-2.0
6%%
7%% Unless required by applicable law or agreed to in writing, software
8%% distributed under the License is distributed on an "AS IS" BASIS,
9%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
10%% See the License for the specific language governing permissions and
11%% limitations under the License.
12%%
13%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
14%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
15%% AB. All Rights Reserved.''
16%%
17%%     $Id: mod_htaccess.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
18
19-module(mod_htaccess).
20
21-export([do/1, load/2]).
22-export([debug/0]).
23
24-include("httpd.hrl").
25
26
27%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
28%% Public methods that interface the eswapi                         %%
29%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
30
31%----------------------------------------------------------------------
32% Public method called by the webbserver to insert the data about
33% Names on accessfiles
34%----------------------------------------------------------------------
35load([$A,$c,$c,$e,$s,$s,$F,$i,$l,$e,$N,$a,$m,$e|FileNames],Context)->
36    CleanFileNames=httpd_conf:clean(FileNames),
37    %%io:format("\n The filenames is:" ++ FileNames ++ "\n"),
38    {ok,[],{access_files,string:tokens(CleanFileNames," ")}}.
39
40
41%----------------------------------------------------------------------
42% Public method that the webbserver calls to control the page
43%----------------------------------------------------------------------
44do(Info)->
45    case httpd_util:key1search(Info#mod.data,status) of
46	{Status_code,PhraseArgs,Reason}->
47	    {proceed,Info#mod.data};
48	undefined ->
49	    control_path(Info)
50    end.
51
52
53%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
54%%                                                                  %%
55%% The functions that start the control if there is a accessfile    %%
56%% and if so controls if the dir is allowed or not                  %%
57%%                                                                  %%
58%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
59%----------------------------------------------------------------------
60%Info = record mod as specified in httpd.hrl
61%returns either {proceed,Info#mod.data}
62%{proceed,[{status,403....}|Info#mod.data]}
63%{proceed,[{status,401....}|Info#mod.data]}
64%{proceed,[{status,500....}|Info#mod.data]}
65%----------------------------------------------------------------------
66control_path(Info) ->
67    Path = mod_alias:path(Info#mod.data,
68			  Info#mod.config_db,
69			  Info#mod.request_uri),
70    case isErlScriptOrNotAccessibleFile(Path,Info) of
71	true->
72	    {proceed,Info#mod.data};
73	false->
74	    case getHtAccessData(Path,Info)of
75		{ok,public}->
76		    %%There was no restrictions on the page continue
77		    {proceed,Info#mod.data};
78		{error,Reason} ->
79		    %Something got wrong continue or quit??????????????????/
80                   {proceed,Info#mod.data};
81		{accessData,AccessData}->
82		    controlAllowedMethod(Info,AccessData)
83	    end
84    end.
85
86
87%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
88%%                                                                  %%
89%% These methods controls that the method the client used in the    %%
90%% request is one of the limited                                    %%
91%%                                                                  %%
92%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
93%----------------------------------------------------------------------
94%Control that if the accessmethod used is in the list of modes to challenge
95%
96%Info is the mod record as specified in httpd.hrl
97%AccessData is an ets table whit the data in the .htaccessfiles
98%----------------------------------------------------------------------
99controlAllowedMethod(Info,AccessData)->
100    case allowedRequestMethod(Info,AccessData) of
101	allow->
102	    %%The request didnt use one of the limited methods
103	    ets:delete(AccessData),
104	    {proceed,Info#mod.data};
105	challenge->
106	    authenticateUser(Info,AccessData)
107    end.
108
109%----------------------------------------------------------------------
110%Check the specified access method in the .htaccessfile
111%----------------------------------------------------------------------
112allowedRequestMethod(Info,AccessData)->
113    case ets:lookup(AccessData,limit) of
114	[{limit,all}]->
115	    challenge;
116	[{limit,Methods}]->
117	    isLimitedRequestMethod(Info,Methods)
118    end.
119
120
121%----------------------------------------------------------------------
122%Check the specified accessmethods in the .htaccesfile against the users
123%accessmethod
124%
125%Info is the record from the do call
126%Methods is a list of the methods specified in the .htaccessfile
127%----------------------------------------------------------------------
128isLimitedRequestMethod(Info,Methods)->
129    case lists:member(Info#mod.method,Methods) of
130	true->
131	    challenge;
132	false ->
133	    allow
134    end.
135
136
137%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
138%%                                                                  %%
139%% These methods controls that the user comes from an allowwed net  %%
140%% and if so wheather its a valid user or a challenge shall be      %%
141%% generated                                                        %%
142%%                                                                  %%
143%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
144%----------------------------------------------------------------------
145%The first thing to control is that the user is from a network
146%that has access to the page
147%----------------------------------------------------------------------
148authenticateUser(Info,AccessData)->
149    case controlNet(Info,AccessData) of
150	allow->
151	    %the network is ok control that it is an allowed user
152	    authenticateUser2(Info,AccessData);
153	deny->
154	    %The user isnt allowed to access the pages from that network
155	    ets:delete(AccessData),
156	    {proceed,[{status,{403,Info#mod.request_uri,
157	    "Restricted area not allowed from your network"}}|Info#mod.data]}
158    end.
159
160
161%----------------------------------------------------------------------
162%The network the user comes from is allowed to view the resources
163%control whether the user needsto supply a password or not
164%----------------------------------------------------------------------
165authenticateUser2(Info,AccessData)->
166    case ets:lookup(AccessData,require) of
167	[{require,AllowedUsers}]->
168	    case ets:lookup(AccessData,auth_name) of
169		[{auth_name,Realm}]->
170		    authenticateUser2(Info,AccessData,Realm,AllowedUsers);
171		_NoAuthName->
172		    ets:delete(AccessData),
173		    {break,[{status,{500,none,
174				     ?NICE("mod_htaccess:AuthName directive not specified")}}]}
175	    end;
176	[] ->
177	    %%No special user is required the network is ok so let
178	    %%the user in
179	    ets:delete(AccessData),
180	    {proceed,Info#mod.data}
181    end.
182
183
184%----------------------------------------------------------------------
185%The user must send a userId and a password to get the resource
186%Control if its already in the http-request
187%if the file with users is bad send an 500 response
188%----------------------------------------------------------------------
189authenticateUser2(Info,AccessData,Realm,AllowedUsers)->
190    case authenticateUser(Info,AccessData,AllowedUsers) of
191	allow ->
192	    ets:delete(AccessData),
193	    {user,Name,Pwd}=getAuthenticatingDataFromHeader(Info),
194	    {proceed, [{remote_user_name,Name}|Info#mod.data]};
195	challenge->
196	    ets:delete(AccessData),
197	    ReasonPhrase = httpd_util:reason_phrase(401),
198	    Message = httpd_util:message(401,none,Info#mod.config_db),
199	    {proceed,
200	     [{response,
201	       {401,
202		["WWW-Authenticate: Basic realm=\"",Realm,
203		 "\"\r\n\r\n","<HTML>\n<HEAD>\n<TITLE>",
204		 ReasonPhrase,"</TITLE>\n",
205		 "</HEAD>\n<BODY>\n<H1>",ReasonPhrase,
206		 "</H1>\n",Message,"\n</BODY>\n</HTML>\n"]}}|
207	      Info#mod.data]};
208	deny->
209	    ets:delete(AccessData),
210	    {break,[{status,{500,none,
211			     ?NICE("mod_htaccess:Bad path to user or group file")}}]}
212    end.
213
214
215%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
216%%                                                                  %%
217%% Methods that validate the netwqork the user comes from           %%
218%% according to the allowed networks                                %%
219%%                                                                  %%
220%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
221%---------------------------------------------------------------------
222%Controls the users networkaddress agains the specifed networks to
223%allow or deny
224%
225%returns either allow or deny
226%----------------------------------------------------------------------
227controlNet(Info,AccessData)->
228    UserNetwork=getUserNetworkAddress(Info),
229    case getAllowDenyOrder(AccessData) of
230	{_deny,[],_allow,[]}->
231	    allow;
232	{deny,[],allow,AllowedNetworks}->
233	    controlIfAllowed(AllowedNetworks,UserNetwork,allow,deny);
234	{allow,AllowedNetworks,deny,[]}->
235	    controlIfAllowed(AllowedNetworks,UserNetwork,allow,deny);
236
237	{deny,DeniedNetworks,allow,[]}->
238	    controlIfAllowed(DeniedNetworks,UserNetwork,allow,deny);
239	{allow,[],deny,DeniedNetworks}->
240	    controlIfAllowed(DeniedNetworks,UserNetwork,allow,deny);
241
242	{deny,DeniedNetworks,allow,AllowedNetworks}->
243	    controlDenyAllow(DeniedNetworks,AllowedNetworks,UserNetwork);
244	{allow,AllowedNetworks,deny,DeniedNetworks}->
245	    controlAllowDeny(AllowedNetworks,DeniedNetworks,UserNetwork)
246    end.
247
248
249%----------------------------------------------------------------------
250%Returns the users IP-Number
251%----------------------------------------------------------------------
252getUserNetworkAddress(Info)->
253    {_Socket,Address}=(Info#mod.init_data)#init_data.peername,
254    Address.
255
256
257%----------------------------------------------------------------------
258%Control the users Ip-number against the ip-numbers in the .htaccessfile
259%----------------------------------------------------------------------
260controlIfAllowed(AllowedNetworks,UserNetwork,IfAllowed,IfDenied)->
261    case AllowedNetworks of
262	[{allow,all}]->
263	   IfAllowed;
264	[{deny,all}]->
265	    IfDenied;
266        [{deny,Networks}]->
267	    memberNetwork(Networks,UserNetwork,IfDenied,IfAllowed);
268	[{allow,Networks}]->
269	    memberNetwork(Networks,UserNetwork,IfAllowed,IfDenied);
270	_Error->
271	    IfDenied
272    end.
273
274
275%--------------------------------------------------------------------%
276%The Denycontrol isn't necessary to preform since the allow control  %
277%override the deny control                                           %
278%--------------------------------------------------------------------%
279controlDenyAllow(DeniedNetworks,AllowedNetworks,UserNetwork)->
280    case AllowedNetworks of
281	[{allow,all}]->
282	    allow;
283	[{allow,Networks}]->
284	  case memberNetwork(Networks,UserNetwork) of
285	      true->
286		  allow;
287	      false->
288		  deny
289	  end
290    end.
291
292
293%----------------------------------------------------------------------%
294%Control that the user is in the allowed list if so control that the   %
295%network is in the denied list
296%----------------------------------------------------------------------%
297controlAllowDeny(AllowedNetworks,DeniedNetworks,UserNetwork)->
298    case controlIfAllowed(AllowedNetworks,UserNetwork,allow,deny) of
299	allow->
300	    controlIfAllowed(DeniedNetworks,UserNetwork,deny,allow);
301	deny ->
302	    deny
303    end.
304
305%----------------------------------------------------------------------
306%Controls if the users Ipnumber is in the list of either denied or
307%allowed networks
308%----------------------------------------------------------------------
309memberNetwork(Networks,UserNetwork,IfTrue,IfFalse)->
310    case memberNetwork(Networks,UserNetwork) of
311	true->
312	    IfTrue;
313	false->
314	    IfFalse
315    end.
316
317
318%----------------------------------------------------------------------
319%regexp match the users ip-address against the networks in the list of
320%ipadresses or subnet addresses.
321memberNetwork(Networks,UserNetwork)->
322    case lists:filter(fun(Net)->
323			      case regexp:match(UserNetwork,
324						formatRegexp(Net)) of
325				  {match,1,_}->
326				      true;
327				  _NotSubNet ->
328				      false
329			      end
330		      end,Networks) of
331	[]->
332	    false;
333	MemberNetWork ->
334	    true
335    end.
336
337
338%----------------------------------------------------------------------
339%Creates a regexp from an ip-number i.e "127.0.0-> "^127[.]0[.]0.*"
340%"127.0.0.-> "^127[.]0[.]0[.].*"
341%----------------------------------------------------------------------
342formatRegexp(Net)->
343    [SubNet1|SubNets]=string:tokens(Net,"."),
344    NetRegexp=lists:foldl(fun(SubNet,Newnet)->
345				  Newnet ++ "[.]" ++SubNet
346			  end,"^"++SubNet1,SubNets),
347    case string:len(Net)-string:rchr(Net,$.) of
348	0->
349	    NetRegexp++"[.].*";
350	_->
351	    NetRegexp++".*"
352    end.
353
354
355%----------------------------------------------------------------------
356%If the user has specified if the allow or deny check shall be preformed
357%first get that order if no order is specified take
358%allow - deny since its harder that deny - allow
359%----------------------------------------------------------------------
360getAllowDenyOrder(AccessData)->
361    case ets:lookup(AccessData,order) of
362	[{order,{deny,allow}}]->
363	    {deny,ets:lookup(AccessData,deny),
364	     allow,ets:lookup(AccessData,allow)};
365	_DefaultOrder->
366	    {allow,ets:lookup(AccessData,allow),
367	     deny,ets:lookup(AccessData,deny)}
368    end.
369
370
371%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
372%%                                                                  %%
373%% The methods that validates the user                              %%
374%%                                                                  %%
375%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
376
377%----------------------------------------------------------------------
378%Control if there is anyu autheticating data in threquest header
379%if so it controls it against the users in the list Allowed Users
380%----------------------------------------------------------------------
381authenticateUser(Info,AccessData,AllowedUsers)->
382    case getAuthenticatingDataFromHeader(Info) of
383	{user,User,PassWord}->
384	    authenticateUser(Info,AccessData,AllowedUsers,
385			     {user,User,PassWord});
386	{error,nouser}->
387	    challenge;
388	{error,BadData}->
389	    challenge
390    end.
391
392
393%----------------------------------------------------------------------
394%Returns the Autheticating data in the http-request
395%----------------------------------------------------------------------
396getAuthenticatingDataFromHeader(Info)->
397    PrsedHeader=Info#mod.parsed_header,
398    case httpd_util:key1search(PrsedHeader,"authorization" ) of
399	undefined->
400	    {error,nouser};
401	[$B,$a,$s,$i,$c,$\ |EncodedString]->
402	    UnCodedString=httpd_util:decode_base64(EncodedString),
403	    case httpd_util:split(UnCodedString,":",2) of
404		{ok,[User,PassWord]}->
405		    {user,User,PassWord};
406		{error,Error}->
407		    {error,Error}
408	    end;
409	BadCredentials ->
410	    {error,BadCredentials}
411    end.
412
413
414%----------------------------------------------------------------------
415%Returns a list of all members of the allowed groups
416%----------------------------------------------------------------------
417getGroupMembers(Groups,AllowedGroups)->
418    Allowed=lists:foldl(fun({group,Name,Members},AllowedMembers)->
419				case lists:member(Name,AllowedGroups) of
420				    true->
421					AllowedMembers++Members;
422				    false ->
423					AllowedMembers
424				end
425	       end,[],Groups),
426    {ok,Allowed}.
427
428authenticateUser(Info,AccessData,{{users,[]},{groups,Groups}},User)->
429    authenticateUser(Info,AccessData,{groups,Groups},User);
430authenticateUser(Info,AccessData,{{users,Users},{groups,[]}},User)->
431    authenticateUser(Info,AccessData,{users,Users},User);
432
433authenticateUser(Info,AccessData,{{users,Users},{groups,Groups}},User)->
434    AllowUser=authenticateUser(Info,AccessData,{users,Users},User),
435    AllowGroup=authenticateUser(Info,AccessData,{groups,Groups},User),
436    case {AllowGroup,AllowUser} of
437	{_,allow}->
438	    allow;
439	{allow,_}->
440	    allow;
441	{challenge,_}->
442	    challenge;
443	{_,challenge}->
444	    challenge;
445	{_deny,_deny}->
446	    deny
447    end;
448
449
450%----------------------------------------------------------------------
451%Controls that the user is a member in one of the allowed group
452%----------------------------------------------------------------------
453authenticateUser(Info,AccessData,{groups,AllowedGroups},{user,User,PassWord})->
454    case getUsers(AccessData,group_file) of
455	{group_data,Groups}->
456	    case  getGroupMembers(Groups,AllowedGroups) of
457	       {ok,Members}->
458		    authenticateUser(Info,AccessData,{users,Members},
459				     {user,User,PassWord});
460		{error,BadData}->
461		    deny
462	    end;
463	{error,BadData}->
464	    deny
465    end;
466
467
468%----------------------------------------------------------------------
469%Control that the user is one of the allowed users and that the passwd is ok
470%----------------------------------------------------------------------
471authenticateUser(Info,AccessData,{users,AllowedUsers},{user,User,PassWord})->
472    case lists:member(User,AllowedUsers) of
473       true->
474	    %Get the usernames and passwords from the file
475	    case getUsers(AccessData,user_file) of
476		{error,BadData}->
477		    deny;
478		{user_data,Users}->
479		    %Users is a list of the users in
480		    %the userfile [{user,User,Passwd}]
481		    checkPassWord(Users,{user,User,PassWord})
482	    end;
483	false ->
484	    challenge
485    end.
486
487
488%----------------------------------------------------------------------
489%Control that the user User={user,"UserName","PassWd"} is
490%member of the list of Users
491%----------------------------------------------------------------------
492checkPassWord(Users,User)->
493    case lists:member(User,Users) of
494	true->
495	    allow;
496	false->
497	    challenge
498    end.
499
500
501%----------------------------------------------------------------------
502%Get the users in the specified file
503%UserOrGroup is an atom that specify if its a group file or a user file
504%i.e. group_file or user_file
505%----------------------------------------------------------------------
506getUsers({file,FileName},UserOrGroup)->
507    case file:open(FileName,[read]) of
508        {ok,AccessFileHandle} ->
509	    getUsers({stream,AccessFileHandle},[],UserOrGroup);
510        {error,Reason} ->
511	    {error,{Reason,FileName}}
512    end;
513
514
515%----------------------------------------------------------------------
516%The method that starts the lokkong for user files
517%----------------------------------------------------------------------
518
519getUsers(AccessData,UserOrGroup)->
520    case ets:lookup(AccessData,UserOrGroup) of
521	[{UserOrGroup,File}]->
522	    getUsers({file,File},UserOrGroup);
523	_ ->
524	    {error,noUsers}
525    end.
526
527
528%----------------------------------------------------------------------
529%Reads data from the filehandle File to the list FileData and when its
530%reach the end it returns the list in a tuple {user_file|group_file,FileData}
531%----------------------------------------------------------------------
532getUsers({stream,File},FileData,UserOrGroup)->
533    case io:get_line(File,[]) of
534        eof when UserOrGroup==user_file->
535	    {user_data,FileData};
536	eof when UserOrGroup ==group_file->
537	   {group_data,FileData};
538        Line ->
539	    getUsers({stream,File},
540		     formatUser(Line,FileData,UserOrGroup),UserOrGroup)
541    end.
542
543
544%----------------------------------------------------------------------
545%If the line is a comment remove it
546%----------------------------------------------------------------------
547formatUser([$#|UserDataComment],FileData,_UserOrgroup)->
548    FileData;
549
550
551%----------------------------------------------------------------------
552%The user name in the file is Username:Passwd\n
553%Remove the newline sign and split the user name in
554%UserName and Password
555%----------------------------------------------------------------------
556formatUser(UserData,FileData,UserOrGroup)->
557    case string:tokens(UserData," \r\n")of
558	[User|Whitespace] when UserOrGroup==user_file->
559	    case string:tokens(User,":") of
560		[Name,PassWord]->
561		    [{user,Name,PassWord}|FileData];
562		_Error->
563		    FileData
564	    end;
565	GroupData when UserOrGroup==group_file ->
566	    parseGroupData(GroupData,FileData);
567	_Error ->
568	    FileData
569    end.
570
571
572%----------------------------------------------------------------------
573%if everything is right GroupData is on the form
574% ["groupName:", "Member1", "Member2", "Member2"
575%----------------------------------------------------------------------
576parseGroupData([GroupName|GroupData],FileData)->
577    [{group,formatGroupName(GroupName),GroupData}|FileData].
578
579
580%----------------------------------------------------------------------
581%the line in the file is GroupName: Member1 Member2 .....MemberN
582%Remove the : from the group name
583%----------------------------------------------------------------------
584formatGroupName(GroupName)->
585    string:strip(GroupName,right,$:).
586
587
588%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
589%%                                                                  %%
590%%  Functions that parses the accessfiles                           %%
591%%                                                                  %%
592%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
593%----------------------------------------------------------------------
594%Control that the asset is a real file and not a request for an virtual
595%asset
596%----------------------------------------------------------------------
597isErlScriptOrNotAccessibleFile(Path,Info)->
598    case file:read_file_info(Path) of
599	{ok,_fileInfo}->
600	    false;
601	{error,_Reason} ->
602	    true
603    end.
604
605
606%----------------------------------------------------------------------
607%Path=PathToTheRequestedFile=String
608%Innfo=record#mod
609%----------------------------------------------------------------------
610getHtAccessData(Path,Info)->
611    HtAccessFileNames=getHtAccessFileNames(Info),
612    case getData(Path,Info,HtAccessFileNames) of
613	{ok,public}->
614	    {ok,public};
615	{accessData,AccessData}->
616	    {accessData,AccessData};
617	{error,Reason} ->
618	    {error,Reason}
619    end.
620
621
622%----------------------------------------------------------------------
623%returns the names of the accessfiles
624%----------------------------------------------------------------------
625getHtAccessFileNames(Info)->
626    case httpd_util:lookup(Info#mod.config_db,access_files) of
627	undefined->
628	    [".htaccess"];
629	Files->
630	    Files
631    end.
632%----------------------------------------------------------------------
633%HtAccessFileNames=["accessfileName1",..."AccessFileName2"]
634%----------------------------------------------------------------------
635getData(Path,Info,HtAccessFileNames)->
636    case regexp:split(Path,"/") of
637	{error,Error}->
638	    {error,Error};
639	{ok,SplittedPath}->
640	    getData2(HtAccessFileNames,SplittedPath,Info)
641	end.
642
643
644%----------------------------------------------------------------------
645%Add to together the data in the Splittedpath up to the path
646%that is the alias or the document root
647%Since we do not need to control after any accessfiles before here
648%----------------------------------------------------------------------
649getData2(HtAccessFileNames,SplittedPath,Info)->
650    case getRootPath(SplittedPath,Info) of
651	{error,Path}->
652	    {error,Path};
653	{ok,StartPath,RestOfSplittedPath} ->
654	    getData2(HtAccessFileNames,StartPath,RestOfSplittedPath,Info)
655    end.
656
657
658%----------------------------------------------------------------------
659%HtAccessFilenames is a list the names the accesssfiles can have
660%Path is the shortest match against all alias and documentroot
661%rest of splitted path is a list of the parts of the path
662%Info is the mod recod from the server
663%----------------------------------------------------------------------
664getData2(HtAccessFileNames,StartPath,RestOfSplittedPath,Info)->
665    case getHtAccessFiles(HtAccessFileNames,StartPath,RestOfSplittedPath) of
666	[]->
667	    %No accessfile qiut its a public directory
668	    {ok,public};
669	Files ->
670	    loadAccessFilesData(Files)
671    end.
672
673
674%----------------------------------------------------------------------
675%Loads the data in the accessFiles specifiied by
676% AccessFiles=["/hoem/public/html/accefile",
677%               "/home/public/html/priv/accessfile"]
678%----------------------------------------------------------------------
679loadAccessFilesData(AccessFiles)->
680    loadAccessFilesData(AccessFiles,ets:new(accessData,[])).
681
682
683%----------------------------------------------------------------------
684%Returns the found data
685%----------------------------------------------------------------------
686contextToValues(AccessData)->
687    case ets:lookup(AccessData,context) of
688	[{context,Values}]->
689	    ets:delete(AccessData,context),
690	    insertContext(AccessData,Values),
691	    {accessData,AccessData};
692	_Error->
693	    {error,errorInAccessFile}
694    end.
695
696
697insertContext(AccessData,[])->
698    ok;
699
700insertContext(AccessData,[{allow,From}|Values])->
701    insertDenyAllowContext(AccessData,{allow,From}),
702    insertContext(AccessData,Values);
703
704insertContext(AccessData,[{deny,From}|Values])->
705    insertDenyAllowContext(AccessData,{deny,From}),
706    insertContext(AccessData,Values);
707
708insertContext(AccessData,[{require,{GrpOrUsr,Members}}|Values])->
709    case ets:lookup(AccessData,require) of
710	[]when GrpOrUsr==users->
711	    ets:insert(AccessData,{require,{{users,Members},{groups,[]}}});
712
713	[{require,{{users,Users},{groups,Groups}}}]when GrpOrUsr==users ->
714	    ets:insert(AccessData,{require,{{users,Users++Members},
715					   {groups,Groups}}});
716	[]when GrpOrUsr==groups->
717	    ets:insert(AccessData,{require,{{users,[]},{groups,Members}}});
718
719	[{require,{{users,Users},{groups,Groups}}}]when GrpOrUsr==groups ->
720	    ets:insert(AccessData,{require,{{users,Users},
721					   {groups,Groups++Members}}})
722    end,
723    insertContext(AccessData,Values);
724
725
726
727%%limit and order directive need no transforming they areis just to insert
728insertContext(AccessData,[Elem|Values])->
729    ets:insert(AccessData,Elem),
730    insertContext(AccessData,Values).
731
732
733insertDenyAllowContext(AccessData,{AllowDeny,From})->
734    case From of
735	all->
736	    ets:insert(AccessData,{AllowDeny,all});
737	AllowedSubnets->
738	    case ets:lookup(AccessData,AllowDeny) of
739		[]->
740		    ets:insert(AccessData,{AllowDeny,From});
741		[{AllowDeny,all}]->
742		    ok;
743		[{AllowDeny,Networks}]->
744		    ets:insert(AccessData,{allow,Networks++From})
745	    end
746    end.
747
748loadAccessFilesData([],AccessData)->
749    %preform context to limits
750    contextToValues(AccessData),
751    {accessData,AccessData};
752
753%----------------------------------------------------------------------
754%Takes each file in the list and load the data to the ets table
755%AccessData
756%----------------------------------------------------------------------
757loadAccessFilesData([FileName|FileNames],AccessData)->
758    case loadAccessFileData({file,FileName},AccessData) of
759	overRide->
760	    loadAccessFilesData(FileNames,AccessData);
761	noOverRide ->
762	    {accessData,AccessData};
763	error->
764	    ets:delete(AccessData),
765	    {error,errorInAccessFile}
766    end.
767
768%----------------------------------------------------------------------
769%opens the filehandle to the specified file
770%----------------------------------------------------------------------
771loadAccessFileData({file,FileName},AccessData)->
772    case file:open(FileName,[read]) of
773        {ok,AccessFileHandle}->
774	    loadAccessFileData({stream,AccessFileHandle},AccessData,[]);
775        {error,Reason} ->
776	    overRide
777    end.
778
779%----------------------------------------------------------------------
780%%look att each line in the file and add them to the database
781%%When end of file is reached control i overrride is allowed
782%% if so return
783%----------------------------------------------------------------------
784loadAccessFileData({stream,File},AccessData,FileData)->
785    case io:get_line(File,[]) of
786        eof->
787	    insertData(AccessData,FileData),
788	    case ets:match_object(AccessData,{'_',error}) of
789		[]->
790		    %Case we got no error control that we can override a
791		    %at least some of the values
792		    case ets:match_object(AccessData,
793					  {allow_over_ride,none}) of
794			[]->
795			    overRide;
796			_NoOverride->
797			    noOverRide
798		    end;
799		Errors->
800		    error
801	    end;
802	Line ->
803	    loadAccessFileData({stream,File},AccessData,
804			       insertLine(string:strip(Line,left),FileData))
805    end.
806
807%----------------------------------------------------------------------
808%AccessData is a ets table where the previous found data is inserted
809%FileData is a list of the directives in the last parsed file
810%before insertion a control is done that the directive is allowed to
811%override
812%----------------------------------------------------------------------
813insertData(AccessData,{{context,Values},FileData})->
814    insertData(AccessData,[{context,Values}|FileData]);
815
816insertData(AccessData,FileData)->
817    case ets:lookup(AccessData,allow_over_ride) of
818	[{allow_over_ride,all}]->
819	    lists:foreach(fun(Elem)->
820				  ets:insert(AccessData,Elem)
821			  end,FileData);
822	[]->
823	    lists:foreach(fun(Elem)->
824				  ets:insert(AccessData,Elem)
825			  end,FileData);
826	[{allow_over_ride,Directives}]when list(Directives)->
827	    lists:foreach(fun({Key,Value})->
828				  case lists:member(Key,Directives) of
829				      true->
830					  ok;
831				      false ->
832					  ets:insert(AccessData,{Key,Value})
833				  end
834			  end,FileData);
835	[{allow_over_ride,_}]->
836	    %Will never appear if the user
837	    %aint doing very strang econfig files
838	    ok
839    end.
840%----------------------------------------------------------------------
841%Take a line in the accessfile and transform it into a tuple that
842%later can be inserted in to the ets:table
843%----------------------------------------------------------------------
844%%%Here is the alternatives that resides inside the limit context
845
846insertLine([$o,$r,$d,$e,$r|Order],{{context,Values},FileData})->
847    {{context,[{order,getOrder(Order)}|Values]},FileData};
848%%Let the user place a tab in the beginning
849insertLine([$\t,$o,$r,$d,$e,$r|Order],{{context,Values},FileData})->
850    {{context,[{order,getOrder(Order)}|Values]},FileData};
851
852insertLine([$a,$l,$l,$o,$w|Allow],{{context,Values},FileData})->
853    {{context,[{allow,getAllowDenyData(Allow)}|Values]},FileData};
854insertLine([$\t,$a,$l,$l,$o,$w|Allow],{{context,Values},FileData})->
855    {{context,[{allow,getAllowDenyData(Allow)}|Values]},FileData};
856
857insertLine([$d,$e,$n,$y|Deny],{{context,Values},FileData})->
858    {{context,[{deny,getAllowDenyData(Deny)}|Values]},FileData};
859insertLine([$\t,$d,$e,$n,$y|Deny],{{context,Values},FileData})->
860    {{context,[{deny,getAllowDenyData(Deny)}|Values]},FileData};
861
862
863insertLine([$r,$e,$q,$u,$i,$r,$e|Require],{{context,Values},FileData})->
864    {{context,[{require,getRequireData(Require)}|Values]},FileData};
865insertLine([$\t,$r,$e,$q,$u,$i,$r,$e|Require],{{context,Values},FileData})->
866    {{context,[{require,getRequireData(Require)}|Values]},FileData};
867
868
869insertLine([$<,$/,$L,$i,$m,$i,$t|EndLimit],{Context,FileData})->
870    [Context|FileData];
871
872insertLine([$<,$L,$i,$m,$i,$t|Limit],FileData)->
873    {{context,[{limit,getLimits(Limit)}]}, FileData};
874
875
876
877insertLine([$A,$u,$t,$h,$U,$s,$e,$r,$F,$i,$l,$e,$\ |AuthUserFile],FileData)->
878    [{user_file,string:strip(AuthUserFile,right,$\n)}|FileData];
879
880insertLine([$A,$u,$t,$h,$G,$r,$o,$u,$p,$F,$i,$l,$e,$\ |AuthGroupFile],
881	   FileData)->
882    [{group_file,string:strip(AuthGroupFile,right,$\n)}|FileData];
883
884insertLine([$A,$l,$l,$o,$w,$O,$v,$e,$r,$R,$i,$d,$e|AllowOverRide],FileData)->
885    [{allow_over_ride,getAllowOverRideData(AllowOverRide)}
886     |FileData];
887
888insertLine([$A,$u,$t,$h,$N,$a,$m,$e,$\ |AuthName],FileData)->
889    [{auth_name,string:strip(AuthName,right,$\n)}|FileData];
890
891insertLine([$A,$u,$t,$h,$T,$y,$p,$e|AuthType],FileData)->
892    [{auth_type,getAuthorizationType(AuthType)}|FileData];
893
894insertLine(_BadDirectiveOrComment,FileData)->
895    FileData.
896
897%----------------------------------------------------------------------
898%transform the Data specified about override to a form that is ieasier
899%handled later
900%Override data="all"|"md5"|"Directive1 .... DirectioveN"
901%----------------------------------------------------------------------
902
903getAllowOverRideData(OverRideData)->
904   case string:tokens(OverRideData," \r\n") of
905       [[$a,$l,$l]|_]->
906	   all;
907        [[$n,$o,$n,$e]|_]->
908	   none;
909       Directives ->
910	   getOverRideDirectives(Directives)
911   end.
912
913getOverRideDirectives(Directives)->
914    lists:map(fun(Directive)->
915		      transformDirective(Directive)
916	      end,Directives).
917transformDirective([$A,$u,$t,$h,$U,$s,$e,$r,$F,$i,$l,$e|_])->
918    user_file;
919transformDirective([$A,$u,$t,$h,$G,$r,$o,$u,$p,$F,$i,$l,$e|_]) ->
920    group_file;
921transformDirective([$A,$u,$t,$h,$N,$a,$m,$e|_])->
922    auth_name;
923transformDirective([$A,$u,$t,$h,$T,$y,$p,$e|_])->
924    auth_type;
925transformDirective(_UnAllowedOverRideDirective) ->
926    unallowed.
927%----------------------------------------------------------------------
928%Replace the string that specify which method to use for authentication
929%and replace it with the atom for easier mathing
930%----------------------------------------------------------------------
931getAuthorizationType(AuthType)->
932    [Arg|Crap]=string:tokens(AuthType,"\n\r\ "),
933    case Arg of
934	[$B,$a,$s,$i,$c]->
935	    basic;
936	[$M,$D,$5] ->
937	    md5;
938	_What ->
939	    error
940    end.
941%----------------------------------------------------------------------
942%Returns a list of the specified methods to limit or the atom all
943%----------------------------------------------------------------------
944getLimits(Limits)->
945    case regexp:split(Limits,">")of
946	{ok,[_NoEndOnLimit]}->
947	    error;
948	{ok,[Methods|Crap]}->
949	    case regexp:split(Methods," ")of
950		{ok,[]}->
951		    all;
952		{ok,SplittedMethods}->
953		    SplittedMethods;
954		{error,Error}->
955		    error
956	    end;
957	{error,_Error}->
958	    error
959    end.
960
961
962%----------------------------------------------------------------------
963% Transform the order to prefrom deny allow control to a tuple of atoms
964%----------------------------------------------------------------------
965getOrder(Order)->
966    [First|Rest]=lists:map(fun(Part)->
967		      list_to_atom(Part)
968	      end,string:tokens(Order," \n\r")),
969    case First of
970	deny->
971	    {deny,allow};
972	allow->
973	    {allow,deny};
974	_Error->
975	    error
976    end.
977
978%----------------------------------------------------------------------
979% The string AllowDeny is "from all" or "from Subnet1 Subnet2...SubnetN"
980%----------------------------------------------------------------------
981getAllowDenyData(AllowDeny)->
982    case string:tokens(AllowDeny," \n\r") of
983	[_From|AllowDenyData] when length(AllowDenyData)>=1->
984	    case lists:nth(1,AllowDenyData) of
985		[$a,$l,$l]->
986		    all;
987		Hosts->
988		    AllowDenyData
989	    end;
990	Error->
991	    errror
992    end.
993%----------------------------------------------------------------------
994% Fix the string that describes who is allowed to se the page
995%----------------------------------------------------------------------
996getRequireData(Require)->
997    [UserOrGroup|UserData]=string:tokens(Require," \n\r"),
998    case UserOrGroup of
999	[$u,$s,$e,$r]->
1000	    {users,UserData};
1001	[$g,$r,$o,$u,$p] ->
1002	    {groups,UserData};
1003	_Whatever ->
1004	    error
1005    end.
1006
1007
1008%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1009%%                                                                  %%
1010%% Methods that collects the searchways to the accessfiles          %%
1011%%                                                                  %%
1012%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1013
1014%----------------------------------------------------------------------
1015% Get the whole path to the different accessfiles
1016%----------------------------------------------------------------------
1017getHtAccessFiles(HtAccessFileNames,Path,RestOfSplittedPath)->
1018    getHtAccessFiles(HtAccessFileNames,Path,RestOfSplittedPath,[]).
1019
1020getHtAccessFiles(HtAccessFileNames,Path,[[]],HtAccessFiles)->
1021    HtAccessFiles ++ accessFilesOfPath(HtAccessFileNames,Path++"/");
1022
1023getHtAccessFiles(HtAccessFileNames,Path,[],HtAccessFiles)->
1024    HtAccessFiles;
1025getHtAccessFiles(HtAccessFileNames,Path,[NextDir|RestOfSplittedPath],
1026		 AccessFiles)->
1027    getHtAccessFiles(HtAccessFileNames,Path++"/"++NextDir,RestOfSplittedPath,
1028		     AccessFiles ++
1029		     accessFilesOfPath(HtAccessFileNames,Path++"/")).
1030
1031
1032%----------------------------------------------------------------------
1033%Control if therer are any accessfies in the path
1034%----------------------------------------------------------------------
1035accessFilesOfPath(HtAccessFileNames,Path)->
1036    lists:foldl(fun(HtAccessFileName,Files)->
1037			case file:read_file_info(Path++HtAccessFileName) of
1038			    {ok,FileInfo}->
1039				[Path++HtAccessFileName|Files];
1040			    {error,_Error} ->
1041				Files
1042			end
1043		end,[],HtAccessFileNames).
1044
1045
1046%----------------------------------------------------------------------
1047%Sake the splitted path and joins it up to the documentroot or the alias
1048%that match first
1049%----------------------------------------------------------------------
1050
1051getRootPath(SplittedPath,Info)->
1052    DocRoot=httpd_util:lookup(Info#mod.config_db,document_root,"/"),
1053    PresumtiveRootPath=
1054	[DocRoot|lists:map(fun({Alias,RealPath})->
1055				   RealPath
1056			   end,
1057		 httpd_util:multi_lookup(Info#mod.config_db,alias))],
1058    getRootPath(PresumtiveRootPath,SplittedPath,Info).
1059
1060
1061getRootPath(PresumtiveRootPath,[[],Splittedpath],Info)->
1062    getRootPath(PresumtiveRootPath,["/",Splittedpath],Info);
1063
1064
1065getRootPath(PresumtiveRootPath,[Part,NextPart|SplittedPath],Info)->
1066    case lists:member(Part,PresumtiveRootPath)of
1067	true->
1068	    {ok,Part,[NextPart|SplittedPath]};
1069	false ->
1070	    getRootPath(PresumtiveRootPath,
1071			[Part++"/"++NextPart|SplittedPath],Info)
1072    end;
1073
1074getRootPath(PresumtiveRootPath,[Part],Info)->
1075    case lists:member(Part,PresumtiveRootPath)of
1076	true->
1077	    {ok,Part,[]};
1078	false ->
1079	    {error,Part}
1080    end.
1081
1082
1083%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1084%%Debug methods                                                     %%
1085%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
1086%----------------------------------------------------------------------
1087% Simulate the webserver by calling do/1 with apropiate parameters
1088%----------------------------------------------------------------------
1089debug()->
1090    Conf=getConfigData(),
1091    Uri=getUri(),
1092    {_Proceed,Data}=getDataFromAlias(Conf,Uri),
1093    Init_data=#init_data{peername={socket,"127.0.0.1"}},
1094    ParsedHeader=headerparts(),
1095    do(#mod{init_data=Init_data,
1096	    data=Data,
1097	    config_db=Conf,
1098	    request_uri=Uri,
1099	    parsed_header=ParsedHeader,
1100	   method="GET"}).
1101
1102%----------------------------------------------------------------------
1103%Add authenticate data to the fake http-request header
1104%----------------------------------------------------------------------
1105headerparts()->
1106    [{"authorization","Basic " ++ httpd_util:encode_base64("lotta:potta")}].
1107
1108getDataFromAlias(Conf,Uri)->
1109    mod_alias:do(#mod{config_db=Conf,request_uri=Uri}).
1110
1111getUri()->
1112    "/appmon/test/test.html".
1113
1114getConfigData()->
1115    Tab=ets:new(test_inets,[bag,public]),
1116    ets:insert(Tab,{server_name,"localhost"}),
1117    ets:insert(Tab,{bind_addresss,{127,0,0,1}}),
1118    ets:insert(Tab,{erl_script_alias,{"/webcover/erl",["webcover"]}}),
1119    ets:insert(Tab,{erl_script_alias,{"/erl",["webappmon"]}}),
1120    ets:insert(Tab,{com_type,ip_comm}),
1121    ets:insert(Tab,{modules,[mod_alias,mod_auth,mod_header]}),
1122    ets:insert(Tab,{default_type,"text/plain"}),
1123    ets:insert(Tab,{server_root,
1124		    "/home/gandalf/marting/exjobb/webtool-1.0/priv/root"}),
1125    ets:insert(Tab,{port,8888}),
1126    ets:insert(Tab,{document_root,
1127		    "/home/gandalf/marting/exjobb/webtool-1.0/priv/root"}),
1128    ets:insert(Tab,
1129	       {alias,
1130		{"/appmon"
1131		 ,"/home/gandalf/marting/exjobb/webappmon-1.0/priv"}}),
1132    ets:insert(Tab,{alias,
1133		    {"/webcover"
1134		     ,"/home/gandalf/marting/exjobb/webcover-1.0/priv"}}),
1135    ets:insert(Tab,{access_file,[".htaccess","kalle","pelle"]}),
1136    Tab.
1137