← 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/httpd_util.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/httpd_util.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: httpd_util.erl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
 
17
%%
 
18
-module(httpd_util).
 
19
-export([key1search/2, key1search/3, lookup/2, lookup/3, multi_lookup/2,
 
20
         lookup_mime/2, lookup_mime/3, lookup_mime_default/2,
 
21
         lookup_mime_default/3, reason_phrase/1, message/3, rfc1123_date/0,
 
22
         rfc1123_date/1, day/1, month/1, decode_hex/1, decode_base64/1, encode_base64/1,
 
23
         flatlength/1, split_path/1, split_script_path/1, suffix/1, to_upper/1,
 
24
         to_lower/1, split/3, header/2, header/3, header/4, uniq/1,
 
25
         make_name/2,make_name/3,make_name/4,strip/1,
 
26
         hexlist_to_integer/1,integer_to_hexlist/1,
 
27
         convert_request_date/1,create_etag/1,create_etag/2,getSize/1,
 
28
         response_generated/1]).
 
29
 
 
30
%%Since hexlist_to_integer is a lousy name make a name convert
 
31
-export([encode_hex/1]).
 
32
-include("httpd.hrl").
 
33
 
 
34
%% key1search
 
35
 
 
36
key1search(TupleList,Key) ->
 
37
  key1search(TupleList,Key,undefined).
 
38
 
 
39
key1search(TupleList,Key,Undefined) ->
 
40
  case lists:keysearch(Key,1,TupleList) of
 
41
    {value,{Key,Value}} ->
 
42
      Value;
 
43
    false ->
 
44
      Undefined
 
45
  end.
 
46
 
 
47
%% lookup
 
48
 
 
49
lookup(Table,Key) ->
 
50
  lookup(Table,Key,undefined).
 
51
 
 
52
lookup(Table,Key,Undefined) ->
 
53
    case catch ets:lookup(Table,Key) of
 
54
        [{Key,Value}|_] ->
 
55
            Value;
 
56
        _->
 
57
            Undefined
 
58
    end.
 
59
 
 
60
%% multi_lookup
 
61
 
 
62
multi_lookup(Table,Key) ->
 
63
    remove_key(ets:lookup(Table,Key)).
 
64
 
 
65
remove_key([]) ->
 
66
    [];
 
67
remove_key([{_Key,Value}|Rest]) ->
 
68
    [Value|remove_key(Rest)].
 
69
 
 
70
%% lookup_mime
 
71
 
 
72
lookup_mime(ConfigDB,Suffix) ->
 
73
    lookup_mime(ConfigDB,Suffix,undefined).
 
74
 
 
75
lookup_mime(ConfigDB,Suffix,Undefined) ->
 
76
    [{mime_types,MimeTypesDB}|_]=ets:lookup(ConfigDB,mime_types),
 
77
    case ets:lookup(MimeTypesDB,Suffix) of
 
78
        [] ->
 
79
            Undefined;
 
80
        [{Suffix,MimeType}|_] ->
 
81
            MimeType
 
82
    end.
 
83
 
 
84
%% lookup_mime_default
 
85
 
 
86
lookup_mime_default(ConfigDB,Suffix) ->
 
87
    lookup_mime_default(ConfigDB,Suffix,undefined).
 
88
 
 
89
lookup_mime_default(ConfigDB,Suffix,Undefined) ->
 
90
    [{mime_types,MimeTypesDB}|_]=ets:lookup(ConfigDB,mime_types),
 
91
    case ets:lookup(MimeTypesDB,Suffix) of
 
92
        [] ->
 
93
            case ets:lookup(ConfigDB,default_type) of
 
94
                [] ->
 
95
                    Undefined;
 
96
                [{default_type,DefaultType}|_] ->
 
97
                    DefaultType
 
98
            end;
 
99
        [{Suffix,MimeType}|_] ->
 
100
            MimeType
 
101
    end.
 
102
 
 
103
%% reason_phrase
 
104
reason_phrase(100) -> "Continue";
 
105
reason_phrase(101) -> "Swithing protocol";
 
106
reason_phrase(200) -> "OK";
 
107
reason_phrase(201) -> "Created";
 
108
reason_phrase(202) -> "Accepted";
 
109
reason_phrase(204) -> "No Content";
 
110
reason_phrase(205) -> "Reset Content";
 
111
reason_phrase(206) -> "Partial Content";
 
112
reason_phrase(301) -> "Moved Permanently";
 
113
reason_phrase(302) -> "Moved Temporarily";
 
