View source with formatted comments or as raw
    1/*  Part of SWISH
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2018, VU University Amsterdam
    7			 CWI Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(swish_version_service, []).   37:- use_module(library(http/http_dispatch)).   38:- use_module(library(http/http_json)).   39:- use_module(library(http/http_parameters)).   40:- use_module(library(http/html_write)).   41:- use_module(library(git)).   42:- use_module(library(apply)).   43
   44:- use_module(version).   45:- use_module(markdown).   46
   47/** <module> Serve version details over HTTP
   48
   49This module serves SWISH and Prolog version   details over HTTP. This is
   50file is normally loaded though the   config file `version_info.pl`. This
   51file is not loaded by default for security reasons.
   52*/
   53
   54:- http_handler(swish(versions),  versions,  [id(versions)]).   55:- http_handler(swish(changes),   changes,   [id(changes)]).   56:- http_handler(swish(changelog), changelog, [id(changelog)]).   57
   58versions(_Request) :-
   59    prolog_version_atom(SWIVersion),
   60    module_version_data(swish, SWISHVersion),
   61    module_version_data(cplint,CplintGitVersion),
   62    pack_property(cplint,version(CplintVersion)),
   63    reply_json_dict(json{ prolog:
   64                          json{ brand:  "SWI-Prolog",
   65                                version: SWIVersion
   66                              },
   67                          swish:SWISHVersion,
   68			  cplint:
   69			  json{ version:CplintVersion,
   70			     gitversion:CplintGitVersion
   71			    }
   72                        }).
   73
   74module_version_data(Module, Dict) :-
   75    findall(Name-Value, module_version_data(Module, Name, Value), Pairs),
   76    dict_pairs(Dict, json, Pairs).
   77
   78module_version_data(Module, Name, Value) :-
   79    git_module_property(Module, Term),
   80    Term =.. [Name,Value].
   81
   82%!  changes(+Request)
   83%
   84%   Get quick statistics on changes since a   commit  to inform the user
   85%   about new functionality. If no commit is  passed we reply no changes
   86%   and the last commit we have seen.
   87
   88:- dynamic  change_cache/3.   89:- volatile change_cache/3.   90
   91:- multifile
   92    user:message_hook/3.   93
   94user:message_hook(make(done(_)), _, _) :-
   95    retractall(change_cache(_,_,_)),
   96    fail.
   97
   98changes(Request) :-
   99    http_parameters(Request,
  100                    [ commit(Commit, [default(last)]),
  101                      show(Show, [oneof([tagged, all]), default(tagged)])
  102                    ]),
  103    changes(Commit, Show, Changes),
  104    reply_json_dict(Changes).
  105
  106changes(Commit, Show, Changes) :-
  107    change_cache(Commit, Show, Changes),
  108    !.
  109changes(Commit, Show, Changes) :-
  110    changes_nc(Commit, Show, Changes),
  111    asserta(change_cache(Commit, Show, Changes)).
  112
  113changes_nc(Commit, Show, Changes) :-
  114    Commit \== last,
  115    git_module_property(swish, directory(Dir)),
  116    atom_concat(Commit, '..', Revisions),
  117    git_shortlog(Dir, ShortLog, [ revisions(Revisions) ]),
  118    last_change(ShortLog, LastCommit, LastModified),
  119    !,
  120    include(filter_change(Show), ShortLog, ShowLog),
  121    length(ShowLog, Count),
  122    Changes = json{ commit:  LastCommit,
  123                    date:    LastModified,
  124                    changes: Count
  125                  }.
  126changes_nc(_, _Show, Changes) :-
  127    git_module_property(swish, directory(Dir)),
  128    git_shortlog(Dir, ShortLog, [limit(1)]),
  129    last_change(ShortLog, LastCommit, LastModified),
  130    !,
  131    Changes = json{ commit:  LastCommit,
  132                    date:    LastModified,
  133                    changes: 0
  134                  }.
  135changes_nc(_Commit, _Show, Changes) :-
  136    Changes = json{ changes: 0
  137                  }.
  138
  139
  140last_change([LastEntry|_], LastCommit, LastModified) :-
  141    git_log_data(commit_hash,         LastEntry, LastCommit),
  142    git_log_data(committer_date_unix, LastEntry, LastModified).
  143
  144filter_change(all, _Change).
  145filter_change(tagged, Change) :-
  146    git_log_data(subject, Change, Message0),
  147    sub_string(Message0, Pre, _, _, ":"),
  148    Pre > 0,
  149    !,
  150    sub_string(Message0, 0, Pre, _, Tag),
  151    string_upper(Tag, Tag).
  152
  153%!  changelog(+Request)
  154%
  155%   Sends the changelog since a  given  version,   as  well  as the last
  156%   commit and its timestamp.
  157
  158changelog(Request) :-
  159    http_parameters(Request,
  160                    [ commit(Since, [optional(true)]),
  161                      last(Count, [default(10)]),
  162                      show(Show, [oneof([tagged, all]), default(tagged)]),
  163		      pack(Pack, [default(swish)])
  164                    ]),
  165    git_module_property(Pack, directory(Dir)),
  166    (   nonvar(Since)
  167    ->  atom_concat(Since, '..', Revisions),
  168        Options = [ revisions(Revisions) ]
  169    ;   Options = [ limit(Count) ]
  170    ),
  171    git_shortlog(Dir, ShortLog, Options),
  172    (   ShortLog = [LastEntry|_]
  173    ->  git_log_data(commit_hash,         LastEntry, LastCommit),
  174        git_log_data(committer_date_unix, LastEntry, LastModified),
  175        convlist(changelog(Show), ShortLog, ChangeLog),
  176        reply_json_dict(json{ commit:    LastCommit,
  177                              date:	 LastModified,
  178                              changelog: ChangeLog
  179                            })
  180    ;   reply_json_dict(json{ message: "No changes"
  181                            })
  182    ).
  183
  184changelog(Show, Entry,
  185          json{commit:Commit,
  186               author: Author,
  187               committer_date_relative: When,
  188               message: Message}) :-
  189    git_log_data(subject, Entry, Message0),
  190    format_commit_message(Show, Message0, Message),
  191    git_log_data(commit_hash, Entry, Commit),
  192    git_log_data(author_name, Entry, Author),
  193    git_log_data(committer_date_relative, Entry, When).
  194
  195
  196format_commit_message(tagged, Message0, Message) :-
  197    sub_string(Message0, Pre, _, Post, ":"),
  198    Pre > 0,
  199    !,
  200    sub_string(Message0, 0, Pre, _, Tag),
  201    string_upper(Tag, Tag),
  202    sub_string(Message0, _, Post, 0, Msg),
  203    string_codes(Msg, Codes),
  204    wiki_file_codes_to_dom(Codes, '/', DOM),
  205    phrase(wiki_html(div(class('v-changelog-entry'),
  206                         [ span(class('v-changelog-tag'), Tag)
  207                         | DOM
  208                         ])),
  209           Tokens),
  210    with_output_to(string(Message), print_html(Tokens)).
  211format_commit_message(all, Message0, Message) :-
  212    format_commit_message(tagged, Message0, Message),
  213    !.
  214format_commit_message(all, Message0, Message) :-
  215    string_codes(Message0, Codes),
  216    wiki_file_codes_to_dom(Codes, '/', DOM),
  217    phrase(wiki_html(div(class('v-changelog-entry'),
  218                         DOM)),
  219           Tokens),
  220    with_output_to(string(Message), print_html(Tokens)).
  221
  222		 /*******************************
  223		 *          COMPATIBILITY	*
  224		 *******************************/
  225
  226% support SWI-Prolog < 7.7.19
  227
  228:- if(\+catch(check_predicate_option(git:git_shortlog/3, 3, revisions(a)),
  229              error(_,_), fail)).  230:- abolish(git:git_shortlog/3).  231git:(
  232git_shortlog(Dir, ShortLog, Options) :-
  233    (   option(revisions(Range), Options)
  234    ->  RangeSpec = [Range]
  235    ;   option(limit(Limit), Options, 10),
  236        RangeSpec = ['-n', Limit]
  237    ),
  238    (   option(git_path(Path), Options)
  239    ->  Extra = ['--', Path]
  240    ;   option(path(Path), Options)
  241    ->  relative_file_name(Path, Dir, RelPath),
  242        Extra = ['--', RelPath]
  243    ;   Extra = []
  244    ),
  245    git_format_string(git_log, Fields, Format),
  246    append([[log, Format], RangeSpec, Extra], GitArgv),
  247    git_process_output(GitArgv,
  248                       read_git_formatted(git_log, Fields, ShortLog),
  249                       [directory(Dir)])).
  250:- endif.