1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2009-2014, VU University Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(http_dirindex,
   36          [ http_reply_dirindex/3,      % +PhysicalDir, +Options, +Request
   37            directory_index//2          % +PhysicalDir, +Options
   38          ]).   39:- use_module(library(http/html_write)).   40:- use_module(library(http/http_path)).   41:- use_module(library(http/http_dispatch)).   42:- use_module(library(http/http_server_files)).   43:- use_module(library(http/html_head)).   44:- use_module(library(http/mimetype)).   45:- use_module(library(apply)).   46:- use_module(library(option)).   47
   48:- meta_predicate
   49    http_reply_dirindex(+, :, +),
   50    directory_index(+, :, ?, ?).   51
   52:- predicate_options(http_reply_dirindex/3, 2,
   53                     [ title(any),
   54                       pass_to(http_dispatch:http_safe_file/2, 2),
   55                       pass_to(directory_index/4, 2)
   56                     ]).   57:- predicate_options(directory_index/4, 2,
   58                     [ name(callable),
   59                       order_by(oneof([name,size,time])),
   60                       order(oneof([ascending,descending]))
   61                     ]).   62
   63/** <module> HTTP directory listings
   64
   65This module provides a simple API to   generate  an index for a physical
   66directory. The index can be customised   by  overruling the dirindex.css
   67CSS file and by defining  additional  rules   for  icons  using the hook
   68http:file_extension_icon/2.
   69
   70@tbd    Provide more options (sorting, selecting columns, hiding files)
   71*/
   72
   73%!  http_reply_dirindex(+DirSpec, :Options, +Request) is det.
   74%
   75%   Provide a directory listing for Request, assuming it is an index
   76%   for the physical directrory Dir. If   the  request-path does not
   77%   end with /, first return a moved (301 Moved Permanently) reply.
   78%
   79%   The  calling  conventions  allows  for    direct   calling  from
   80%   http_handler/3.
   81
   82http_reply_dirindex(DirSpec, Options0, Request) :-
   83    meta_options(is_meta, Options0, Options),
   84    http_safe_file(DirSpec, Options),
   85    absolute_file_name(DirSpec, Dir,
   86                       [ file_type(directory),
   87                         access(read)
   88                       ]),
   89    memberchk(path(Path), Request),
   90    (   atom_concat(PlainPath, /, Path),
   91        merge_options(Options,
   92                      [ title(['Index of ', PlainPath]) ],
   93                      Options1)
   94    ->  dir_index(Dir, Options1)
   95    ;   atom_concat(Path, /, NewLocation),
   96        throw(http_reply(moved(NewLocation)))
   97    ).
   98
   99is_meta(name).
  100
  101dir_index(Dir, Options) :-
  102    directory_members(Dir, SubDirs, Files),
  103    option(title(Title), Options, Dir),
  104    reply_html_page(
  105        dir_index(Dir, Title),
  106        title(Title),
  107        [ h1(Title),
  108          \dirindex_table(SubDirs, Files, Options)
  109        ]).
  110
  111directory_members(Dir, Dirs, Files) :-
  112    atom_concat(Dir, '/*', Pattern),
  113    expand_file_name(Pattern, Matches),
  114    partition(exists_directory, Matches, Dirs, Files).
  115
  116%!  directory_index(+Dir, :Options)// is det.
  117%
  118%   Show index for a directory.  Options processed:
  119%
  120%     * order_by(+Field)
  121%     Sort the files in the directory listing by Field.  Field
  122%     is one of =name= (default), =size= or =time=.
  123%     * order(+AscentDescent)
  124%     Sorting order.  Default is =ascending=.  The altenative is
  125%     =descending=
  126%     * name(:RenderName)
  127%     DCG used to render a name in the table.  The File is passed.
  128
  129directory_index(Dir, Options0) -->
  130    { meta_options(is_meta, Options0, Options),
  131      directory_members(Dir, SubDirs, Files)
  132    },
  133    dirindex_table(SubDirs, Files, Options).
  134
  135dirindex_table(SubDirs, Files, Options) -->
  136    { option(order_by(By), Options, name),
  137      sort_files(By, Files, SortedFiles0),
  138      asc_desc(SortedFiles0, SortedFiles, Options)
  139    },
  140    html_requires(http_dirindex),
  141    html(table(class(dirindex),
  142               [ \dirindex_title,
  143                 \back
  144               | \dirmembers(SubDirs, SortedFiles, Options)
  145               ])).
  146
  147sort_files(name, Files, Files) :- !.
  148sort_files(Order, Files, Sorted) :-
  149    map_list_to_pairs(key_file(Order), Files, Pairs),
  150    keysort(Pairs, SortedPairs),
  151    pairs_values(SortedPairs, Sorted).
  152
  153key_file(name, File, Base) :-
  154    file_base_name(File, Base).
  155key_file(size, File, Size) :-
  156    size_file(File, Size).
  157key_file(time, File, Time) :-
  158    time_file(File, Time).
  159
  160asc_desc(Files, Ordered, Options) :-
  161    (   option(order(ascending), Options, ascending)
  162    ->  Ordered = Files
  163    ;   reverse(Files, Ordered)
  164    ).
  165
  166dirindex_title -->
  167    html(tr(class(dirindex_header),
  168            [ th(class(icon),     ''),
  169              th(class(name),     'Name'),
  170              th(class(modified), 'Last modified'),
  171              th(class(size),     'Size')
  172            ])).
  173
  174back -->
  175    html(tr([ \icon_cell('back.png', '[UP]'),
  176              td(class(name), \name_cell(.., [label('Up')])),
  177              td(class(modified), -),
  178              td(class(size),     -)
  179            ])).
  180
  181dirmembers(Dirs, Files, Options) -->
  182    dir_rows(Dirs, odd, End),
  183    file_rows(Files, End, _, Options).
  184
  185dir_rows([], OE, OE) --> [].
  186dir_rows([H|T], OE0, OE) -->
  187    dir_row(H, OE0),
  188    { oe(OE0, OE1) },
  189    dir_rows(T, OE1, OE).
  190
  191file_rows([], OE, OE, _) --> [].
  192file_rows([H|T], OE0, OE, Options) -->
  193    file_row(H, OE0, Options),
  194    {oe(OE0, OE1)},
  195    file_rows(T, OE1, OE, Options).
  196
  197oe(odd, even).
  198oe(even, odd).
  199
  200dir_row(Dir, OE) -->
  201    html(tr(class(OE),
  202            [ \icon_cell('folder.png', '[DIR]'),
  203              td(class(name), \name_cell(Dir, [])),
  204              \modified_cell(Dir),
  205              td(class(size), -)
  206            ])).
  207
  208
  209file_row(File, OE, Options) -->
  210    { file_base_name(File, Name),
  211      file_mime_type(File, MimeType),
  212      mime_type_icon(MimeType, IconName)
  213    },
  214    html(tr(class(OE),
  215            [ \icon_cell(IconName, '[FILE]'),
  216              td(class(name), \name_cell(Name, Options)),
  217              \modified_cell(File),
  218              td(class(size), \size(File))
  219            ])).
  220
  221icon_cell(IconName, Alt) -->
  222    { http_absolute_location(icons(IconName), Icon, [])
  223    },
  224    html(td(class(icon), img([src(Icon), alt(Alt)]))).
  225
  226
  227name_cell(File, Options) -->
  228    { option(label(Label), Options),
  229      !,
  230      uri_encoded(path, File, Ref)
  231    },
  232    html(a(href(Ref), Label)).
  233name_cell(File, Options) -->
  234    { option(name(Name), Options) },
  235    !,
  236    call(Name, File).
  237name_cell(File, _Options) -->
  238    { file_base_name(File, Name),
  239      uri_encoded(path, Name, Ref)
  240    },
  241    html(a(href(Ref), Name)).
  242
  243modified_cell(Name) -->
  244    { time_file(Name, Stamp),
  245      format_time(string(Date), '%+', Stamp)
  246    },
  247    html(td(class(modified), Date)).
  248
  249size(Name) -->
  250    { size_file(Name, Size)
  251    },
  252    html('~D'-[Size]).
  253
  254%!  mime_type_icon(+MimeType, -Icon) is det.
  255%
  256%   Determine the icon that is used  to   show  a  file of the given
  257%   extension. This predicate can  be   hooked  using  the multifile
  258%   http:mime_type_icon/2 hook with the same  signature. Icon is the
  259%   plain name of an image file that appears in the file-search-path
  260%   =icons=.
  261%
  262%   @param  MimeType  is  a  term    Type/SubType   as  produced  by
  263%   file_mime_type/2.
  264
  265mime_type_icon(Ext, Icon) :-
  266    http:mime_type_icon(Ext, Icon),
  267    !.
  268mime_type_icon(_, 'generic.png').
  269
  270%!  http:mime_type_icon(+MimeType, -IconName) is nondet.
  271%
  272%   Multi-file hook predicate that can be used to associate icons to
  273%   files listed by http_reply_dirindex/3. The   actual icon file is
  274%   located by absolute_file_name(icons(IconName), Path, []).
  275%
  276%   @see serve_files_in_directory/2 serves the images.
  277
  278:- multifile
  279    http:mime_type_icon/2.  280
  281http:mime_type_icon(application/pdf,      'layout.png').
  282http:mime_type_icon(text/csrc,            'c.png').
  283http:mime_type_icon(application/'x-gzip', 'compressed.png').
  284http:mime_type_icon(application/'x-gtar', 'compressed.png').
  285http:mime_type_icon(application/zip,      'compressed.png').
  286
  287
  288                 /*******************************
  289                 *            RESOURCES         *
  290                 *******************************/
  291
  292:- html_resource(http_dirindex,
  293                 [ virtual(true),
  294                   requires([ css('dirindex.css')
  295                            ])
  296                 ]).