← Back to branch summary

~ubuntu-branches/ubuntu/trusty/erlang/trusty

« back to all changes in this revision

Viewing changes to lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_security_server.erl

  • Committer: Bazaar Package Importer
  • Author(s): Clint Byrum
  • Date: 2011-05-05 15:48:43 UTC
  • mfrom: (3.5.13 sid)
  • Revision ID: james.westby@ubuntu.com-20110505154843-0om6ekzg6m7ugj27
Tags: 1:14.b.2-dfsg-3ubuntu1
* Merge from debian unstable.  Remaining changes:
  - Drop libwxgtk2.8-dev build dependency. Wx isn't in main, and not
    supposed to.
  - Drop erlang-wx binary.
  - Drop erlang-wx dependency from -megaco, -common-test, and -reltool, they
    do not really need wx. Also drop it from -debugger; the GUI needs wx,
    but it apparently has CLI bits as well, and is also needed by -megaco,
    so let's keep the package for now.
  - debian/patches/series: Do what I meant, and enable build-options.patch
    instead.
* Additional changes:
  - Drop erlang-wx from -et
* Dropped Changes:
  - patches/pcre-crash.patch: CVE-2008-2371: outer level option with
    alternatives caused crash. (Applied Upstream)
  - fix for ssl certificate verification in newSSL: 
    ssl_cacertfile_fix.patch (Applied Upstream)
  - debian/patches/series: Enable native.patch again, to get stripped beam
    files and reduce the package size again. (build-options is what
    actually accomplished this)
  - Remove build-options.patch on advice from upstream and because it caused
    odd build failures.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/dialyzer/test/r9c_tests_SUITE_data/src/inets/mod_security_server.erl
 
1
%% ``The contents of this file are subject to the Erlang Public License,
 
2
%% Version 1.1, (the "License"); you may not use this file except in
 
3
%% compliance with the License. You should have received a copy of the
 
4
%% Erlang Public License along with this software. If not, it can be
 
5
%% retrieved via the world wide web at http://www.erlang.org/.
 
6
%% 
 
7
%% Software distributed under the License is distributed on an "AS IS"
 
8
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 
9
%% the License for the specific language governing rights and limitations
 
10
%% under the License.
 
11
%% 
 
12
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
 
13
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
 
14
%% AB. All Rights Reserved.''
 
15
%% 
 
16
%%     $Id: mod_security_server.erl,v 1.1 2008/12/17 09:53:36 mikpe Exp $
 
17
%%
 
18
%% Security Audit Functionality
 
19
 
 
20
%%
 
21
%% The gen_server code.
 
22
%%
 
23
%% A gen_server is needed in this module to take care of shared access to the
 
24
%% data file used to store failed and successful authentications aswell as 
 
25
%% user blocks.
 
26
%%
 
27
%% The storage model is a write-through model with both an ets and a dets 
 
28
%% table. Writes are done to both the ets and then the dets table, but reads 
 
29
%% are only done from the ets table.
 
30
%%
 
31
%% This approach also enables parallelism when using dets by returning the 
 
32
%% same dets table identifier when opening several files with the same 
 
33
%% physical location.
 
34
%%
 
35
%% NOTE: This could be implemented using a single dets table, as it is 
 
36
%%       possible to open a dets file with the ram_file flag, but this 
 
37
%%       would require periodical sync's to disk, and it would be hard 
 
38
%%       to decide when such an operation should occur.
 
39
%%
 
40
 
 
41
 
 
42
-module(mod_security_server).
 
43
 
 
44
-include("httpd.hrl").
 
45
-include("httpd_verbosity.hrl").
 
46
 
 
47
 
 
48
-behaviour(gen_server).
 
49
 
 
50
 
 
51
%% User API exports (called via mod_security)
 
52
-export([list_blocked_users/2, list_blocked_users/3, 
 
53
         block_user/5, 
 
54
         unblock_user/3, unblock_user/4,
 
55
         list_auth_users/2, list_auth_users/3]).
 
56
 
 
57
%% Internal exports (for mod_security only)
 
58
-export([start/2, stop/1, stop/2,
 
59
         new_table/3, delete_tables/2, 
 
60
         store_failed_auth/5, store_successful_auth/4, 
 
61
         check_blocked_user/5]).
 
62
 
 
63
%% gen_server exports
 
64
-export([start_link/3, 
 
65
         init/1, 
 
66
         handle_info/2, handle_call/3, handle_cast/2, 
 
67
         terminate/2,
 
68
         code_change/3]).
 
