View source with formatted comments or as raw
    1/*  Part of ClioPatria
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2010-2011 University of Amsterdam
    7                             CWI, Asterdam
    8                             VU University Amsterdam
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(cpa_wiki,
   38          [ serve_page/2
   39          ]).   40:- use_module(library(http/http_dispatch)).   41:- use_module(library(http/http_parameters)).   42:- use_module(library(http/http_dirindex)).   43:- use_module(library(http/html_write)).   44:- use_module(library(pldoc/doc_wiki)).   45:- use_module(library(readutil)).   46:- use_module(library(option)).   47:- use_module(library(settings)).   48:- use_module(library(pldoc/doc_index)).   49:- use_module(library(pldoc/doc_html),
   50              except([ file//2,
   51                       include//3
   52                     ])).   53
   54/** <module> ClioPatria wiki-page server
   55
   56This module serves wiki-pages from (by default) cliopatria(web/help). If
   57the user requests an X.html page, it runs SWI-Prolog's PlDoc wiki-engine
   58over the associated X.txt file.
   59
   60@see The file load.pl binds this functionality to cliopatria(web/help).
   61*/
   62
   63:- setting(http:index_files,
   64           list(atom),
   65           [ 'index.txt', 'index.html' ],
   66           'List of files that provide a directory index').   67
   68%
   69%       serve_page(+Alias, +Request)
   70%
   71%       HTTP handler for files below the file-path Alias. .txt files are
   72%       served as Wiki-pages. All other files   are  served according to
   73%       the rules of http_reply_file/3. To serve   a directory, one must
   74%       create a file search path for it   and decide on the location in
   75%       the web-hierarchy. Here is an example that serves files from the
   76%       subdirectory =www= below  the  search-path   =myapp=  from  HTTP
   77%       locations below =|/web|=.
   78%
   79%           ==
   80%           user:file_search_path(web_files, myapp(www)).
   81%
   82%           :- http_handler(root(web), serve_page(web_files), [prefix]).
   83%           ==
   84
   85serve_page(Alias, Request) :-
   86    memberchk(path_info(Relative), Request),
   87    Spec =.. [ Alias, Relative ],
   88    http_safe_file(Spec, []),
   89    find_file(Spec, File),
   90    !,
   91    setup_call_cleanup(b_setval(doc_alias, Alias),
   92                       serve_file(File, Request),
   93                       nb_delete(Alias)).
   94serve_page(Alias, Request) :-
   95    \+ memberchk(path_info(_), Request),
   96    !,
   97    serve_page(Alias, [path_info('index.html')|Request]).
   98serve_page(_, Request) :-
   99    http_404([], Request).
  100
  101%!  find_file(+Spec, -File) is semidet.
  102%
  103%   Translate Spec into a File  in   the  document-root tree. If the
  104%   given extension is .html, also look for   .txt files that can be
  105%   translated into HTML.
  106
  107find_file(Spec, File) :-
  108    spec_replace_extension(Spec, html, txt, TxtSpec),
  109    absolute_file_name(TxtSpec,
  110                       File,
  111                       [ access(read),
  112                         file_errors(fail)
  113                       ]),
  114    !.
  115find_file(Spec, File) :-
  116    absolute_file_name(Spec,
  117                       File,
  118                       [ access(read),
  119                         file_errors(fail)
  120                       ]).
  121find_file(Spec, File) :-
  122    absolute_file_name(Spec,
  123                       File,
  124                       [ access(read),
  125                         file_errors(fail),
  126                         file_type(directory)
  127                       ]).
  128
  129spec_replace_extension(File0, Ext0, Ext, File) :-
  130    atomic(File0),
  131    !,
  132    file_name_extension(Base, Ext0, File0),
  133    file_name_extension(Base, Ext, File).
  134spec_replace_extension(Comp0, Ext0, Ext, Comp) :-
  135    Comp0 =.. [Alias,Inside0],
  136    spec_replace_extension(Inside0, Ext0, Ext, Inside),
  137    Comp =.. [Alias,Inside].
  138
  139%!  serve_file(+File, +Request) is det.
  140%!  serve_file(+Extension, +File, +Request) is det.
  141%
  142%   Serve the requested file.
  143
  144serve_file(File, Request) :-
  145    file_name_extension(_, Ext, File),
  146    debug(plweb, 'Serving ~q; ext=~q', [File, Ext]),
  147    serve_file(Ext, File, Request).
  148
  149serve_file('',  Dir, Request) :-
  150    exists_directory(Dir),
  151    !,
  152    (   sub_atom(Dir, _, _, 0, /),
  153        serve_index_file(Dir, Request)
  154    ->  true
  155    ;   http_reply_dirindex(Dir, [unsafe(true)], Request)
  156    ).
  157serve_file(txt, File, Request) :-
  158    http_parameters(Request,
  159                    [ format(Format, [ oneof([raw,html]),
  160                                       default(html)
  161                                     ])
  162                    ]),
  163    Format == html,
  164    !,
  165    read_file_to_codes(File, String, []),
  166    setup_call_cleanup(b_setval(pldoc_file, File),
  167                       serve_wiki(String, File, Request),
  168                       nb_delete(pldoc_file)).
  169serve_file(_Ext, File, Request) :-      % serve plain files
  170    http_reply_file(File, [unsafe(true)], Request).
  171
  172%!  serve_index_file(+Dir, +Request) is semidet.
  173%
  174%   Serve index.txt or index.html, etc. if it exists.
  175
  176serve_index_file(Dir, Request) :-
  177    setting(http:index_files, Indices),
  178    member(Index, Indices),
  179    ensure_slash(Dir, DirSlash),
  180    atom_concat(DirSlash, Index, File),
  181    access_file(File, read),
  182    !,
  183    serve_file(File, Request).
  184
  185ensure_slash(Dir, Dir) :-
  186    sub_atom(Dir, _, _, 0, /),
  187    !.
  188ensure_slash(Dir0, Dir) :-
  189    atom_concat(Dir0, /, Dir).
  190
  191
  192%!  serve_wiki(+String, +File, +Request) is det.
  193%
  194%   Emit page from wiki content in String.
  195
  196serve_wiki(String, File, Request) :-
  197    wiki_codes_to_dom(String, [], DOM0),
  198    (   sub_term(h1(_, Title), DOM0)
  199    ->  true
  200    ;   Title = 'SWI-Prolog'
  201    ),
  202    insert_edit_button(DOM0, File, Request, DOM),
  203    setup_call_cleanup(b_setval(pldoc_options,
  204                                [ prefer(manual)
  205                                ]),
  206                       serve_wiki_page(Title, DOM),
  207                       nb_delete(pldoc_options)).
  208
  209serve_wiki_page(Title, DOM) :-
  210    reply_html_page(pldoc(wiki),
  211                    [ title(Title)
  212                    ],
  213                    DOM).
  214
  215insert_edit_button(DOM, _, Request, DOM) :-
  216    \+ catch(http:authenticate(pldoc(edit), Request, _), _, fail),
  217    !.
  218insert_edit_button([h1(Attrs,Title)|DOM], File, _,
  219                   [h1(Attrs,[ span(style('float:right'),
  220                                   \edit_button(File, [edit(true)]))
  221                             | Title
  222                             ])|DOM]) :- !.
  223insert_edit_button(DOM, File, _,
  224                   [ h1(class(wiki),
  225                        [ span(style('float:right'),
  226                               \edit_button(File, [edit(true)]))
  227                        ])
  228                   | DOM
  229                   ]).
  230
  231
  232:- public                               % Called through wiki \Term
  233    include//3,
  234    file//2.  235
  236                 /*******************************
  237                 *           RENDERING          *
  238                 *******************************/
  239
  240%!  include(+Object, +Type, +Options)//
  241
  242include(Object, Type, Options) -->
  243    pldoc_html:include(Object, Type,
  244                       [ map_extension([txt-html])
  245                       | Options
  246                       ]).
  247
  248%!  file(+Path, Options)//
  249%
  250%   Trap translation of \file(+Path,  Options).   The  first  clause
  251%   reduces the label of the file to the plain file-name if the file
  252%   is inside the help-system.
  253
  254file(Path, Options) -->
  255    { \+ option(label(_), Options),
  256      file_name_extension(Base, txt, Path),
  257      option(absolute_path(AbsPath), Options),
  258      current_alias_root(DocRoot),
  259      sub_atom(AbsPath, 0, _, _, DocRoot),
  260      !,
  261      file_base_name(Base, Label),
  262      file_href(Options, Options1)
  263    },
  264    pldoc_html:file(Path,
  265                    [ label(Label),
  266                      map_extension([txt-html])
  267                    | Options1
  268                    ]).
  269file(File, Options) -->
  270    { file_href(Options, Options1)
  271    },
  272    pldoc_html:file(File,
  273                    [ map_extension([txt-html])
  274                    | Options1
  275                    ]).
  276
  277
  278file_href(Options0, Options) :-
  279    \+ ( nb_current(pldoc_file, CFile),
  280         CFile \== []
  281       ),
  282    option(absolute_path(Path), Options0),
  283    current_alias_root(DocRoot),
  284    atom_concat(DocRoot, DocLocal, Path),
  285    !,
  286    ensure_leading_slash(DocLocal, HREF),
  287    Options = [ href(HREF) | Options0 ].
  288file_href(Options0, Options) :-
  289    nb_current(pldoc_file, CFile),
  290    CFile \== [],
  291    option(absolute_path(Path), Options0),
  292    plfile_href(Path, HREF),
  293    Options = [ href(HREF)|Options0 ].
  294file_href(Options, Options).
  295
  296%!  plfile_href(+Path, -HREF) is det.
  297%
  298%   Create a link for a file to see  the (pretty) source if the file
  299%   is inside the help system. Otherwise create a normal PlDoc link.
  300
  301plfile_href(Path, HREF) :-
  302    file_name_extension(_, Ext, Path),
  303    prolog_file_type(Ext, prolog),
  304    current_alias_root(DocRoot),
  305    sub_atom(Path, 0, _, _, DocRoot),
  306    !,
  307    doc_file_href(Path, HREF0),
  308    atom_concat(HREF0, '?show=src', HREF).
  309plfile_href(Path, HREF) :-
  310    doc_file_href(Path, HREF).
  311
  312%!  current_alias_root(-Root)
  313%
  314%   Root is the root of the current file-alias we are served from.
  315
  316current_alias_root(DocRoot) :-
  317    (   nb_current(doc_alias, Val), Val \== []
  318    ->  Alias = Val
  319    ;   Alias = document_root
  320    ),
  321    Term =.. [Alias,'.'],
  322    absolute_file_name(Term,
  323                       DocRoot,
  324                       [ file_type(directory),
  325                         access(read)
  326                       ]).
  327
  328
  329ensure_leading_slash(Path, SlashPath) :-
  330    (   sub_atom(Path, 0, _, _, /)
  331    ->  SlashPath = Path
  332    ;   atom_concat(/, Path, SlashPath)
  333    )