View source with formatted comments or as raw
    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)  2002-2016, University of 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(license,
   36          [ license/1,                  % +LicenseId
   37            license/2,                  % +LicenseId, +ModuleId
   38            license/0,                  % Current situation
   39
   40            known_licenses/0
   41          ]).   42
   43:- dynamic
   44    licensed/2.                     % +Id, +Module
   45
   46:- multifile
   47    license/3.   48
   49/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   50License  definitions.  This  data  is   (still  incomplete)  taken  from
   51http://www.fsf.org/licenses/license-list.html. The first argument is the
   52license identifier. The second tells us with  which of the two principal
   53licenses (GPL and LGPL) the license is   compatible.  The remainder is a
   54list  of  properties  that   can   be    used   with   more   high-level
   55license-information tools.
   56- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
   57
   58license(gpl, gpl,
   59        [ comment('GNU General Public License'),
   60          url('http://www.fsf.org/copyleft/gpl.html')
   61        ]).
   62license(gplv2, gpl,
   63        [ comment('GNU General Public License, version 2'),
   64          url('http://www.fsf.org/copyleft/gpl.html')
   65        ]).
   66license('gplv2+', gpl,
   67        [ comment('GNU General Public License, version 2 or later'),
   68          url('http://www.fsf.org/copyleft/gpl.html')
   69        ]).
   70license(gplv3, gpl,
   71        [ comment('GNU General Public License, version 3'),
   72          url('http://www.fsf.org/copyleft/gpl.html')
   73        ]).
   74license(lgpl, lgpl,
   75        [ comment('GNU Lesser General Public License'),
   76          url('http://www.fsf.org/copyleft/lesser.html')
   77        ]).
   78license(lgplv2, lgpl,
   79        [ comment('GNU Lesser General Public License, version 2'),
   80          url('http://www.fsf.org/copyleft/lesser.html')
   81        ]).
   82license('lgplv2+', lgpl,
   83        [ comment('GNU Lesser General Public License, version 2 or later'),
   84          url('http://www.fsf.org/copyleft/lesser.html')
   85        ]).
   86license(lgplv3, lgpl,
   87        [ comment('GNU Lesser General Public License, version 3'),
   88          url('http://www.fsf.org/copyleft/lesser.html')
   89        ]).
   90license(gpl_swipl, lgpl,
   91        [ comment('SWI-Prolog Prolog Source License for versions up to 7.3.32'),
   92          url('http://www.swi-prolog.org/license-old.html')
   93        ]).
   94license(swipl, lgpl,
   95        [ comment('SWI-Prolog Prolog Source License for versions up to 7.3.32'),
   96          url('http://www.swi-prolog.org/license-old.html')
   97        ]).
   98
   99%       Other GPL/LGPL compatible licenses.
  100%       TBD: Check permissive status of these licenses
  101
  102license(guile, lgpl,
  103        [ comment('License for Guile'),
  104          url('https://www.gnu.org/software/guile/docs/docs-1.6/guile-ref/Guile-License.html')
  105        ]).
  106license(gnu_ada, lgpl,
  107        [ comment('The license of the run-time units of the GNU Ada compiler'),
  108          url('https://en.wikipedia.org/wiki/GNAT#License')
  109        ]).
  110license(x11, permissive,
  111        [ comment('The X11 license'),
  112          url('http://www.x.org/terms.htm')
  113        ]).
  114license(expat, permissive,
  115        [ comment('Expat license'),
  116          url('http://www.jclark.com/xml/copying.txt')
  117        ]).
  118license(sml, permissive,
  119        [ comment('Standard ML of New Jersey Copyright License'),
  120          url('http://cm.bell-labs.com/cm/cs/what/smlnj/license.html')
  121        ]).
  122license(public_domain, permissive,
  123        [ comment('Unrestricted Public domain')
  124        ]).
  125license(cryptix, permissive,
  126        [ comment('The Cryptix General License'),
  127          url('http://www.cryptix.org/docs/license.html')
  128        ]).
  129license(bsd, permissive,
  130        [ comment('The modified BSD license'),
  131          url('http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5')
  132        ]).
  133license(mit, permissive,
  134        [ comment('The MIT License'),
  135          url('https://en.wikipedia.org/wiki/MIT_License')
  136        ]).
  137license(zlib, permissive,
  138        [ comment('The license of ZLib'),
  139          url('http://www.gzip.org/zlib/zlib_license.html')
  140        ]).
  141license(agpl, gpl,
  142        [ comment('Affero General Public License'),
  143          url('http://www.gnu.org/licenses/agpl-3.0.en.html')
  144        ]).
  145license(lgpl_compatible, lgpl,
  146        [ comment('Other LGPL compatible license')
  147        ]).
  148license(gpl_compatible, gpl,
  149        [ comment('Other GPL and not LGPL compatible license')
  150        ]).
  151license(permissive, permissive,
  152        [ comment('Other permissive license')
  153        ]).
  154license(asl2, permissive,
  155        [ comment('Apache License 2.0'),
  156          url('http://www.apache.org/licenses/LICENSE-2.0')
  157        ]).
  158
  159
  160%!  license(+License) is det.
  161%!  license(+License, +ModuleId) is det.
  162%
  163%   Register the current file under the given license restriction.
  164
  165license(License) :-
  166    (   prolog_load_context(file, File)
  167    ->  true
  168    ;   File = '<unknown file>'
  169    ),
  170    license(License, File).
  171
  172license(License, File) :-
  173    warn_if_unknown(License),
  174    assertz(licensed(License, File)).
  175
  176warn_if_unknown(License) :-
  177    license(License, _, _),
  178    !.
  179warn_if_unknown(License) :-
  180    print_message(warning, unknown_license(License)).
  181
  182%!  license is det.
  183%
  184%   Report current license situation
  185
  186license :-
  187    (setof(Module, gpled(Module), GPL)   -> true ; GPL  = []),
  188    (setof(Module, lgpled(Module), LGPL) -> true ; LGPL = []),
  189    findall(L-Modules,
  190            setof(Module, permissive(Module, L), Modules),
  191            Permissive),
  192    findall(L-Modules,
  193            setof(Module, proprietary(Module, L), Modules),
  194            Proprietary),
  195    print_message(informational, license(GPL,LGPL,Permissive,Proprietary)).
  196
  197gpled(Module) :-
  198    licensed(X, Module),
  199    license(X, gpl, _).
  200
  201lgpled(Module) :-
  202    licensed(X, Module),
  203    license(X, lgpl, _).
  204
  205permissive(Module, L) :-
  206    licensed(L, Module),
  207    license(L, permissive, _).
  208
  209proprietary(Module, L) :-
  210    licensed(L, Module),
  211    (   license(L, C, _)
  212    ->  C \== gpl,
  213        C \== lgpl,
  214        C \== permissive
  215    ;   true
  216    ).
  217
  218%!  known_licenses
  219%
  220%   Print all known licenses.
  221
  222known_licenses :-
  223    findall(license(Id,Compat,Atts),
  224            license(Id,Compat,Atts),
  225            Licenses),
  226    print_message(informational, known_licenses(Licenses)).
  227
  228
  229                 /*******************************
  230                 *             MESSAGES         *
  231                 *******************************/
  232
  233:- multifile
  234    prolog:message/3.  235
  236prolog:message(license(GPL,LGPL,Permissive,Proprietary)) -->
  237    license_message(GPL,LGPL,Permissive,Proprietary).
  238prolog:message(unknown_license(License)) -->
  239    [ 'The license "~w" is not known.  You can list the known '-[License], nl,
  240      'licenses using ?- known_licenses. or add information about this ',
  241      'license by extending license:license/3.'
  242    ].
  243prolog:message(known_licenses(Licenses)) -->
  244    [ 'The following license identifiers may be used in license/2',
  245      'and PL_license()'
  246    ],
  247    known_licenses(Licenses).
  248
  249%!  license_message(+GPL, +LGPL, +Proprietary)//
  250
  251license_message(GPL, LGPL, Permissive, Proprietary) -->
  252    license_message(GPL, LGPL, Permissive),
  253    proprietary_licenses(Proprietary).
  254
  255license_message([], [], Permissive) -->
  256    !,
  257    [ 'This program contains only components covered by permissive license', nl,
  258      'conditions. SWI-Prolog is covered by the Simplified BSD license:',
  259      nl, nl
  260    ],
  261    bsd2_license,
  262	permissive_licenses(Permissive).
  263license_message(GPL, _, _) -->
  264    { GPL \== [] },
  265    !,
  266    [ 'SWI-Prolog is covered by the Simplified BSD license:', nl, nl ],
  267    bsd2_license, [nl, nl],
  268    warn([ 'This program contains components covered by the GNU General', nl,
  269           'Public License, which therefore apply to the entire program.', nl,
  270           'These components are:', nl, nl
  271         ]),
  272    file_list(GPL).
  273license_message([], LGPL, _) -->
  274    !,
  275    [ 'SWI-Prolog is covered by the Simplified BSD license:', nl, nl ],
  276    bsd2_license, [nl, nl],
  277    warn([ 'This program contains components covered by the GNU Lesser', nl,
  278           'Public License.  Distribution of this program is subject to',  nl,
  279           'additional conditions.  These components are:', nl, nl
  280         ]),
  281    file_list(LGPL).
  282
  283
  284bsd2_license -->
  285    [ 'Redistribution and use in source and binary forms, with or without', nl,
  286      'modification, are permitted provided that the following conditions', nl,
  287      'are met:', nl,
  288      nl,
  289      '1. Redistributions of source code must retain the above copyright', nl,
  290      '   notice, this list of conditions and the following disclaimer.', nl,
  291      nl,
  292      '2. Redistributions in binary form must reproduce the above copyright', nl,
  293      '   notice, this list of conditions and the following disclaimer in', nl,
  294      '   the documentation and/or other materials provided with the', nl,
  295      '   distribution.', nl,
  296      nl,
  297      'THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS', nl,
  298      '"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT', nl,
  299      'LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS', nl,
  300      'FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE', nl,
  301      'COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,', nl,
  302      'INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,', nl,
  303      'BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;', nl,
  304      'LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER', nl,
  305      'CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT', nl,
  306      'LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN', nl,
  307      'ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE', nl,
  308      'POSSIBILITY OF SUCH DAMAGE.'
  309    ].
  310
  311permissive_licenses([]) --> !.
  312permissive_licenses([LM| LMs]) -->
  313    [ nl, nl,
  314      'This program contains other components with permissive licenses:',
  315      nl, nl
  316    ],
  317    permissive([LM| LMs]).
  318
  319permissive([]) --> [].
  320permissive([License-Modules|T]) -->
  321    license_title(License),
  322    license_url(License),
  323    [nl],
  324    file_list(Modules),
  325    (   {T==[]}
  326    ->  []
  327    ;   [nl],
  328        permissive(T)
  329    ).
  330
  331proprietary_licenses([]) --> !.
  332proprietary_licenses(List) -->
  333    warn([ nl,
  334           'This program contains components with proprietary licenses:',
  335           nl, nl
  336         ]),
  337    proprietary(List).
  338
  339proprietary([]) --> [].
  340proprietary([License-Modules|T]) -->
  341    license_title(License),
  342    license_url(License),
  343    [nl],
  344    file_list(Modules),
  345    (   {T==[]}
  346    ->  []
  347    ;   [nl],
  348        proprietary(T)
  349    ).
  350
  351license_title(License) -->
  352    {   license(License, _, Att),
  353        memberchk(comment(C), Att)
  354    ->  true
  355    ;   C = License
  356    },
  357    [ '  The following components are covered by the "~w" license'-[C] ].
  358
  359license_url(License) -->
  360    { license(License, _, Att),
  361      memberchk(url(URL), Att)
  362    },
  363    !,
  364    [ nl, '    (see ~w)'-[URL] ].
  365license_url(_) --> [].
  366
  367file_list([]) -->
  368    [].
  369file_list([H|T]) -->
  370    [ '    ~w'-[H], nl ],
  371    file_list(T).
  372
  373known_licenses([]) --> [].
  374known_licenses([H|T]) --> [nl,nl], known_license(H), known_licenses(T).
  375
  376known_license(license(ID, Compat, Atts)) -->
  377    { memberchk(comment(Comment), Atts) },
  378    !,
  379    [ '  ~w (category ~w): ~w'-[ID, Compat, Comment] ],
  380    license_url(ID).
  381known_license(license(ID, Compat, _)) -->
  382    [ '  ~w (category ~w)'-[ID, Compat] ],
  383    license_url(ID).
  384
  385warn([]) --> [].
  386warn([H|T]) --> warn1(H), warn(T).
  387
  388warn1(nl) --> !, [nl].
  389warn1(Line) --> [ansi([fg(red)], Line, [])].
  390warn1(Line-Args) --> [ansi([fg(red)], Line, Args)]