69
 
 
70
-export([verbosity/3]).
 
71
 
 
72
 
 
73
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
74
%%                                                                  %%
 
75
%% External API                                                     %%
 
76
%%                                                                  %%
 
77
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
78
 
 
79
%% start_link/3
 
80
%% 
 
81
%% NOTE: This is called by httpd_misc_sup when the process is started
 
82
%% 
 
83
 
 
84
start_link(Addr, Port, Verbosity) ->
 
85
    ?vtrace("start_link -> entry with"
 
86
            "~n   Addr: ~p"
 
87
            "~n   Port: ~p", [Addr, Port]),
 
88
    Name = make_name(Addr, Port),
 
89
    gen_server:start_link({local, Name}, ?MODULE, [Verbosity],
 
90
                          [{timeout, infinity}]).
 
91
 
 
92
 
 
93
%% start/2
 
94
%% Called  by the mod_security module.
 
95
 
 
96
start(Addr, Port) ->
 
97
    Name = make_name(Addr, Port),
 
98
    case whereis(Name) of
 
99
        undefined ->
 
100
            Verbosity = get(security_verbosity),
 
101
            case httpd_misc_sup:start_sec_server(Addr, Port, Verbosity) of
 
102
                {ok, Pid} ->
 
103
                    put(security_server, Pid),
 
104
                    ok;
 
105
                Error ->
 
106
                    exit({failed_start_security_server, Error})
 
107
            end;
 
108
        _ -> %% Already started...
 
109
            ok
 
110
    end.
 
111
 
 
112
 
 
113
%% stop
 
114
 
 
115
stop(Port) ->
 
116
    stop(undefined, Port).
 
117
stop(Addr, Port) ->
 
118
    Name = make_name(Addr, Port),
 
119
    case whereis(Name) of
 
120
        undefined ->
 
121
            ok;
 
122
        _ ->
 
123
            httpd_misc_sup:stop_sec_server(Addr, Port)
 
124
    end.
 
125
 
 
126
 
 
127
%% verbosity
 
128
 
 
129
verbosity(Addr, Port, Verbosity) ->
 
130
    Name = make_name(Addr, Port),
 
131
    Req  = {verbosity, Verbosity},
 
132
    call(Name, Req).
 
133
    
 
134
 
 
135
%% list_blocked_users
 
136
 
 
137
list_blocked_users(Addr, Port) ->
 
138
    Name = make_name(Addr,Port),
 
139
    Req  = {list_blocked_users, Addr, Port, '_'},
 
140
    call(Name, Req).
 
141
 
 
142
list_blocked_users(Addr, Port, Dir) ->
 
143
    Name = make_name(Addr, Port),
 
144
    Req  = {list_blocked_users, Addr, Port, Dir},
 
145
    call(Name, Req).
 
146
 
 
147
 
 
148
%% block_user
 
149
 
 
150
block_user(User, Addr, Port, Dir, Time) ->
 
151
    Name = make_name(Addr, Port),
 
152
    Req  = {block_user, User, Addr, Port, Dir, Time},
 
153
    call(Name, Req).
 
154
 
 
155
 
 
156
%% unblock_user
 
157
 
 
158
unblock_user(User, Addr, Port) ->
 
159
    Name = make_name(Addr, Port),
 
160
    Req  = {unblock_user, User, Addr, Port, '_'},
 
161
    call(Name, Req).
 
162
 
 
163
unblock_user(User, Addr, Port, Dir) ->
 
164
    Name = make_name(Addr, Port),
 
165
    Req  = {unblock_user, User, Addr, Port, Dir},
 
166
    call(Name, Req).
 
167
 
 
168
 
 
169
%% list_auth_users
 
170
 
 
171
list_auth_users(Addr, Port) ->
 
172
    Name = make_name(Addr, Port),
 
173
    Req  = {list_auth_users, Addr, Port, '_'},
 
174
    call(Name, Req).
 
175
 
 
176
list_auth_users(Addr, Port, Dir) ->
 
177
    Name = make_name(Addr,Port),
 
178
    Req  = {list_auth_users, Addr, Port, Dir}, 
 
179
    call(Name, Req).
 
180
    
 
181
 
 
182
%% new_table
 
183
 
 
184
new_table(Addr, Port, TabName) ->
 
185
    Name = make_name(Addr,Port),
 
186
    Req  = {new_table, Addr, Port, TabName}, 
 