114
reason_phrase(304) -> "Not Modified";
 
115
reason_phrase(400) -> "Bad Request";
 
116
reason_phrase(401) -> "Unauthorized";
 
117
reason_phrase(402) -> "Payment Required";
 
118
reason_phrase(403) -> "Forbidden";
 
119
reason_phrase(404) -> "Not Found";
 
120
reason_phrase(405) -> "Method Not Allowed";
 
121
reason_phrase(408) -> "Request Timeout";
 
122
reason_phrase(411) -> "Length Required";
 
123
reason_phrase(414) -> "Request-URI Too Long";
 
124
reason_phrase(412) -> "Precondition Failed";
 
125
reason_phrase(416) -> "request Range Not Satisfiable";
 
126
reason_phrase(417) -> "Expectation failed";
 
127
reason_phrase(500) -> "Internal Server Error";
 
128
reason_phrase(501) -> "Not Implemented";
 
129
reason_phrase(502) -> "Bad Gateway";
 
130
reason_phrase(503) -> "Service Unavailable";
 
131
reason_phrase(_) -> "Internal Server Error".
 
132
 
 
133
%% message
 
134
 
 
135
message(301,URL,_) ->
 
136
  "The document has moved <A HREF=\""++URL++"\">here</A>.";
 
137
message(304,_URL,_) ->
 
138
    "The document has not been changed.";
 
139
message(400,none,_) ->
 
140
  "Your browser sent a query that this server could not understand.";
 
141
message(401,none,_) ->
 
142
  "This server could not verify that you
 
143
are authorized to access the document you
 
144
requested.  Either you supplied the wrong
 
145
credentials (e.g., bad password), or your
 
146
browser does not understand how to supply
 
147
the credentials required.";
 
148
message(403,RequestURI,_) ->
 
149
  "You do not have permission to access "++RequestURI++" on this server.";
 
150
message(404,RequestURI,_) ->
 
151
  "The requested URL "++RequestURI++" was not found on this server.";
 
152
message(412,none,_) ->
 
153
  "The requested preconditions where false";
 
154
message(414,ReasonPhrase,_) ->
 
155
  "Message "++ReasonPhrase++".";
 
156
message(416,ReasonPhrase,_) ->
 
157
    ReasonPhrase;
 
158
 
 
159
message(500,none,ConfigDB) ->
 
160
  ServerAdmin=lookup(ConfigDB,server_admin,"unknown@unknown"),
 
161
  "The server encountered an internal error or
 
162
misconfiguration and was unable to complete
 
163
your request.
 
164
<P>Please contact the server administrator "++ServerAdmin++",
 
165
and inform them of the time the error occurred
 
166
and anything you might have done that may have
 
167
caused the error.";
 
168
message(501,{Method,RequestURI,HTTPVersion},_ConfigDB) ->
 
169
  Method++" to "++RequestURI++" ("++HTTPVersion++") not supported.";
 
170
message(503,String,_ConfigDB) ->
 
171
  "This service in unavailable due to: "++String.
 
172
 
 
173
%%convert_rfc_date(Date)->{{YYYY,MM,DD},{HH,MIN,SEC}}
 
174
 
 
175
convert_request_date([D,A,Y,DateType|Rest]) ->
 
176
    Func=case DateType of
 
177
             $\, ->
 
178
                 fun convert_rfc1123_date/1;
 
179
             $\  ->
 
180
                 fun convert_ascii_date/1;
 
181
             _ ->
 
182
                 fun convert_rfc850_date/1
 
183
         end,
 
184
    case catch Func([D,A,Y,DateType|Rest])of
 
185
        {ok,Date} ->
 
186
            Date;
 
187
        _Error ->
 
188
            bad_date
 
189
    end.
 
190
 
 
191
convert_rfc850_date(DateStr) ->
 
192
    case string:tokens(DateStr," ") of
 
193
        [_WeekDay,Date,Time,_TimeZone|_Rest] ->
 
194
           convert_rfc850_date(Date,Time);
 
195
        _Error ->
 
196
            bad_date
 
197
    end.
 
198
 
 
199
convert_rfc850_date([D1,D2,_,M,O,N,_,Y1,Y2|_Rest],[H1,H2,_Col,M1,M2,_Col,S1,S2|_Rest2])->    
 
200
    Year=list_to_integer([50,48,Y1,Y2]),
 
201
    Day=list_to_integer([D1,D2]),
 
202
    Month=convert_month([M,O,N]),
 
