← 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_socket.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_socket.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_socket.erl,v 1.1 2008/12/17 09:53:34 mikpe Exp $
 
17
%%
 
18
-module(httpd_socket).
 
19
-export([start/1,
 
20
         listen/2, listen/3, accept/2, accept/3,
 
21
         deliver/3, send/3, recv/4, 
 
22
         close/2,
 
23
         peername/2, resolve/1, config/1,
 
24
         controlling_process/3,
 
25
         active_once/2]).
 
26
 
 
27
-include("httpd.hrl").
 
28
 
 
29
-define(VMODULE,"SOCKET").
 
30
-include("httpd_verbosity.hrl").
 
31
 
 
32
-include_lib("kernel/include/inet.hrl").
 
33
 
 
34
%% start -> ok | {error,Reason}
 
35
 
 
36
start(ip_comm) ->
 
37
    case inet_db:start() of
 
38
        {ok,_Pid} ->
 
39
            ok;
 
40
        {error,{already_started,_Pid}} ->
 
41
            ok;
 
42
        Error ->
 
43
            Error
 
44
    end;
 
45
start({ssl,_SSLConfig}) ->
 
46
    case ssl:start() of
 
47
        ok ->
 
48
            ok;
 
49
        {ok, _} ->
 
50
            ok;
 
51
        {error,{already_started,_}} ->
 
52
            ok;
 
53
        Error ->
 
54
            Error
 
55
    end.
 
56
 
 
57
%% listen
 
58
 
 
59
listen(SocketType,Port) ->
 
60
    listen(SocketType,undefined,Port).
 
61
 
 
62
listen(ip_comm,Addr,Port) ->
 
63
    ?DEBUG("listening(ip_comm) to port ~p", [Port]),
 
64
    Opt = sock_opt(Addr,[{backlog,128},{reuseaddr,true}]),
 
65
    case gen_tcp:listen(Port,Opt) of
 
66
        {ok,ListenSocket} ->
 
67
            ListenSocket;
 
68
        Error ->
 
69
            Error
 
70
    end;
 
71
listen({ssl,SSLConfig},Addr,Port) ->
 
72
    ?DEBUG("listening(ssl) to port ~p"
 
73
           "~n   SSLConfig: ~p", [Port,SSLConfig]),
 
74
    Opt = sock_opt(Addr,SSLConfig),
 
75
    case ssl:listen(Port, Opt) of
 
76
        {ok,ListenSocket} ->
 
77
            ListenSocket;
 
78
        Error ->
 
79
            Error
 
80
    end.
 
81
 
 
82
 
 
83
sock_opt(undefined,Opt) -> [{packet,0},{active,false}|Opt];
 
84
sock_opt(Addr,Opt)      -> [{ip, Addr},{packet,0},{active,false}|Opt].
 
85
 
 
86
%% -define(packet_type_http,true).
 
87
%% -define(packet_type_httph,true).
 
88
 
 
89
%% -ifdef(packet_type_http).
 
90
%% sock_opt(undefined,Opt) -> [{packet,http},{active,false}|Opt];
 
91
%% sock_opt(Addr,Opt)      -> [{ip, Addr},{packet,http},{active,false}|Opt].
 
92
%% -elif(packet_type_httph).
 
93
%% sock_opt(undefined,Opt) -> [{packet,httph},{active,false}|Opt];
 
94
%% sock_opt(Addr,Opt)      -> [{ip, Addr},{packet,httph},{active,false}|Opt].
 
95
%% -else.
 
96
%% sock_opt(undefined,Opt) -> [{packet,0},{active,false}|Opt];
 
97
%% sock_opt(Addr,Opt)      -> [{ip, Addr},{packet,0},{active,false}|Opt].
 
98
%% -endif.
 
99
 
 
100
 
 
101
%% active_once
 
102
 
 
103
active_once(Type, Sock) ->
 
104
    active(Type, Sock, once).
 
105
 
 
106
active(ip_comm, Sock, Active) ->
 
