1%% -*- coding: latin-1 -*-
2%%%----------------------------------------------------------------------
3%%% File    : yaws_ls.erl
4%%% Author  : Claes Wikstrom <klacke@hyber.org>
5%%% Purpose :
6%%% Created :  5 Feb 2002 by Claes Wikstrom <klacke@hyber.org>
7%%% Modified: 13 Jan 2004 by Martin Bjorklund <mbj@bluetail.com>
8%%% Modified:    Jan 2006 by S�bastien Bigot <sebastien.bigot@tremplin-utc.net>
9%%%----------------------------------------------------------------------
10
11-module(yaws_ls).
12-author('klacke@hyber.org').
13
14-include("../include/yaws.hrl").
15-include("../include/yaws_api.hrl").
16-include("yaws_debug.hrl").
17
18-include_lib("kernel/include/file.hrl").
19-export([list_directory/6, out/1]).
20
21%% Exports for EUNIT.
22-export([parse_query/1, trim/2]).
23
24-define(FILE_LEN_SZ, 45).
25
26list_directory(_Arg, CliSock, List, DirName, Req, DoAllZip) ->
27    {abs_path, Path} = Req#http_request.path,
28    {DirStr, Pos, Direction, Qry} = parse_query(Path),
29    ?Debug("List=~p Dirname~p~n", [List, DirName]),
30
31    Descriptions = read_descriptions(DirName),
32
33    L0 = lists:zf(
34           fun(F) ->
35                   File = DirName ++ [$/|F],
36                   FI = file:read_file_info(File),
37                   file_entry(FI, DirName, F, Qry,Descriptions)
38           end, List),
39
40    L1 = lists:keysort(Pos, L0),
41
42    L2 = if Direction == normal -> L1;
43            Direction == reverse -> lists:reverse(L1)
44         end,
45
46    L3 = [Html || {_, _, _, _, Html} <- L2],
47
48    Body = [ doc_head(DirStr),
49             dir_header(DirName,DirStr),
50             table_head(Direction),
51             parent_dir(),
52             if
53                 DoAllZip == true ->
54                     allzip();
55                 DoAllZip == true_nozip ->
56                     [];
57                 true ->
58                     []
59             end,
60
61             %%              if DoAllGZip == true -> alltgz() end,
62             %%              if DoAllBZip2 == true -> alltbz2() end,
63
64             %%              if DoAllZip == true -> alltgz() end,
65             %%              if DoAllZip == true -> alltbz2() end,
66
67             L3,
68             table_tail(),
69             dir_footer(DirName),%yaws:address(),
70             doc_tail()
71           ],
72
73    B = unicode:characters_to_binary(Body),
74
75    %% Always use UTF-8 encoded file names. So, set the UTF-8 charset in the
76    %% Content-Type header
77    NewCT = case yaws:outh_get_content_type() of
78                undefined ->
79                    "text/html; charset=utf-8";
80                CT0 ->
81                    [CT|_] = yaws:split_sep(CT0, $;),
82                    CT++"; charset=utf-8"
83            end,
84    yaws:outh_set_content_type(NewCT),
85
86    yaws_server:accumulate_content(B),
87    yaws_server:deliver_accumulated(CliSock),
88    yaws_server:done_or_continue().
89
90parse_query(Path) ->
91    case string:tokens(Path, [$?]) of
92        [DirStr, [PosC, $=, DirC] = Q] ->
93            Pos = case PosC of
94                      $m -> 2;
95                      $M -> 2; % last modified
96                      $s -> 3;
97                      $S -> 3; % size
98                      $d -> 4;
99                      $D -> 4; % description
100                      _  -> 1  % name (default)
101                  end,
102            Dir = case DirC of
103                      $r -> reverse;
104                      _  -> normal
105                  end,
106            {DirStr, Pos, Dir, "/?"++Q};
107        _ ->
108            {Path, 1, normal, "/"}
109    end.
110
111parse_description(Line) ->
112    L = string:strip(Line),
113    Pos = string:chr(L,$ ),
114    Filename = string:substr(L, 1, Pos-1),
115    D = string:substr(L,Pos+1),
116    Description = string:strip(D,left),
117    {Filename,Description}.
118
119read_descriptions(DirName) ->
120    File = filename:join(DirName, "MANIFEST.txt"),
121    case file:read_file(File) of
122        {ok,Bin} -> Lines = string:tokens(binary_to_list(Bin),"\n"),
123                    lists:map(fun parse_description/1,Lines);
124        _ -> []
125    end.
126
127get_description(Name,Descriptions) ->
128    case lists:keysearch(Name,1,Descriptions) of
129        {value, {_,Description}} -> Description;
130        _ -> []
131    end.
132
133doc_head(DirName) ->
134    EncDirName = file_display_name(yaws_api:url_decode(DirName)),
135    HtmlDirName = yaws_api:htmlize(EncDirName),
136    ?F("<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n"
137       "<html>\n"
138       " <head>\n"
139       "  <meta charset=\"utf-8\">"
140       "  <title>Index of ~ts</title>\n"
141       "  <style type=\"text/css\">\n"
142       "    img { border: 0; padding: 0 2px; vertical-align: text-bottom; }\n"
143       "    td  { font-family: monospace; padding: 2px 3px; text-align:left;\n"
144       "          vertical-align: bottom; white-space: pre; }\n"
145       "    td:first-child { text-align: left; padding: 2px 10px 2px 3px; }\n"
146       "    table { border: 0; }\n"
147       "  </style>\n"
148       "</head> \n"
149       "<body>\n",
150       [list_to_binary(HtmlDirName)]
151      ).
152
153doc_tail() ->
154    "</body>\n"
155        "</html>\n".
156
157table_head(Direction) ->
158    NextDirection = if Direction == normal  -> "r";
159                       Direction == reverse -> "n"
160                    end,
161    ["<table>\n"
162     "  <tr>\n"
163     "    <td><img src=\"/icons/blank.gif\" alt=\"&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;\"/><a href=\"?N=",NextDirection,"\">Name</a></td>\n"
164     "    <td><a href=\"?M=",NextDirection,"\">Last Modified</a></td>\n"
165     "    <td><a href=\"?S=",NextDirection,"\">Size</a></td>\n"
166     "    <td><a href=\"?D=",NextDirection,"\">Description</a></td>\n"
167     "  </tr>\n"
168     "  <tr><th colspan=\"4\"><hr/></th></tr>\n"].
169
170table_tail() ->
171    "  <tr><th colspan=\"4\"><hr/></th></tr>\n"
172        "</table>\n".
173
174
175dir_footer(DirName) ->
176    File = DirName ++ [$/ | "README.txt"],
177    case file:read_file(File) of
178        {ok,Bin} -> "<pre>\n" ++ binary_to_list(Bin) ++ "</pre>\n";
179        _ -> yaws:address()
180    end.
181
182dir_header(DirName,DirStr) ->
183    File = DirName ++ [$/ | "HEADER.txt"],
184    case file:read_file(File) of
185        {ok,Bin} ->
186            "<pre>\n" ++ binary_to_list(Bin) ++ "</pre>\n";
187        _ ->
188            EncDirStr   = file_display_name(yaws_api:url_decode(DirStr)),
189            HtmlDirName = yaws_api:htmlize(EncDirStr),
190            ?F("<h1>Index of ~ts</h1>\n", [list_to_binary(HtmlDirName)])
191    end.
192
193parent_dir() ->
194    {Gif, Alt} = list_gif(directory,"."),
195    ?F("  <tr>\n"
196       "    <td><img src=~p alt=~p/><a href=\"..\">Parent Directory</a></td>\n"
197       "    <td></td>\n"
198       "    <td>-</td>\n"
199       "    <td></td>\n"
200       "  </tr>\n",
201       ["/icons/" ++ Gif,
202        Alt
203       ]).
204
205%% FIXME: would be nice with a good size approx.  but it would require
206%% a deep scan of possibly the entire docroot, (and also some knowledge
207%% about zip's compression ratio in advance...)
208allzip() ->
209    {Gif, Alt} = list_gif(zip,""),
210    ?F("  <tr>\n"
211       "    <td><img src=~p alt=~p/><a href=\"all.zip\">all.zip</a></td>\n"
212       "    <td></td>\n"
213       "    <td>-</td>\n"
214       "    <td>Build a zip archive of current directory</td>\n"
215       "  </tr>\n",
216       ["/icons/" ++ Gif,
217        Alt]).
218
219%% alltgz() ->
220%%    {Gif, Alt} = list_gif(zip,""),
221%%    ?F("  <tr>\n"
222%%       "    <td><img src=~p alt=~p/><a href=\"all.tgz\">all.tgz</a></td>\n"
223%%       "    <td></td>\n"
224%%       "    <td>-</td>\n"
225%%       "    <td>Build a gzip archive of current directory</td>\n"
226%%       "  </tr>\n",
227%%       ["/icons/" ++ Gif,
228%%        Alt]).
229
230%% alltbz2() ->
231%%    {Gif, Alt} = list_gif(zip,""),
232%%    ?F("  <tr>\n"
233%%       "    <td><img src=~p alt=~p/><a href=\"all.tbz2\">all.tbz2</a></td>\n"
234%%       "    <td></td>\n"
235%%       "    <td>-</td>\n"
236%%       "    <td>Build a bzip2 archive of current directory</td>\n"
237%%       "  </tr>\n",
238%%       ["/icons/" ++ Gif,
239%%        Alt]).
240
241is_user_dir(SP) ->
242    case SP of
243        [$/,$~ | T] -> User = string:sub_word(T,1,$/),
244                       case catch yaws:user_to_home(User) of
245                           {'EXIT', _} ->
246                               false;
247                           Home ->
248                               {true,Home}
249                       end;
250        _ -> false
251    end.
252
253out(A) ->
254    SP = A#arg.server_path,
255    PP = A#arg.appmod_prepath,
256    Dir = case is_user_dir(SP) of
257              {true,Home} -> Home ++ "/public_html";
258              false -> A#arg.docroot
259          end ++ PP,
260
261    %%    {html,?F("<h2>~p</h2>",[Dir])}.
262
263    YPid = self(),
264
265    Forbidden_Paths = accumulate_forbidden_paths(),
266    case filename:basename(A#arg.server_path) of
267        "all.zip" -> spawn_link(fun() -> zip(YPid, Dir, Forbidden_Paths) end),
268                     {streamcontent, "application/zip", ""}
269                     %%        "all.tgz" -> spawn_link(fun() -> tgz(YPid, Dir) end),
270                     %%                     {streamcontent, "application/gzip", ""};
271                     %%        "all.tbz2" -> spawn_link(fun() -> tbz2(YPid, Dir) end),
272                     %%                     {streamcontent, "application/gzip", ""}
273    end.
274
275
276generate_random_fn() ->
277    Bytes = try crypto:strong_rand_bytes(64) of
278                B when is_bitstring(B) ->
279                    B
280            catch _:_ ->
281                    %% for installations without crypto
282                    << <<(yaws_dynopts:random_uniform(256) - 1)>> || _ <- lists:seq(1,64) >>
283            end,
284    << Int:512/unsigned-big-integer >> = << Bytes/binary >>,
285    integer_to_list(Int).
286
287mktempfilename([]) ->
288    {error, no_temp_dir};
289mktempfilename([Dir|R]) ->
290    RandomFN = generate_random_fn(),
291    Filename = filename:join(Dir, RandomFN),
292    case file:open(Filename, [write]) of
293        {ok, FileHandle} ->
294            {ok, {Filename, FileHandle}};
295        _Else ->
296            mktempfilename(R)
297    end.
298
299mktempfilename() ->
300    %% TODO: Add code to determine the temporary directory on various
301    %% operating systems.
302    PossibleDirs = ["/tmp", "/var/tmp"],
303    mktempfilename(PossibleDirs).
304
305zip(YPid, Dir, ForbiddenPaths) ->
306    {ok, RE_ForbiddenNames} = re:compile("\\.yaws\$", [unicode]),
307    Files = dig_through_dir(Dir, ForbiddenPaths, RE_ForbiddenNames),
308    {ok, {Tempfile, TempfileH}} = mktempfilename(),
309    file:write(TempfileH, lists:foldl(fun(I, Acc) ->
310                                              [Acc, list_to_binary(file_display_name(I)), "\n"]
311                                      end, [], Files)),
312    file:close(TempfileH),
313    process_flag(trap_exit, true),
314    %% TODO: find a way to directly pass the list of files to
315    %% zip. Erlang ports do not allow stdin to be closed
316    %% independently; however, zip needs stdin to be closed as an
317    %% indicator that the list of files is complete.
318    P = open_port({spawn, "zip -q -1 - -@ < " ++ Tempfile},
319                  [{cd, Dir},use_stdio, binary, exit_status]),
320    F = fun() ->
321                file:delete(Tempfile)
322        end,
323    stream_loop(YPid, P, F).
324
325accumulate_forbidden_paths() ->
326    SC = get(sc),
327    Auth = SC#sconf.authdirs,
328    lists:foldl(fun({Path, _Auth}, Acc) ->
329                        Acc ++ [Path]
330                end, [], Auth).
331
332
333%% tgz(YPid, Dir) ->
334%%    process_flag(trap_exit, true),
335%%    P = open_port({spawn, "tar cz ."},
336%%                  [{cd, Dir},use_stdio, binary, exit_status]),
337%%    stream_loop(YPid, P).
338
339%% tbz2(YPid, Dir) ->
340%%     process_flag(trap_exit, true),
341%%     P = open_port({spawn, "tar cj ."},
342%%                   [{cd, Dir},use_stdio, binary, exit_status]),
343%%     stream_loop(YPid, P).
344
345dir_contains_indexfile(_Dir, []) ->
346    false;
347dir_contains_indexfile(Dir, [File|R]) ->
348    case file:read_file_info(filename:join(Dir, File)) of
349        {ok, _} ->
350            true;
351        _Else ->
352            dir_contains_indexfile(Dir, R)
353    end.
354
355dir_contains_indexfile(Dir) ->
356    Indexfiles = [".yaws.auth", "index.yaws", "index.html", "index.htm"],
357    dir_contains_indexfile(Dir, Indexfiles).
358
359dig_through_dir(Basedirlen, Dir, ForbiddenPaths, RE_ForbiddenNames) ->
360    Dir1 = string:sub_string(Dir, Basedirlen),
361    case {lists:member(Dir1, ForbiddenPaths),
362          dir_contains_indexfile(Dir)} of
363        {true,_} ->
364            [];
365        {_,true} ->
366            [];
367        {false, false} ->
368            {ok, Files} = file:list_dir(Dir),
369            lists:foldl(fun(I, Acc) ->
370                                Filename = filename:join(Dir, I),
371                                case {file:read_file_info(Filename),
372                                      re:run(Filename, RE_ForbiddenNames)} of
373                                    {_, {match, _}} ->
374                                        Acc;
375                                    {{ok, #file_info{type=directory}}, _} ->
376                                        Acc ++ dig_through_dir(
377                                                 Basedirlen,
378                                                 Filename,
379                                                 ForbiddenPaths,
380                                                 RE_ForbiddenNames);
381                                    {{ok, #file_info{type=regular}}, _} ->
382                                        Acc ++ [string:sub_string(
383                                                  Filename, Basedirlen)];
384                                    _Else ->
385                                        Acc %% Ignore other files
386                                end
387                        end, [], Files)
388    end.
389
390dig_through_dir(Dir, ForbiddenPaths, RE_ForbiddenNames) ->
391    dig_through_dir(length(Dir) + 1,
392                    Dir,
393                    ForbiddenPaths,
394                    RE_ForbiddenNames).
395
396stream_loop(YPid, P, FinishedFun) ->
397    receive
398        {P, {data, Data}} ->
399            yaws_api:stream_chunk_deliver_blocking(YPid, Data),
400            stream_loop(YPid, P, FinishedFun);
401        {P, {exit_status, _}} ->
402            yaws_api:stream_chunk_end(YPid),
403            FinishedFun();
404        {'EXIT', YPid, Status} ->
405            FinishedFun(),
406            exit(Status);
407        Else ->
408            FinishedFun(),
409            error_logger:error_msg("Could not deliver zip file: ~p\n", [Else])
410    end.
411
412file_entry({ok, FI}, _DirName, Name, Qry, Descriptions) ->
413    ?Debug("file_entry(~p) ", [Name]),
414    Ext = filename:extension(Name),
415    {Gif, Alt} = list_gif(FI#file_info.type, Ext),
416    QryStr = if FI#file_info.type == directory -> Qry;
417                true -> ""
418             end,
419
420    EncName  = file_display_name(Name),
421    Description = get_description(Name,Descriptions),
422
423    Entry =
424        ?F("  <tr>\n"
425           "    <td><img src=~p alt=~p/><a href=~p title=\"~ts\">~ts</a></td>\n"
426           "    <td>~s</td>\n"
427           "    <td>~s</td>\n"
428           "    <td>~s</td>\n"
429           "  </tr>\n",
430           ["/icons/" ++ Gif,
431            Alt,
432            yaws_api:url_encode(Name) ++ QryStr,
433            list_to_binary(EncName),
434            list_to_binary(trim(EncName,?FILE_LEN_SZ)),
435            datestr(FI),
436            sizestr(FI),
437            Description]),
438    ?Debug("Entry:~p", [Entry]),
439
440    {true, {EncName, FI#file_info.mtime, FI#file_info.size, Description, Entry}};
441
442file_entry(_Err, _, _Name, _, _) ->
443    ?Debug("no entry for ~p: ~p", [_Name, _Err]),
444    false.
445
446trim(L,N) ->
447    trim(L,N,[]).
448trim([_H1,_H2,_H3]=[H|T], 3=I, Acc) ->
449    trim(T, I-1, [H|Acc]);
450trim([H1,H2,H3|_T], 3=_I, Acc) when H1 < 128, H2 < 128, H3 < 128 ->
451    lists:reverse(Acc) ++ "..&gt;";
452trim([H1,H2,H3|_T], 3=_I, [H0|Acc]) ->
453    %% Drop UTF8 continuation bytes: 10xxxxxx
454    Hs0 = lists:dropwhile(fun(Byte) -> Byte bsr 6 == 2#10 end, [H3,H2,H1,H0]),
455    %% Drop UTF8 leading byte: 11xxxxxx
456    Hs = lists:dropwhile(fun(Byte) -> Byte bsr 6 == 2#11 end, Hs0),
457    lists:reverse(Hs++Acc) ++ "..&gt;";
458trim([H|T], I, Acc) ->
459    trim(T, I-1, [H|Acc]);
460trim([], _I, Acc) ->
461    lists:reverse(Acc).
462
463%% FI -> 16-Jan-2006 23:06
464datestr(FI) ->
465    {{Year, Month, Day}, {Hour, Min, _}} = FI#file_info.mtime,
466    io_lib:format("~s-~s-~w ~s:~s",
467                  [yaws:mk2(Day),yaws:month(Month),Year,
468                   yaws:mk2(Hour),yaws:mk2(Min)]).
469
470sizestr(FI) when FI#file_info.size > 1000000 ->
471    ?F("~.1fM", [FI#file_info.size / 1000000]);
472sizestr(FI) when FI#file_info.size > 1000 ->
473    ?F("~wk", [trunc(FI#file_info.size / 1000)]);
474sizestr(FI) when FI#file_info.size == 0 ->
475    ?F("0k", []);
476sizestr(_FI) ->
477    ?F("1k", []). % As apache does it...
478
479list_gif(directory, ".") ->
480    {"back.gif", "[DIR]"};
481list_gif(regular, ".txt") ->
482    {"text.gif", "[TXT]"};
483list_gif(regular, ".c") ->
484    {"c.gif", "[&nbsp;&nbsp;&nbsp;]"};
485list_gif(regular, ".dvi") ->
486    {"dvi.gif", "[&nbsp;&nbsp;&nbsp;]"};
487list_gif(regular, ".pdf") ->
488    {"pdf.gif", "[&nbsp;&nbsp;&nbsp;]"};
489list_gif(regular, _) ->
490    {"layout.gif", "[&nbsp;&nbsp;&nbsp;]"};
491list_gif(directory, _) ->
492    {"dir.gif", "[DIR]"};
493list_gif(zip, _) ->
494    {"compressed.gif", "[DIR]"};
495list_gif(_, _) ->
496    {"unknown.gif", "[OTH]"}.
497
498
499%% Assume that all file names are UTF-8 encoded. If the VM uses ISO-latin-1
500%% encoding, then no conversion is needed (file already returns the byte
501%% representation of file names). If the VM uses UTF-8, we need to do a little
502%% conversion to return the byte representation of file names.
503file_display_name(Name) ->
504    case file:native_name_encoding() of
505        latin1 -> Name;
506        utf8   -> binary_to_list(unicode:characters_to_binary(Name))
507    end.
508