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                     ]).

 http_reply_dirindex(+DirSpec, :Options, +Request) is det

Provide a directory listing for Request, assuming it is an index for the physical directrory Dir. If the request-path does not end with /, first return a moved (301 Moved Permanently) reply.

The calling conventions allows for direct calling from http_handler/3.

   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).

 directory_index(+Dir, :Options)// is det

Show index for a directory. Options processed:

order_by(+Field)

Sort the files in the directory listing by Field. Field is one of name (default), size or time.

order(+AscentDescent)

Sorting order. Default is ascending. The altenative is descending

name(:RenderName)

DCG used to render a name in the table. The File is passed.

  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]).

 mime_type_icon(+MimeType, -Icon) is det

Determine the icon that is used to show a file of the given extension. This predicate can be hooked using the multifile http:mime_type_icon/2 hook with the same signature. Icon is the plain name of an image file that appears in the file-search-path icons.

Arguments:

MimeType

- is a term Type/SubType as produced by file_mime_type/2.

  265mime_type_icon(Ext, Icon) :-
  266    http:mime_type_icon(Ext, Icon),
  267    !.
  268mime_type_icon(_, 'generic.png').

 http:mime_type_icon(+MimeType, -IconName) is nondet

Multi-file hook predicate that can be used to associate icons to files listed by http_reply_dirindex/3. The actual icon file is located by absolute_file_name(icons(IconName), Path, []).

See also

- serve_files_in_directory/2 serves the images.

  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                 ]).