34
35:- module(license,
36 [ license/1, 37 license/2, 38 license/0, 39
40 known_licenses/0
41 ]).
42
43:- dynamic
44 licensed/2. 45
46:- multifile
47 license/3.
48
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
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
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
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, proprietary(Module, L), Modules),
191 Proprietary),
192 print_message(informational, license(GPL,LGPL,Proprietary)).
193
194gpled(Module) :-
195 licensed(X, Module),
196 license(X, gpl, _).
197
198lgpled(Module) :-
199 licensed(X, Module),
200 license(X, lgpl, _).
201
202proprietary(Module, L) :-
203 licensed(L, Module),
204 ( license(L, C, _)
205 -> C \== gpl,
206 C \== lgpl,
207 C \== permissive
208 ; true
209 ).
210
214
215known_licenses :-
216 findall(license(Id,Compat,Atts),
217 license(Id,Compat,Atts),
218 Licenses),
219 print_message(informational, known_licenses(Licenses)).
220
221
222 225
226:- multifile
227 prolog:message/3.
228
229prolog:message(license(GPL,LGPL,Proprietary)) -->
230 license_message(GPL,LGPL,Proprietary).
231prolog:message(unknown_license(License)) -->
232 [ 'The license "~w" is not known. You can list the known '-[License], nl,
233 'licenses using ?- known_licenses. or add information about this ',
234 'license by extending license:license/3.'
235 ].
236prolog:message(known_licenses(Licenses)) -->
237 [ 'The following license identifiers may be used in license/2',
238 'and PL_license()'
239 ],
240 known_licenses(Licenses).
241
243
244license_message(GPL, LGPL, Proprietary) -->
245 license_message(GPL, LGPL),
246 proprietary_licenses(Proprietary).
247
248license_message([],[]) -->
249 !,
250 [ 'This program contains no modules registered with non-permissive', nl,
251 'license conditions and is therefore covered by the Simplified BSD', nl,
252 'license:',
253 nl, nl
254 ],
255 bsd2_license.
256license_message(GPL,_) -->
257 { GPL \== [] },
258 !,
259 [ 'SWI-Prolog is covered by the Simplified BSD license:', nl, nl ],
260 bsd2_license, [nl, nl],
261 warn([ 'This program contains components covered by the GNU General', nl,
262 'Public License, which therefore apply to the entire program.', nl,
263 'These components are:', nl, nl
264 ]),
265 file_list(GPL).
266license_message([],LGPL) -->
267 !,
268 [ 'SWI-Prolog is covered by the Simplified BSD license:', nl, nl ],
269 bsd2_license, [nl, nl],
270 warn([ 'This program contains components covered by the GNU Lesser', nl,
271 'Public License. Distribution of this program is subject to', nl,
272 'additional conditions. These components are:', nl, nl
273 ]),
274 file_list(LGPL).
275
276
277bsd2_license -->
278 [ 'Redistribution and use in source and binary forms, with or without', nl,
279 'modification, are permitted provided that the following conditions', nl,
280 'are met:', nl,
281 nl,
282 '1. Redistributions of source code must retain the above copyright', nl,
283 ' notice, this list of conditions and the following disclaimer.', nl,
284 nl,
285 '2. Redistributions in binary form must reproduce the above copyright', nl,
286 ' notice, this list of conditions and the following disclaimer in', nl,
287 ' the documentation and/or other materials provided with the', nl,
288 ' distribution.', nl,
289 nl,
290 'THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS', nl,
291 '"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT', nl,
292 'LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS', nl,
293 'FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE', nl,
294 'COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,', nl,
295 'INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,', nl,
296 'BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;', nl,
297 'LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER', nl,
298 'CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT', nl,
299 'LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN', nl,
300 'ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE', nl,
301 'POSSIBILITY OF SUCH DAMAGE.'
302 ].
303
304proprietary_licenses([]) --> !.
305proprietary_licenses(List) -->
306 warn([ nl,
307 'This program contains components with proprietary licenses:',
308 nl, nl
309 ]),
310 proprietary(List).
311
312proprietary([]) --> [].
313proprietary([License-Modules|T]) -->
314 license_title(License),
315 license_url(License),
316 [nl],
317 file_list(Modules),
318 ( {T==[]}
319 -> []
320 ; [nl],
321 proprietary(T)
322 ).
323
324license_title(License) -->
325 { license(License, _, Att),
326 memberchk(comment(C), Att)
327 -> true
328 ; C = License
329 },
330 [ ' The following modules are covered by the "~w" license'-[C] ].
331
332license_url(License) -->
333 { license(License, _, Att),
334 memberchk(url(URL), Att)
335 },
336 !,
337 [ nl, ' (see ~w)'-[URL] ].
338license_url(_) --> [].
339
340file_list([]) -->
341 [].
342file_list([H|T]) -->
343 [ ' ~w'-[H], nl ],
344 file_list(T).
345
346known_licenses([]) --> [].
347known_licenses([H|T]) --> [nl,nl], known_license(H), known_licenses(T).
348
349known_license(license(ID, Compat, Atts)) -->
350 { memberchk(comment(Comment), Atts) },
351 !,
352 [ ' ~w (category ~w): ~w'-[ID, Compat, Comment] ],
353 license_url(ID).
354known_license(license(ID, Compat, _)) -->
355 [ ' ~w (category ~w)'-[ID, Compat] ],
356 license_url(ID).
357
358warn([]) --> [].
359warn([H|T]) --> warn1(H), warn(T).
360
361warn1(nl) --> !, [nl].
362warn1(Line) --> [ansi([fg(red)], Line, [])].
363warn1(Line-Args) --> [ansi([fg(red)], Line, Args)].