203
    Hour=list_to_integer([H1,H2]),
 
204
    Min=list_to_integer([M1,M2]),
 
205
    Sec=list_to_integer([S1,S2]),
 
206
    {ok,{{Year,Month,Day},{Hour,Min,Sec}}};
 
207
convert_rfc850_date(_BadDate,_BadTime)->
 
208
    bad_date.
 
209
 
 
210
convert_ascii_date([_D,_A,_Y,_SP,M,O,N,_SP,D1,D2,_SP,H1,H2,_Col,M1,M2,_Col,S1,S2,_SP,Y1,Y2,Y3,Y4|_Rest])->
 
211
    Year=list_to_integer([Y1,Y2,Y3,Y4]),
 
212
    Day=case D1 of 
 
213
        $\ ->
 
214
            list_to_integer([D2]);
 
215
        _->
 
216
            list_to_integer([D1,D2])
 
217
    end,
 
218
    Month=convert_month([M,O,N]),
 
219
    Hour=list_to_integer([H1,H2]),
 
220
    Min=list_to_integer([M1,M2]),
 
221
    Sec=list_to_integer([S1,S2]),
 
222
    {ok,{{Year,Month,Day},{Hour,Min,Sec}}};
 
223
convert_ascii_date(BadDate)->
 
224
    bad_date.
 
225
convert_rfc1123_date([_D,_A,_Y,_C,_SP,D1,D2,_SP,M,O,N,_SP,Y1,Y2,Y3,Y4,_SP,H1,H2,_Col,M1,M2,_Col,S1,S2|Rest])->    
 
226
    Year=list_to_integer([Y1,Y2,Y3,Y4]),
 
227
    Day=list_to_integer([D1,D2]),
 
228
    Month=convert_month([M,O,N]),
 
229
    Hour=list_to_integer([H1,H2]),
 
230
    Min=list_to_integer([M1,M2]),
 
231
    Sec=list_to_integer([S1,S2]),
 
232
    {ok,{{Year,Month,Day},{Hour,Min,Sec}}};
 
233
convert_rfc1123_date(BadDate)->    
 
234
    bad_date.
 
235
 
 
236
convert_month("Jan")->1;
 
237
convert_month("Feb") ->2;
 
238
convert_month("Mar") ->3; 
 
239
convert_month("Apr") ->4;
 
240
convert_month("May") ->5;
 
241
convert_month("Jun") ->6;
 
242
convert_month("Jul") ->7;
 
243
convert_month("Aug") ->8;
 
244
convert_month("Sep") ->9;
 
245
convert_month("Oct") ->10;
 
246
convert_month("Nov") ->11;
 
247
convert_month("Dec") ->12.
 
248
 
 
249
 
 
250
%% rfc1123_date
 
251
 
 
252
rfc1123_date() ->
 
253
  {{YYYY,MM,DD},{Hour,Min,Sec}}=calendar:universal_time(),
 
254
  DayNumber=calendar:day_of_the_week({YYYY,MM,DD}),
 
255
  lists:flatten(io_lib:format("~s, ~2.2.0w ~3.s ~4.4.0w ~2.2.0w:~2.2.0w:~2.2.0w GMT",
 
256
                        [day(DayNumber),DD,month(MM),YYYY,Hour,Min,Sec])).
 
257
 
 
258
rfc1123_date({{YYYY,MM,DD},{Hour,Min,Sec}}) ->
 
259
  DayNumber=calendar:day_of_the_week({YYYY,MM,DD}),
 
260
  lists:flatten(io_lib:format("~s, ~2.2.0w ~3.s ~4.4.0w ~2.2.0w:~2.2.0w:~2.2.0w GMT",
 
261
                        [day(DayNumber),DD,month(MM),YYYY,Hour,Min,Sec])).
 
262
 
 
263
%% uniq
 
264
 
 
265
uniq([]) ->
 
266
    [];
 
267
uniq([First,First|Rest]) ->
 
268
    uniq([First|Rest]);
 
269
uniq([First|Rest]) ->
 
270
    [First|uniq(Rest)].
 
271
 
 
272
 
 
273
%% day
 
274
 
 
275
day(1) -> "Mon";
 
276
day(2) -> "Tue";
 
277
day(3) -> "Wed";
 
278
day(4) -> "Thu";
 
279
day(5) -> "Fri";
 
280
day(6) -> "Sat"; 
 
281
day(7) -> "Sun".
 
282
 
 
283
%% month
 
