~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_disk_log.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:
 
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_disk_log.erl,v 1.1 2008/12/17 09:53:35 mikpe Exp $
 
17
%%
 
18
-module(mod_disk_log).
 
19
-export([do/1,error_log/5,security_log/2,load/2,store/2,remove/1]).
 
20
 
 
21
-export([report_error/2]).
 
22
 
 
23
-define(VMODULE,"DISK_LOG").
 
24
-include("httpd_verbosity.hrl").
 
25
 
 
26
-include("httpd.hrl").
 
27
 
 
28
%% do
 
29
 
 
30
do(Info) ->
 
31
    AuthUser  = auth_user(Info#mod.data),
 
32
    Date      = custom_date(),
 
33
    log_internal_info(Info,Date,Info#mod.data),
 
34
    LogFormat = get_log_format(Info#mod.config_db),
 
35
    case httpd_util:key1search(Info#mod.data,status) of
 
36
        %% A status code has been generated!
 
37
        {StatusCode,PhraseArgs,Reason} ->
 
38
            transfer_log(Info, "-", AuthUser, Date, StatusCode, 0, LogFormat),
 
39
            if
 
40
                StatusCode >= 400 ->
 
41
                    error_log(Info, Date, Reason, LogFormat);
 
42
                true ->
 
43
                    not_an_error
 
44
            end,
 
45
            {proceed,Info#mod.data};
 
46
        %% No status code has been generated!
 
47
        undefined ->
 
48
            case httpd_util:key1search(Info#mod.data,response) of
 
49
                {already_sent,StatusCode,Size} ->
 
50
                    transfer_log(Info, "-", AuthUser, Date, StatusCode,
 
51
                                 Size, LogFormat),
 
52
                    {proceed,Info#mod.data};
 
53
 
 
54
                {response, Head, Body} ->
 
55
                    Size = httpd_util:key1search(Head, content_length, 0),
 
56
                    Code = httpd_util:key1search(Head, code, 200),
 
57
                    transfer_log(Info, "-", AuthUser, Date, Code, 
 
58
                                 Size, LogFormat),
 
59
                    {proceed,Info#mod.data};    
 
60
                
 
61
                {StatusCode,Response} ->
 
62
                    transfer_log(Info, "-", AuthUser, Date, 200,
 
63
                                 httpd_util:flatlength(Response), LogFormat),
 
64
                    {proceed,Info#mod.data};
 
65
                undefined ->
 
66
                    transfer_log(Info, "-", AuthUser, Date, 200,
 
67
                                 0, LogFormat),
 
68
                    {proceed,Info#mod.data}
 
69
            end
 
70
    end.
 
71
 
 
72
custom_date() ->
 
73
    LocalTime     = calendar:local_time(),
 
74
    UniversalTime = calendar:universal_time(),
 
75
    Minutes       = round(diff_in_minutes(LocalTime,UniversalTime)),
 
76
    {{YYYY,MM,DD},{Hour,Min,Sec}} = LocalTime,
 
77
    Date = 
 
78
        io_lib:format("~.2.0w/~.3s/~.4w:~.2.0w:~.2.0w:~.2.0w ~c~.2.0w~.2.0w",
 
79
                      [DD,httpd_util:month(MM),YYYY,Hour,Min,Sec,sign(Minutes),
 
80
                       abs(Minutes) div 60,abs(Minutes) rem 60]),  
 
81
    lists:flatten(Date).
 
82
 
 
83
diff_in_minutes(L,U) ->
 
84
    (calendar:datetime_to_gregorian_seconds(L) -
 
85
     calendar:datetime_to_gregorian_seconds(U))/60.
 
86
 
 
87
sign(Minutes) when Minutes > 0 ->
 
88
    $+;
 
89
sign(Minutes) ->
 
90
    $-.
 
91
 
 
92
auth_user(Data) ->
 
93
    case httpd_util:key1search(Data,remote_user) of
 
94
        undefined ->
 
95
            "-";
 
96
        RemoteUser ->
 
97
            RemoteUser
 
98
    end.
 
99
 
 
100
%% log_internal_info
 
101
 
 
102
log_internal_info(Info,Date,[]) ->
 
103
    ok;
 
104
log_internal_info(Info,Date,[{internal_info,Reason}|Rest]) ->
 
105
    Format = get_log_format(Info#mod.config_db),
 
106
    error_log(Info,Date,Reason,Format),
 
107
    log_internal_info(Info,Date,Rest);
 
108
log_internal_info(Info,Date,[_|Rest]) ->
 
109
    log_internal_info(Info,Date,Rest).
 
110
 
 
111
 
 
112
%% transfer_log
 
113
 
 
114
transfer_log(Info,RFC931,AuthUser,Date,StatusCode,Bytes,Format) ->
 
115
    case httpd_util:lookup(Info#mod.config_db,transfer_disk_log) of
 
116
        undefined ->
 
117
            no_transfer_log;
 
118
        TransferDiskLog ->
 
119
            {PortNumber,RemoteHost}=(Info#mod.init_data)#init_data.peername,
 
120
            Entry = io_lib:format("~s ~s ~s [~s] \"~s\" ~w ~w~n",
 
121
                                  [RemoteHost,RFC931,AuthUser,Date,
 
122
                                   Info#mod.request_line,StatusCode,Bytes]),
 
123
            write(TransferDiskLog, Entry, Format)
 
124
    end.
 
125
 
 
126
 
 
127
%% error_log
 
128
 
 
129
error_log(Info, Date, Reason, Format) ->
 
130
    Format=get_log_format(Info#mod.config_db),
 
131
    case httpd_util:lookup(Info#mod.config_db,error_disk_log) of
 
132
        undefined ->
 
133
            no_error_log;
 
134
        ErrorDiskLog ->
 
135
            {PortNumber,RemoteHost}=(Info#mod.init_data)#init_data.peername,
 
136
            Entry = 
 
137
                io_lib:format("[~s] access to ~s failed for ~s, reason: ~p~n",
 
138
                              [Date, Info#mod.request_uri, 
 
139
                               RemoteHost, Reason]),
 
140
            write(ErrorDiskLog, Entry, Format)
 
141
    end.
 
142
 
 
143
error_log(SocketType, Socket, ConfigDB, {PortNumber, RemoteHost}, Reason) ->
 
144
    Format = get_log_format(ConfigDB),
 
145
    case httpd_util:lookup(ConfigDB,error_disk_log) of
 
146
        undefined ->
 
147
            no_error_log;
 
148
        ErrorDiskLog ->
 
149
            Date  = custom_date(),
 
150
            Entry = 
 
151
                io_lib:format("[~s] server crash for ~s, reason: ~p~n",
 
152
                              [Date,RemoteHost,Reason]),
 
153
            write(ErrorDiskLog, Entry, Format),
 
154
            ok
 
155
    end.
 
156
 
 
157
 
 
158
%% security_log
 
159
 
 
160
security_log(ConfigDB, Event) ->
 
161
    Format = get_log_format(ConfigDB),
 
162
    case httpd_util:lookup(ConfigDB,security_disk_log) of
 
163
        undefined ->
 
164
            no_error_log;
 
165
        DiskLog ->
 
166
            Date  = custom_date(),
 
167
            Entry = io_lib:format("[~s] ~s ~n", [Date, Event]),
 
168
            write(DiskLog, Entry, Format),
 
169
            ok
 
170
    end.
 
171
 
 
172
report_error(ConfigDB, Error) ->
 
173
    Format = get_log_format(ConfigDB),
 
174
    case httpd_util:lookup(ConfigDB, error_disk_log) of
 
175
        undefined ->
 
176
            no_error_log;
 
177
        ErrorDiskLog ->
 
178
            Date  = custom_date(),
 
179
            Entry = io_lib:format("[~s] reporting error: ~s",[Date,Error]),
 
180
            write(ErrorDiskLog, Entry, Format),
 
181
            ok
 
182
    end.
 
183
 
 
184
%%----------------------------------------------------------------------
 
185
%% Get the current format of the disklog
 
186
%%----------------------------------------------------------------------
 
187
get_log_format(ConfigDB)->
 
188
    httpd_util:lookup(ConfigDB,disk_log_format,external).
 
189
 
 
190
 
 
191
%%
 
192
%% Configuration
 
193
%%
 
194
 
 
195
%% load
 
196
 
 
197
load([$T,$r,$a,$n,$s,$f,$e,$r,$D,$i,$s,$k,$L,$o,$g,$S,$i,$z,$e,$ |
 
198
      TransferDiskLogSize],[]) ->
 
199
    case regexp:split(TransferDiskLogSize," ") of
 
200
        {ok,[MaxBytes,MaxFiles]} ->
 
201
            case httpd_conf:make_integer(MaxBytes) of
 
202
                {ok,MaxBytesInteger} ->
 
203
                    case httpd_conf:make_integer(MaxFiles) of
 
204
                        {ok,MaxFilesInteger} ->
 
205
                            {ok,[],{transfer_disk_log_size,
 
206
                                    {MaxBytesInteger,MaxFilesInteger}}};
 
207
                        {error,_} ->
 
208
                            {error,
 
209
                             ?NICE(httpd_conf:clean(TransferDiskLogSize)++
 
210
                                   " is an invalid TransferDiskLogSize")}
 
211
                    end;
 
212
                {error,_} ->
 
213
                    {error,?NICE(httpd_conf:clean(TransferDiskLogSize)++
 
214
                                 " is an invalid TransferDiskLogSize")}
 
215
            end
 
216
    end;
 
217
load([$T,$r,$a,$n,$s,$f,$e,$r,$D,$i,$s,$k,$L,$o,$g,$ |TransferDiskLog],[]) ->
 
218
    {ok,[],{transfer_disk_log,httpd_conf:clean(TransferDiskLog)}};
 
219
 
 
220
load([$E,$r,$r,$o,$r,$D,$i,$s,$k,$L,$o,$g,$S,$i,$z,$e,$ | ErrorDiskLogSize],[]) ->
 
221
    case regexp:split(ErrorDiskLogSize," ") of
 
222
        {ok,[MaxBytes,MaxFiles]} ->
 
223
            case httpd_conf:make_integer(MaxBytes) of
 
224
                {ok,MaxBytesInteger} ->
 
225
                    case httpd_conf:make_integer(MaxFiles) of
 
226
                        {ok,MaxFilesInteger} ->
 
227
                            {ok,[],{error_disk_log_size,
 
228
                                    {MaxBytesInteger,MaxFilesInteger}}};
 
229
                        {error,_} ->
 
230
                            {error,?NICE(httpd_conf:clean(ErrorDiskLogSize)++
 
231
                                         " is an invalid ErrorDiskLogSize")}
 
232
                    end;
 
233
                {error,_} ->
 
234
                    {error,?NICE(httpd_conf:clean(ErrorDiskLogSize)++
 
235
                                 " is an invalid ErrorDiskLogSize")}
 
236
            end
 
237
    end;
 
238
load([$E,$r,$r,$o,$r,$D,$i,$s,$k,$L,$o,$g,$ |ErrorDiskLog],[]) ->
 
239
    {ok, [], {error_disk_log, httpd_conf:clean(ErrorDiskLog)}};
 
240
 
 
241
load([$S,$e,$c,$u,$r,$i,$t,$y,$D,$i,$s,$k,$L,$o,$g,$S,$i,$z,$e,$ |SecurityDiskLogSize],[]) ->
 
242
    case regexp:split(SecurityDiskLogSize, " ") of
 
243
        {ok, [MaxBytes, MaxFiles]} ->
 
244
            case httpd_conf:make_integer(MaxBytes) of
 
245
                {ok, MaxBytesInteger} ->
 
246
                    case httpd_conf:make_integer(MaxFiles) of
 
247
                        {ok, MaxFilesInteger} ->
 
248
                            {ok, [], {security_disk_log_size,
 
249
                                      {MaxBytesInteger, MaxFilesInteger}}};
 
250
                        {error,_} ->
 
251
                            {error, ?NICE(httpd_conf:clean(SecurityDiskLogSize)++
 
252
                                          " is an invalid SecurityDiskLogSize")}
 
253
                    end;
 
254
                {error, _} ->
 
255
                    {error, ?NICE(httpd_conf:clean(SecurityDiskLogSize)++
 
256
                                  " is an invalid SecurityDiskLogSize")}
 
257
            end
 
258
    end;
 
259
load([$S,$e,$c,$u,$r,$i,$t,$y,$D,$i,$s,$k,$L,$o,$g,$ |SecurityDiskLog],[]) ->
 
260
    {ok, [], {security_disk_log, httpd_conf:clean(SecurityDiskLog)}};
 
261
 
 
262
load([$D,$i,$s,$k,$L,$o,$g,$F,$o,$r,$m,$a,$t,$ |Format],[]) ->
 
263
    case httpd_conf:clean(Format) of
 
264
        "internal" ->
 
265
            {ok, [], {disk_log_format,internal}};
 
266
        "external" ->
 
267
            {ok, [], {disk_log_format,external}};
 
268
        _Default ->
 
269
            {ok, [], {disk_log_format,external}}
 
270
    end.
 
271
 
 
272
%% store
 
273
 
 
274
store({transfer_disk_log,TransferDiskLog},ConfigList) ->
 
275
    case create_disk_log(TransferDiskLog, transfer_disk_log_size, ConfigList) of
 
276
        {ok,TransferDB} ->
 
277
            {ok,{transfer_disk_log,TransferDB}};
 
278
        {error,Reason} ->
 
279
            {error,Reason}
 
280
    end;
 
281
store({security_disk_log,SecurityDiskLog},ConfigList) ->
 
282
    case create_disk_log(SecurityDiskLog, security_disk_log_size, ConfigList) of
 
283
        {ok,SecurityDB} ->
 
284
            {ok,{security_disk_log,SecurityDB}};
 
285
        {error,Reason} ->
 
286
            {error,Reason}
 
287
    end;
 
288
store({error_disk_log,ErrorDiskLog},ConfigList) ->
 
289
    case create_disk_log(ErrorDiskLog, error_disk_log_size, ConfigList) of
 
290
        {ok,ErrorDB} ->
 
291
            {ok,{error_disk_log,ErrorDB}};
 
292
        {error,Reason} ->
 
293
            {error,Reason}
 
294
    end.
 
295
 
 
296
 
 
297
%%----------------------------------------------------------------------
 
298
%% Open or creates the disklogs 
 
299
%%----------------------------------------------------------------------
 
300
log_size(ConfigList, Tag) ->
 
301
    httpd_util:key1search(ConfigList, Tag, {500*1024,8}).
 
302
 
 
303
create_disk_log(LogFile, SizeTag, ConfigList) ->
 
304
    Filename = httpd_conf:clean(LogFile),
 
305
    {MaxBytes, MaxFiles} = log_size(ConfigList, SizeTag),
 
306
    case filename:pathtype(Filename) of
 
307
        absolute ->
 
308
            create_disk_log(Filename, MaxBytes, MaxFiles, ConfigList);
 
309
        volumerelative ->
 
310
            create_disk_log(Filename, MaxBytes, MaxFiles, ConfigList);
 
311
        relative ->
 
312
            case httpd_util:key1search(ConfigList,server_root) of
 
313
                undefined ->
 
314
                    {error,
 
315
                     ?NICE(Filename++
 
316
                           " is an invalid ErrorLog beacuse ServerRoot is not defined")};
 
317
                ServerRoot ->
 
318
                    AbsoluteFilename = filename:join(ServerRoot,Filename),
 
319
                    create_disk_log(AbsoluteFilename, MaxBytes, MaxFiles,
 
320
                                     ConfigList)
 
321
            end
 
322
    end.
 
323
 
 
324
create_disk_log(Filename, MaxBytes, MaxFiles, ConfigList) ->
 
325
    Format = httpd_util:key1search(ConfigList, disk_log_format, external),
 
326
    open(Filename, MaxBytes, MaxFiles, Format).
 
327
    
 
328
 
 
329
 
 
330
%% remove
 
331
remove(ConfigDB) ->
 
332
    lists:foreach(fun([DiskLog]) -> close(DiskLog) end,
 
333
                  ets:match(ConfigDB,{transfer_disk_log,'$1'})),
 
334
    lists:foreach(fun([DiskLog]) -> close(DiskLog) end,
 
335
                  ets:match(ConfigDB,{error_disk_log,'$1'})),
 
336
    ok.
 
337
 
 
338
 
 
339
%% 
 
340
%% Some disk_log wrapper functions:
 
341
%% 
 
342
 
 
343
%%----------------------------------------------------------------------
 
344
%% Function:    open/4
 
345
%% Description: Open a disk log file.
 
346
%% Control which format the disk log will be in. The external file 
 
347
%% format is used as default since that format was used by older 
 
348
%% implementations of inets.
 
349
%%
 
350
%% When the internal disk log format is used, we will do some extra 
 
351
%% controls. If the files are valid, try to repair them and if 
 
352
%% thats not possible, truncate.
 
353
%%----------------------------------------------------------------------
 
354
 
 
355
open(Filename, MaxBytes, MaxFiles, internal) ->
 
356
    Opts = [{format, internal}, {repair, truncate}],
 
357
    open1(Filename, MaxBytes, MaxFiles, Opts);
 
358
open(Filename, MaxBytes, MaxFiles, _) ->
 
359
    Opts = [{format, external}],
 
360
    open1(Filename, MaxBytes, MaxFiles, Opts).
 
361
 
 
362
open1(Filename, MaxBytes, MaxFiles, Opts0) ->
 
363
    Opts1 = [{name, Filename}, {file, Filename}, {type, wrap}] ++ Opts0,
 
364
    case open2(Opts1, {MaxBytes, MaxFiles}) of
 
365
        {ok, LogDB} ->
 
366
            {ok, LogDB};
 
367
        {error, Reason} ->
 
368
            ?vlog("failed opening disk log with args:"
 
369
                  "~n   Filename: ~p"
 
370
                  "~n   MaxBytes: ~p"
 
371
                  "~n   MaxFiles: ~p"
 
372
                  "~n   Opts0:    ~p"
 
373
                  "~nfor reason:"
 
374
                  "~n   ~p", [Filename, MaxBytes, MaxFiles, Opts0, Reason]),
 
375
            {error, 
 
376
             ?NICE("Can't create " ++ Filename ++ 
 
377
                   lists:flatten(io_lib:format(", ~p",[Reason])))};
 
378
        _ ->
 
379
            {error, ?NICE("Can't create "++Filename)}
 
380
    end.
 
381
 
 
382
open2(Opts, Size) ->
 
383
    case disk_log:open(Opts) of
 
384
        {error, {badarg, size}} ->
 
385
            %% File did not exist, add the size option and try again
 
386
            disk_log:open([{size, Size} | Opts]);
 
387
        Else ->
 
388
            Else
 
389
    end.
 
390
 
 
391
 
 
392
%%----------------------------------------------------------------------
 
393
%% Actually writes the entry to the disk_log. If the log is an 
 
394
%% internal disk_log write it with log otherwise with blog.
 
395
%%----------------------------------------------------------------------  
 
396
write(Log, Entry, internal) ->
 
397
    disk_log:log(Log, Entry);
 
398
 
 
399
write(Log, Entry, _) ->
 
400
    disk_log:blog(Log, Entry).
 
401
 
 
402
%% Close the log file
 
403
close(Log) ->
 
404
    disk_log:close(Log).
 
405