107
    inet:setopts(Sock, [{active, Active}]);
 
108
active({ssl, _SSLConfig}, Sock, Active) ->
 
109
    ssl:setopts(Sock, [{active, Active}]).
 
110
 
 
111
%% accept
 
112
 
 
113
accept(A, B) ->
 
114
    accept(A, B, infinity).
 
115
 
 
116
 
 
117
accept(ip_comm,ListenSocket, T) ->
 
118
    ?DEBUG("accept(ip_comm) on socket ~p", [ListenSocket]),
 
119
    case gen_tcp:accept(ListenSocket, T) of
 
120
        {ok,Socket} ->
 
121
            Socket;
 
122
        Error ->
 
123
            ?vtrace("accept(ip_comm) failed for reason:"
 
124
                    "~n   Error: ~p",[Error]),
 
125
            Error
 
126
    end;
 
127
accept({ssl,_SSLConfig},ListenSocket, T) ->
 
128
    ?DEBUG("accept(ssl) on socket ~p", [ListenSocket]),
 
129
    case ssl:accept(ListenSocket, T) of
 
130
        {ok,Socket} ->
 
131
            Socket;
 
132
        Error ->
 
133
            ?vtrace("accept(ssl) failed for reason:"
 
134
                    "~n   Error: ~p",[Error]),
 
135
            Error
 
136
    end.
 
137
 
 
138
 
 
139
%% controlling_process
 
140
 
 
141
controlling_process(ip_comm, Socket, Pid) ->
 
142
    gen_tcp:controlling_process(Socket, Pid);
 
143
controlling_process({ssl, _}, Socket, Pid) ->
 
144
    ssl:controlling_process(Socket, Pid).
 
145
 
 
146
 
 
147
%% deliver
 
148
 
 
149
deliver(SocketType, Socket, IOListOrBinary)  ->
 
150
    case send(SocketType, Socket, IOListOrBinary) of
 
151
%       {error, einval} ->
 
152
%           ?vlog("deliver failed for reason: einval"
 
153
%                 "~n   SocketType: ~p"
 
154
%                 "~n   Socket:     ~p"
 
155
%                 "~n   Data:       ~p",
 
156
%                 [SocketType, Socket, type(IOListOrBinary)]),
 
157
%           (catch close(SocketType, Socket)), 
 
158
%           socket_closed;
 
159
        {error, _Reason} ->
 
160
            ?vlog("deliver(~p) failed for reason:"
 
161
                  "~n   Reason: ~p",[SocketType,_Reason]),
 
162
            (catch close(SocketType, Socket)), 
 
163
            socket_closed;
 
164
        _ ->
 
165
            ok
 
166
    end.
 
167
 
 
168
% type(L) when list(L) ->
 
169
%     {list, L};
 
170
% type(B) when binary(B) ->
 
171
%     Decoded = 
 
172
%       case (catch binary_to_term(B)) of
 
173
%           {'EXIT', _} ->
 
174
%               %% Oups, not a term, try list
 
175
%               case (catch binary_to_list(B)) of
 
176
%                   %% Oups, not a list either, give up
 
177
%                   {'EXIT', _} ->
 
178
%                       {size, size(B)};
 
179
%                   L ->
 
180
%                   {list, L}
 
181
%               end;
 
182
            
 
183
%           T ->
 
184
%               {term, T}
 
185
%       end,
 
186
%     {binary, Decoded};
 
187
% type(T) when tuple(T) ->
 
188
%     {tuple, T};
 
189
% type(I) when integer(I) ->
 
190
%     {integer, I};
 
191
% type(F) when float(F) ->
 
192
%     {float, F};
 
193
% type(P) when pid(P) ->
 
194
%     {pid, P};
 
195
% type(P) when port(P) ->
 
196
%     {port, P};
 
197
% type(R) when reference(R) ->
 
198
%     {reference, R};
 
199
% type(T) ->
 
200
%     {term, T}.
 
201
 
 
202
     
 
203
 
 
204
send(ip_comm,Socket,Data) ->
 