284
 
 
285
month(1) -> "Jan";
 
286
month(2) -> "Feb";
 
287
month(3) -> "Mar";
 
288
month(4) -> "Apr";
 
289
month(5) -> "May";
 
290
month(6) -> "Jun";
 
291
month(7) -> "Jul";
 
292
month(8) -> "Aug";
 
293
month(9) -> "Sep";
 
294
month(10) -> "Oct";
 
295
month(11) -> "Nov";
 
296
month(12) -> "Dec".
 
297
 
 
298
%% decode_hex
 
299
 
 
300
decode_hex([$%,Hex1,Hex2|Rest]) ->
 
301
  [hex2dec(Hex1)*16+hex2dec(Hex2)|decode_hex(Rest)];
 
302
decode_hex([First|Rest]) ->
 
303
  [First|decode_hex(Rest)];
 
304
decode_hex([]) ->
 
305
  [].
 
306
 
 
307
hex2dec(X) when X>=$0,X=<$9 -> X-$0;
 
308
hex2dec(X) when X>=$A,X=<$F -> X-$A+10;
 
309
hex2dec(X) when X>=$a,X=<$f -> X-$a+10.
 
310
 
 
311
%% decode_base64 (DEBUG STRING: QWxhZGRpbjpvcGVuIHNlc2FtZQ==)
 
312
 
 
313
decode_base64([]) ->
 
314
  [];
 
315
decode_base64([Sextet1,Sextet2,$=,$=|Rest]) ->
 
316
  Bits2x6=
 
317
    (d(Sextet1) bsl 18) bor
 
318
    (d(Sextet2) bsl 12),
 
319
  Octet1=Bits2x6 bsr 16,
 
320
  [Octet1|decode_base64(Rest)];
 
321
decode_base64([Sextet1,Sextet2,Sextet3,$=|Rest]) ->
 
322
  Bits3x6=
 
323
    (d(Sextet1) bsl 18) bor
 
324
    (d(Sextet2) bsl 12) bor
 
325
    (d(Sextet3) bsl 6),
 
326
  Octet1=Bits3x6 bsr 16,
 
327
  Octet2=(Bits3x6 bsr 8) band 16#ff,
 
328
  [Octet1,Octet2|decode_base64(Rest)];
 
329
decode_base64([Sextet1,Sextet2,Sextet3,Sextet4|Rest]) ->
 
330
  Bits4x6=
 
331
    (d(Sextet1) bsl 18) bor
 
332
    (d(Sextet2) bsl 12) bor
 
333
    (d(Sextet3) bsl 6) bor
 
334
    d(Sextet4),
 
335
  Octet1=Bits4x6 bsr 16,
 
336
  Octet2=(Bits4x6 bsr 8) band 16#ff,
 
337
  Octet3=Bits4x6 band 16#ff,
 
338
  [Octet1,Octet2,Octet3|decode_base64(Rest)];
 
339
decode_base64(CatchAll) ->
 
340
  "BAD!".
 
341
 
 
342
d(X) when X >= $A, X =<$Z ->
 
343
    X-65;
 
344
d(X) when X >= $a, X =<$z ->
 
345
    X-71;
 
346
d(X) when X >= $0, X =<$9 ->
 
347
    X+4;
 
348
d($+) -> 62;
 
349
d($/) -> 63;
 
350
d(_) -> 63.
 
351
 
 
352
 
 
353
encode_base64([]) ->
 
354
    [];
 
355
encode_base64([A]) ->
 
356
    [e(A bsr 2), e((A band 3) bsl 4), $=, $=];
 
357
encode_base64([A,B]) ->
 
358
    [e(A bsr 2), e(((A band 3) bsl 4) bor (B bsr 4)), e((B band 15) bsl 2), $=];
 
359
encode_base64([A,B,C|Ls]) ->
 
360
    encode_base64_do(A,B,C, Ls).
 
361
encode_base64_do(A,B,C, Rest) ->
 
362
    BB = (A bsl 16) bor (B bsl 8) bor C,
 
363
    [e(BB bsr 18), e((BB bsr 12) band 63), 
 
364
     e((BB bsr 6) band 63), e(BB band 63)|encode_base64(Rest)].
 
365
 
 
366
e(X) when X >= 0, X < 26 -> X+65;
 
367
e(X) when X>25, X<52 ->     X+71;
 
368
e(X) when X>51, X<62 ->     X-4;
 
369
e(62) ->                    $+;
 
370
e(63) ->                    $/;
 
