Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

551 lines (470 sloc) 18.281 kb
-module(yaws_cgi).
-author('carsten@codimi.de').
-include("../include/yaws_api.hrl").
-include("yaws_debug.hrl").
-include("../include/yaws.hrl").
-export([call_cgi/5, call_cgi/4, call_cgi/3, call_cgi/2]).
-export([cgi_worker/7]).
%% TO DO: Handle failure and timeouts.
%% call_cgi calls the script `Scriptfilename' (full path).
%% If `Exefilename' is given, it is the executable to handle this,
%% otherwise `Scriptfilame' is assumed to be executable itself.
%%
%% Corresponding to a URI of
%% `http://somehost/some/dir/script.cgi/path/info',
%% `Pathinfo' should be set to `/path/info'.
%% These functions can be used from a `.yaws' file.
%% Note however, that they usually generate stream content.
call_cgi(Arg, Scriptfilename) ->
call_cgi(Arg, undefined, Scriptfilename, undefined, []).
call_cgi(Arg, Exefilename, Scriptfilename) ->
call_cgi(Arg, Exefilename, Scriptfilename, undefined, []).
call_cgi(Arg, Exefilename, Scriptfilename, Pathinfo) ->
call_cgi(Arg, Exefilename, Scriptfilename, Pathinfo, []).
call_cgi(Arg, Exefilename, Scriptfilename, Pathinfo, ExtraEnv) ->
case Arg#arg.state of
{cgistate, Worker} ->
case Arg#arg.cont of
cgicont ->
handle_clidata(Arg, Worker);
undefined ->
?Debug("Error while reading clidata: ~p~n",
[Arg#arg.clidata]),
%% Error, what to do?
exit(normal)
end;
_ ->
Worker = start_worker(Arg, Exefilename, Scriptfilename,
Pathinfo, ExtraEnv, get(sc)),
handle_clidata(Arg, Worker)
end.
handle_clidata(Arg, Worker) ->
case Arg#arg.clidata of
undefined ->
end_of_clidata(Arg, Worker);
{partial, Data} ->
send_clidata(Worker, Data),
{get_more, cgicont, {cgistate, Worker}};
Data when binary(Data) ->
send_clidata(Worker, Data),
end_of_clidata(Arg, Worker)
end.
end_of_clidata(Arg, Worker) ->
Worker ! {self(), end_of_clidata},
get_from_worker(Arg, Worker).
send_clidata(Worker, Data) ->
Worker ! {self(), clidata, Data},
receive
{Worker, clidata_receipt} -> ok
end.
start_worker(Arg, Exefilename, Scriptfilename, Pathinfo, ExtraEnv, SC) ->
ExeFN = case Exefilename of
undefined -> exeof(Scriptfilename);
"" -> exeof(Scriptfilename);
FN -> FN
end,
PI = case Pathinfo of
undefined -> Arg#arg.pathinfo;
OK -> OK
end,
Worker = proc_lib:spawn(?MODULE, cgi_worker,
[self(), Arg, ExeFN, Scriptfilename, PI, ExtraEnv, SC]),
Worker.
get_from_worker(Arg, Worker) ->
{Headers, Data} = get_resp(Worker),
AllResps = lists:map(fun(X)->do_header(Arg, X, Data) end, Headers),
{ContentResps, Others} = filter2(fun iscontent/1, AllResps),
{RedirResps, OtherResps} = filter2(fun isredirect/1, Others),
case RedirResps of
[R|_] ->
Worker ! {self(), no_data},
OtherResps ++ [R];
[] ->
case ContentResps of
[C={streamcontent, _, _}|_] ->
Worker ! {self(), stream_data},
OtherResps++[C];
[C={content, _, _}|_] ->
Worker ! {self(), no_data},
OtherResps++[C];
[] ->
Worker ! {self(), no_data},
OtherResps
end
end.
filter2(Pred, Xs) ->
filter2(Pred, Xs, [], []).
filter2(_Pred, [], Ts, Fs) ->
{lists:reverse(Ts), lists:reverse(Fs)};
filter2(Pred, [X|Xs], Ts, Fs) ->
case Pred(X) of
true ->
filter2(Pred, Xs, [X|Ts], Fs);
false ->
filter2(Pred, Xs, Ts, [X|Fs])
end.
iscontent({content, _, _}) ->
true;
iscontent({streamcontent, _, _}) ->
true;
iscontent(_) ->
false.
isredirect({redirect_local, _}) ->
true;
isredirect({redirect, _}) ->
true;
isredirect(_) ->
false.
checkdef(undefined) ->
"";
checkdef(L) ->
L.
deep_drop_prefix([], L) ->
L;
deep_drop_prefix([X|Xs], [X|Ys]) when integer(X) ->
deep_drop_prefix(Xs, Ys);
deep_drop_prefix([X|Xs], Ys) when list(X) ->
deep_drop_prefix(X++Xs, Ys);
deep_drop_prefix(Xs, [Y|Ys]) when list(Y) ->
deep_drop_prefix(Xs, Y++Ys);
deep_drop_prefix(_, _) ->
false.
get_socket_peername(Socket={sslsocket,_,_}) ->
{ok, {IP, _Port}}=ssl:peername(Socket),
inet_parse:ntoa(IP);
get_socket_peername(Socket) ->
{ok, {IP, _Port}}=inet:peername(Socket),
inet_parse:ntoa(IP).
get_socket_sockname(Socket={sslsocket,_,_}) ->
{ok, {IP, _Port}}=ssl:sockname(Socket),
inet_parse:ntoa(IP);
get_socket_sockname(Socket) ->
{ok, {IP, _Port}}=inet:sockname(Socket),
inet_parse:ntoa(IP).
cgi_env(Arg, Scriptfilename, Pathinfo, ExtraEnv, SC) ->
H = Arg#arg.headers,
R = Arg#arg.req,
case R#http_request.path of
{abs_path, RequestURI} -> ok;
_ -> RequestURI = undefined
end,
{Maj,Min} = R#http_request.version,
{Hostname, Hosttail}=lists:splitwith(fun(X)->X /= $: end,
checkdef(H#headers.host)),
Hostport = case Hosttail of
[$: | P] -> P;
[] -> integer_to_list(SC#sconf.port)
end,
PeerAddr = get_socket_peername(Arg#arg.clisock),
LocalAddr = get_socket_sockname(Arg#arg.clisock),
Scheme = (catch yaws:redirect_scheme(SC)),
%% Needed by trac, for redirs after POST
HttpsEnv = case Scheme of
"https://" -> [{"HTTPS", "1"}];
_ ->[]
end,
%%Scriptname = deep_drop_prefix(Arg#arg.docroot, Arg#arg.fullpath),
%%SCRIPT_NAME is the path of the script relative to the root of the website.
%%just dropping docroot from the fullpath does not give the full SCRIPT_NAME
%% path if a 'vdir' is involved.
UriTail = deep_drop_prefix(Arg#arg.docroot, Arg#arg.fullpath),
case Arg#arg.docroot_mount of
"/" ->
%%no arg.docroot_mount means that arg.docroot
%% corresponds to the URI-root of the request "/"
Scriptname = UriTail;
Vdir ->
Scriptname = Vdir ++ string:strip(UriTail,left,$/)
end,
Pathinfo2 = checkdef(Pathinfo),
case Pathinfo2 of
"" ->
PathTranslated = "";
_ ->
%%determine what physical path the server would map Pathinfo2
%%to if it had received just Pathinfo2 in the request.
PathTranslated = yaws_server:mappath(SC,Arg,Pathinfo2)
end,
%%Pass auth info in environment - yes - including password in plain text.
%%REMOTE_USER always = AUTH_USER
%%!todo - LOGON_USER - same as AUTH_USER unless some auth filter has mapped
%%the user to another username under which to run the request.
case H#headers.authorization of
undefined ->
AuthEnv = [];
{User, Password, "Basic " ++ Auth64} ->
AuthEnv = [
{"HTTP_AUTHORIZATION", "Basic " ++ Auth64},
{"AUTH_TYPE", "Basic"},
{"AUTH_USER", User},
{"REMOTE_USER", User},
{"LOGON_USER", User},
{"AUTH_PASSWORD", Password}
];
{_User, _Password, _OrigString} ->
%%not attempting to pass through any auth info for
%% auth schemes that we don't yet handle
AuthEnv = []
end,
%%todo - review. should AuthEnv entries be overridable by ExtraEnv or not?
%% we should define policy here rather than let through dupes.
ExtraEnv ++
HttpsEnv ++
AuthEnv ++
lists:filter(
fun({K, L}) when list(L) ->
case lists:keysearch(K, 1, ExtraEnv) of
false ->
true;
_ ->
%% we have override in extraenv
false
end;
(_) ->
false
end,
([
{"SERVER_SOFTWARE", "Yaws/"++yaws_generated:version()},
{"SERVER_NAME", Hostname},
{"HTTP_HOST", Hostname},
{"GATEWAY_INTERFACE", "CGI/1.1"},
{"SERVER_PROTOCOL", "HTTP/" ++ integer_to_list(Maj) ++
"." ++ integer_to_list(Min)},
{"SERVER_PORT", Hostport},
{"REQUEST_METHOD", yaws:to_list(R#http_request.method)},
{"REQUEST_URI", RequestURI},
{"DOCUMENT_ROOT", Arg#arg.docroot},
{"DOCUMENT_ROOT_MOUNT", Arg#arg.docroot_mount},
{"SCRIPT_FILENAME", Scriptfilename},% For PHP 4.3.2 and higher
% see http://bugs.php.net/bug.php?id=28227
% (Sergei Golovan).
% {"SCRIPT_TRANSLATED", Scriptfilename}, %IIS6+
{"PATH_INFO", Pathinfo2},
{"PATH_TRANSLATED", PathTranslated},
%% <JMN_2007-02>
%% CGI/1.1 spec says PATH_TRANSLATED should be NULL or unset
%% if PATH_INFO is NULL
%% This is in contrast to IIS behaviour - and may break some apps.
%% broken apps that expect it to always correspond to path of
%% script
%% should be modified to use SCRIPT_FILENAME instead - or wrapped.
%% </JMN_2007-02>
%% --------------------
%% <pre_2007-02_comments>
%% This seems not to
%% correspond to the
%% documentation I have
%% read, but it works
%% with PHP.
%%
%% (Not with PHP 4.3.10-16) from
%% Debian sarge (Sergei Golovan).
%% </pre_2007-02_comments>
%% ---------------------
{"SCRIPT_NAME", Scriptname},
{"REMOTE_ADDR", PeerAddr},
{"REMOTE_HOST", PeerAddr}, %% We SHOULD send this
%% Resolving DNS not practical for performance reasons
%% - at least on 1st contact from a particular host.
%% we could do background lookup so that it's available
%% for subsequent invocations,
%% but it hardly seems worthwhile. We are permitted by the
%% CGI/1.1 spec to substitute REMOTE_ADDR
{"SERVER_ADDR", LocalAddr}, %% Apache compat
{"LOCAL_ADDR", LocalAddr}, %% IIS compat
{"QUERY_STRING", checkdef(Arg#arg.querydata)},
{"CONTENT_TYPE", H#headers.content_type},
{"CONTENT_LENGTH", H#headers.content_length},
{"HTTP_ACCEPT", H#headers.accept},
{"HTTP_USER_AGENT", H#headers.user_agent},
{"HTTP_REFERER", H#headers.referer},
{"HTTP_IF_MODIFIED_SINCE", H#headers.if_modified_since},
{"HTTP_IF_MATCH", H#headers.if_match},
{"HTTP_IF_NONE_MATCH", H#headers.if_none_match},
{"HTTP_IF_UNMODIFIED_SINCE", H#headers.if_unmodified_since},
{"HTTP_COOKIE", flatten_val(make_cookie_val(H#headers.cookie))}
]++lists:map(fun({http_header,_,Var,_,Val})->{tohttp(Var),Val} end,
H#headers.other)
)).
tohttp(X) ->
"HTTP_"++lists:map(fun tohttp_c/1, yaws:to_list(X)).
tohttp_c($-) ->
$_;
tohttp_c(C) when C >= $a , C =< $z ->
C - $a + $A;
tohttp_c(C) ->
C.
%% JMN - apparently redundant. host/1 was being used in cgi_env/5 when
%% Hostname had already been split out of Host.
%% %% Get Host part from a host string that can contain host or host:port
%% host(Host) ->
%% case string:tokens(Host, ":") of
%% [Hostname, _Port] -> Hostname;
%% [Hostname] -> Hostname;
%% _Other -> Host
%% end.
make_cookie_val([]) ->
undefined;
make_cookie_val([C]) ->
C;
make_cookie_val([C|CS]) ->
[make_cookie_val(CS), $; | C].
%% Seems not to be necessary, but open_port documentation says that
%% value has to be a string.
flatten_val(L) when list(L) ->
lists:flatten(L);
flatten_val(X) ->
X.
notslash($/) ->
false;
notslash(_) ->
true.
pathof(F) ->
case lists:dropwhile(fun notslash/1, lists:reverse(F)) of
"/" ->
"/";
[$/ | Tail] -> lists:reverse(Tail)
end.
exeof(F) ->
[$\., $/|lists:reverse(lists:takewhile(fun notslash/1, lists:reverse(F)))].
%% We almost always generate stream content.
%% Actually, we could do away with `content' altogether.
do_header(_Arg, "Content-type: "++CT, {partial_data, Data}) ->
{streamcontent, CT, Data};
do_header(_Arg, "Content-type: "++CT, {all_data, Data}) ->
{content, CT, Data};
do_header(_Arg, "Content-Type: "++CT, {partial_data, Data}) ->
{streamcontent, CT, Data};
do_header(_Arg, "Content-Type: "++CT, {all_data, Data}) ->
{content, CT, Data};
do_header(_Arg, "Location: "++Loc, _) ->
{redirect_local, {any_path, Loc}};
do_header(_Arg, "Status: "++[N1,N2,N3|_], _) ->
{status, list_to_integer([N1,N2,N3])};
do_header(_Arg, "HTTP/1."++[_,_,N1,N2,N3|_], _) ->
{status, list_to_integer([N1,N2,N3])};
do_header(_Arg, Line, _) ->
{header, Line}. % Is this correct?
get_resp(Worker) ->
get_resp([], Worker).
get_resp(Hs, Worker) ->
receive
{Worker, header, H} ->
?Debug("~p~n", [{Worker, header, H}]),
get_resp([H|Hs], Worker);
{Worker, all_data, Data} ->
?Debug("~p~n", [{Worker, all_data, Data}]),
{Hs, {all_data, Data}};
{Worker, partial_data, Data} ->
?Debug("~p~n", [{Worker, partial_data, binary_to_list(Data)}]),
{Hs, {partial_data, Data}};
{Worker, failure, _} ->
{[], undef};
_Other ->
?Debug("~p~n", [_Other]),
get_resp(Hs, Worker)
end.
cgi_worker(Parent, Arg, Exefilename, Scriptfilename, Pathinfo, ExtraEnv,SC) ->
Env = cgi_env(Arg, Scriptfilename, Pathinfo, ExtraEnv,SC),
?Debug("~p~n", [Env]),
CGIPort = open_port({spawn, Exefilename},
[{env, Env},
{cd, pathof(Scriptfilename)},
exit_status,
binary]),
pass_through_clidata(Parent, CGIPort),
do_work(Parent, Arg, CGIPort).
pass_through_clidata(Parent, CGIPort) ->
receive
{Parent, clidata, Clidata} ->
?Debug("Got clidata ~p~n", [binary_to_list(Clidata)]),
Parent ! {self(), clidata_receipt},
CGIPort ! {self(), {command, Clidata}},
pass_through_clidata(Parent, CGIPort);
{Parent, end_of_clidata} ->
?Debug("End of clidata~n", []),
ok
end.
do_work(Parent, Arg, Port) ->
header_loop(Parent, Arg, {start, Port}).
header_loop(Parent, Arg, S) ->
Line = get_line(S),
?Debug("Line = ~p~n", [Line]),
case Line of
{failure, F} ->
Parent ! {self(), failure, F};
{[], T} ->
case T of
{middle, Data, Port} ->
Parent ! {self(), partial_data, Data},
receive
{Parent, stream_data} ->
data_loop(Arg#arg.pid, Port);
{Parent, no_data} ->
ok
end;
{ending, Data, _} ->
Parent ! {self(), all_data, Data},
receive
{Parent, stream_data} ->
yaws_api:stream_chunk_end(Arg#arg.pid);
{Parent, no_data} ->
ok
end
end;
{H, T} ->
Parent ! {self(), header, H},
header_loop(Parent, Arg, T)
end.
data_loop(Pid, Port) ->
receive
{Port, {data,Data}} ->
?Debug("~p~n", [{data, binary_to_list(Data)}]),
yaws_api:stream_chunk_deliver_blocking(Pid, Data),
data_loop(Pid, Port);
{Port, {exit_status, _Status}} ->
?Debug("~p~n", [{exit_status, _Status}]),
yaws_api:stream_chunk_end(Pid);
_Other ->
?Debug("~p~n", [_Other]),
data_loop(Pid, Port)
end.
get_line({start, Port}) ->
receive
{Port, {data,Data}} ->
get_line([], {middle, Data, Port});
{Port, {exit_status, 0}} ->
?Debug("~p~n", [{exit_status, 0}]),
get_line([], {ending, <<>>, Port});
{Port, {exit_status, Status}} when Status /=0 ->
?Debug("~p~n", [{exit_status, Status}]),
{failure, {exit_status, Status}};
_Other ->
?Debug("~p~n", [_Other]),
get_line({start, Port})
end;
get_line(State) ->
get_line([], State).
get_line(Acc, {S, <<10, Tail/binary>>, Port}) ->
{lists:reverse(Acc), {S, Tail, Port}};
get_line(Acc, {S, <<13, 10, Tail/binary>>, Port}) ->
{lists:reverse(Acc), {S, Tail, Port}};
get_line(Acc, {middle, <<>>, Port}) ->
get_line(Acc, add_cgi_resp(<<>>, Port));
get_line(Acc, {middle, <<13>>, Port}) -> % We SHOULD test for CRLF.
get_line(Acc, add_cgi_resp(<<13>>, Port)); % Would be easier without.
get_line(Acc, {ending, <<>>, Port}) ->
{lists:reverse(Acc), {ending, <<>>, Port}};
get_line(Acc, {S, <<C, Tail/binary>>, Port}) ->
get_line([C|Acc], {S, Tail, Port}).
add_cgi_resp(Bin, Port) ->
receive
{Port, {data,Data}} ->
{middle, <<Bin/binary, Data/binary>>, Port};
{Port, {exit_status, _Status}} ->
?Debug("~p~n", [{exit_status, _Status}]),
{ending, Bin, Port};
_Other ->
?Debug("~p~n", [_Other]),
add_cgi_resp(Bin, Port)
end.
Jump to Line
Something went wrong with that request. Please try again.