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/.
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
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.''
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]).
30
%%Since hexlist_to_integer is a lousy name make a name convert
31
-export([encode_hex/1]).
32
-include("httpd.hrl").
36
key1search(TupleList,Key) ->
37
key1search(TupleList,Key,undefined).
39
key1search(TupleList,Key,Undefined) ->
40
case lists:keysearch(Key,1,TupleList) of
41
{value,{Key,Value}} ->
50
lookup(Table,Key,undefined).
52
lookup(Table,Key,Undefined) ->
53
case catch ets:lookup(Table,Key) of
62
multi_lookup(Table,Key) ->
63
remove_key(ets:lookup(Table,Key)).
67
remove_key([{Key,Value}|Rest]) ->
68
[Value|remove_key(Rest)].
72
lookup_mime(ConfigDB,Suffix) ->
73
lookup_mime(ConfigDB,Suffix,undefined).
75
lookup_mime(ConfigDB,Suffix,Undefined) ->
76
[{mime_types,MimeTypesDB}|_]=ets:lookup(ConfigDB,mime_types),
77
case ets:lookup(MimeTypesDB,Suffix) of
80
[{Suffix,MimeType}|_] ->
84
%% lookup_mime_default
86
lookup_mime_default(ConfigDB,Suffix) ->
87
lookup_mime_default(ConfigDB,Suffix,undefined).
89
lookup_mime_default(ConfigDB,Suffix,Undefined) ->
90
[{mime_types,MimeTypesDB}|_]=ets:lookup(ConfigDB,mime_types),
91
case ets:lookup(MimeTypesDB,Suffix) of
93
case ets:lookup(ConfigDB,default_type) of
96
[{default_type,DefaultType}|_] ->
99
[{Suffix,MimeType}|_] ->
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".
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 doesn't understand how to supply
147
the credentials required.";
148
message(403,RequestURI,_) ->
149
"You don't 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,_) ->
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
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
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.
173
%%convert_rfc_date(Date)->{{YYYY,MM,DD},{HH,MIN,SEC}}
175
convert_request_date([D,A,Y,DateType|Rest])->
176
Func=case DateType of
178
fun convert_rfc1123_date/1;
180
fun convert_ascii_date/1;
182
fun convert_rfc850_date/1
184
case catch Func([D,A,Y,DateType|Rest])of
190
convert_rfc850_date(DateStr)->
191
case string:tokens(DateStr," ") of
192
[WeekDay,Date,Time,TimeZone|Rest]->
193
convert_rfc850_date(Date,Time);
200
convert_rfc850_date([D1,D2,_,M,O,N,_,Y1,Y2|_Rest],[H1,H2,_Col,M1,M2,_Col,S1,S2|_Rest2])->
201
Year=list_to_integer([50,48,Y1,Y2]),
202
Day=list_to_integer([D1,D2]),
203
Month=convert_month([M,O,N]),
204
Hour=list_to_integer([H1,H2]),
205
Min=list_to_integer([M1,M2]),
206
Sec=list_to_integer([S1,S2]),
207
{ok,{{Year,Month,Day},{Hour,Min,Sec}}};
208
convert_rfc850_date(_BadDate,_BadTime)->
211
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])->
212
Year=list_to_integer([Y1,Y2,Y3,Y4]),
215
list_to_integer([D2]);
217
list_to_integer([D1,D2])
219
Month=convert_month([M,O,N]),
220
Hour=list_to_integer([H1,H2]),
221
Min=list_to_integer([M1,M2]),
222
Sec=list_to_integer([S1,S2]),
223
{ok,{{Year,Month,Day},{Hour,Min,Sec}}};
224
convert_ascii_date(BadDate)->
226
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])->
227
Year=list_to_integer([Y1,Y2,Y3,Y4]),
228
Day=list_to_integer([D1,D2]),
229
Month=convert_month([M,O,N]),
230
Hour=list_to_integer([H1,H2]),
231
Min=list_to_integer([M1,M2]),
232
Sec=list_to_integer([S1,S2]),
233
{ok,{{Year,Month,Day},{Hour,Min,Sec}}};
234
convert_rfc1123_date(BadDate)->
237
convert_month("Jan")->1;
238
convert_month("Feb") ->2;
239
convert_month("Mar") ->3;
240
convert_month("Apr") ->4;
241
convert_month("May") ->5;
242
convert_month("Jun") ->6;
243
convert_month("Jul") ->7;
244
convert_month("Aug") ->8;
245
convert_month("Sep") ->9;
246
convert_month("Oct") ->10;
247
convert_month("Nov") ->11;
248
convert_month("Dec") ->12.
254
{{YYYY,MM,DD},{Hour,Min,Sec}}=calendar:universal_time(),
255
DayNumber=calendar:day_of_the_week({YYYY,MM,DD}),
256
lists:flatten(io_lib:format("~s, ~2.2.0w ~3.s ~4.4.0w ~2.2.0w:~2.2.0w:~2.2.0w GMT",
257
[day(DayNumber),DD,month(MM),YYYY,Hour,Min,Sec])).
259
rfc1123_date({{YYYY,MM,DD},{Hour,Min,Sec}}) ->
260
DayNumber=calendar:day_of_the_week({YYYY,MM,DD}),
261
lists:flatten(io_lib:format("~s, ~2.2.0w ~3.s ~4.4.0w ~2.2.0w:~2.2.0w:~2.2.0w GMT",
262
[day(DayNumber),DD,month(MM),YYYY,Hour,Min,Sec])).
268
uniq([First,First|Rest]) ->
270
uniq([First|Rest]) ->
301
decode_hex([$%,Hex1,Hex2|Rest]) ->
302
[hex2dec(Hex1)*16+hex2dec(Hex2)|decode_hex(Rest)];
303
decode_hex([First|Rest]) ->
304
[First|decode_hex(Rest)];
308
hex2dec(X) when X>=$0,X=<$9 -> X-$0;
309
hex2dec(X) when X>=$A,X=<$F -> X-$A+10;
310
hex2dec(X) when X>=$a,X=<$f -> X-$a+10.
312
%% decode_base64 (DEBUG STRING: QWxhZGRpbjpvcGVuIHNlc2FtZQ==)
316
decode_base64([Sextet1,Sextet2,$=,$=|Rest]) ->
318
(d(Sextet1) bsl 18) bor
320
Octet1=Bits2x6 bsr 16,
321
[Octet1|decode_base64(Rest)];
322
decode_base64([Sextet1,Sextet2,Sextet3,$=|Rest]) ->
324
(d(Sextet1) bsl 18) bor
325
(d(Sextet2) bsl 12) bor
327
Octet1=Bits3x6 bsr 16,
328
Octet2=(Bits3x6 bsr 8) band 16#ff,
329
[Octet1,Octet2|decode_base64(Rest)];
330
decode_base64([Sextet1,Sextet2,Sextet3,Sextet4|Rest]) ->
332
(d(Sextet1) bsl 18) bor
333
(d(Sextet2) bsl 12) bor
334
(d(Sextet3) bsl 6) bor
336
Octet1=Bits4x6 bsr 16,
337
Octet2=(Bits4x6 bsr 8) band 16#ff,
338
Octet3=Bits4x6 band 16#ff,
339
[Octet1,Octet2,Octet3|decode_base64(Rest)];
340
decode_base64(CatchAll) ->
343
d(X) when X >= $A, X =<$Z ->
345
d(X) when X >= $a, X =<$z ->
347
d(X) when X >= $0, X =<$9 ->
356
encode_base64([A]) ->
357
[e(A bsr 2), e((A band 3) bsl 4), $=, $=];
358
encode_base64([A,B]) ->
359
[e(A bsr 2), e(((A band 3) bsl 4) bor (B bsr 4)), e((B band 15) bsl 2), $=];
360
encode_base64([A,B,C|Ls]) ->
361
encode_base64_do(A,B,C, Ls).
362
encode_base64_do(A,B,C, Rest) ->
363
BB = (A bsl 16) bor (B bsl 8) bor C,
364
[e(BB bsr 18), e((BB bsr 12) band 63),
365
e((BB bsr 6) band 63), e(BB band 63)|encode_base64(Rest)].
367
e(X) when X >= 0, X < 26 -> X+65;
368
e(X) when X>25, X<52 -> X+71;
369
e(X) when X>51, X<62 -> X-4;
372
e(X) -> exit({bad_encode_base64_token, X}).
380
flatlength([H|T],L) when list(H) ->
381
flatlength(H,flatlength(T,L));
382
flatlength([H|T],L) when binary(H) ->
383
flatlength(T,L+size(H));
384
flatlength([H|T],L) ->
392
case regexp:match(Path,"[\?].*\$") of
393
%% A QUERY_STRING exists!
394
{match,Start,Length} ->
395
{httpd_util:decode_hex(string:substr(Path,1,Start-1)),
396
string:substr(Path,Start,Length)};
397
%% A possible PATH_INFO exists!
402
split_path([],SoFar) ->
403
{httpd_util:decode_hex(lists:reverse(SoFar)),[]};
404
split_path([$/|Rest],SoFar) ->
405
Path=httpd_util:decode_hex(lists:reverse(SoFar)),
406
case file:read_file_info(Path) of
407
{ok,FileInfo} when FileInfo#file_info.type == regular ->
410
split_path(Rest,[$/|SoFar]);
412
split_path(Rest,[$/|SoFar])
414
split_path([C|Rest],SoFar) ->
415
split_path(Rest,[C|SoFar]).
419
split_script_path(Path) ->
420
case split_script_path(Path, []) of
421
{Script, AfterPath} ->
422
{PathInfo, QueryString} = pathinfo_querystring(AfterPath),
423
{Script, {PathInfo, QueryString}};
428
pathinfo_querystring(Str) ->
429
pathinfo_querystring(Str, []).
430
pathinfo_querystring([], SoFar) ->
431
{lists:reverse(SoFar), []};
432
pathinfo_querystring([$?|Rest], SoFar) ->
433
{lists:reverse(SoFar), Rest};
434
pathinfo_querystring([C|Rest], SoFar) ->
435
pathinfo_querystring(Rest, [C|SoFar]).
437
split_script_path([$?|QueryString], SoFar) ->
438
Path = httpd_util:decode_hex(lists:reverse(SoFar)),
439
case file:read_file_info(Path) of
440
{ok,FileInfo} when FileInfo#file_info.type == regular ->
441
{Path, [$?|QueryString]};
447
split_script_path([], SoFar) ->
448
Path = httpd_util:decode_hex(lists:reverse(SoFar)),
449
case file:read_file_info(Path) of
450
{ok,FileInfo} when FileInfo#file_info.type == regular ->
457
split_script_path([$/|Rest], SoFar) ->
458
Path = httpd_util:decode_hex(lists:reverse(SoFar)),
459
case file:read_file_info(Path) of
460
{ok, FileInfo} when FileInfo#file_info.type == regular ->
463
split_script_path(Rest, [$/|SoFar]);
465
split_script_path(Rest, [$/|SoFar])
467
split_script_path([C|Rest], SoFar) ->
468
split_script_path(Rest,[C|SoFar]).
473
case filename:extension(Path) of
482
to_upper([C|Cs]) when C >= $a, C =< $z ->
483
[C-($a-$A)|to_upper(Cs)];
491
to_lower([C|Cs]) when C >= $A, C =< $Z ->
492
[C+($a-$A)|to_lower(Cs)];
501
lists:reverse(remove_ws(lists:reverse(remove_ws(Value)))).
503
remove_ws([$\s|Rest])->
505
remove_ws([$\t|Rest]) ->
512
split(String,RegExp,Limit) ->
513
case regexp:parse(RegExp) of
517
{ok,do_split(String,RegExp,Limit)}
520
do_split(String,RegExp,1) ->
523
do_split(String,RegExp,Limit) ->
524
case regexp:first_match(String,RegExp) of
525
{match,Start,Length} ->
526
[string:substr(String,1,Start-1)|
527
do_split(lists:nthtail(Start+Length-1,String),RegExp,Limit-1)];
533
header(StatusCode,Date)when list(Date)->
534
header(StatusCode,"text/plain",false);
536
header(StatusCode, PersistentConnection) when integer(StatusCode)->
537
Date = rfc1123_date(),
539
case PersistentConnection of
543
"Connection: close \r\n"
545
io_lib:format("HTTP/1.1 ~w ~s \r\nDate: ~s\r\nServer: ~s\r\n~s",
546
[StatusCode, httpd_util:reason_phrase(StatusCode),
547
Date, ?SERVER_SOFTWARE, Connection]).
549
%%----------------------------------------------------------------------
551
header(StatusCode, MimeType, Date) when list(Date) ->
552
header(StatusCode, MimeType, false,rfc1123_date());
555
header(StatusCode, MimeType, PersistentConnection) when integer(StatusCode) ->
556
header(StatusCode, MimeType, PersistentConnection,rfc1123_date()).
559
%%----------------------------------------------------------------------
561
header(416, MimeType,PersistentConnection,Date)->
563
case PersistentConnection of
567
"Connection: close \r\n"
569
io_lib:format("HTTP/1.1 ~w ~s \r\nDate: ~s\r\nServer: ~s\r\n"
570
"Content-Range:bytes *"
571
"Content-Type: ~s\r\n~s",
572
[416, httpd_util:reason_phrase(416),
573
Date, ?SERVER_SOFTWARE, MimeType, Connection]);
576
header(StatusCode, MimeType,PersistentConnection,Date) when integer(StatusCode)->
578
case PersistentConnection of
582
"Connection: close \r\n"
584
io_lib:format("HTTP/1.1 ~w ~s \r\nDate: ~s\r\nServer: ~s\r\n"
585
"Content-Type: ~s\r\n~s",
586
[StatusCode, httpd_util:reason_phrase(StatusCode),
587
Date, ?SERVER_SOFTWARE, MimeType, Connection]).
591
%% make_name/2, make_name/3
592
%% Prefix -> string()
593
%% First part of the name, e.g. "httpd"
594
%% Addr -> {A,B,C,D} | string() | undefined
595
%% The address part of the name.
596
%% e.g. "123.234.55.66" or {123,234,55,66} or "otp.ericsson.se"
597
%% for a host address or undefined if local host.
599
%% Last part of the name, such as the HTTPD server port
601
%% Postfix -> Any string that will be added last to the name
604
%% make_name("httpd","otp.ericsson.se",80) => httpd__otp_ericsson_se__80
605
%% make_name("httpd",undefined,8088) => httpd_8088
607
make_name(Prefix,Port) ->
608
make_name(Prefix,undefined,Port,"").
610
make_name(Prefix,Addr,Port) ->
611
make_name(Prefix,Addr,Port,"").
613
make_name(Prefix,"*",Port,Postfix) ->
614
make_name(Prefix,undefined,Port,Postfix);
616
make_name(Prefix,any,Port,Postfix) ->
617
make_name1(io_lib:format("~s_~w~s",[Prefix,Port,Postfix]));
619
make_name(Prefix,undefined,Port,Postfix) ->
620
make_name1(io_lib:format("~s_~w~s",[Prefix,Port,Postfix]));
622
make_name(Prefix,Addr,Port,Postfix) ->
624
Prefix ++ "__" ++ make_name2(Addr) ++ "__" ++
625
integer_to_list(Port) ++ Postfix,
626
make_name1(NameString).
628
make_name1(String) ->
629
list_to_atom(lists:flatten(String)).
631
make_name2({A,B,C,D}) ->
632
io_lib:format("~w_~w_~w_~w",[A,B,C,D]);
634
search_and_replace(Addr,$.,$_).
636
search_and_replace(S,A,B) ->
647
%%----------------------------------------------------------------------
648
%% Converts a string that constists of 0-9,A-F,a-f to a
650
%%----------------------------------------------------------------------
652
hexlist_to_integer([])->
656
%%When the string only contains one value its eaasy done.
658
hexlist_to_integer([Size]) when Size>=48 , Size=<57 ->
661
hexlist_to_integer([Size]) when Size>=65 , Size=<70 ->
664
hexlist_to_integer([Size]) when Size>=97 , Size=<102 ->
666
hexlist_to_integer([Size]) ->
669
hexlist_to_integer(Size) ->
670
Len=string:span(Size,"1234567890abcdefABCDEF"),
671
hexlist_to_integer2(Size,16 bsl (4 *(Len-2)),0).
673
hexlist_to_integer2([],_Pos,Sum)->
675
hexlist_to_integer2([HexVal|HexString],Pos,Sum)when HexVal>=48,HexVal=<57->
676
hexlist_to_integer2(HexString,Pos bsr 4,Sum+((HexVal-48)*Pos));
678
hexlist_to_integer2([HexVal|HexString],Pos,Sum)when HexVal>=65,HexVal=<70->
679
hexlist_to_integer2(HexString,Pos bsr 4,Sum+((HexVal-55)*Pos));
681
hexlist_to_integer2([HexVal|HexString],Pos,Sum)when HexVal>=97,HexVal=<102->
682
hexlist_to_integer2(HexString,Pos bsr 4,Sum+((HexVal-87)*Pos));
684
hexlist_to_integer2(_AfterHexString,_Pos,Sum)->
687
%%----------------------------------------------------------------------
688
%%Converts an integer to an hexlist
689
%%----------------------------------------------------------------------
691
integer_to_hexlist(Num).
694
integer_to_hexlist(Num)->
695
integer_to_hexlist(Num,getSize(Num),[]).
697
integer_to_hexlist(Num,Pot,Res) when Pot<0 ->
698
convert_to_ascii([Num|Res]);
700
integer_to_hexlist(Num,Pot,Res) ->
701
Position=(16 bsl (Pot*4)),
702
PosVal=Num div Position,
703
integer_to_hexlist(Num-(PosVal*Position),Pot-1,[PosVal|Res]).
704
convert_to_ascii(RevesedNum)->
705
convert_to_ascii(RevesedNum,[]).
707
convert_to_ascii([],Num)->
709
convert_to_ascii([Num|Reversed],Number)when Num>-1, Num<10 ->
710
convert_to_ascii(Reversed,[Num+48|Number]);
711
convert_to_ascii([Num|Reversed],Number)when Num>9, Num<16 ->
712
convert_to_ascii(Reversed,[Num+55|Number]);
713
convert_to_ascii(NumReversed,Number) ->
721
getSize(Num,Pot)when Num<(16 bsl(Pot *4)) ->
731
create_etag(FileInfo)->
732
create_etag(FileInfo#file_info.mtime,FileInfo#file_info.size).
734
create_etag({{Year,Month,Day},{Hour,Min,Sec}},Size)->
735
create_part([Year,Month,Day,Hour,Min,Sec])++io_lib:write(Size);
737
create_etag(FileInfo,Size)->
738
create_etag(FileInfo#file_info.mtime,Size).
740
create_part(Values)->
741
lists:map(fun(Val0)->
756
%%----------------------------------------------------------------------
757
%%Function that controls whether a response is generated or not
758
%%----------------------------------------------------------------------
759
response_generated(Info)->
760
case httpd_util:key1search(Info#mod.data,status) of
761
%% A status code has been generated!
762
{StatusCode,PhraseArgs,Reason}->
764
%%No status code control repsonsxe
766
case httpd_util:key1search(Info#mod.data, response) of
767
%% No response has been generated!
770
%% A response has been generated or sent!
added
removed
lib/inets/src/httpd_util.erl