371
e(X) ->                     exit({bad_encode_base64_token, X}).
 
372
 
 
373
 
 
374
%% flatlength
 
375
 
 
376
flatlength(List) ->
 
377
    flatlength(List, 0).
 
378
 
 
379
flatlength([H|T],L) when list(H) ->
 
380
    flatlength(H,flatlength(T,L));
 
381
flatlength([H|T],L) when binary(H) ->
 
382
    flatlength(T,L+size(H));
 
383
flatlength([H|T],L) ->
 
384
    flatlength(T,L+1);
 
385
flatlength([],L) ->
 
386
  L.
 
387
 
 
388
%% split_path
 
389
 
 
390
split_path(Path) ->
 
391
    case regexp:match(Path,"[\?].*\$") of
 
392
        %% A QUERY_STRING exists!
 
393
        {match,Start,Length} ->
 
394
            {httpd_util:decode_hex(string:substr(Path,1,Start-1)),
 
395
             string:substr(Path,Start,Length)};
 
396
        %% A possible PATH_INFO exists!
 
397
        nomatch ->
 
398
            split_path(Path,[])
 
399
    end.
 
400
 
 
401
split_path([],SoFar) ->
 
402
    {httpd_util:decode_hex(lists:reverse(SoFar)),[]};
 
403
split_path([$/|Rest],SoFar) ->
 
404
    Path=httpd_util:decode_hex(lists:reverse(SoFar)),
 
405
    case file:read_file_info(Path) of
 
406
        {ok,FileInfo} when FileInfo#file_info.type == regular ->
 
407
            {Path,[$/|Rest]};
 
408
        {ok,FileInfo} ->
 
409
            split_path(Rest,[$/|SoFar]);
 
410
        {error,Reason} ->
 
411
            split_path(Rest,[$/|SoFar])
 
412
    end;
 
413
split_path([C|Rest],SoFar) ->
 
414
    split_path(Rest,[C|SoFar]).
 
415
 
 
416
%% split_script_path
 
417
 
 
418
split_script_path(Path) ->
 
419
    case split_script_path(Path, []) of
 
420
        {Script, AfterPath} ->
 
421
            {PathInfo, QueryString} = pathinfo_querystring(AfterPath),
 
422
            {Script, {PathInfo, QueryString}};
 
423
        not_a_script ->
 
424
            not_a_script
 
425
    end.
 
426
 
 
427
pathinfo_querystring(Str) ->
 
428
    pathinfo_querystring(Str, []).
 
429
pathinfo_querystring([], SoFar) ->
 
430
    {lists:reverse(SoFar), []};
 
431
pathinfo_querystring([$?|Rest], SoFar) ->
 
432
    {lists:reverse(SoFar), Rest};
 
433
pathinfo_querystring([C|Rest], SoFar) ->
 
434
    pathinfo_querystring(Rest, [C|SoFar]).
 
435
 
 
436
split_script_path([$?|QueryString], SoFar) ->
 
437
    Path = httpd_util:decode_hex(lists:reverse(SoFar)),
 
438
    case file:read_file_info(Path) of
 
439
        {ok,FileInfo} when FileInfo#file_info.type == regular ->
 
440
            {Path, [$?|QueryString]};
 
441
        {ok,FileInfo} ->
 
442
            not_a_script;
 
443
        {error,Reason} ->
 
444
            not_a_script
 
445
    end;
 
446
split_script_path([], SoFar) ->
 
447
    Path = httpd_util:decode_hex(lists:reverse(SoFar)),
 
448
    case file:read_file_info(Path) of
 
449
        {ok,FileInfo} when FileInfo#file_info.type == regular ->
 
450
            {Path, []};
 
451
        {ok,FileInfo} ->
 
452
            not_a_script;
 
453
        {error,Reason} ->
 
454
            not_a_script
 
455
    end;
 
456
split_script_path([$/|Rest], SoFar) ->
 
457
    Path = httpd_util:decode_hex(lists:reverse(SoFar)),
 
458
    case file:read_file_info(Path) of
 
459
        {ok, FileInfo} when FileInfo#file_info.type == regular ->
 
460
            {Path, [$/|Rest]};
 
461
        {ok, _FileInfo} ->
 
462
            split_script_path(Rest, [$/|SoFar]);
 
463
        {error, _Reason} ->
 
464
            split_script_path(Rest, [$/|SoFar])
 
465
    end;
 
466
split_script_path([C|Rest], SoFar) ->
 
467
    split_script_path(Rest,[C|SoFar]).
 