187
    call(Name, Req).
 
188
 
 
189
 
 
190
%% delete_tables
 
191
    
 
192
delete_tables(Addr, Port) ->
 
193
    Name = make_name(Addr, Port),
 
194
    case whereis(Name) of
 
195
        undefined ->
 
196
            ok;
 
197
        _ ->
 
198
            call(Name, delete_tables)
 
199
    end.
 
200
 
 
201
 
 
202
%% store_failed_auth
 
203
 
 
204
store_failed_auth(Info, Addr, Port, DecodedString, SDirData) ->
 
205
    Name = make_name(Addr,Port),
 
206
    Msg  = {store_failed_auth,[Info,DecodedString,SDirData]},
 
207
    cast(Name, Msg).
 
208
 
 
209
 
 
210
%% store_successful_auth
 
211
 
 
212
store_successful_auth(Addr, Port, User, SDirData) ->
 
213
    Name = make_name(Addr,Port),
 
214
    Msg  = {store_successful_auth, [User,Addr,Port,SDirData]}, 
 
215
    cast(Name, Msg).
 
216
    
 
217
 
 
218
%% check_blocked_user
 
219
 
 
220
check_blocked_user(Info, User, SDirData, Addr, Port) ->
 
221
    Name = make_name(Addr, Port),
 
222
    Req  = {check_blocked_user, [Info, User, SDirData]}, 
 
223
    call(Name, Req).
 
224
 
 
225
 
 
226
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
227
%%                                                                  %%
 
228
%% Server call-back functions                                       %%
 
229
%%                                                                  %%
 
230
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
231
 
 
232
%% init
 
233
 
 
234
init([undefined]) ->
 
235
    init([?default_verbosity]);
 
236
init([Verbosity]) ->
 
237
    ?DEBUG("init -> entry with Verbosity: ~p",[Verbosity]),
 
238
    process_flag(trap_exit, true),
 
239
    put(sname, sec),
 
240
    put(verbosity, Verbosity),
 
241
    ?vlog("starting",[]),
 
242
    {ok, []}.
 
243
 
 
244
 
 
245
%% handle_call
 
246
 
 
247
handle_call(stop, _From, Tables) ->
 
248
    ?vlog("stop",[]),
 
249
    {stop, normal, ok, []};
 
250
 
 
251
 
 
252
handle_call({verbosity,Verbosity}, _From, Tables) ->
 
253
    ?vlog("set verbosity to ~p",[Verbosity]),
 
254
    OldVerbosity = get(verbosity),
 
255
    put(verbosity,Verbosity),
 
256
    ?vdebug("old verbosity: ~p",[OldVerbosity]),
 
257
    {reply,OldVerbosity,Tables};
 
258
 
 
259
 
 
260
handle_call({block_user, User, Addr, Port, Dir, Time}, _From, Tables) ->
 
261
    ?vlog("block user '~p' for ~p",[User,Dir]),
 
262
    Ret = block_user_int({User, Addr, Port, Dir, Time}),
 
263
    ?vdebug("block user result: ~p",[Ret]),
 
264
    {reply, Ret, Tables};
 
265
 
 
266
 
 
267
handle_call({list_blocked_users, Addr, Port, Dir}, _From, Tables) ->
 
268
    ?vlog("list blocked users for ~p",[Dir]),
 
269
    Blocked = list_blocked(Tables, Addr, Port, Dir, []),
 
270
    ?vdebug("list blocked users: ~p",[Blocked]),
 
271
    {reply, Blocked, Tables};
 
272
 
 
273
 
 
274
handle_call({unblock_user, User, Addr, Port, Dir}, _From, Tables) ->
 
275
    ?vlog("unblock user '~p' for ~p",[User,Dir]),
 
276
    Ret = unblock_user_int({User, Addr, Port, Dir}),
 
277
    ?vdebug("unblock user result: ~p",[Ret]),
 
278
    {reply, Ret, Tables};
 
279
 
 
280
 
 
281
handle_call({list_auth_users, Addr, Port, Dir}, _From, Tables) ->
 
282
    ?vlog("list auth users for ~p",[Dir]),
 
283
    Auth = list_auth(Tables, Addr, Port, Dir, []),
 
284
    ?vdebug("list auth users result: ~p",[Auth]),
 
285
    {reply, Auth, Tables};
 
286
 
 
287
 
 
288
handle_call({new_table, Addr, Port, Name}, _From, Tables) ->
 
