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