468
 
 
469
%% suffix
 
470
 
 
471
suffix(Path) ->
 
472
    case filename:extension(Path) of
 
473
        [] ->
 
474
            [];
 
475
        Extension ->
 
476
            tl(Extension)
 
477
    end.
 
478
 
 
479
%% to_upper
 
480
 
 
481
to_upper([C|Cs]) when C >= $a, C =< $z ->
 
482
    [C-($a-$A)|to_upper(Cs)];
 
483
to_upper([C|Cs]) ->
 
484
    [C|to_upper(Cs)];
 
485
to_upper([]) ->
 
486
    [].
 
487
 
 
488
%% to_lower
 
489
 
 
490
to_lower([C|Cs]) when C >= $A, C =< $Z ->
 
491
    [C+($a-$A)|to_lower(Cs)];
 
492
to_lower([C|Cs]) ->
 
493
    [C|to_lower(Cs)];
 
494
to_lower([]) ->
 
495
    [].
 
496
 
 
497
 
 
498
%% strip
 
499
strip(Value)->
 
500
    lists:reverse(remove_ws(lists:reverse(remove_ws(Value)))).
 
501
        
 
502
remove_ws([$\s|Rest])->
 
503
    remove_ws(Rest);
 
504
remove_ws([$\t|Rest]) ->
 
505
    remove_ws(Rest);
 
506
remove_ws(Rest) ->
 
507
    Rest.
 
508
 
 
509
%% split
 
510
 
 
511
split(String,RegExp,Limit) ->
 
512
    case regexp:parse(RegExp) of
 
513
        {error,Reason} ->
 
514
            {error,Reason};
 
515
        {ok,_} ->
 
516
            {ok,do_split(String,RegExp,Limit)}
 
517
    end.
 
518
 
 
519
do_split(String,RegExp,1) ->
 
520
    [String];
 
521
 
 
522
do_split(String,RegExp,Limit) ->
 
523
    case regexp:first_match(String,RegExp) of 
 
524
        {match,Start,Length} ->
 
525
            [string:substr(String,1,Start-1)|
 
526
             do_split(lists:nthtail(Start+Length-1,String),RegExp,Limit-1)];
 
527
        nomatch ->
 
528
            [String]
 
529
    end.
 
530
 
 
531
%% header
 
532
header(StatusCode,Date)when list(Date)->
 
533
    header(StatusCode,"text/plain",false);
 
534
 
 
535
header(StatusCode, PersistentConnection) when integer(StatusCode)->
 
536
    Date = rfc1123_date(),
 
537
    Connection = 
 
538
        case PersistentConnection of
 
539
            true ->
 
540
                "";
 
541
            _ ->
 
542
                "Connection: close \r\n"
 
543
        end,
 
544
    io_lib:format("HTTP/1.1 ~w ~s \r\nDate: ~s\r\nServer: ~s\r\n~s",
 
545
                  [StatusCode, httpd_util:reason_phrase(StatusCode),
 
546
                   Date, ?SERVER_SOFTWARE, Connection]).
 
547
 
 
548
%%----------------------------------------------------------------------
 
549
 
 
550
header(StatusCode, MimeType, Date) when list(Date) ->
 
551
    header(StatusCode, MimeType, false,rfc1123_date());
 
552
 
 
553
 
 
554
header(StatusCode, MimeType, PersistentConnection) when integer(StatusCode) ->
 
555
    header(StatusCode, MimeType, PersistentConnection,rfc1123_date()).
 
556
 
 
557
 
 
558
%%----------------------------------------------------------------------
 
559
 
 
560
header(416, MimeType,PersistentConnection,Date)-> 
 
561
    Connection = 
 
562
        case PersistentConnection of
 
563
            true ->
 
564
                "";
 
565
            _ ->
 
566
                "Connection: close \r\n"
 
567
        end,
 
568
    io_lib:format("HTTP/1.1 ~w ~s \r\nDate: ~s\r\nServer: ~s\r\n"
 
569
                  "Content-Range:bytes *"
 
570
                  "Content-Type: ~s\r\n~s",
 
571
                  [416, httpd_util:reason_phrase(416),
 
572
                   Date, ?SERVER_SOFTWARE, MimeType, Connection]);
 
573
 
 
574
 
 
575
header(StatusCode, MimeType,PersistentConnection,Date) when integer(StatusCode)-> 
 
576
    Connection = 
 
577
        case PersistentConnection of
 
578
            true ->
 