205
    ?DEBUG("send(ip_comm) -> ~p bytes on socket ~p",[data_size(Data),Socket]),
 
206
    gen_tcp:send(Socket,Data);
 
207
send({ssl,SSLConfig},Socket,Data) ->
 
208
    ?DEBUG("send(ssl) -> ~p bytes on socket ~p",[data_size(Data),Socket]),
 
209
    ssl:send(Socket, Data).
 
210
 
 
211
recv(ip_comm,Socket,Length,Timeout) ->
 
212
    ?DEBUG("recv(ip_comm) -> read from socket ~p",[Socket]),
 
213
    gen_tcp:recv(Socket,Length,Timeout);
 
214
recv({ssl,SSLConfig},Socket,Length,Timeout) ->
 
215
    ?DEBUG("recv(ssl) -> read from socket ~p",[Socket]),
 
216
    ssl:recv(Socket,Length,Timeout).
 
217
 
 
218
-ifdef(inets_debug).
 
219
data_size(L) when list(L) -> 
 
220
    httpd_util:flatlength(L);
 
221
data_size(B) when binary(B) ->
 
222
    size(B);
 
223
data_size(O) ->
 
224
    {unknown_size,O}.
 
225
-endif.
 
226
 
 
227
 
 
228
%% peername
 
229
 
 
230
peername(ip_comm, Socket) ->
 
231
    case inet:peername(Socket) of
 
232
        {ok,{{A,B,C,D},Port}} ->
 
233
            PeerName = integer_to_list(A)++"."++integer_to_list(B)++"."++
 
234
                integer_to_list(C)++"."++integer_to_list(D),
 
235
            ?DEBUG("peername(ip_comm) on socket ~p: ~p",
 
236
                   [Socket,{Port,PeerName}]),
 
237
            {Port,PeerName};
 
238
        {error,Reason} ->
 
239
            ?vlog("failed getting peername:"
 
240
                  "~n   Reason: ~p"
 
241
                  "~n   Socket: ~p",
 
242
                  [Reason,Socket]),
 
243
            {-1,"unknown"}
 
244
    end;
 
245
peername({ssl,_SSLConfig},Socket) ->
 
246
    case ssl:peername(Socket) of
 
247
        {ok,{{A,B,C,D},Port}} ->
 
248
            PeerName = integer_to_list(A)++"."++integer_to_list(B)++"."++
 
249
                integer_to_list(C)++"."++integer_to_list(D),
 
250
            ?DEBUG("peername(ssl) on socket ~p: ~p", 
 
251
                   [Socket, {Port,PeerName}]),
 
252
            {Port,PeerName};
 
253
        {error,_Reason} ->
 
254
            {-1,"unknown"}
 
255
    end.
 
256
 
 
257
%% resolve
 
258
 
 
259
resolve(_) ->
 
260
    {ok,Name} = inet:gethostname(),
 
261
    Name.
 
262
 
 
263
%% close
 
264
 
 
265
close(ip_comm,Socket) ->
 
266
    Res = 
 
267
        case (catch gen_tcp:close(Socket)) of
 
268
            ok ->                  ok;
 
269
            {error,Reason} ->      {error,Reason};
 
270
            {'EXIT',{noproc,_}} -> {error,closed};
 
271
            {'EXIT',Reason} ->     {error,Reason};
 
272
            Otherwise ->           {error,Otherwise}
 
273
        end,
 
274
    ?vtrace("close(ip_comm) result: ~p",[Res]),
 
275
    Res;
 
276
close({ssl,_SSLConfig},Socket) ->
 
277
    Res = 
 
278
        case (catch ssl:close(Socket)) of
 
279
            ok ->                  ok;
 
280
            {error,Reason} ->      {error,Reason};
 
281
            {'EXIT',{noproc,_}} -> {error,closed};
 
282
            {'EXIT',Reason} ->     {error,Reason};
 
283
            Otherwise ->           {error,Otherwise}
 
284
        end,
 
285
    ?vtrace("close(ssl) result: ~p",[Res]),
 