289
    case lists:keysearch(Name, 1, Tables) of
 
290
        {value, {Name, {Ets, Dets}}} ->
 
291
            ?DEBUG("handle_call(new_table) -> we already have this table: ~p",
 
292
                   [Name]),
 
293
            ?vdebug("new table; we already have this one: ~p",[Name]),
 
294
            {reply, {ok, {Ets, Dets}}, Tables};
 
295
        false ->
 
296
            ?LOG("handle_call(new_table) -> new_table: Name = ~p",[Name]),
 
297
            ?vlog("new table: ~p",[Name]),
 
298
            TName = make_name(Addr,Port,length(Tables)),
 
299
            ?DEBUG("handle_call(new_table) -> TName: ~p",[TName]),
 
300
            ?vdebug("new table: ~p",[TName]),
 
301
            case dets:open_file(TName, [{type, bag}, {file, Name}, 
 
302
                                        {repair, true}, 
 
303
                                        {access, read_write}]) of
 
304
                {ok, DFile} ->
 
305
                    ETS = ets:new(TName, [bag, private]),
 
306
                    sync_dets_to_ets(DFile, ETS),
 
307
                    NewTables = [{Name, {ETS, DFile}}|Tables],
 
308
                    ?DEBUG("handle_call(new_table) -> ~n"
 
309
                           "       NewTables: ~p",[NewTables]),
 
310
                    ?vtrace("new tables: ~p",[NewTables]),
 
311
                    {reply, {ok, {ETS, DFile}}, NewTables};
 
312
                {error, Err} ->
 
313
                    ?LOG("handle_call -> Err: ~p",[Err]),
 
314
                    ?vinfo("failed open dets file: ~p",[Err]),
 
315
                    {reply, {error, {create_dets, Err}}, Tables}
 
316
            end
 
317
    end;
 
318
 
 
319
handle_call(delete_tables, _From, Tables) ->
 
320
    ?vlog("delete tables",[]),
 
321
    lists:foreach(fun({Name, {ETS, DETS}}) ->
 
322
                          dets:close(DETS),
 
323
                          ets:delete(ETS)
 
324
                  end, Tables),
 
325
    {reply, ok, []};
 
326
 
 
327
handle_call({check_blocked_user, [Info, User, SDirData]}, _From, Tables) ->
 
328
    ?vlog("check blocked user '~p'",[User]),
 
329
    {ETS, DETS} = httpd_util:key1search(SDirData, data_file),
 
330
    Dir = httpd_util:key1search(SDirData, path),
 
331
    Addr = httpd_util:key1search(SDirData, bind_address),
 
332
    Port = httpd_util:key1search(SDirData, port),
 
333
    CBModule = httpd_util:key1search(SDirData, callback_module, no_module_at_all),
 
334
    ?vdebug("call back module: ~p",[CBModule]),
 
335
    Ret = check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule),
 
336
    ?vdebug("check result: ~p",[Ret]),
 
337
    {reply, Ret, Tables};
 
338
handle_call(Request,From,Tables) ->
 
339
    ?vinfo("~n   unknown call '~p' from ~p",[Request,From]),
 
340
    {reply,ok,Tables}.
 
341
  
 
342
 
 
343
%% handle_cast
 
344
 
 
345
handle_cast({store_failed_auth, [Info, DecodedString, SDirData]}, Tables) ->
 
346
    ?vlog("store failed auth",[]),
 
347
    {ETS, DETS} = httpd_util:key1search(SDirData, data_file),
 
348
    Dir  = httpd_util:key1search(SDirData, path),
 
349
    Addr = httpd_util:key1search(SDirData, bind_address),
 
350
    Port = httpd_util:key1search(SDirData, port),
 
351
    {ok, [User,Password]} = httpd_util:split(DecodedString,":",2),
 
352
    ?vdebug("user '~p' and password '~p'",[User,Password]),
 
353
    Seconds = universal_time(),
 
354
    Key = {User, Dir, Addr, Port},
 
355
 
 
356
    %% Event
 
357
    CBModule = httpd_util:key1search(SDirData, callback_module, no_module_at_all),
 
358
    ?vtrace("call back module: ~p",[CBModule]),
 
359
    auth_fail_event(CBModule,Addr,Port,Dir,User,Password),
 
360
    
 
361
    %% Find out if any of this user's other failed logins are too old to keep..
 
362
    ?vtrace("remove old login failures",[]),
 