579
                "";
 
580
            _ ->
 
581
                "Connection: close \r\n"
 
582
        end,
 
583
    io_lib:format("HTTP/1.1 ~w ~s \r\nDate: ~s\r\nServer: ~s\r\n"
 
584
                  "Content-Type: ~s\r\n~s",
 
585
                  [StatusCode, httpd_util:reason_phrase(StatusCode),
 
586
                   Date, ?SERVER_SOFTWARE, MimeType, Connection]).
 
587
 
 
588
 
 
589
 
 
590
%% make_name/2, make_name/3
 
591
%% Prefix  -> string()
 
592
%%            First part of the name, e.g. "httpd"
 
593
%% Addr    -> {A,B,C,D} | string() | undefined
 
594
%%            The address part of the name. 
 
595
%%            e.g. "123.234.55.66" or {123,234,55,66} or "otp.ericsson.se" 
 
596
%%            for a host address or undefined if local host.
 
597
%% Port    -> integer()
 
598
%%            Last part of the name, such as the HTTPD server port 
 
599
%%            number (80).
 
600
%% Postfix -> Any string that will be added last to the name
 
601
%%
 
602
%% Example:
 
603
%% make_name("httpd","otp.ericsson.se",80) => httpd__otp_ericsson_se__80
 
604
%% make_name("httpd",undefined,8088)       => httpd_8088
 
605
 
 
606
make_name(Prefix,Port) ->
 
607
    make_name(Prefix,undefined,Port,"").
 
608
 
 
609
make_name(Prefix,Addr,Port) ->
 
610
    make_name(Prefix,Addr,Port,"").
 
611
    
 
612
make_name(Prefix,"*",Port,Postfix) ->
 
613
    make_name(Prefix,undefined,Port,Postfix);
 
614
 
 
615
make_name(Prefix,any,Port,Postfix) ->
 
616
    make_name1(io_lib:format("~s_~w~s",[Prefix,Port,Postfix]));
 
617
 
 
618
make_name(Prefix,undefined,Port,Postfix) ->
 
619
    make_name1(io_lib:format("~s_~w~s",[Prefix,Port,Postfix]));
 
620
 
 
621
make_name(Prefix,Addr,Port,Postfix) ->
 
622
    NameString = 
 
623
        Prefix ++ "__" ++ make_name2(Addr) ++ "__" ++ 
 
624
        integer_to_list(Port) ++ Postfix,
 
625
    make_name1(NameString).
 
626
    
 
627
make_name1(String) ->
 
628
    list_to_atom(lists:flatten(String)).
 
629
 
 
630
make_name2({A,B,C,D}) ->
 
631
    io_lib:format("~w_~w_~w_~w",[A,B,C,D]);
 
632
make_name2(Addr) ->
 
633
    search_and_replace(Addr,$.,$_).
 
634
 
 
635
search_and_replace(S,A,B) ->
 
636
    Fun = fun(What) -> 
 
637
                  case What of
 
638
                      A -> B;
 
639
                      O -> O
 
640
                  end
 
641
          end,
 
642
    lists:map(Fun,S).
 
643
 
 
644
 
 
645
 
 
646
%%----------------------------------------------------------------------
 
647
%% Converts  a string that constists of 0-9,A-F,a-f to a 
 
648
%% integer
 
649
%%----------------------------------------------------------------------
 
650
 
 
651
hexlist_to_integer([])->
 
652
    empty;
 
653
 
 
654
 
 
655
%%When the string only contains one value its eaasy done.
 
656
%% 0-9
 
657
hexlist_to_integer([Size]) when Size>=48 , Size=<57 ->
 
658
   Size-48;
 
659
%% A-F
 
660
hexlist_to_integer([Size]) when Size>=65 , Size=<70 ->
 
661
    Size-55;
 
662
%% a-f
 
663
hexlist_to_integer([Size]) when Size>=97 , Size=<102 ->
 
664
    Size-87;
 
665
hexlist_to_integer([Size]) ->
 
666
    not_a_num;
 
667
 
 
668
hexlist_to_integer(Size) ->
 
669
    Len=string:span(Size,"1234567890abcdefABCDEF"),
 
670
    hexlist_to_integer2(Size,16 bsl (4 *(Len-2)),0).
 
671
 
 
672
hexlist_to_integer2([],_Pos,Sum)->
 
673
    Sum;
 
674
hexlist_to_integer2([HexVal|HexString],Pos,Sum)when HexVal>=48,HexVal=<57->
 
