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

476 lines (415 sloc) 15.987 kb
%%%----------------------------------------------------------------------
%%% File : yaws_ls.erl
%%% Author : Claes Wikstrom <klacke@hyber.org>
%%% Purpose :
%%% Created : 5 Feb 2002 by Claes Wikstrom <klacke@hyber.org>
%%% Modified: 13 Jan 2004 by Martin Bjorklund <mbj@bluetail.com>
%%% Modified: Jan 2006 by Sébastien Bigot <sebastien.bigot@tremplin-utc.net>
%%%----------------------------------------------------------------------
-module(yaws_ls).
-author('klacke@hyber.org').
-include("../include/yaws.hrl").
-include("../include/yaws_api.hrl").
-include("yaws_debug.hrl").
-include_lib("kernel/include/file.hrl").
-export([list_directory/6, out/1]).
-define(FILE_LEN_SZ, 45).
list_directory(_Arg, CliSock, List, DirName, Req, DoAllZip) ->
{abs_path, Path} = Req#http_request.path,
{DirStr, Pos, Direction, Qry} = parse_query(Path),
?Debug("List=~p Dirname~p~n", [List, DirName]),
Descriptions = read_descriptions(DirName),
L0 = lists:zf(
fun(F) ->
File = DirName ++ [$/|F],
FI = file:read_file_info(File),
file_entry(FI, DirName, F, Qry,Descriptions)
end, List),
L1 = lists:keysort(Pos, L0),
L2 = if Direction == normal -> L1;
Direction == reverse -> lists:reverse(L1)
end,
L3 = [Html || {_, _, _, _, Html} <- L2],
Body = [ doc_head(DirStr),
dir_header(DirName,DirStr),
table_head(Direction),
parent_dir(),
if
DoAllZip == true ->
allzip();
DoAllZip == true_nozip ->
[];
true ->
[]
end,
%% if DoAllGZip == true -> alltgz() end,
%% if DoAllBZip2 == true -> alltbz2() end,
%% if DoAllZip == true -> alltgz() end,
%% if DoAllZip == true -> alltbz2() end,
L3,
table_tail(),
dir_footer(DirName),%yaws:address(),
doc_tail()
],
B = list_to_binary(Body),
yaws_server:accumulate_content(B),
yaws_server:deliver_accumulated(CliSock),
yaws_server:done_or_continue().
parse_query(Path) ->
case string:tokens(Path, [$?]) of
[DirStr, [PosC, $=, DirC] = Q] ->
Pos = case PosC of
$N -> 1; % name
$M -> 2; % last modified
$S -> 3; % size
$D -> 4 % Description
end,
Dir = case DirC of
$r -> reverse;
_ -> normal
end,
{DirStr, Pos, Dir, "/?"++Q};
_ ->
{Path, 1, normal, ""}
end.
parse_description(Line) ->
L = string:strip(Line),
Pos = string:chr(L,$ ),
Filename = string:substr(L, 1, Pos-1),
D = string:substr(L,Pos+1),
Description = string:strip(D,left),
{Filename,Description}.
read_descriptions(DirName) ->
File = DirName ++ [$/ | "MANIFEST.txt"],
case file:read_file(File) of
{ok,Bin} -> Lines = string:tokens(binary_to_list(Bin),"\n"),
lists:map(fun parse_description/1,Lines);
_ -> []
end.
get_description(Name,Descriptions) ->
case lists:keysearch(Name,1,Descriptions) of
{value, {_,Description}} -> Description;
_ -> []
end.
doc_head(DirName) ->
HtmlDirName = yaws_api:htmlize(yaws_api:url_decode(DirName)),
?F("<?xml version=\"1.0\" encoding=\"ISO-8859-1\"?>\n"
"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n"
"<html>\n"
" <head>\n"
" <title>Index of ~s</title>\n"
" <style type=\"text/css\">\n"
" img { border: 0; padding: 0 2px; vertical-align: text-bottom; }\n"
" td { font-family: monospace; padding: 2px 3px; text-align:left;\n"
" vertical-align: bottom; white-space: pre; }\n"
" td:first-child { text-align: left; padding: 2px 10px 2px 3px; }\n"
" table { border: 0; }\n"
" </style>\n"
"</head> \n"
"<body>\n",
[HtmlDirName]
).
doc_tail() ->
"</body>\n"
"</html>\n".
table_head(Direction) ->
NextDirection = if Direction == normal -> "r";
Direction == reverse -> "n"
end,
["<table>\n"
" <tr>\n"
" <td><img src=\"/icons/blank.gif\" alt=\"&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;\"/><a href=\"?N=",NextDirection,"\">Name</a></td>\n"
" <td><a href=\"?M=",NextDirection,"\">Last Modified</a></td>\n"
" <td><a href=\"?S=",NextDirection,"\">Size</a></td>\n"
" <td><a href=\"?D=",NextDirection,"\">Description</a></td>\n"
" </tr>\n"
" <tr><th colspan=\"4\"><hr/></th></tr>\n"].
table_tail() ->
" <tr><th colspan=\"4\"><hr/></th></tr>\n"
"</table>\n".
dir_footer(DirName) ->
File = DirName ++ [$/ | "README.txt"],
case file:read_file(File) of
{ok,Bin} -> "<pre>\n" ++ binary_to_list(Bin) ++ "</pre>\n";
_ -> yaws:address()
end.
dir_header(DirName,DirStr) ->
File = DirName ++ [$/ | "HEADER.txt"],
case file:read_file(File) of
{ok,Bin} -> "<pre>\n" ++ binary_to_list(Bin) ++ "</pre>\n";
_ -> HtmlDirName = yaws_api:htmlize(yaws_api:url_decode(DirStr)),
"<h1>Index of " ++ HtmlDirName ++ "</h1>\n"
end.
parent_dir() ->
{Gif, Alt} = list_gif(directory,"."),
?F(" <tr>\n"
" <td><img src=~p alt=~p/><a href=\"..\">Parent Directory</a></td>\n"
" <td></td>\n"
" <td>-</td>\n"
" <td></td>\n"
" </tr>\n",
["/icons/" ++ Gif,
Alt
]).
%% FIXME: would be nice with a good size approx. but it would require
%% a deep scan of possibly the entire docroot, (and also some knowledge
%% about zip's compression ratio in advance...)
allzip() ->
{Gif, Alt} = list_gif(zip,""),
?F(" <tr>\n"
" <td><img src=~p alt=~p/><a href=\"all.zip\">all.zip</a></td>\n"
" <td></td>\n"
" <td>-</td>\n"
" <td>Build a zip archive of current directory</td>\n"
" </tr>\n",
["/icons/" ++ Gif,
Alt]).
%% alltgz() ->
%% {Gif, Alt} = list_gif(zip,""),
%% ?F(" <tr>\n"
%% " <td><img src=~p alt=~p/><a href=\"all.tgz\">all.tgz</a></td>\n"
%% " <td></td>\n"
%% " <td>-</td>\n"
%% " <td>Build a gzip archive of current directory</td>\n"
%% " </tr>\n",
%% ["/icons/" ++ Gif,
%% Alt]).
%% alltbz2() ->
%% {Gif, Alt} = list_gif(zip,""),
%% ?F(" <tr>\n"
%% " <td><img src=~p alt=~p/><a href=\"all.tbz2\">all.tbz2</a></td>\n"
%% " <td></td>\n"
%% " <td>-</td>\n"
%% " <td>Build a bzip2 archive of current directory</td>\n"
%% " </tr>\n",
%% ["/icons/" ++ Gif,
%% Alt]).
is_user_dir(SP) ->
case SP of
[$/,$~ | T] -> User = string:sub_word(T,1,$/),
case catch yaws:user_to_home(User) of
{'EXIT', _} ->
false;
Home ->
{true,Home}
end;
_ -> false
end.
out(A) ->
SP = A#arg.server_path,
PP = A#arg.appmod_prepath,
Dir = case is_user_dir(SP) of
{true,Home} -> Home ++ "/public_html";
false -> A#arg.docroot
end ++ PP,
%% {html,?F("<h2>~p</h2>",[Dir])}.
YPid = self(),
Forbidden_Paths = accumulate_forbidden_paths(),
case filename:basename(A#arg.server_path) of
"all.zip" -> spawn_link(fun() -> zip(YPid, Dir, Forbidden_Paths) end),
{streamcontent, "application/zip", ""}
%% "all.tgz" -> spawn_link(fun() -> tgz(YPid, Dir) end),
%% {streamcontent, "application/gzip", ""};
%% "all.tbz2" -> spawn_link(fun() -> tbz2(YPid, Dir) end),
%% {streamcontent, "application/gzip", ""}
end.
generate_random_fn() ->
Bytes = try crypto:rand_bytes(64) of
B when is_bitstring(B) ->
B
catch _:_ ->
%% for installations without crypto
<< <<(random:uniform(256) - 1)>> || _ <- lists:seq(1,64) >>
end,
<< Int:512/unsigned-big-integer >> = << Bytes/binary >>,
integer_to_list(Int).
mktempfilename([]) ->
{error, no_temp_dir};
mktempfilename([Dir|R]) ->
RandomFN = generate_random_fn(),
Filename = filename:join(Dir, RandomFN),
case file:open(Filename, [write]) of
{ok, FileHandle} ->
{ok, {Filename, FileHandle}};
_Else ->
mktempfilename(R)
end.
mktempfilename() ->
%% TODO: Add code to determine the temporary directory on various
%% operating systems.
PossibleDirs = ["/tmp", "/var/tmp"],
mktempfilename(PossibleDirs).
zip(YPid, Dir, ForbiddenPaths) ->
{ok, RE_ForbiddenNames} = re:compile("\\.yaws\$"),
Files = dig_through_dir(Dir, ForbiddenPaths, RE_ForbiddenNames),
{ok, {Tempfile, TempfileH}} = mktempfilename(),
file:write(TempfileH, lists:foldl(fun(I, Acc) ->
Acc ++ I ++ "\n"
end, [], Files)),
file:close(TempfileH),
process_flag(trap_exit, true),
%% TODO: find a way to directly pass the list of files to
%% zip. Erlang ports do not allow stdin to be closed
%% independently; however, zip needs stdin to be closed as an
%% indicator that the list of files is complete.
P = open_port({spawn, "zip -q -1 - -@ < " ++ Tempfile},
[{cd, Dir},use_stdio, binary, exit_status]),
F = fun() ->
file:delete(Tempfile)
end,
stream_loop(YPid, P, F).
accumulate_forbidden_paths() ->
SC = get(sc),
Auth = SC#sconf.authdirs,
lists:foldl(fun({Path, _Auth}, Acc) ->
Acc ++ [Path]
end, [], Auth).
%% tgz(YPid, Dir) ->
%% process_flag(trap_exit, true),
%% P = open_port({spawn, "tar cz ."},
%% [{cd, Dir},use_stdio, binary, exit_status]),
%% stream_loop(YPid, P).
%% tbz2(YPid, Dir) ->
%% process_flag(trap_exit, true),
%% P = open_port({spawn, "tar cj ."},
%% [{cd, Dir},use_stdio, binary, exit_status]),
%% stream_loop(YPid, P).
dir_contains_indexfile(_Dir, []) ->
false;
dir_contains_indexfile(Dir, [File|R]) ->
case file:read_file_info(filename:join(Dir, File)) of
{ok, _} ->
true;
_Else ->
dir_contains_indexfile(Dir, R)
end.
dir_contains_indexfile(Dir) ->
Indexfiles = [".yaws.auth", "index.yaws", "index.html", "index.htm"],
dir_contains_indexfile(Dir, Indexfiles).
dig_through_dir(Basedirlen, Dir, ForbiddenPaths, RE_ForbiddenNames) ->
Dir1 = string:sub_string(Dir, Basedirlen),
case {lists:member(Dir1, ForbiddenPaths),
dir_contains_indexfile(Dir)} of
{true,_} ->
[];
{_,true} ->
[];
{false, false} ->
{ok, Files} = file:list_dir(Dir),
lists:foldl(fun(I, Acc) ->
Filename = filename:join(Dir, I),
case {file:read_file_info(Filename),
re:run(Filename, RE_ForbiddenNames)} of
{_, {match, _}} ->
Acc;
{{ok, #file_info{type=directory}}, _} ->
Acc ++ dig_through_dir(
Basedirlen,
Filename,
ForbiddenPaths,
RE_ForbiddenNames);
{{ok, #file_info{type=regular}}, _} ->
Acc ++ [string:sub_string(
Filename, Basedirlen)];
_Else ->
Acc %% Ignore other files
end
end, [], Files)
end.
dig_through_dir(Dir, ForbiddenPaths, RE_ForbiddenNames) ->
dig_through_dir(length(Dir) + 1,
Dir,
ForbiddenPaths,
RE_ForbiddenNames).
stream_loop(YPid, P, FinishedFun) ->
receive
{P, {data, Data}} ->
yaws_api:stream_chunk_deliver_blocking(YPid, Data),
stream_loop(YPid, P, FinishedFun);
{P, {exit_status, _}} ->
yaws_api:stream_chunk_end(YPid),
FinishedFun();
{'EXIT', YPid, Status} ->
FinishedFun(),
exit(Status);
Else ->
FinishedFun(),
error_logger:error_msg("Could not deliver zip file: ~p\n", [Else])
end.
%% Removed code that appendended Qry to the file name.
%% It might still be a good idea in case type==directory.
%% Was that the intention?
%% Carsten
%%
%% yes, that was the intention. fixed now (mbj)
%% ... and maybe we should just remove this conversation in the next checkin :)
file_entry({ok, FI}, _DirName, Name, Qry, Descriptions) ->
?Debug("file_entry(~p) ", [Name]),
Ext = filename:extension(Name),
{Gif, Alt} = list_gif(FI#file_info.type, Ext),
QryStr = if FI#file_info.type == directory -> Qry;
true -> ""
end,
Description = get_description(Name,Descriptions),
Entry =
?F(" <tr>\n"
" <td><img src=~p alt=~p/><a href=~p title=~p>~s</a></td>\n"
" <td>~s</td>\n"
" <td>~s</td>\n"
" <td>~s</td>\n"
" </tr>\n",
["/icons/" ++ Gif,
Alt,
yaws_api:url_encode(Name) ++ QryStr,
Name,
trim(Name,?FILE_LEN_SZ),
datestr(FI),
sizestr(FI),
Description]),
?Debug("Entry:~p", [Entry]),
{true, {Name, FI#file_info.mtime, FI#file_info.size, Description, Entry}};
file_entry(_Err, _, _Name, _, _) ->
?Debug("no entry for ~p: ~p", [_Name, _Err]),
false.
trim(L,N) ->
trim(L,N,[]).
trim([_H1,_H2,_H3]=[H|T], 3=I, Acc) ->
trim(T, I-1, [H|Acc]);
trim([_H1,_H2,_H3|_T], 3=_I, Acc) ->
lists:reverse(Acc) ++ "..&gt;";
trim([H|T], I, Acc) ->
trim(T, I-1, [H|Acc]);
trim([], _I, Acc) ->
lists:reverse(Acc).
%% FI -> 16-Jan-2006 23:06
datestr(FI) ->
{{Year, Month, Day}, {Hour, Min, _}} = FI#file_info.mtime,
io_lib:format("~s-~s-~w ~s:~s",
[yaws:mk2(Day),yaws:month(Month),Year,
yaws:mk2(Hour),yaws:mk2(Min)]).
sizestr(FI) when FI#file_info.size > 1000000 ->
?F("~.1fM", [FI#file_info.size / 1000000]);
sizestr(FI) when FI#file_info.size > 1000 ->
?F("~wk", [trunc(FI#file_info.size / 1000)]);
sizestr(FI) when FI#file_info.size == 0 ->
?F("0k", []);
sizestr(_FI) ->
?F("1k", []). % As apache does it...
list_gif(directory, ".") ->
{"back.gif", "[DIR]"};
list_gif(regular, ".txt") ->
{"text.gif", "[TXT]"};
list_gif(regular, ".c") ->
{"c.gif", "[&nbsp;&nbsp;&nbsp;]"};
list_gif(regular, ".dvi") ->
{"dvi.gif", "[&nbsp;&nbsp;&nbsp;]"};
list_gif(regular, ".pdf") ->
{"pdf.gif", "[&nbsp;&nbsp;&nbsp;]"};
list_gif(regular, _) ->
{"layout.gif", "[&nbsp;&nbsp;&nbsp;]"};
list_gif(directory, _) ->
{"dir.gif", "[DIR]"};
list_gif(zip, _) ->
{"compressed.gif", "[DIR]"};
list_gif(_, _) ->
{"unknown.gif", "[OTH]"}.
Jump to Line
Something went wrong with that request. Please try again.