363
    case ets:match_object(ETS, {failed, {Key, '_', '_'}}) of
 
364
        [] ->
 
365
            ?vtrace("no old login failures",[]),
 
366
            no;
 
367
        List when list(List) ->
 
368
            ?vtrace("~p old login failures",[length(List)]),
 
369
            ExpireTime = httpd_util:key1search(SDirData, fail_expire_time, 30)*60,
 
370
            ?vtrace("expire time ~p",[ExpireTime]),
 
371
            lists:map(fun({failed, {TheKey, LS, Gen}}) ->
 
372
                              Diff = Seconds-LS,
 
373
                              if
 
374
                                  Diff > ExpireTime ->
 
375
                                      ?vtrace("~n   '~p' is to old to keep: ~p",
 
376
                                              [TheKey,Gen]),
 
377
                                      ets:match_delete(ETS, {failed, {TheKey, LS, Gen}}),
 
378
                                      dets:match_delete(DETS, {failed, {TheKey, LS, Gen}});
 
379
                                  true ->
 
380
                                      ?vtrace("~n   '~p' is not old enough: ~p",
 
381
                                              [TheKey,Gen]),
 
382
                                      ok
 
383
                              end
 
384
                      end,
 
385
                      List);
 
386
        O ->
 
387
            ?vlog("~n   unknown login failure search resuylt: ~p",[O]),
 
388
            no
 
389
    end,
 
390
 
 
391
    %% Insert the new failure..
 
392
    Generation = length(ets:match_object(ETS, {failed, {Key, '_', '_'}})),
 
393
    ?vtrace("insert ('~p') new login failure: ~p",[Key,Generation]),
 
394
    ets:insert(ETS, {failed, {Key, Seconds, Generation}}),
 
395
    dets:insert(DETS, {failed, {Key, Seconds, Generation}}),
 
396
    
 
397
    %% See if we should block this user..
 
398
    MaxRetries = httpd_util:key1search(SDirData, max_retries, 3),
 
399
    BlockTime = httpd_util:key1search(SDirData, block_time, 60),
 
400
    ?vtrace("~n   Max retries ~p, block time ~p",[MaxRetries,BlockTime]),
 
401
    case ets:match_object(ETS, {failed, {Key, '_', '_'}}) of
 
402
        List1 ->
 
403
            ?vtrace("~n   ~p tries so far",[length(List1)]),
 
404
            if 
 
405
                length(List1) >= MaxRetries ->
 
406
                    %% Block this user until Future
 
407
                    ?vtrace("block user '~p'",[User]),
 
408
                    Future = Seconds+BlockTime*60,
 
409
                    ?vtrace("future: ~p",[Future]),
 
410
                    Reason = io_lib:format("Blocking user ~s from dir ~s "
 
411
                                           "for ~p minutes", 
 
412
                                           [User, Dir, BlockTime]),
 
413
                    mod_log:security_log(Info, lists:flatten(Reason)),
 
414
                    
 
415
                    %% Event
 
416
                    user_block_event(CBModule,Addr,Port,Dir,User),
 
417
                    
 
418
                    ets:match_delete(ETS,{blocked_user,
 
419
                                          {User, Addr, Port, Dir, '$1'}}), 
 
420
                    dets:match_delete(DETS, {blocked_user,
 
421
                                             {User, Addr, Port, Dir, '$1'}}),
 
422
                    BlockRecord = {blocked_user, 
 
423
                                   {User, Addr, Port, Dir, Future}},
 
424
                    ets:insert(ETS, BlockRecord),
 
425
                    dets:insert(DETS, BlockRecord),
 
426
                    %% Remove previous failed requests.
 
427
                    ets:match_delete(ETS, {failed, {Key, '_', '_'}}),
 
428
                    dets:match_delete(DETS, {failed, {Key, '_', '_'}});
 
429
                true ->
 
430
                    ?vtrace("still some tries to go",[]),
 
431
                    no
 
432
            end;
 
433
        Other ->
 
434
            no
 
435
    end,
 
436
    {noreply, Tables};
 
437
 
 
438
handle_cast({store_successful_auth, [User, Addr, Port, SDirData]}, Tables) ->
 
439
    ?vlog("store successfull auth",[]),
 
440
    {ETS, DETS} = httpd_util:key1search(SDirData, data_file),
 
441
    AuthTimeOut = httpd_util:key1search(SDirData, auth_timeout, 30),
 
442
    Dir = httpd_util:key1search(SDirData, path),
 