675
    hexlist_to_integer2(HexString,Pos bsr 4,Sum+((HexVal-48)*Pos));
 
676
 
 
677
hexlist_to_integer2([HexVal|HexString],Pos,Sum)when HexVal>=65,HexVal=<70->
 
678
    hexlist_to_integer2(HexString,Pos bsr 4,Sum+((HexVal-55)*Pos));
 
679
 
 
680
hexlist_to_integer2([HexVal|HexString],Pos,Sum)when HexVal>=97,HexVal=<102->
 
681
    hexlist_to_integer2(HexString,Pos bsr 4,Sum+((HexVal-87)*Pos));
 
682
 
 
683
hexlist_to_integer2(_AfterHexString,_Pos,Sum)->
 
684
    Sum.
 
685
 
 
686
%%----------------------------------------------------------------------
 
687
%%Converts an integer to an hexlist
 
688
%%----------------------------------------------------------------------
 
689
encode_hex(Num)->
 
690
    integer_to_hexlist(Num).
 
691
 
 
692
 
 
693
integer_to_hexlist(Num)->
 
694
    integer_to_hexlist(Num,getSize(Num),[]).
 
695
 
 
696
integer_to_hexlist(Num,Pot,Res) when Pot<0 ->
 
697
    convert_to_ascii([Num|Res]);
 
698
 
 
699
integer_to_hexlist(Num,Pot,Res) ->
 
700
    Position=(16 bsl (Pot*4)),
 
701
    PosVal=Num div Position,
 
702
    integer_to_hexlist(Num-(PosVal*Position),Pot-1,[PosVal|Res]).
 
703
convert_to_ascii(RevesedNum)->
 
704
    convert_to_ascii(RevesedNum,[]).
 
705
 
 
706
convert_to_ascii([],Num)->
 
707
    Num;
 
708
convert_to_ascii([Num|Reversed],Number)when Num>-1, Num<10 ->
 
709
    convert_to_ascii(Reversed,[Num+48|Number]);
 
710
convert_to_ascii([Num|Reversed],Number)when Num>9, Num<16 ->
 
711
    convert_to_ascii(Reversed,[Num+55|Number]);
 
712
convert_to_ascii(NumReversed,Number) ->
 
713
    error.
 
714
 
 
715
 
 
716
                                              
 
717
getSize(Num)->
 
718
    getSize(Num,0).
 
719
 
 
720
getSize(Num,Pot)when Num<(16 bsl(Pot *4))  ->
 
721
    Pot-1;
 
722
 
 
723
getSize(Num,Pot) ->
 
724
    getSize(Num,Pot+1).
 
725
 
 
726
 
 
727
 
 
728
 
 
729
 
 
730
create_etag(FileInfo)->
 
731
    create_etag(FileInfo#file_info.mtime,FileInfo#file_info.size).
 
732
 
 
733
create_etag({{Year,Month,Day},{Hour,Min,Sec}},Size)->
 
734
    create_part([Year,Month,Day,Hour,Min,Sec])++io_lib:write(Size);
 
735
 
 
736
create_etag(FileInfo,Size)->
 
737
    create_etag(FileInfo#file_info.mtime,Size).
 
738
 
 
739
create_part(Values)->
 
740
    lists:map(fun(Val0)->
 
741
                      Val=Val0 rem 60,
 
742
                          if
 
743
                              Val=<25 ->
 
744
                                  65+Val;  % A-Z
 
745
                              Val=<50 ->
 
746
                                  72+Val;  % a-z
 
747
                              %%Since no date s
 
748
                              true ->
 
749
                                  Val-3
 
750
                          end
 
751
              end,Values).
 
752
                                    
 
753
 
 
754
 
 
755
%%----------------------------------------------------------------------
 
756
%%Function that controls whether a response is generated or not
 
757
%%----------------------------------------------------------------------
 
758
response_generated(Info)->
 
759
    case httpd_util:key1search(Info#mod.data,status) of
 
760
        %% A status code has been generated!
 
761
        {StatusCode,PhraseArgs,Reason}->
 
762
            true;
 
763
        %%No status code control repsonsxe
 
764
        undefined ->
 
765
            case httpd_util:key1search(Info#mod.data, response) of
 
766
                %% No response has been generated!
 
767
                undefined ->
 
768
                    false;
 
769
                %% A response has been generated or sent!
 
770
                Response ->
 
771
                    true
 
772
            end
 
773
    end.
 
774
 
 
775
 
 
776
 
 
777