286
    Res.
 
287
 
 
288
%% config (debug: {certfile, "/var/tmp/server_root/conf/ssl_server.pem"})
 
289
 
 
290
config(ConfigDB) ->
 
291
    case httpd_util:lookup(ConfigDB,com_type,ip_comm) of
 
292
        ssl ->
 
293
            case ssl_certificate_file(ConfigDB) of
 
294
                undefined ->
 
295
                    {error,
 
296
                     ?NICE("Directive SSLCertificateFile "
 
297
                           "not found in the config file")};
 
298
                SSLCertificateFile ->
 
299
                    {ssl,
 
300
                     SSLCertificateFile++
 
301
                     ssl_certificate_key_file(ConfigDB)++
 
302
                     ssl_verify_client(ConfigDB)++
 
303
                     ssl_ciphers(ConfigDB)++
 
304
                     ssl_password(ConfigDB)++
 
305
                     ssl_verify_depth(ConfigDB)++
 
306
                     ssl_ca_certificate_file(ConfigDB)}
 
307
            end;
 
308
        ip_comm ->
 
309
            ip_comm
 
310
    end.
 
311
 
 
312
ssl_certificate_file(ConfigDB) ->
 
313
    case httpd_util:lookup(ConfigDB,ssl_certificate_file) of
 
314
        undefined ->
 
315
            undefined;
 
316
        SSLCertificateFile ->
 
317
            [{certfile,SSLCertificateFile}]
 
318
    end.
 
319
 
 
320
ssl_certificate_key_file(ConfigDB) ->
 
321
    case httpd_util:lookup(ConfigDB,ssl_certificate_key_file) of
 
322
        undefined ->
 
323
            [];
 
324
        SSLCertificateKeyFile ->
 
325
            [{keyfile,SSLCertificateKeyFile}]
 
326
    end.
 
327
 
 
328
ssl_verify_client(ConfigDB) ->
 
329
    case httpd_util:lookup(ConfigDB,ssl_verify_client) of
 
330
        undefined ->
 
331
            [];
 
332
        SSLVerifyClient ->
 
333
            [{verify,SSLVerifyClient}]
 
334
    end.
 
335
 
 
336
ssl_ciphers(ConfigDB) ->
 
337
    case httpd_util:lookup(ConfigDB,ssl_ciphers) of
 
338
        undefined ->
 
339
            [];
 
340
        Ciphers ->
 
341
            [{ciphers, Ciphers}]
 
342
    end.
 
343
 
 
344
ssl_password(ConfigDB) ->
 
345
    case httpd_util:lookup(ConfigDB,ssl_password_callback_module) of
 
346
        undefined ->
 
347
            [];
 
348
        Module ->
 
349
            case httpd_util:lookup(ConfigDB, ssl_password_callback_function) of
 
350
                undefined ->
 
351
                    [];
 
352
                Function ->
 
353
                    case catch apply(Module, Function, []) of
 
354
                        Password when list(Password) ->
 
355
                            [{password, Password}];
 
356
                        Error ->
 
357
                            error_report(ssl_password,Module,Function,Error),
 
358
                            []
 
359
                    end
 
360
            end
 
361
    end.
 
362
 
 
363
ssl_verify_depth(ConfigDB) ->
 
364
    case httpd_util:lookup(ConfigDB, ssl_verify_client_depth) of
 
365
        undefined ->
 
366
            [];
 
367
        Depth ->
 
368
            [{depth, Depth}]
 
369
    end.
 
370
 
 
371
ssl_ca_certificate_file(ConfigDB) ->
 
372
    case httpd_util:lookup(ConfigDB, ssl_ca_certificate_file) of
 
373
        undefined ->
 
374
            [];
 
375
        File ->
 
376
            [{cacertfile, File}]
 
377
    end.
 
378
 
 
379
 
 
380
error_report(Where,M,F,Error) ->
 
381
    error_logger:error_report([{?MODULE, Where}, {apply, {M, F, []}}, Error]).