443
    Key = {User, Dir, Addr, Port},
 
444
 
 
445
    %% Remove failed entries for this Key
 
446
    dets:match_delete(DETS, {failed, {Key, '_', '_'}}),
 
447
    ets:match_delete(ETS, {failed, {Key, '_', '_'}}), 
 
448
 
 
449
    %% Keep track of when the last successful login took place.
 
450
    Seconds = universal_time()+AuthTimeOut,
 
451
    ets:match_delete(ETS, {success, {Key, '_'}}),
 
452
    dets:match_delete(DETS, {success, {Key, '_'}}),
 
453
    ets:insert(ETS, {success, {Key, Seconds}}),
 
454
    dets:insert(DETS, {success, {Key, Seconds}}),
 
455
    {noreply, Tables};
 
456
            
 
457
handle_cast(Req, Tables) ->
 
458
    ?vinfo("~n   unknown cast '~p'",[Req]),
 
459
    error_msg("security server got unknown cast: ~p",[Req]),
 
460
    {noreply, Tables}.
 
461
 
 
462
 
 
463
%% handle_info
 
464
 
 
465
handle_info(Info, State) ->
 
466
    ?vinfo("~n   unknown info '~p'",[Info]),
 
467
    {noreply, State}.
 
468
 
 
469
 
 
470
%% terminate
 
471
 
 
472
terminate(Reason, _Tables) ->
 
473
    ?vlog("~n   Terminating for reason: ~p",[Reason]),
 
474
    ok.
 
475
 
 
476
 
 
477
%% code_change({down, ToVsn}, State, Extra)
 
478
%% 
 
479
code_change({down, _}, State, _Extra) ->
 
480
    ?vlog("downgrade", []),
 
481
    {ok, State};
 
482
 
 
483
 
 
484
%% code_change(FromVsn, State, Extra)
 
485
%%
 
486
code_change(_, State, Extra) ->
 
487
    ?vlog("upgrade", []),
 
488
    {ok, State}.
 
489
 
 
490
 
 
491
 
 
492
 
 
493
%% block_user_int/2
 
494
block_user_int({User, Addr, Port, Dir, Time}) ->
 
495
    Dirs = httpd_manager:config_match(Addr, Port, {security_directory, '_'}),
 
496
    ?vtrace("block '~p' for ~p during ~p",[User,Dir,Time]),
 
497
    case find_dirdata(Dirs, Dir) of
 
498
        {ok, DirData, {ETS, DETS}} ->
 
499
            Time1 = 
 
500
                case Time of
 
501
                    infinity ->
 
502
                        99999999999999999999999999999;
 
503
                    _ ->
 
504
                        Time
 
505
                end,
 
506
            Future = universal_time()+Time1,
 
507
            ets:match_delete(ETS, {blocked_user, {User,Addr,Port,Dir,'_'}}),
 
508
            dets:match_delete(DETS, {blocked_user, {User,Addr,Port,Dir,'_'}}),
 
509
            ets:insert(ETS, {blocked_user, {User,Addr,Port,Dir,Future}}),
 
510
            dets:insert(DETS, {blocked_user, {User,Addr,Port,Dir,Future}}),
 
511
            CBModule = httpd_util:key1search(DirData, callback_module, 
 
512
                                             no_module_at_all),
 
513
            ?vtrace("call back module ~p",[CBModule]),
 
514
            user_block_event(CBModule,Addr,Port,Dir,User),
 
515
            true;
 
516
        _ ->
 
517
            {error, no_such_directory}
 
518
    end.
 
519
    
 
520
 
 
521
find_dirdata([], _Dir) ->
 
522
    false;
 
523
find_dirdata([{security_directory, DirData}|SDirs], Dir) ->
 
524
    case lists:keysearch(path, 1, DirData) of
 
525
        {value, {path, Dir}} ->
 
526
            {value, {data_file, {ETS, DETS}}} =
 
527
                lists:keysearch(data_file, 1, DirData),
 
528
            {ok, DirData, {ETS, DETS}};
 
529
        _ ->
 
530
            find_dirdata(SDirs, Dir)
 
531
    end.
 
532
 
 
533
%% unblock_user_int/2
 
534
 
 
535
unblock_user_int({User, Addr, Port, Dir}) ->
 
536
    ?vtrace("unblock user '~p' for ~p",[User,Dir]),
 
537
    Dirs = httpd_manager:config_match(Addr, Port, {security_directory, '_'}),
 
538
    ?vtrace("~n   dirs: ~p",[Dirs]),
 
539
    case find_dirdata(Dirs, Dir) of
 
540
        {ok, DirData, {ETS, DETS}} ->
 
541
            case ets:match_object(ETS,{blocked_user,{User,Addr,Port,Dir,'_'}}) of
 
542
                [] ->
 
543
                    ?vtrace("not blocked",[]),
 
544
                    {error, not_blocked};
 
545
                Objects ->
 
546
                    ets:match_delete(ETS, {blocked_user,
 
547
                                           {User, Addr, Port, Dir, '_'}}),
 
548
                    dets:match_delete(DETS, {blocked_user,
 
549
                                             {User, Addr, Port, Dir, '_'}}),
 
550
                    CBModule = httpd_util:key1search(DirData, callback_module, 
 
551
                                                     no_module_at_all),
 
552
                    user_unblock_event(CBModule,Addr,Port,Dir,User),
 
553
                    true
 
554
            end;
 
555
        _ ->
 
556
            ?vlog("~n   cannot unblock: no such directory '~p'",[Dir]),
 
557
            {error, no_such_directory}
 
558
    end.
 
559
 
 
560
 
 
561
 
 
562
%% list_auth/2
 
563
 
 
564
list_auth([], _Addr, _Port, Dir, Acc) ->
 
565
    Acc;
 
566
list_auth([{Name, {ETS, DETS}}|Tables], Addr, Port, Dir, Acc) ->
 
567
    case ets:match_object(ETS, {success, {{'_', Dir, Addr, Port}, '_'}}) of
 
568
        [] ->
 
569
            list_auth(Tables, Addr, Port, Dir, Acc);
 
570
        List when list(List) ->
 
571
            TN = universal_time(),
 
572
            NewAcc = lists:foldr(fun({success,{{U,Ad,P,D},T}},Ac) -> 
 
573
                                         if
 
574
                                             T-TN > 0 ->
 
575
                                                 [U|Ac];
 
576
                                             true ->
 
577
                                                 Rec = {success,{{U,Ad,P,D},T}},
 
578
                                                 ets:match_delete(ETS,Rec),
 
579
                                                 dets:match_delete(DETS,Rec),
 
580
                                                 Ac
 
581
                                         end
 
582
                                 end,
 
583
                                 Acc, List),
 
584
            list_auth(Tables, Addr, Port, Dir, NewAcc);
 
585
        _ ->
 
586
            list_auth(Tables, Addr, Port, Dir, Acc)
 
587
    end.
 
588
 
 
589
 
 
590
%% list_blocked/2
 
591
 
 
592
list_blocked([], Addr, Port, Dir, Acc) ->
 
593
    TN = universal_time(),
 
594
    lists:foldl(fun({U,Ad,P,D,T}, Ac) ->
 
595
                        if
 
596
                            T-TN > 0 ->
 
597
                                [{U,Ad,P,D,local_time(T)}|Ac];
 
598
                            true ->
 
599
                                Ac
 
600
                        end
 
601
                end, 
 
602
                [], Acc);
 
603
list_blocked([{Name, {ETS, DETS}}|Tables], Addr, Port, Dir, Acc) ->
 
604
    NewBlocked = 
 
605
        case ets:match_object(ETS, {blocked_user, {'_',Addr,Port,Dir,'_'}}) of
 
606
            List when list(List) ->
 
607
                lists:foldl(fun({blocked_user, X}, A) -> [X|A] end, Acc, List);
 
608
            _ ->
 
609
                Acc
 
610
        end,
 
611
    list_blocked(Tables, Addr, Port, Dir, NewBlocked).
 
612
    
 
613
 
 
614
%%
 
615
%% sync_dets_to_ets/2
 
616
%%
 
617
%% Reads dets-table DETS and syncronizes it with the ets-table ETS.
 
618
%%
 
619
sync_dets_to_ets(DETS, ETS) ->
 
620
    dets:traverse(DETS, fun(X) ->
 
621
                                ets:insert(ETS, X),
 
622
                                continue
 
623
                        end).
 
624
 
 
625
%%
 
626
%% check_blocked_user/7 -> true | false
 
627
%%
 
628
%% Check if a specific user is blocked from access.
 
629
%%
 
630
%% The sideeffect of this routine is that it unblocks also other users
 
631
%% whos blocking time has expired. This to keep the tables as small
 
632
%% as possible.
 
633
%%
 
634
check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule) ->
 
635
    TN = universal_time(),
 
636
    case ets:match_object(ETS, {blocked_user, {User, '_', '_', '_', '_'}}) of
 
637
        List when list(List) ->
 
638
            Blocked = lists:foldl(fun({blocked_user, X}, A) ->
 
639
                                          [X|A] end, [], List),
 
640
            check_blocked_user(Info,User,Dir,Addr,Port,ETS,DETS,TN,Blocked,CBModule);
 
641
        _ ->
 
642
            false
 
643
    end.
 
644
check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, TN, [], CBModule) ->
 
645
    false;
 
646
check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, TN, 
 
647
                   [{User,Addr,Port,Dir,T}|Ls], CBModule) ->
 
648
    TD = T-TN,
 
649
    if
 
650
        TD =< 0 ->
 
651
            %% Blocking has expired, remove and grant access.
 
652
            unblock_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule),
 
653
            false;
 
654
        true ->
 
655
            true
 
656
    end;
 
657
check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, TN, 
 
658
                   [{OUser,ODir,OAddr,OPort,T}|Ls], CBModule) ->
 
659
    TD = T-TN,
 
660
    if
 
661
        TD =< 0 ->
 
662
            %% Blocking has expired, remove.
 
663
            unblock_user(Info, OUser, ODir, OAddr, OPort, ETS, DETS, CBModule);
 
664
        true ->
 
665
            true
 
666
    end,
 
667
    check_blocked_user(Info, User, Dir, Addr, Port, ETS, DETS, TN, Ls, CBModule).
 
668
 
 
669
unblock_user(Info, User, Dir, Addr, Port, ETS, DETS, CBModule) ->
 
670
    Reason=io_lib:format("User ~s was removed from the block list for dir ~s",
 
671
                         [User, Dir]),
 
672
    mod_log:security_log(Info, lists:flatten(Reason)),
 
673
    user_unblock_event(CBModule,Addr,Port,Dir,User),
 
674
    dets:match_delete(DETS, {blocked_user, {User, Addr, Port, Dir, '_'}}),
 
675
    ets:match_delete(ETS, {blocked_user, {User, Addr, Port, Dir, '_'}}).
 
676
  
 
677
 
 
678
make_name(Addr,Port) ->
 
679
    httpd_util:make_name("httpd_security",Addr,Port).
 
680
 
 
681
make_name(Addr,Port,Num) ->
 
682
    httpd_util:make_name("httpd_security",Addr,Port,
 
683
                         "__" ++ integer_to_list(Num)).
 
684
 
 
685
 
 
686
auth_fail_event(Mod,Addr,Port,Dir,User,Passwd) ->
 
687
    event(auth_fail,Mod,Addr,Port,Dir,[{user,User},{password,Passwd}]).
 
688
 
 
689
user_block_event(Mod,Addr,Port,Dir,User) ->
 
690
    event(user_block,Mod,Addr,Port,Dir,[{user,User}]).
 
691
 
 
692
user_unblock_event(Mod,Addr,Port,Dir,User) ->
 
693
    event(user_unblock,Mod,Addr,Port,Dir,[{user,User}]).
 
694
 
 
695
event(Event,Mod,undefined,Port,Dir,Info) ->
 
696
    (catch Mod:event(Event,Port,Dir,Info));
 
697
event(Event,Mod,Addr,Port,Dir,Info) ->
 
698
    (catch Mod:event(Event,Addr,Port,Dir,Info)).
 
699
 
 
700
universal_time() ->
 
701
    calendar:datetime_to_gregorian_seconds(calendar:universal_time()).
 
702
 
 
703
local_time(T) ->
 
704
    calendar:universal_time_to_local_time(
 
705
      calendar:gregorian_seconds_to_datetime(T)).
 
706
 
 
707
 
 
708
error_msg(F, A) ->
 
709
    error_logger:error_msg(F, A).
 
710
 
 
711
 
 
712
call(Name, Req) ->
 
713
    case (catch gen_server:call(Name, Req)) of
 
714
        {'EXIT', Reason} ->
 
715
            {error, Reason};
 
716
        Reply ->
 
717
            Reply
 
718
    end.
 
719
 
 
720
 
 
721
cast(Name, Msg) ->
 
722
    case (catch gen_server:cast(Name, Msg)) of
 
723
        {'EXIT', Reason} ->
 
724
            {error, Reason};
 
725
        Result ->
 
726
            Result
 
727
    end.
 
728