Annotation
35 |
36 | @author Wouter Beek
37 | @tbd Build annotation2post converter.
38 | @version 2014/01
39 | */
40 |
41 | :- use_module(generics).
42 | :- use_module(library(http/html_head)).
43 | :- use_module(library(http/html_write)).
44 | :- use_module(library(http/http_dispatch)).
45 | :- use_module(library(pldoc/doc_html), [object_ref//2]).
46 | :- use_module(object_support).
47 | :- use_module(post).
48 |
49 | :- html_resource(css('annotation.css'),
50 | [ requires([css('post.css')])
51 | ]).
52 |
53 | :- multifile
54 | prolog:doc_object_page_footer/2.
55 |
56 | :- http_handler(root(annotation), annotation_process, [prefix]).
57 |
58 | %% annotation_process(+Request)
59 | %
60 | % REST HTTP handler for /annotation/ID
61 | %
62 | % @tbd Where is this used for? This also seems to do a request
63 | % on ourselves. We'd like to avoid that.
64 |
65 | annotation_process(Request):-
66 | memberchk(method(get), Request),
67 | request_to_id(Request, annotation, Post), !,
68 | post(Post, id, Id),
69 | post(Post, about, Object),
70 | object_label(Object, Label),
71 | atomic_list_concat(['Annotation',Label], '--', Title),
72 | reply_html_page(
73 | wiki(Title),
74 | title(Title),
75 | \post(Id, [])).
76 | annotation_process(Request):-
77 | post_process(Request, annotation).
78 |
79 | %% annotation(+Object)//
80 | %
81 | % Show annotations for Object.
82 |
83 | annotation(Object) -->
84 | { ground(Object), !,
85 | ( prolog:doc_canonical_object(Object, Object2)
86 | -> true
87 | ; Object2 = Object
88 | ),
89 | find_posts(annotation, object_post(Object2), Ids)
90 | },
91 | html([\html_requires(css('annotation.css')),
92 | \posts(annotation, Object2, Ids, [])
93 | ]).
94 | annotation(_) --> [].
95 |
96 | object_post(About, Id) :-
97 | post(Id, object, About).
98 |
99 |
--------------------------------------------------------------------------------
/api.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Jan Wielemaker
4 | E-mail: J.Wielemaker@cs.vu.nl
5 | WWW: http://www.swi-prolog.org
6 | Copyright (C): 2020, VU University Amsterdam
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalidate any other reasons why the executable file might be covered by
27 | the GNU General Public License.
28 | */
29 |
30 | :- module(plweb_api,
31 | []).
32 | :- use_module(library(http/http_dispatch)).
33 | :- use_module(library(http/http_cors)).
34 | :- use_module(library(http/http_json)).
35 | :- use_module(library(http/http_parameters)).
36 | :- use_module(library(pldoc/man_index)).
37 | :- use_module(library(pldoc/doc_util)).
38 | :- use_module(library(prolog_code)).
39 | :- use_module(library(prolog_source)).
40 | :- use_module(library(apply)).
41 | :- use_module(library(error)).
42 | :- use_module(library(pairs)).
43 | :- use_module(library(option)).
44 |
45 | :- http_handler(root(doc_link), doc_link, []).
46 |
47 | %! doc_link(+Request)
48 | %
49 | % Get a link to the documentation for a predicate reference. This
50 | % hander may be used in two ways:
51 | %
52 | % - GET
53 | % Adding a parameter `for` providing the predicate you want
54 | % to have information about.
55 | % - POST
56 | % Passing a JSON list of strings. The reply is a JSON object
57 | % with for each string the corresponding reply object (`null`
58 | % if the predicate is not known).
59 |
60 | doc_link(Request) :-
61 | reply_options(Request, [get,post]),
62 | !.
63 | doc_link(Request) :-
64 | memberchk(method(post), Request),
65 | !,
66 | http_read_json_dict(Request, Atoms,
67 | [value_string_as(atom)]),
68 | cors_enable(Request, [methods([get,post])]),
69 | must_be(list(atom), Atoms),
70 | for_links(Atoms, Pairs),
71 | dict_create(Dict, json, Pairs),
72 | reply_json_dict(Dict).
73 | doc_link(Request) :-
74 | http_parameters(Request,
75 | [ for(For, [])
76 | ]),
77 | cors_enable(Request, [methods([get,post])]),
78 | ( for_link(For, Link)
79 | -> reply_json_dict(Link)
80 | ; reply_json_dict(null, [status(404)])
81 | ).
82 |
83 | for_links([], []).
84 | for_links([H|T0], [H-I|T]) :-
85 | ( for_link(H, I)
86 | -> true
87 | ; I = null
88 | ),
89 | for_links(T0, T).
90 |
91 | for_link(For, Info) :-
92 | atom_to_object(For, Obj),
93 | current_man_object(Obj),
94 | findall(Prop, obj_property(Obj, Prop), Props),
95 | format(string(URL),
96 | 'https://www.swi-prolog.org/pldoc/doc_for?object=~w',
97 | [For]),
98 | dict_pairs(Info, json, [url-URL|Props]).
99 |
100 | obj_property(Obj, summary-Summary) :-
101 | once(man_object_property(Obj, summary(Summary))).
102 | obj_property(PI, Prop) :-
103 | pi_head(PI, Head0),
104 | ( Head0 = M:_
105 | -> Head = Head0
106 | ; Head = M:Head0
107 | ),
108 | ( M=system,
109 | predicate_property(Head, iso)
110 | -> Prop = (class-iso)
111 | ; M=system,
112 | predicate_property(Head, built_in)
113 | -> Prop = (class-builtin)
114 | ; predicate_property(Head, autoload(File))
115 | -> ( Prop = (class-autoload)
116 | ; library_prop(File, Prop)
117 | )
118 | ; predicate_property(Head, file(File)),
119 | predicate_property(Head, exported)
120 | -> ( Prop = (class-library)
121 | ; library_prop(File, Prop)
122 | )
123 | ).
124 |
125 | library_prop(File, library-LibS) :-
126 | file_name_extension(File, pl, LibFile),
127 | file_name_on_path(LibFile, library(Lib)),
128 | format(string(LibS), '~w', [Lib]).
129 |
130 | %! reply_options(+Request, +Methods) is semidet.
131 | %
132 | % Reply the HTTP OPTIONS request
133 |
134 | reply_options(Request, Allowed) :-
135 | option(method(options), Request),
136 | !,
137 | cors_enable(Request,
138 | [ methods(Allowed)
139 | ]),
140 | format('Content-type: text/plain\r\n'),
141 | format('~n'). % empty body
142 |
--------------------------------------------------------------------------------
/blog.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Jan Wielemaker
4 | E-mail: jan@swi-prolog.org
5 | WWW: https://www.swi-prolog.org
6 | Copyright (C): 2020, SWI-Prolog Solutions b.v.
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalexpandidate any other reasons why the executable file might be
27 | covered by the GNU General Public License.
28 | */
29 |
30 | :- module(blog,
31 | []).
32 | :- use_module(library(http/html_head)).
33 | :- use_module(library(http/html_write)).
34 | :- use_module(library(http/http_dispatch)).
35 | :- use_module(library(debug)).
36 | :- use_module(library(yaml)).
37 | :- use_module(library(dcg/high_order)).
38 | :- use_module(library(apply)).
39 | :- use_module(library(lists)).
40 | :- use_module(library(pairs)).
41 | :- use_module(library(git)).
42 | :- use_module(library(option)).
43 | :- use_module(library(http/http_json)).
44 | :- use_module(library(http/http_host)).
45 | :- use_module(library(http/js_write)).
46 | :- use_module(library(uri)).
47 |
48 | :- use_module(wiki).
49 | :- use_module(messages).
50 | :- use_module(fastly).
51 | :- use_module(parms).
52 |
53 | :- http_handler(root(blog), blog, [prefix, id(blog)]).
54 |
55 | :- html_resource(pldoc_blog,
56 | [ ordered(true),
57 | requires([ jquery,
58 | js('blog.js')
59 | ]),
60 | virtual(true)
61 | ]).
62 | :- html_resource(css('blog.css'), []).
63 |
64 |
65 | blog(Request) :-
66 | memberchk(path_info(PathInfo), Request),
67 | PathInfo \== '/',
68 | !,
69 | debug(blog, 'Path info ~p', [PathInfo]),
70 | atom_concat(/, File, PathInfo),
71 | safe_file_name(File),
72 | absolute_file_name(blog(File), Path,
73 | [ access(read)
74 | ]),
75 | wiki_file_to_dom(Path, DOM0),
76 | extract_title(DOM0, Title, DOM1),
77 | append(DOM1, [\discourse(Request)], DOM),
78 | title_text(Title, TitleString),
79 | http_link_to_id(blog, [], HREF),
80 | reply_html_page(
81 | blog(Path, [a(href(HREF), 'Blog'), ': ' | Title]),
82 | [ title(TitleString)
83 | ],
84 | DOM).
85 | blog(_Request) :-
86 | blog_index(Blogs),
87 | reply_html_page(
88 | blog(index),
89 | [ title("SWI-Prolog blog")
90 | ],
91 | \blog_index_page(Blogs)).
92 |
93 | blog_index_page(Blogs) -->
94 | html_requires(pldoc_blog),
95 | html_requires(css('blog.css')),
96 | blog_index_title,
97 | blog_tags(Blogs),
98 | blog_index(Blogs).
99 |
100 | blog_index_title -->
101 | html({|html||
102 |
103 | The SWI-Prolog blog is intended for articles on how to tackle certain problems
104 | using SWI-Prolog, experience using SWI-Prolog for larger projects, etc. Posts
105 | can be submitted as pull-requests on
106 | GitHub.
107 | |}).
108 |
109 |
110 | %! blog_tags(+Blogs)//
111 |
112 | blog_tags(Blogs) -->
113 | { blog_tag_counts(Blogs, Counts) },
114 | html(div(class('blog-tags'), \sequence(tag, [' '], Counts))).
115 |
116 | tag(Tag-Count) -->
117 | html(span([ class('blog-tag'),
118 | 'data-tag'(Tag)
119 | ],
120 | [ span(class('blog-tag-tag'), Tag),
121 | span(class('blog-tag-cnt'), Count)
122 | ])).
123 |
124 | blog_tag_counts(Blogs, Pairs) :-
125 | convlist(get_dict(tags), Blogs, Tags),
126 | flatten(Tags, TagList0),
127 | msort(TagList0, TagList),
128 | clumped(TagList, Pairs0),
129 | sort(2, >=, Pairs0, Pairs).
130 |
131 | blog_index(Index) :-
132 | absolute_file_name(blog('Index.yaml'), File,
133 | [ access(read)
134 | ]),
135 | yaml_read(File, Index0),
136 | sort(date, @>=, Index0.posts, Index).
137 |
138 | blog_index(Blogs) -->
139 | { map_list_to_pairs(key_blog_year, Blogs, Tagged),
140 | group_pairs_by_key(Tagged, ByYear)
141 | },
142 | html(div(class('blog-index'),
143 | \sequence(blog_year, ByYear))).
144 |
145 | key_blog_year(Blog, Year) :-
146 | split_string(Blog.get(date), "-", "", [YS|_]),
147 | number_string(Year, YS).
148 |
149 | blog_year(Year-Blogs) -->
150 | html(div(class('blog-year-index'),
151 | [ div(class('blog-year'), Year),
152 | div(class('blog-year-entries'),
153 | \sequence(blog_index_entry, Blogs))
154 | ])).
155 |
156 | blog_index_entry(Blog) -->
157 | { atomics_to_string(Blog.get(tags,[]),"|",Tags),
158 | http_link_to_id(blog, path_postfix(Blog.file), HREF)
159 | },
160 | html(a([ class('blog-index-entry'),
161 | 'data-tags'(Tags),
162 | href(HREF)
163 | ],
164 | [ \block_date(Blog),
165 | \block_title(Blog)
166 | ])).
167 |
168 | block_date(Blog) -->
169 | optional(html(span(class('blog-index-date'),Blog.get(date))), []).
170 | block_title(Blog) -->
171 | optional(html(span(class('blog-index-title'),Blog.get(title))), []).
172 |
173 |
174 | /*******************************
175 | * DISCOURSE *
176 | *******************************/
177 |
178 | discourse(Request) -->
179 | { cdn_url(Request, URL) },
180 | html(div(id('discourse-comments'), [])),
181 | js_script({|javascript(URL)||
182 | window.DiscourseEmbed = { discourseUrl: 'https://swi-prolog.discourse.group/',
183 | discourseEmbedUrl: URL };
184 |
185 | (function() {
186 | var d = document.createElement('script'); d.type = 'text/javascript'; d.async = true;
187 | d.src = window.DiscourseEmbed.discourseUrl + 'javascripts/embed.js';
188 | (document.getElementsByTagName('head')[0] || document.getElementsByTagName('body')[0]).appendChild(d);
189 | })();
190 | |}).
191 |
192 |
193 | cdn_url(Request, CDNURL) :-
194 | memberchk(request_uri(ReqURL), Request),
195 | server(cdn, CDN, _),
196 | format(atom(CDNURL), 'https://~w~w', [CDN, ReqURL]).
197 |
198 |
199 | /*******************************
200 | * UPDATE *
201 | *******************************/
202 |
203 | %! pull_blogs
204 | %
205 | % Do a git pull on the blog repo
206 |
207 | pull_blogs :-
208 | ( absolute_file_name(blog(.), BlogDir,
209 | [ file_type(directory),
210 | access(write),
211 | solutions(all)
212 | ]),
213 | is_git_directory(BlogDir),
214 | git([pull], [directory(BlogDir)]),
215 | fail
216 | ; purge_location('/blog')
217 | ).
218 |
219 |
220 | /*******************************
221 | * HTTP *
222 | *******************************/
223 |
224 | :- http_handler(root(blog/pull), pull_blogs, []).
225 |
226 | pull_blogs(Request) :-
227 | ( option(method(post), Request)
228 | -> http_read_json(Request, JSON),
229 | print_message(informational, got(JSON))
230 | ; true
231 | ),
232 | call_showing_messages(pull_blogs, []).
233 |
--------------------------------------------------------------------------------
/changelog.pl:
--------------------------------------------------------------------------------
1 | :- module(changelog,
2 | [
3 | ]).
4 | :- use_module(library(settings)).
5 | :- use_module(library(process)).
6 | :- use_module(library(readutil)).
7 | :- use_module(library(http/http_dispatch)).
8 | :- use_module(library(http/http_parameters)).
9 | :- use_module(library(http/html_write)).
10 | :- use_module(wiki).
11 |
12 | :- setting(sources,
13 | atom,
14 | '~/src/swipl-devel',
15 | 'Sourced directory for getting changelog').
16 | :- setting(branches,
17 | list(any),
18 | [ development = 'origin/master',
19 | stable = 'stable/master'
20 | ],
21 | 'Branches displayed').
22 | :- setting(default_branch,
23 | atom,
24 | development,
25 | 'Default branch to show').
26 |
27 | :- http_handler(root('ChangeLog'), changelog, [pool(wiki)]).
28 |
29 | %% changelog(+Request)
30 | %
31 | % HTTP handler that shows the ChangeLog since a given version.
32 |
33 | changelog(Request) :-
34 | http_parameters(Request,
35 | [ from(VFrom, [optional(true)]),
36 | to(VTo, [optional(true)]),
37 | branch(Branch, [optional(true)])
38 | ]),
39 | defaults(VFrom, VTo, Branch),
40 | changelog_dom(VFrom-VTo, DOM),
41 | ( memberchk(h1(_, TitleParts), DOM)
42 | -> atomic_list_concat(TitleParts, Title)
43 | ; Title = 'SWI-Prolog ChangeLog'
44 | ),
45 | reply_html_page(pldoc(default),
46 | title(Title),
47 | [ \alt_branches(Branch), ', ',
48 | \alt_versions(Branch, VFrom, VTo)
49 | | DOM
50 | ]).
51 |
52 | defaults(VFrom, VTo, _Branch) :-
53 | nonvar(VFrom), nonvar(VTo), !.
54 | defaults(VFrom, VTo, Branch) :-
55 | ( var(Branch)
56 | -> setting(default_branch, Branch)
57 | ; true
58 | ),
59 | branch_versions(Branch, Versions),
60 | append(_, [VTo,VFrom|_], Versions), !.
61 |
62 | :- dynamic
63 | changelog_cache/2,
64 | changelog_seen/2.
65 |
66 | changelog_dom(Range, DOM) :-
67 | changelog_cache(Range, DOM), !,
68 | get_time(Now),
69 | retractall(changelog_seen(Range, _)),
70 | assertz(changelog_seen(Range, Now)).
71 | changelog_dom(Range, DOM) :-
72 | changelog(Range, Codes),
73 | wiki_file_codes_to_dom(Codes, -, DOM),
74 | assertz(changelog_cache(Range, DOM)),
75 | get_time(Now),
76 | assertz(changelog_seen(Range, Now)),
77 | clean_cached_changelogs(5).
78 |
79 | clean_cached_changelogs(Keep) :-
80 | repeat,
81 | predicate_property(changelog_cache(_,_), number_of_clauses(N)),
82 | ( N > Keep
83 | -> retract(changelog_seen(Range, _)),
84 | retractall(changelog_cache(Range, _)),
85 | fail
86 | ; !
87 | ).
88 |
89 | changelog(Range, Codes) :-
90 | setting(sources, SourceDir0),
91 | expand_file_name(SourceDir0, [SourceDir]),
92 | directory_file_path(SourceDir, 'scripts/mkchangelog', Script),
93 | range_arg(Range, Versions),
94 | setup_call_cleanup(
95 | process_create(Script, ['--wiki', Versions],
96 | [ stdout(pipe(Out)),
97 | cwd(SourceDir)
98 | ]),
99 | read_stream_to_codes(Out, Codes),
100 | close(Out)).
101 |
102 | range_arg(From-To, Versions) :-
103 | atomic_list_concat([From, To], '..', Versions).
104 | range_arg(From, From).
105 |
106 | %% alt_branches(+Current)// is det.
107 |
108 | alt_branches(Branch) -->
109 | { setting(branches, Branches),
110 | maplist(arg(1), Branches, Aliases)
111 | },
112 | html(b('Branch:')),
113 | ( { select(Branch, Aliases, Switch) }
114 | -> ( { Switch \== [] }
115 | -> html([' ', Branch, ' (switch to ' | \branches(Switch)]),
116 | html(')')
117 | ; []
118 | )
119 | ; branches(Aliases)
120 | ).
121 |
122 | branches([]) --> [].
123 | branches([H|T]) --> branch(H), branches(T).
124 |
125 | branch(B) -->
126 | { http_link_to_id(changelog, [branch(B)], HREF)
127 | },
128 | html([' ', a(href(HREF), B)]).
129 |
130 | alt_versions(Branch, _VFrom, _VTo) -->
131 | { var(Branch) }, !.
132 | alt_versions(Branch, VFrom, VTo) -->
133 | { branch_versions(Branch, Versions),
134 | http_link_to_id(changelog, [], Action)
135 | },
136 | html([ form([action(Action), style('display:inline')],
137 | [ input([type(hidden), name(branch), value(Branch)]),
138 | b('version'),' ',
139 | \select(from, Versions, VFrom),
140 | b(' to version '),
141 | \select(to, Versions, VTo), ' ',
142 | input([ type(submit),
143 | value('Update')
144 | ])
145 | ])
146 | ]).
147 |
148 | select(Name, Values, Selected) -->
149 | html(select(name(Name), \values(Values, Selected))).
150 |
151 | values([], _) --> [].
152 | values([H|T], Selected) --> value(H, Selected), values(T, Selected).
153 |
154 | value(V, V) --> !,
155 | html(option([selected], V)).
156 | value(V, _) -->
157 | html(option(V)).
158 |
159 | %% versions(Branch, Versions) is det.
160 | %
161 | % Retrieve the versions that are available for Branch.
162 |
163 | :- dynamic
164 | version_cache/3. % Branch, Retrieved, Versions
165 |
166 | branch_versions(Alias, Versions) :-
167 | setting(branches, Map),
168 | memberchk(Alias=Branch, Map),
169 | versions(Alias, Branch, Versions).
170 |
171 | versions(_, Branch, Versions) :-
172 | version_cache(Branch, Retrieved, Versions),
173 | get_time(Now),
174 | Now-Retrieved < 600, !.
175 | versions(Alias, Branch, Versions) :-
176 | retractall(version_cache(Branch, _, _)),
177 | versions_no_cache(Branch, AllVersions),
178 | include(branch_version(Alias), AllVersions, Versions),
179 | get_time(Now),
180 | assertz(version_cache(Branch, Now, Versions)).
181 |
182 | versions_no_cache(Branch, Versions) :-
183 | git_repo(Repo),
184 | git_tags_on_branch(Repo, Branch, Tags),
185 | tags_versions(Tags, Versions).
186 |
187 | tags_versions([], []).
188 | tags_versions([H|T], Versions) :-
189 | atomic_list_concat(Tags, ', ', H),
190 | ( Tags = [Tag]
191 | -> ( atom_concat('V', Version, Tag)
192 | -> Versions = [Version|VT],
193 | tags_versions(T, VT)
194 | ; tags_versions(T, Versions)
195 | )
196 | ; append(Tags, T, AllTags),
197 | tags_versions(AllTags, Versions)
198 | ).
199 |
200 | git_repo(Repo) :-
201 | setting(sources, SourceDir0),
202 | expand_file_name(SourceDir0, [Repo]).
203 |
204 | %% branch_version(+BranchAlias, +Version)
205 | %
206 | % True if Version is a stable version
207 |
208 | branch_version(stable, Version) :- !,
209 | atomic_list_concat([_Major,MinorAtom,_Patch], '.', Version),
210 | atom_number(MinorAtom, Minor),
211 | Minor mod 2 =:= 0.
212 | branch_version(_, _).
213 |
--------------------------------------------------------------------------------
/changes.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Jan Wielemaker
4 | E-mail: J.Wielemaker@cs.vu.nl
5 | WWW: http://www.swi-prolog.org
6 | Copyright (C): 2019, VU University Amsterdam
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalidate any other reasons why the executable file might be covered by
27 | the GNU General Public License.
28 | */
29 |
30 | :- module(plweb_changes,
31 | [ load_changes/2, % +GitDir, +Revisions
32 | changes/2 % +About, -Changes
33 | ]).
34 | :- use_module(library(git)).
35 | :- use_module(library(dcg/basics)).
36 | :- use_module(library(debug)).
37 |
38 | /** Examine changelog entries relevant for a predicate
39 |
40 | This is some demo code to extract changelog entries that mention a
41 | particular predicate. The aim is to use this in the online manual to
42 | inform people about relevant changes.
43 | */
44 |
45 | :- dynamic changelog/5. % Commit, Version, About, Level, Subject
46 |
47 | :- debug(changelog).
48 |
49 | load_changes :-
50 | load_changes('..', 'V5.6.0..').
51 |
52 | load_changes(Dir, Revisions) :-
53 | retractall(changelog(_,_,_,_,_)),
54 | git_shortlog(Dir, Logs, [revisions(Revisions)]),
55 | length(Logs, Len),
56 | debug(changelog, 'Processing ~D commits', [Len]),
57 | process_logs(Logs, 'HEAD'),
58 | predicate_property(changelog(_,_,_,_,_), number_of_clauses(N)),
59 | debug(changelog, 'Extracted ~D records', [N]).
60 |
61 | process_logs([], _).
62 | process_logs([H|T], Version0) :-
63 | update_version(H, Version0, Version),
64 | parse_commit(H, Level, Abouts),
65 | ( Abouts \== []
66 | -> git_log_data(commit_hash, H, Commit),
67 | git_log_data(subject, H, Subject),
68 | forall(member(About, Abouts),
69 | assertz(changelog(Commit, Version, About, Level, Subject)))
70 | ; true
71 | ),
72 | process_logs(T, Version).
73 |
74 | update_version(Commit, _Version0, Version) :-
75 | git_log_data(ref_names, Commit, RefNames),
76 | member(RefName, RefNames),
77 | string_concat("tag: V", Nr, RefName),
78 | split_string(Nr, ".", "", NumS),
79 | maplist(number_string, [Major, Minor, Patch], NumS),
80 | !,
81 | Version is 10000*Major+100*Minor+Patch.
82 | update_version(_, Version, Version).
83 |
84 | parse_commit(Commit, Level, Abouts) :-
85 | git_log_data(subject, Commit, Subject),
86 | string_codes(Subject, Codes),
87 | phrase(subject(Level, Abouts), Codes).
88 |
89 | subject(Level, Abouts) -->
90 | level(Level),
91 | abouts(Abouts0),
92 | { sort(Abouts0, Abouts)
93 | }.
94 |
95 | level(Level) -->
96 | capitals(List), ":",
97 | { List \== [] },
98 | !,
99 | { string_codes(S, List),
100 | downcase_atom(S, Level)
101 | }.
102 | level(unclassified) -->
103 | [].
104 |
105 | abouts([H|T]) --> about(H), !, abouts(T).
106 | abouts([]) --> remainder(_).
107 |
108 | about(Name/Arity) -->
109 | string(_),
110 | blank,
111 | prolog_identifier(Name),
112 | arity(Arity),
113 | !.
114 |
115 | prolog_identifier(Name) -->
116 | [C0], { code_type(C0, prolog_atom_start) }, !,
117 | prolog_id_cont(CL),
118 | { atom_codes(Name, [C0|CL]) }.
119 |
120 | prolog_id_cont([H|T]) -->
121 | [H], { code_type(H, prolog_identifier_continue) }, !,
122 | prolog_id_cont(T).
123 | prolog_id_cont([]) --> "".
124 |
125 | arity(Arity) --> "//", nonneg(A0), !, { Arity is A0+2 }.
126 | arity(Arity) --> "/", nonneg(Arity).
127 |
128 |
129 | capitals([H|T]) --> capital(H), !, capitals(T).
130 | capitals([]) --> [].
131 |
132 | capital(H) --> [H], { between(0'A, 0'Z, H) }.
133 |
134 | nonneg(I) --> int_codes(Codes), { number_codes(I, Codes) }.
135 |
136 | int_codes([D0|D]) --> digit(D0), digits(D).
137 |
138 |
139 | /*******************************
140 | * QUERY *
141 | *******************************/
142 |
143 | changes(About, Commits) :-
144 | findall(commit(Commit, Version, Level, Subject),
145 | changelog(Commit, Version, About, Level, Subject),
146 | Commits).
147 |
148 |
--------------------------------------------------------------------------------
/contents.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Jan Wielemaker
4 | E-mail: J.Wielemaker@cs.vu.nl
5 | WWW: http://www.swi-prolog.org
6 | Copyright (C): 2013, VU University Amsterdam
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalidate any other reasons why the executable file might be covered by
27 | the GNU General Public License.
28 | */
29 |
30 | :- module(man_contents,
31 | []).
32 | :- use_module(library(pldoc/doc_man)).
33 | :- use_module(library(pldoc/doc_html)).
34 | :- use_module(library(http/html_write)).
35 | :- use_module(library(http/http_dispatch)).
36 |
37 | :- http_handler(root(contents), contents, []).
38 |
39 | /** Documentation contents as a hierarchy
40 | */
41 |
42 | contents(_Request) :-
43 | reply_html_page(
44 | pldoc(tree),
45 | title('SWI-Prolog manual'),
46 | html(\contents([ secref_style(title)
47 | ]))).
48 |
49 | %% contents(+Options)//
50 | %
51 | % Emit a =ul= hierarchy of the entire manual, including the
52 | % packages.
53 |
54 | contents(Options) -->
55 | html(ul([ \refman_contents(swi('doc/Manual'), Options),
56 | \package_contents(Options)
57 | ])).
58 |
59 | refman_contents(Dir, Options) -->
60 | { man_content_tree(Dir, Tree)
61 | },
62 | man_tree(Tree, Options).
63 |
64 | package_contents(Options) -->
65 | { man_packages_tree(Tree)
66 | },
67 | man_tree(Tree, Options).
68 |
69 | man_tree(node(Obj, Children), Options) -->
70 | html(li(\contents_link(Obj, Options))),
71 | ( { Children == [] }
72 | -> []
73 | ; html(ul(\man_children(Children, Options)))
74 | ).
75 | man_tree(Obj, Options) -->
76 | html(li(\contents_link(Obj, Options))).
77 |
78 | man_children([], _) --> [].
79 | man_children([H|T], Options) --> man_tree(H, Options), man_children(T, Options).
80 |
81 | contents_link(manual, _) --> !,
82 | { http_link_to_id(pldoc_root, [], HREF) },
83 | html(a(href(HREF), 'Base system')).
84 | contents_link(packages, _) --> !,
85 | { http_link_to_id(pldoc_index, [], HREF) }, % wrong link
86 | html(a(href(HREF), 'Packages')).
87 | contents_link(Obj, Options) -->
88 | object_ref(Obj, Options).
89 |
--------------------------------------------------------------------------------
/customise.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Jan Wielemaker
4 | E-mail: J.Wielemaker@cs.vu.nl
5 | WWW: http://www.swi-prolog.org
6 | Copyright (C): 2009, VU University Amsterdam
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalidate any other reasons why the executable file might be covered by
27 | the GNU General Public License.
28 | */
29 |
30 | :- module(plweb_customise,
31 | [
32 | ]).
33 | :- include(library(pldoc/hooks)).
34 |
35 | prolog:doc_places_menu(_) -->
36 | [].
37 |
--------------------------------------------------------------------------------
/daemon.pl:
--------------------------------------------------------------------------------
1 | :- use_module(library(http/http_log)).
2 |
3 | % Avoid that XPCE creates a thread because that stops us forking.
4 | :- set_prolog_flag(xpce_threaded, false).
5 | :- [load].
6 |
7 | :- http_schedule_logrotate(monthly(1, 04:00),
8 | [ keep_logs(6)
9 | ]).
10 | % library(http/http_unix_daemon) is loaded when loading the library
11 | :- initialization(http_daemon, main).
12 |
13 |
--------------------------------------------------------------------------------
/daemon.sh:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 | ### BEGIN INIT INFO
3 | # Provides: swipl-website
4 | # Required-Start: $local_fs $remote_fs $network $syslog $named
5 | # Required-Stop: $local_fs $remote_fs $network $syslog $named
6 | # Default-Start: 2 3 4 5
7 | # Default-Stop: 0 1 6
8 | # X-Interactive: true
9 | # Short-Description: Start/stop SWI-Prolog web server
10 | ### END INIT INFO
11 |
12 | # Installation
13 | #
14 | # 1. Copy this file to /etc/init.d/
15 | # 2. Edit the Configuration section below
16 | # 3. Run
17 | # % update-rc.d defaults
18 | # % /etc/init.d/ start
19 |
20 | # Configuration section
21 | #
22 | SWIPL=/home/janw/bin/swipl
23 | DIR=/home/janw/src/plweb
24 | SCRIPT=daemon.pl
25 | USER=www
26 | PORT=80
27 | DAEMONARGS=
28 |
29 | # Uncomment to only listen for connections from localhost
30 | # DAEMONARGS="$DAEMONARGS --ip=localhost"
31 |
32 | HTTPID=swipl-httpd-$PORT
33 | PIDFILE=/var/run/$HTTPID.pid
34 | SYSLOG=$HTTPID
35 |
36 | # End of normal configuration
37 |
38 | . /lib/lsb/init-functions
39 | test -f /etc/default/rcS && . /etc/default/rcS
40 |
41 | DAEMONARGS="$DAEMONARGS --port=$PORT --user=$USER --fork"
42 | if [ ! -z "$SYSLOG" ]; then DAEMONARGS="$DAEMONARGS --syslog=$SYSLOG"; fi
43 | if [ ! -z "$PIDFILE" ]; then DAEMONARGS="$DAEMONARGS --pidfile=$PIDFILE"; fi
44 |
45 | pidofserver()
46 | { if [ -f "$PIDFILE" ]; then
47 | cat "$PIDFILE"
48 | else
49 | ps aux | grep "[0-9] *$SWIPL.*--port=$PORT" 2>/dev/null | awk '{print $2}'
50 | fi
51 | }
52 |
53 | running()
54 | { if [ -z "$1" ]; then return 1; fi
55 |
56 | if kill -0 $1 2> /dev/null; then
57 | return 0
58 | else
59 | return 1
60 | fi
61 | }
62 |
63 | waitserver()
64 | { i=0;
65 |
66 | while running $1; do
67 | if [ $i = '60' ]; then
68 | return 1;
69 | else
70 | if [ $i = '0' ]; then
71 | echo -n " ... waiting "
72 | else
73 | echo -n "."
74 | fi
75 | i=$(($i+1))
76 | sleep 1
77 | fi
78 | done
79 | }
80 |
81 | case $1 in
82 | start)
83 | log_daemon_msg "Starting web server" "$HTTPID"
84 | if (cd $DIR && $SWIPL -q -f $SCRIPT -- $DAEMONARGS); then
85 | log_end_msg 0
86 | else
87 | log_end_msg 1
88 | fi
89 | ;;
90 | stop)
91 | log_daemon_msg "Stopping web server" "$HTTPID"
92 | PID=$(pidofserver)
93 | kill $PID
94 | if waitserver $PID; then
95 | log_end_msg 0
96 | else
97 | kill -9 $PID
98 | waitserver $PID
99 | fi
100 | ;;
101 | reload)
102 | PID=$(pidofserver)
103 | kill -HUP $PID
104 | ;;
105 | restart)
106 | $0 stop && $0 start
107 | ;;
108 | status)
109 | PID=$(pidofserver)
110 | if running "$PID"; then
111 | echo "SWI-Prolog HTTP server is running (pid $PID)."
112 | exit 0
113 | else
114 | echo "SWI-Prolog HTTP server is NOT running."
115 | if [ -e $PIDFILE ]; then
116 | exit 1
117 | else
118 | exit 3
119 | fi
120 | fi
121 | ;;
122 | *)
123 | log_success_msg "Usage: /etc/init.d/swipl-httpd {start|stop|restart|status}"
124 | exit 1
125 | esac
126 |
--------------------------------------------------------------------------------
/debug.pl:
--------------------------------------------------------------------------------
1 | % Debug file for project `plweb`.
2 | user:debug_project.
3 |
4 | %:- initialization(init_plweb).
5 | %init_plweb:-
6 | % source_file(init_plweb, ThisFile),
7 | % file_directory_name(ThisFile, ThisDir),
8 | % assert(user:file_search_path(plweb, ThisDir)).
9 |
10 | % Print code strings with their code table replacements.
11 | :- use_module(library(portray_text)).
12 | :- portray_text(true).
13 | :- set_portray_text(ellipsis, 100).
14 |
15 | % Enforce more stringent style checking.
16 | :- style_check(+atom).
17 | :- style_check(+charset).
18 | :- style_check(+discontiguous).
19 | :- style_check(+no_effect).
20 | :- style_check(+singleton).
21 | %:- style_check(+var_branches).
22 |
23 | % Notice this gives information to hackers
24 | % when loaded from within a production environment!
25 | :- use_module(library(http/http_error)).
26 |
27 | % This library allows for exploiting the color and attribute facilities
28 | % of most modern terminals using ANSI escape sequences.
29 | % The Windows console (swipl-win) does not (yet) support ANSI (color) codes.
30 | :- use_module(library(ansi_term)).
31 |
32 | % PCE-based debug monitor.
33 | %:- use_module(library(swi_ide)).
34 | %:- prolog_ide(debug_monitor).
35 |
36 | % Make some debug message categories visible.
37 | :- use_module(library(debug)).
38 | :- debug(plweb).
39 |
40 | % Run unit tests, unless compiled with optimisation turned on.
41 | :- use_module(library(plunit)).
42 | :- set_test_options([load(normal),run(manual)]).
43 | %:- set_test_options([load(normal),run(make(all))]).
44 |
45 | :- [load].
46 | :- server.
47 |
48 | %:- use_module(library(settings)).
49 | %:- set_setting_default(http:public_host, localhost).
50 | %:- set_setting_default(http:public_port, setting(http:port)).
51 |
52 | :- use_module(library(settings)).
53 | :- set_setting_default(
54 | recaptcha:public_key,
55 | '6LeRb-wSAAAAAAAMSfqiceu8u7QHOsfe4WOBJL44'
56 | ).
57 | :- set_setting_default(
58 | recaptcha:private_key,
59 | '6LeRb-wSAAAAAM9IwyUZBtSvbK38kTjUn5xJhpha'
60 | ).
61 |
62 |
--------------------------------------------------------------------------------
/doc/Examples.md:
--------------------------------------------------------------------------------
1 | # Adding examples to the SWI-Prolog website
2 |
3 | ## An Example is a markdown file
4 |
5 | ----------------------------------------------------------------
6 | # Title
7 |
8 | Bla bla
9 |
10 | ```
11 | Code
12 | ```
13 |
14 | ```
15 | ?- query
16 | ```
17 |
18 | @see p/1, p/2, library(x)
19 | ----------------------------------------------------------------
20 |
21 | ## Indexing
22 |
23 | - If @see, link to the predicate indicators and libraries listed
24 | - Else, scan the code and find it
25 |
26 | ## Display
27 |
28 | - Code rendered using htmlsrc when possible.
29 | - Extend to link goals.
30 |
31 | ## Include in the website
32 |
33 | - Show shortest if < N lines
34 | - Show max M others as carousel
35 | - _Show all all_ to fill carousel
36 |
37 | Show only fragment containing predicate from a more extensive example
38 | with _view all_?
39 |
40 | Embedded SWISH like LPN?
41 |
42 |
43 |
44 | ## Import/export to SWISH
45 |
46 | - Sequence of markdown and code blocks.
47 |
--------------------------------------------------------------------------------
/docker/Dockerfile:
--------------------------------------------------------------------------------
1 | FROM debian:bookworm-slim
2 |
3 | RUN apt-get update && apt-get install -y --no-install-recommends \
4 | git curl ca-certificates unzip \
5 | build-essential cmake autoconf ninja-build pkg-config \
6 | gdb \
7 | cleancss node-requirejs uglifyjs \
8 | ncurses-dev libreadline-dev libedit-dev \
9 | libgoogle-perftools-dev \
10 | libgmp-dev \
11 | libssl-dev \
12 | unixodbc-dev \
13 | zlib1g-dev libarchive-dev \
14 | libossp-uuid-dev \
15 | libxext-dev libice-dev libjpeg-dev libxinerama-dev libxft-dev \
16 | libxpm-dev libxt-dev \
17 | libdb-dev \
18 | libpcre2-dev \
19 | libyaml-dev \
20 | libpython3-dev \
21 | default-jdk junit4 \
22 | libssh-dev openssh-client \
23 | locales
24 |
25 | RUN sed -i -e 's/# en_GB.UTF-8 UTF-8/en_GB.UTF-8 UTF-8/' /etc/locale.gen && \
26 | locale-gen
27 | ENV LC_ALL en_GB.UTF-8
28 | ENV LANG en_GB.UTF-8
29 | ENV LANGUAGE en_GB:en
30 |
31 | # Primary build
32 |
33 | ENV REBUILD_MOST 4
34 | RUN mkdir -p /usr/local/src && cd /usr/local/src && \
35 | git clone --recursive https://github.com/SWI-Prolog/swipl-devel.git && \
36 | cd swipl-devel && mkdir build && cd build && \
37 | cmake -DCMAKE_INSTALL_PREFIX=/usr -DCMAKE_BUILD_TYPE=PGO -DSWIPL_DOC_SERVER=ON -G Ninja .. && \
38 | ninja && ninja install
39 |
40 | ENV REBUILD_PLWEB 5
41 | RUN mkdir -p /srv && cd /srv && \
42 | git clone https://github.com/SWI-Prolog/plweb.git && \
43 | cd /srv/plweb && \
44 | git submodule update --init packs/googleclient \
45 | packs/recaptcha \
46 | packs/smtp \
47 | packs/libssh
48 |
49 | RUN cd /srv/plweb && \
50 | SWIPL_PACK_PATH=packs swipl -g pack_rebuild -t halt
51 |
52 | RUN cd /usr/local/src/swipl-devel && \
53 | git remote add stable https://github.com/SWI-Prolog/swipl.git && \
54 | git fetch stable
55 |
56 | # Update. Run `make update-plweb` or `make update-swipl` to update
57 | # the `ENV` command below and redo the relevant part of the build
58 |
59 | ENV SWIPL_VERSION Wed 31 Jan 2024 06:17:31 PM CET
60 | RUN git config --global pull.ff only
61 | RUN cd /usr/local/src/swipl-devel && (git pull || git pull) && \
62 | git fetch stable && \
63 | git submodule update --init && \
64 | find build -name '*.qlf' | xargs rm && \
65 | cd build && rm -rf home && cmake . && ninja && \
66 | ninja install
67 | ENV PLWEB_VERSION Sun Feb 11 10:09:26 AM CET 2024
68 | RUN cd /srv/plweb && (git pull || git pull) && \
69 | git submodule update
70 |
71 | # Running
72 |
73 | copy health.sh health.sh
74 | HEALTHCHECK --interval=30s --timeout=2m --start-period=1m CMD /health.sh
75 |
76 | COPY start-plweb.sh /srv/start-plweb.sh
77 |
78 | ENV PLWEB_DATA /srv/plweb/data
79 | ENV PLWEB_HOME /srv/plweb
80 | VOLUME ${PLWEB_DATA}
81 | WORKDIR ${PLWEB_HOME}
82 |
83 | ENTRYPOINT ["/srv/start-plweb.sh"]
84 |
--------------------------------------------------------------------------------
/docker/Makefile:
--------------------------------------------------------------------------------
1 | RESTART=--restart unless-stopped
2 | VOLUME=$(shell cd .. && pwd)/data
3 | PORT=3400
4 |
5 | PUBLISH=--publish=${PORT}:3400 --publish=3420:2022
6 | DOPTS=${PUBLISH} -v ${VOLUME}:/srv/plweb/data
7 | IMG=plweb
8 |
9 | all:
10 | @echo "Targets"
11 | @echo
12 | @echo "image Build the plweb image"
13 | @echo "run Run the image (detached)"
14 | @echo "restart Stop and restart the image"
15 | @echo
16 | @echo "update-mostly Rebuild most except for the OS"
17 | @echo "update-swipl Rebuild swipl and plweb"
18 | @echo "update-plweb Rebuild plweb"
19 |
20 | image::
21 | docker build -t $(IMG) .
22 |
23 | run:
24 | docker run --name=plweb -d ${RESTART} ${DOPTS} $(IMG)
25 |
26 | restart:
27 | docker stop plweb
28 | docker rm plweb
29 | make run
30 |
31 | bash:
32 | docker run -it ${DOPTS} $(IMG) --bash
33 |
34 | update-plweb:
35 | sed -i "s/PLWEB_VERSION.*/PLWEB_VERSION $$(date)/" Dockerfile
36 | make image
37 |
38 | update-swipl:
39 | sed -i "s/SWIPL_VERSION.*/SWIPL_VERSION $$(date)/" Dockerfile
40 | make image
41 |
42 | update-mostly:
43 | sed -i "s/REBUILD_MOST.*/REBUILD_MOST $$(date)/" Dockerfile
44 | make image
45 |
46 |
--------------------------------------------------------------------------------
/docker/README.md:
--------------------------------------------------------------------------------
1 | # A SWISH (SWI-Prolog for SHaring) docker
2 |
3 | This repository provides a [Docker](https://www.docker.com/) image for
4 | the [public swish instance](https://swish.swi-prolog.org). This image
5 | is similar to the normal [SWISH](https://hub.docker.com/r/swipl/swish/)
6 | Docker image. However, it is based on the GIT version of Prolog and
7 | contains several additional packages such as CHAT80 and Wordnet.
8 |
9 | ## Building the image
10 |
11 | The image is built by running
12 |
13 | make image
14 |
15 | ## Running the image
16 |
17 | > Needs to be updated
18 |
19 | The image may be used in many configurations, both controlled by docker
20 | options and options to the entry point. As basic operation typically
21 | already requires publishing ports and setting up a volume for the data,
22 | we added a bash script `swish.sh` that automates the common scenarios by
23 | providing `docker run` options from defaults and provided options. When
24 | called with `-n`, as in `./swish.sh -n option ...`, it merery prints the
25 | docker command it will execute. The following options are processed:
26 |
27 | - `--port=N`
28 | Modify the `-p` option to `-p N:3050`. Default is 3050.
29 | - `--data=dir`
30 | Mount the given directory as data. Default is the working
31 | directory.
32 | - `--with-R[=from]`
33 | Add `--volumes-from from` where _from_ defaults to `rserve`
34 | to connect to an
35 | [R docker image](https://github.com/JanWielemaker/rserve-sandbox)
36 | - `-n`
37 | Just print the docker command that will be executed.
38 | - `-d`
39 | Detach from the terminal
40 | - `-it`
41 | Pass on (interactive)
42 |
43 | All remaining options are passed to the entry point of the image.
44 |
45 | ### Data
46 |
47 | The docker image maintains its data (user programs and configuration) on
48 | the _volume_ `/data`. This may be mapped to a host directory using the
49 | docker `-v` options (see also the `--data=dir` option of `swish.sh`).
50 |
51 | Within the data directory, SWISH manages the following items:
52 |
53 | - **config-enabled** is a directory where the configuration is stored.
54 | If it doesn't exist it is created and filled with a default
55 | configuration that depends on the provided options. The directory
56 | and its files have the same owner and group as the root of the managed
57 | volume.
58 |
59 | - **data** is the directory where all dynamic user data is maintained.
60 | If the directory exists, the SWISH server is started with the user and
61 | group of the directory. If it doesn't exist the directory is created
62 | as owned by `daemon.daemon` and the server is started with these
63 | credentials.
64 |
65 | - **https** If the `--https` option is passed, it creates or reuses
66 | this directory and the files `server.crt` and `server.key`. The
67 | created certificate is _self-signed_.
68 |
69 | - **passwd** If authenticated mode is enabled, this file maintains
70 | the users and password hashes.
71 |
72 |
73 | ### Network access
74 |
75 | The container creates a server at port `3050`. By default this is an
76 | HTTP server. If `run swish --https` is used, an HTTPS
77 | server is started.
78 |
79 |
80 | ### The entry point
81 |
82 | The entry point of the containser is `/entry.sh`, a shell script that
83 | initialises the data volume if needed and starts the server. It accepts
84 | the following options:
85 |
86 | - `--bash`
87 | Instead of starting the server, start a bash shell. Terminate after
88 | bash completes.
89 |
90 | - `--help`
91 | Emit short help.
92 |
93 |
94 | ### Configuration
95 |
96 | The SWISH configuration is controlled by files in the `config-enabled`
97 | directory. Several commands may be used to control the configuration.
98 | These are executed as below:
99 |
100 | ```
101 | docker run -it swish option ...
102 | ```
103 |
104 | Multiple configuration options may be passed to update multiple facets
105 | of the configuration. Normally the image stops after updating the
106 | configuration. If `--run` is added the entry point starts the server
107 | after updating the configuration.
108 |
109 | The options provided are:
110 |
111 | - `--list-config`
112 | List installed and available configuration items. If an item is
113 | installed, indicate whether it is modified.
114 |
115 | - `--auth=type`
116 | Change the configured authentication scheme. This is one of
117 |
118 | - `always`
119 | Run in fully _authenticated_ mode, forcing the user to login
120 | and allowing to execute arbitrary commands. When executed for
121 | the first time, docker must be run _interactively_ (`run -it`)
122 | to create the first user. Additional users are created using
123 |
124 | `docker run -it swish --add-user`.
125 |
126 | - `social`
127 | Use _social_ login. By default enables optional http login,
128 | login using google and stackoverflow. Both need to be further
129 | configured by editing `config-enabled/auth_google.pl` and
130 | `config-enabled/auth_stackoverflow.pl`
131 |
132 | - `anon` (or anonymous)
133 | This is the initial default, providing fully anonymous login,
134 | executing only sandboxed Prolog queries.
135 |
136 | - `--add-config file ...`
137 | Add one or more configuration files by copying them from the
138 | available configuration directory.
139 |
140 | - `--add-user`
141 | Add a new user to the HTTP authentication. Prompts for user name,
142 | email, group (unused, use `users`) and password.
143 |
144 | - `--https`
145 | Create an HTTPS server. This uses the certificate from the
146 | `https` directory (see above). If no certificate exists, a
147 | self-signed certificate is created. The details may be refined
148 | using `--CN=host`, `--O=organization` and `--C=country`
149 |
150 | ## Starting R
151 |
152 | docker pull swipl/rserve
153 | docker run -d --net=none --name=rserve --restart unless-stopped swipl/rserve
154 |
155 |
--------------------------------------------------------------------------------
/docker/health.sh:
--------------------------------------------------------------------------------
1 | #!/bin/bash
2 | exec &> health.log
3 |
4 | check()
5 | { auth=
6 | if [ -r health.auth ]; then
7 | auth="$(cat health.auth)"
8 | fi
9 | curl --fail -s --retry 3 --max-time 5 \
10 | http://localhost:3400/health
11 | return $?
12 | }
13 |
14 | stop()
15 | { pid=1
16 | echo "Health check failed. Killing swish with SIGTERM"
17 | kill -s TERM 1 $pid
18 | timeout 10 tail --pid=$pid -f /dev/null
19 | if [ $? == 124 ]; then
20 | echo "Gracefull termination failed. Trying QUIT"
21 | kill -s QUIT $pid
22 | timeout 10 tail --pid=$pid -f /dev/null
23 | if [ $? == 124 ]; then
24 | echo "QUIT failed. Trying KILL"
25 | kill -s KILL $pid
26 | fi
27 | fi
28 | echo "Done"
29 | }
30 |
31 | starting()
32 | { if [ -f /var/run/epoch ]; then
33 | epoch=$(cat /var/run/epoch)
34 | running=$(($(date "+%s") - $epoch))
35 | [ $running -gt 60 ] || return 1
36 | fi
37 | echo "Starting, so not killing"
38 | return 0
39 | }
40 |
41 | check || starting || stop
42 |
43 |
--------------------------------------------------------------------------------
/docker/start-plweb.sh:
--------------------------------------------------------------------------------
1 | #!/bin/bash
2 | #
3 | # Start script for the PlWeb docker
4 | #
5 | # This script is started in /srv/plweb.
6 |
7 | start=--no-fork
8 | ssl=
9 | scheme=http
10 | udaemon=daemon
11 | uconfig=root
12 | config_run=no
13 |
14 | date "+%s" > /var/run/epoch
15 |
16 | usage()
17 | { echo "Usage: docker run [docker options] swish [swish options]"
18 | echo "swish options:"
19 | echo " --help Display this message"
20 | echo " --bash Just run bash in the container"
21 | echo " --auth=type Configure authentication>:"
22 | echo " always Force HTTP authentication"
23 | echo " social Allow HTTP and oauth2 authentication"
24 | echo " anonymous No authentication"
25 | echo " --add-user Add a new user"
26 | echo " --http Create an HTTP server"
27 | echo " --https Create an HTTPS server"
28 | echo " --CN=host Hostname for certificate"
29 | echo " --O=organization Organization for certificate"
30 | echo " --C=country Country for certificate"
31 | echo " --run Start SWISH after config options"
32 | echo " --list-config List configuration files"
33 | echo " --add-config file ... Add a configuration file"
34 | echo ""
35 | echo "--add-config should be the last option if used."
36 | }
37 |
38 | # `mkuser file user` creates user with the uid and gid of file.
39 |
40 | mkuser()
41 | { f="$1"
42 | u="$2"
43 |
44 | groupadd "$(ls -nd "$f" | awk '{printf "-g %s\n",$4 }')" -o $u
45 | useradd "$(ls -nd "$f" | awk '{printf "-u %s\n",$3 }')" -g $u -o $u
46 | }
47 |
48 | # If there is a data directory, reuse it and set our user to be the
49 | # native user of this directory.
50 |
51 | if [ -d /srv/plweb/data ]; then
52 | mkuser /srv/plweb/data plweb
53 | udaemon=plweb
54 | else
55 | mkdir /srv/plweb/data
56 | chown $udaemon.$udaemon /srv/plweb/data
57 | fi
58 |
59 | # Allow the daemon to get the git version
60 | mkdir -p /home/$udaemon
61 | chown $udaemon /home/$udaemon
62 | # su -c "git config --global --add safe.directory /swish" $udaemon
63 |
64 | if [ -t 0 ] ; then
65 | start=--interactive
66 | fi
67 |
68 | did_config=no
69 |
70 | while [ ! -z "$1" ]; do
71 | case "$1" in
72 | --bash) su $udaemon -c /bin/bash
73 | did_config=yes
74 | shift
75 | ;;
76 | --help) usage
77 | exit 0
78 | ;;
79 | *) usage
80 | exit 1
81 | ;;
82 | esac
83 | done
84 |
85 | if [ $did_config = yes -a $config_run = no ]; then
86 | exit 0
87 | fi
88 |
89 | ## Make the server stop on signals sent from the health.sh. Process
90 | ## 1 only accepts signals for which there is an installed signal
91 | ## handler. We cannot install a signal handler for SIGKILL and
92 | ## therefore forcefully killing that even works in the case of
93 | ## deadlocks does not work. We run the server in another pid
94 | ## to work around this issue.
95 |
96 | stop()
97 | { echo "signal = $1; child = $child_pid"
98 |
99 | kill -s $1 $child_pid
100 | timeout 10 tail --pid=$child_pid -f /dev/null
101 | if [ $? == 124 ]; then
102 | echo "Gracefull termination failed. Killing"
103 | kill -s KILL $child_pid
104 | fi
105 |
106 | exit 1
107 | }
108 |
109 | hangup()
110 | { echo "child = $child_pid"
111 | kill -s HUP $child_pid
112 | }
113 |
114 | trap "stop TERM" SIGTERM
115 | trap "stop QUIT" SIGQUIT
116 | trap "hangup" SIGHUP
117 |
118 | export HOME=/home/$udaemon
119 |
120 | git config --global --add safe.directory '*'
121 | git config --global user.email "wiki@swi-prolog.org"
122 | git config --global user.name "Wiki editor"
123 |
124 | swipl -Dsource ${PLWEB_HOME}/daemon.pl --port=3400 --user=$udaemon $start &
125 | child_pid=$!
126 |
127 | stat=129
128 | while [ $stat = 129 ]; do
129 | wait -f $child_pid
130 | stat=$?
131 | done
132 |
--------------------------------------------------------------------------------
/download-custom/devel/bin/linux.txt:
--------------------------------------------------------------------------------
1 | Linux RPM package created on SuSE Linux 11.2. You may try on other
2 | Linux releases. If you are a one-time user, check whether your
3 | Linux distro provides SWI-Prolog. If you are a frequent user,
4 | consider to download and [[compile][]] the source.
5 |
--------------------------------------------------------------------------------
/download-custom/devel/bin/macosx-bundle.txt:
--------------------------------------------------------------------------------
1 | Mac OS X disk image with [relocatable application
2 | bundle](https://en.wikipedia.org/wiki/Bundle_%28macOS%29#macOS_application_bundles).
3 | Needs [[xquartz][]]. Same as the _fat_ bundle, but only
4 | contains the `x86_64` binaries, compiled using gcc13 from Macports. This
5 | version is __30-40% faster__ than the fat binaries on Intel Macs.
6 |
--------------------------------------------------------------------------------
/download-custom/devel/bin/macosx-fat-bundle.txt:
--------------------------------------------------------------------------------
1 | Mac OS X disk image with [relocatable application
2 | bundle](https://en.wikipedia.org/wiki/Bundle_%28macOS%29#macOS_application_bundles).
3 | Needs [[xquartz][]] (X11) installed for running the
4 | [[development tools][]]. The bundle also provides the
5 | commandline tools in the =Contents/MacOS= directory. Users of older
6 | MacOS versions are adviced to use Macports, Homebrew or install from
7 | source. This bundle contains universal (fat) binaries that run natively
8 | on Intel and Apple Silicon (M1, arm64).
9 |
10 |
--------------------------------------------------------------------------------
/download-custom/devel/bin/macosx-lion.txt:
--------------------------------------------------------------------------------
1 | Installer with binaries created using [[Macports][]].
2 | Installs =|/opt/local/bin/swipl|=. Needs [[xquartz][]] (X11)
3 | installed for running the [[development tools][]]. Currently,
4 | version 2.7.4 is required. You can check the version by opening an X11
5 | application and then checking `about' in the X11 menu. This binary is
6 | linked against GMP 5, which implies that it is covered by the LGPL-V3
7 | license. See below.
8 |
--------------------------------------------------------------------------------
/download-custom/devel/bin/macosx-snow_leopard.txt:
--------------------------------------------------------------------------------
1 | Installer with binaries created using [[Macports][]].
2 | Installs =|/opt/local/bin/swipl|=. Needs X11 (bundled with the MacOS X
3 | installer) and Developer Tools (Xcode) installed for running the
4 | [[development tools][]].
5 |
--------------------------------------------------------------------------------
/download-custom/devel/bin/macosx-snow_leopard_and_later.txt:
--------------------------------------------------------------------------------
1 | Mac OS X disk image with [relocatable application
2 | bundle](https://en.wikipedia.org/wiki/Bundle_%28macOS%29#macOS_application_bundles).
3 | Needs [[xquartz][]] (X11) installed for running the
4 | [[development tools][]]. The bundle also provides the
5 | commandline tools in the =Contents/MacOS= directory.
6 |
7 |
--------------------------------------------------------------------------------
/download-custom/devel/bin/macosx.txt:
--------------------------------------------------------------------------------
1 | Installer with binaries created using [[Macports][]].
2 | Installs =|/opt/local/bin/swipl|=. Needs [[xquartz][]] (X11)
3 | installed for running the [[development tools][]]. Currently,
4 | version 2.4.0 is required. You can check the version by opening an X11
5 | application and then checking `about' in the X11 menu.
6 |
--------------------------------------------------------------------------------
/download-custom/devel/bin/space.txt:
--------------------------------------------------------------------------------
1 | Binary installer for the spatial indexing package
2 | [[space][]]
3 |
4 |
--------------------------------------------------------------------------------
/download-custom/devel/bin/win32.txt:
--------------------------------------------------------------------------------
1 | Self-installing executable for Microsoft Windows 32-bit editions.
2 | Version 9.3 is that last version of SWI-Prolog that is also released for
3 | 32-bit. Note that this version lacks the Janus interface to Python.
4 |
--------------------------------------------------------------------------------
/download-custom/devel/bin/win64.txt:
--------------------------------------------------------------------------------
1 | Self-installing executable for Microsoft Windows 64-bit editions.
2 |
--------------------------------------------------------------------------------
/download-custom/devel/doc/doc-pdf.txt:
--------------------------------------------------------------------------------
1 | SWI-Prolog reference manual as PDF file. This does _not_ include the
2 | [[package][]] documentation.
3 |
--------------------------------------------------------------------------------
/download-custom/devel/footer.txt:
--------------------------------------------------------------------------------
1 | ## About the development releases
2 |
3 | The development branches have their own GIT repository at the address
4 | below. See the general [[GIT][]] instructions for details.
5 |
6 | ```
7 | % git clone https://github.com/SWI-Prolog/swipl-devel.git
8 | ```
9 |
10 | ### Should I use the development release or the stable one?
11 |
12 | Many active SWI-Prolog users track the development releases or GIT
13 | versions for developing Prolog applications. Most of the time the
14 | development versions are fairly stable. Infrequent larger rewrites to
15 | the core infrastructure that may cause instability is typically
16 | announced on the [forum](https://swi-prolog.discourse.group/).
17 |
18 | Tracking the latest version offers some advantages for you are user:
19 |
20 | - Bug fixes are quickly available.
21 | - When you are stuck on a missing feature you can use this quickly
22 | after it has been added.
23 | - Although you are a little more often confronted with
24 | incompatibilities and regressions, such issues can be discussed and
25 | resolved.
26 |
--------------------------------------------------------------------------------
/download-custom/devel/header.txt:
--------------------------------------------------------------------------------
1 | ---+ Download SWI-Prolog development versions
2 |
3 | [[linux.png;align="left",width="24px"][]]
4 | We collect information about available packages and issues for building
5 | on specific distros [[here][]].
6 | We provide a [[PPA][]]
7 | for [[Ubuntu][http://www.ubuntu.com/]] and [[snap
8 | images][]]
9 |
10 | [[WIP.png;align="left",width="24px"][]]
11 | Examine the [[ChangeLog][]].
12 |
13 |
--------------------------------------------------------------------------------
/download-custom/devel/src/src-tgz.txt:
--------------------------------------------------------------------------------
1 | Sources in =|.tar.gz|= format, including packages. See [[build
2 | instructions][]]. See also the [GIT
3 | repository](https://github.com/SWI-Prolog).
4 |
--------------------------------------------------------------------------------
/download-custom/old/header.txt:
--------------------------------------------------------------------------------
1 | ---+ Download SWI-Prolog old binaries
2 |
3 | These are binaries of some old SWI-Prolog [[versions][]].
4 | We only provide the Windows binaries. You can access the sources via
5 | [[GIT][]].
6 |
--------------------------------------------------------------------------------
/download-custom/stable/bin/linux-rpm.txt:
--------------------------------------------------------------------------------
1 | Linux RPM package created on SuSE Linux 11.2. You may try on other
2 | Linux releases. If you are a one-time user, check whether your
3 | Linux distro provides SWI-Prolog. If you are a frequent user,
4 | consider to download and [[compile][]] the source.
5 |
--------------------------------------------------------------------------------
/download-custom/stable/bin/linux.txt:
--------------------------------------------------------------------------------
1 | Tar image of a relocatable SWI-Prolog installation. This merged image
2 | was created on Ubuntu 10.10 (64-bit) and Debian 6.0 (32-bit). It
3 | contains copies of shared libraries that are less widely available
4 | and/or suffer regularly from version issues. If you are a one-time user,
5 | check whether your Linux distro provides SWI-Prolog. If you are a
6 | frequent user, consider to download and [[compile][]]
7 | the source.
8 |
--------------------------------------------------------------------------------
/download-custom/stable/bin/macosx-bundle.txt:
--------------------------------------------------------------------------------
1 | Mac OS X disk image with [relocatable application
2 | bundle](https://en.wikipedia.org/wiki/Bundle_%28macOS%29#macOS_application_bundles).
3 | Needs [[xquartz][]]. Same as the _fat_ bundle, but only
4 | contains the `x86_64` binaries, compiled using gcc13 from Macports. This
5 | version is __30-40% faster__ than the fat binaries on Intel Macs. The intel
6 | version is not regularly updated.
7 |
--------------------------------------------------------------------------------
/download-custom/stable/bin/macosx-fat-bundle.txt:
--------------------------------------------------------------------------------
1 | Mac OS X disk image with [relocatable application
2 | bundle](https://en.wikipedia.org/wiki/Bundle_%28macOS%29#macOS_application_bundles).
3 | Needs [[xquartz][]] (X11) installed for running the
4 | [[development tools][]]. The bundle also provides the
5 | commandline tools in the =Contents/MacOS= directory. Users of older
6 | MacOS versions are adviced to use Macports, Homebrew or install from
7 | source. This bundle contains universal (fat) binaries that run natively
8 | on Intel (x86_64) and Apple Silicon (M1-3, arm64).
9 |
--------------------------------------------------------------------------------
/download-custom/stable/bin/macosx-snow_leopard.txt:
--------------------------------------------------------------------------------
1 | Installer with binaries created using [[Macports][]].
2 | Installs =|/opt/local/bin/swipl|=. Needs X11 (bundled with the MacOS X
3 | installer) and Developer Tools (Xcode) installed for running the
4 | [[development tools][]].
5 |
--------------------------------------------------------------------------------
/download-custom/stable/bin/macosx-snow_leopard_and_later.txt:
--------------------------------------------------------------------------------
1 | Mac OS X disk image with *relocatable application bundle*. Needs
2 | [[xquartz][]] (X11) installed for running the [[development
3 | tools][]]. Currently, version 2.7.11 is required. You can
4 | check the version by opening an X11 application and then checking
5 | `about' in the X11 menu. The bundle also provides the commandline tools
6 | in =Contents/MacOS=. The command line tools need at least MacOS *10.6*
7 | (Snow Leopard). The graphical application needs at least MacOS *10.7*
8 | (Lion).
9 |
--------------------------------------------------------------------------------
/download-custom/stable/bin/macosx-tiger.txt:
--------------------------------------------------------------------------------
1 | Installer with binaries created using [[Macports][]].
2 | Installs =|/opt/local/bin/swipl|=. Needs X11 (bundled with the
3 | MacOS X installer installed for running the [[development tools][]]
4 |
--------------------------------------------------------------------------------
/download-custom/stable/bin/macosx.txt:
--------------------------------------------------------------------------------
1 | Installer with binaries created using [[Macports][]].
2 | Installs =|/opt/local/bin/swipl|=. Needs [[xquartz][]] (X11)
3 | and the Developer Tools (Xcode) installed for running the [[development
4 | tools][]]
5 |
--------------------------------------------------------------------------------
/download-custom/stable/bin/win32.txt:
--------------------------------------------------------------------------------
1 | Self-installing executable for Microsoft Windows 32-bit editions.
2 | Version 9.3 is that last version of SWI-Prolog that is also released for
3 | 32-bit. Note that this version lacks the Janus interface to Python.
4 |
--------------------------------------------------------------------------------
/download-custom/stable/bin/win64.txt:
--------------------------------------------------------------------------------
1 | Self-installing executable for Microsoft Windows 64-bit editions.
2 |
--------------------------------------------------------------------------------
/download-custom/stable/doc/doc-pdf.txt:
--------------------------------------------------------------------------------
1 | SWI-Prolog reference manual as PDF file. This does _not_ include the
2 | [[package][]] documentation.
3 |
--------------------------------------------------------------------------------
/download-custom/stable/footer.txt:
--------------------------------------------------------------------------------
1 | ## SWI-Prolog version 9.2
2 |
3 | The SWI-Prolog 9.2 is the latest stable release. Highlights:
4 |
5 | - Bundled Python bi-directional interface (Janus)
6 | - C++ interface version 2 (`SWI-ccp2.h`) covers much more
7 | of the SWI-Prolog C API and is more (type-)safe.
8 | - Sources are now strict C11 and may be compiled using
9 | e.g. VS2022 on Windows.
10 | - Many improvements to the tooling.
11 | - The profiler can provide accurate port counts
12 | - The coverage analysis tool can annotate files by line
13 | and collect data from multiple threads and Prolog runs.
14 | - The unit testing tool supports concurrent testing and
15 | hiding of output of succeeded tests.
16 | - The pack manager can deal with version and feature
17 | restrictions, plan multiple packs together, build using
18 | CMake.
19 | - Added an option for commandline tools that can be called
20 | as ``swipl [arg ...]``. Provides cli tools for
21 | pack management and `.qlf` compilation.
22 |
--------------------------------------------------------------------------------
/download-custom/stable/header.txt:
--------------------------------------------------------------------------------
1 | # Download SWI-Prolog stable versions
2 |
3 | [[linux.png;align="left",width="24px"][]]
4 | Linux versions are often available as a package for your distribution.
5 | We collect information about available packages and issues for building
6 | on specific distros [[here][]].
7 | We provide a [[PPA][]]
8 | for [[Ubuntu][http://www.ubuntu.com/]] and [[snap
9 | images][]]
10 |
11 | [[Android.png;align="left",width="24px"][]] Android
12 | binaries are available for [Termux](https://termux.com/) as the package
13 | `swi-prolog`. See also [[Building SWI-Prolog on Android using
14 | LinuxOnAndroid][]]
15 |
16 | [[windows.jpg;align="left",width="24px"][]] Please
17 | check the [[windows release notes][]] (also in the
18 | SWI-Prolog startup menu of your installed version) for details.
19 |
20 | [[WIP.png;align="left",width="24px"][]]
21 | Examine the [[ChangeLog][]].
22 |
23 |
--------------------------------------------------------------------------------
/download-custom/stable/src/src-tgz.txt:
--------------------------------------------------------------------------------
1 | Sources in =|.tar.gz|= format, including packages and generated documentation
2 | files. See [[build instructions][]].
3 |
--------------------------------------------------------------------------------
/fastly.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Jan Wielemaker
4 | E-mail: jan@swi-prolog.org
5 | WWW: https://www.swi-prolog.org
6 | Copyright (C): 2020, SWI-Prolog Solutions b.v.
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalidate any other reasons why the executable file might be covered by
27 | the GNU General Public License.
28 | */
29 |
30 | :- module(fastly,
31 | [ purge_location/1 % +Location
32 | ]).
33 | :- use_module(library(http/json)).
34 | :- use_module(library(http/http_open)).
35 | :- use_module(library(http/http_path)).
36 |
37 | :- use_module(parms).
38 |
39 | /** Purge pages on our CDN
40 | */
41 |
42 | :- multifile
43 | http_open:map_method/2.
44 |
45 | http_open:map_method(purge, 'PURGE').
46 |
47 | %! purge_location(+Location) is det.
48 | %
49 | % Send a purge request for a Fastly URL
50 |
51 | purge_location(Location) :-
52 | compound(Location),
53 | !,
54 | http_absolute_location(Location, Path, []),
55 | purge_location(Path).
56 | purge_location(Location) :-
57 | server(cdn, Server),
58 | format(string(URL), 'https://~w~w', [Server, Location]),
59 | setup_call_cleanup(
60 | http_open(URL, In,
61 | [ method(purge)
62 | ]),
63 | json_read_dict(In, Reply),
64 | close(In)),
65 | ( Reply.get(status) == "ok"
66 | -> true
67 | ; print_message(warning, fastly(purge(Reply)))
68 | ).
69 |
70 |
--------------------------------------------------------------------------------
/footer.pl:
--------------------------------------------------------------------------------
1 | :- module(
2 | footer,
3 | [
4 | footer//1, % +Options
5 | server_information//0
6 | ]
7 | ).
8 |
9 | /** Footer
10 |
11 | Footer for SWI-Prolog Web pages.
12 |
13 | @author Wouter Beek
14 | @version 2014/01
15 | */
16 |
17 | :- use_module(library(http/html_head)).
18 | :- use_module(library(http/html_write)).
19 | :- use_module(library(http/js_write)).
20 | :- use_module(openid).
21 | :- use_module(tagit).
22 | :- use_module(annotation).
23 |
24 | :- html_resource(css('footer.css'), []).
25 |
26 |
27 | 'community-content'(Options) -->
28 | { option(object(Object), Options) }, !,
29 | html(div(id='community-content',
30 | [ \tagit_footer(Object, []),
31 | \annotation(Object)
32 | ])).
33 | 'community-content'(_) -->
34 | [].
35 |
36 | %% footer(+Options)// is det.
37 | %
38 | % Emit the footer, which contains the community content, server
39 | % address and user information. Options:
40 | %
41 | % * object(Object)
42 | % Display community content area for Object.
43 | % * show_user(+Boolean)
44 | % If =false=, omit the user
45 |
46 | footer(Options) -->
47 | html_requires(css('footer.css')),
48 | html(div(class=footer,
49 | [ \'community-content'(Options),
50 | \'footer-footer'(Options)
51 | ])),
52 | balance_columns_script.
53 |
54 | 'footer-footer'(Options) -->
55 | html(div(id=footer,
56 | [ \show_user(Options),
57 | \server_information
58 | ])).
59 |
60 | show_user(Options) -->
61 | { option(show_user(false), Options) }, !.
62 | show_user(_) -->
63 | current_user.
64 |
65 | balance_columns_script -->
66 | js_script({|javascript||
67 | $().ready(function()
68 | { var $navtree = $(".navwindow");
69 | var $navcontent = $(".navcontent");
70 | if ( $navtree.length > 0 && $navcontent.length > 0 )
71 | { var $window = $(window).on("resize", function()
72 | { var ch = $navcontent.height();
73 | var nh = $navtree.height();
74 | if ( nh > 400 && nh > ch + 200 )
75 | { if ( ch < 300 ) ch = 300;
76 | $navtree.height(ch);
77 | $navtree.css('overflow-y', 'scroll');
78 |
79 | var current = $navtree.find("li.nav.current");
80 | if ( current.position().top > ch-40 )
81 | { $navtree.scrollTop(current.position().top - (ch-40));
82 | }
83 | }
84 | }).trigger("resize")
85 | }
86 | });
87 | |}).
88 |
89 |
90 | prolog_version(Version) :-
91 | current_prolog_flag(version_git, Version), !.
92 | prolog_version(Version) :-
93 | current_prolog_flag(version_data, swi(Ma,Mi,Pa,_)),
94 | format(atom(Version), '~w.~w.~w', [Ma,Mi,Pa]).
95 |
96 | %! server_information// is det.
97 | % Emit server information.
98 |
99 | server_information -->
100 | {prolog_version(Version)},
101 | html(
102 | a([id=powered,href='http://www.swi-prolog.org'], [
103 | 'Powered by SWI-Prolog ',
104 | Version
105 | ])
106 | ).
107 |
108 |
--------------------------------------------------------------------------------
/forum.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Jan Wielemaker
4 | E-mail: J.Wielemaker@cs.vu.nl
5 | WWW: http://www.swi-prolog.org
6 | Copyright (C): 2009-2013, VU University Amsterdam
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalidate any other reasons why the executable file might be covered by
27 | the GNU General Public License.
28 | */
29 |
30 | :- module(plweb_forum, []).
31 | :- use_module(library(http/html_write)).
32 | :- use_module(library(http/js_write)).
33 | :- use_module(library(http/http_dispatch)).
34 |
35 | :- http_handler(root(forum), forum, []).
36 |
37 | forum(_Request) :-
38 | reply_html_page(
39 | forum(default),
40 | title('SWI-Prolog user forum'),
41 | \embed_forum).
42 |
43 | embed_forum -->
44 | html({|html||
45 | |}),
48 | js_script({|javascript||
49 | document.getElementById('forum_embed').src =
50 | 'https://groups.google.com/forum/embed/?place=forum/swi-prolog'
51 | + '&showsearch=true&showpopout=true&showtabs=false'
52 | + '&parenturl=' + encodeURIComponent(window.location.href);
53 | |}).
54 |
55 | :- multifile plweb:page_title//1.
56 |
57 | plweb:page_title(forum(default)) -->
58 | html('SWI-Prolog user forum').
59 |
--------------------------------------------------------------------------------
/generics.pl:
--------------------------------------------------------------------------------
1 | :- module(
2 | generics,
3 | [
4 | clean_dom/2, % +DOM:list
5 | % -CleanedDOM:list
6 | ensure_number/2, % +Something:term
7 | % -Number:number
8 | is_empty/1, % +Content:atom
9 | login_link//0,
10 | request_to_id/3, % +Request:list
11 | % +Kind:oneof([annotation,news,post])
12 | % -Id:atom
13 | true/1, % +Term
14 | uri_query_add/4, % +FromURI:uri
15 | % +Name:atom
16 | % +Value:atom
17 | % -ToURI:atom
18 | wiki_file_codes_to_dom/3 % +Codes:list(code)
19 | % +File:atom
20 | % -DOM:list
21 | ]
22 | ).
23 |
24 | /** Generics
25 |
26 | Generic predicates in plweb.
27 | Candidates for placement in some library.
28 |
29 | @author Wouter Beek
30 | @version 2013/12-2014/01
31 | */
32 |
33 | :- use_module(library(apply)).
34 | :- use_module(library(http/http_dispatch)).
35 | :- use_module(library(http/http_path)).
36 | :- use_module(library(http/http_wrapper)).
37 | :- use_module(library(option)).
38 | :- use_module(library(pldoc/doc_wiki)).
39 | :- use_module(library(semweb/rdf_db)).
40 | :- use_module(library(uri)).
41 | :- use_module(openid).
42 |
43 | %! add_option(
44 | %! +FromOptions:list(nvpair),
45 | %! +Name:atom,
46 | %! +Value:atom,
47 | %! +ToOptions:list(nvpair)
48 | %! ) is det.
49 | % Adds an option with the given name and value (i.e. `Name(Value)`),
50 | % and ensures that old options are overwritten and
51 | % that the resultant options list is sorted.
52 |
53 | add_option(Os1, N, V, Os2):-
54 | O =.. [N,V],
55 | merge_options([O], Os1, Os2).
56 |
57 | clean_dom([p(X)], X) :- !.
58 | clean_dom(X, X).
59 |
60 | ensure_number(X, X):-
61 | number(X), !.
62 | ensure_number(X, Y):-
63 | atom(X), !,
64 | atom_number(X, Y).
65 |
66 | %! is_empty(+Content:atom) is semidet.
67 |
68 | is_empty(Content):-
69 | var(Content), !.
70 | is_empty(Content):-
71 | normalize_space(atom(''), Content).
72 |
73 | login_link -->
74 | {http_current_request(Request)},
75 | login_link(Request).
76 |
77 | %% request_to_id(+Request, ?Kind, -Id) is semidet.
78 | %
79 | % True when Request is a request to the post service for the given
80 | % Kind and Id. Id is '' when accessing without an id.
81 |
82 | request_to_id(Request, Kind, Id) :-
83 | memberchk(path(Path), Request),
84 | ( atomic_list_concat(['',Kind,Id], '/', Path)
85 | -> true
86 | ; atom_concat(/, Kind, Path)
87 | -> Id = ''
88 | ).
89 |
90 | true(_).
91 |
92 | %! uri_query_add(+FromURI:uri, +Name:atom, +Value:atom, -ToURI:atom) is det.
93 | % Inserts the given name-value pair as a query component into the given URI.
94 |
95 | uri_query_add(URI1, Name, Value, URI2):-
96 | uri_components(
97 | URI1,
98 | uri_components(Scheme, Authority, Path, Search1_, Fragment)
99 | ),
100 | (var(Search1_) -> Search1 = '' ; Search1 = Search1_),
101 | uri_query_components(Search1, SearchPairs1),
102 | add_option(SearchPairs1, Name, Value, SearchPairs2),
103 | uri_query_components(Search2, SearchPairs2),
104 | uri_components(
105 | URI2,
106 | uri_components(Scheme, Authority, Path, Search2, Fragment)
107 | ).
108 |
109 | %% wiki_file_codes_to_dom(+Codes, +File, -DOM)
110 | %
111 | % DOM is the HTML dom representation for Codes that originate from
112 | % File.
113 |
114 | wiki_file_codes_to_dom(String, File, DOM):-
115 | nb_current(pldoc_file, OrgFile), !,
116 | setup_call_cleanup(
117 | b_setval(pldoc_file, File),
118 | wiki_codes_to_dom(String, [], DOM),
119 | b_setval(pldoc_file, OrgFile)
120 | ).
121 | wiki_file_codes_to_dom(String, File, DOM):-
122 | setup_call_cleanup(
123 | b_setval(pldoc_file, File),
124 | wiki_codes_to_dom(String, [], DOM),
125 | nb_delete(pldoc_file)
126 | ).
127 |
--------------------------------------------------------------------------------
/git-web/footer.html:
--------------------------------------------------------------------------------
1 |
2 |
3 | 
4 | Further information about the SWI-Prolog GIT repositories
5 |
6 |
--------------------------------------------------------------------------------
/git-web/gitweb.conf:
--------------------------------------------------------------------------------
1 | use File::Basename;
2 |
3 | # turn off potentially CPU-intensive features
4 | $feature{'search'}{'default'} = [undef];
5 | $feature{'blame'}{'default'} = [undef];
6 | $feature{'pickaxe'}{'default'} = [undef];
7 | $feature{'grep'}{'default'} = [undef];
8 |
9 | $GIT = "git";
10 | $projectroot = $ENV{PROJECT_ROOT} || "/home/pl/git/";
11 | #$projectroot = "/home/pl/git/";
12 |
13 | $gitwebdir = dirname($ENV{SCRIPT_FILENAME});
14 | $site_header = $gitwebdir . "/header.html";
15 | $site_footer = $gitwebdir . "/footer.html";
16 | $project_maxdepth = 1;
17 |
18 | @stylesheets = ("/git/static/gitweb.css");
19 | $javascript = "/git/static/gitweb.js";
20 | $logo = "/git/static/git-logo.png";
21 | $favicon = "/git/static/git-favicon.png";
22 |
23 | # nicer-looking URLs
24 | $feature{'pathinfo'}{'default'} = [1];
25 |
26 | $site_name = "SWI-Prolog GIT browser";
27 |
28 | $site_uri = "http://" . $ENV{'SERVER_NAME'};
29 | $port = $ENV{SERVER_PORT} || "80";
30 | if ( $port != "80" )
31 | { $site_uri = $site_uri . ":" . $port;
32 | }
33 | $my_uri = $site_uri . "/git/";
34 | $home_link = $site_uri . "/git/";
35 |
--------------------------------------------------------------------------------
/git-web/header.html:
--------------------------------------------------------------------------------
1 | The SWI-Prolog GIT repositories
2 |
3 |
--------------------------------------------------------------------------------
/git-web/plweb-apache.env:
--------------------------------------------------------------------------------
1 | SERVER_SIGNATURE=
2 | HTTP_KEEP_ALIVE=300
3 | HTTP_USER_AGENT=Mozilla/5.0 (X11; U; Linux x86_64; en-GB; rv:1.9.0.5) Gecko/2008121300 SUSE/3.0.5-1.1 Firefox/3.0.5
4 | SERVER_PORT=80
5 | HTTP_HOST=prolog.cs.vu.nl
6 | DOCUMENT_ROOT=/home/pl/web
7 | HTTP_ACCEPT_CHARSET=ISO-8859-1,utf-8;q=0.7,*;q=0.7
8 | SCRIPT_FILENAME=/home/pl/web/git/test.cgi
9 | REQUEST_URI=/git/test.cgi/pl-57x.git?a=commit;h=0dfb0aa39fd3f51382d16a3c931997b58031a108
10 | SCRIPT_NAME=/git/test.cgi
11 | SCRIPT_URI=http://prolog.cs.vu.nl/git/test.cgi/pl-57x.git
12 | HTTP_CONNECTION=keep-alive
13 | PATH_INFO=/pl-57x.git
14 | REMOTE_PORT=56315
15 | PATH=/usr/local/bin:/usr/bin:/bin
16 | SCRIPT_URL=/git/test.cgi/pl-57x.git
17 | PWD=/home/pl/web/git
18 | SERVER_ADMIN=jrvosse@cs.vu.nl
19 | HTTP_ACCEPT_LANGUAGE=en-gb,en;q=0.5
20 | PATH_TRANSLATED=/home/pl/web/pl-57x.git
21 | HTTP_ACCEPT=text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8
22 | REMOTE_ADDR=130.37.30.3
23 | SHLVL=1
24 | SERVER_NAME=prolog.cs.vu.nl
25 | SERVER_SOFTWARE=Apache/2.2.9 (Unix) DAV/2 SVN/1.4.2
26 | QUERY_STRING=a=commit;h=0dfb0aa39fd3f51382d16a3c931997b58031a108
27 | SERVER_ADDR=130.37.193.11
28 | GATEWAY_INTERFACE=CGI/1.1
29 | SERVER_PROTOCOL=HTTP/1.1
30 | HTTP_CACHE_CONTROL=max-age=0
31 | HTTP_ACCEPT_ENCODING=gzip,deflate
32 | REQUEST_METHOD=GET
33 | HTTP_COOKIE=__utma=214905872.3938434877739744000.1221743656.1224244323.1232619166.3; __utmz=214905872.1232619166.3.2.utmcsr=cs.vu.nl|utmccn=(referral)|utmcmd=referral|utmcct=/
34 | _=/usr/bin/printenv
35 |
--------------------------------------------------------------------------------
/git-web/printenv:
--------------------------------------------------------------------------------
1 | #!/bin/bash -f
2 |
3 | echo "Content-type: text/plain"
4 | echo ""
5 | echo "Hello world"
6 | printenv
7 |
--------------------------------------------------------------------------------
/git-web/static/git-favicon.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/SWI-Prolog/plweb/5788f8e26d2041e200dba8d5587bf3850422009b/git-web/static/git-favicon.png
--------------------------------------------------------------------------------
/git-web/static/git-logo.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/SWI-Prolog/plweb/5788f8e26d2041e200dba8d5587bf3850422009b/git-web/static/git-logo.png
--------------------------------------------------------------------------------
/git-web/test.c:
--------------------------------------------------------------------------------
1 | #include
2 |
3 | int
4 | main(int argc, char **argv)
5 | { printf("Content-type: text/plain\n\n");
6 | printf("Hello world\n");
7 |
8 | return 0;
9 | }
10 |
--------------------------------------------------------------------------------
/gitweb.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Jan Wielemaker
4 | E-mail: J.Wielemaker@cs.vu.nl
5 | WWW: http://www.swi-prolog.org
6 | Copyright (C): 2009-2011, VU University Amsterdam
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalidate any other reasons why the executable file might be covered by
27 | the GNU General Public License.
28 | */
29 |
30 | :- module(gitweb, []).
31 | :- use_module(library(http/http_dispatch)).
32 | :- use_module(library(http/html_write)).
33 | :- use_module(library(apply)).
34 | :- use_module(library(url)).
35 | :- use_module(library(debug)).
36 | :- use_module(http_cgi).
37 |
38 | /** Provide gitweb support
39 |
40 | @tbd Also serve the GIT repository over this gateway
41 | @tbd Better way to locate the GIT project root
42 | */
43 |
44 | :- if(true).
45 |
46 | :- http_handler(root('git'), github, []).
47 | :- http_handler(root('git/'), github, [ prefix, spawn(cgi) ]).
48 | :- http_handler(root('home/pl/git/'), github, [prefix, spawn(download)]).
49 |
50 | github(_Request) :-
51 | reply_html_page(
52 | git(github),
53 | title('SWI-Prolog git services moved to github'),
54 | \github).
55 |
56 | github -->
57 | html({|html||
58 | The SWI-Prolog source repository has been moved to
59 | GitHub.
60 | |}).
61 |
62 | :- multifile plweb:page_title//1.
63 |
64 | plweb:page_title(git(github)) -->
65 | html('SWI-Prolog git services moved to github').
66 |
67 | :- else.
68 |
69 | :- http_handler(root('git'), gitroot, []).
70 | :- http_handler(root('git/'), gitweb, [ prefix, spawn(cgi) ]).
71 | :- http_handler(root('home/pl/git/'), git_http, [prefix, spawn(download)]).
72 |
73 |
74 |
75 |
76 | %% gitroot(+Request) is det.
77 | %
78 | % Some toplevel requests are send to /git, while working inside
79 | % the repository asks for /git/. This is a hack to work around
80 | % these problems.
81 |
82 | gitroot(Request) :-
83 | http_location_by_id(gitroot, Me),
84 | atom_concat(Me, /, NewPath),
85 | include(local, Request, Parts),
86 | http_location([path(NewPath)|Parts], Moved),
87 | throw(http_reply(moved(Moved))).
88 |
89 | local(search(_)).
90 | local(fragment(_)).
91 |
92 | %% gitweb(+Request)
93 | %
94 | % Call gitweb script
95 |
96 | gitweb(Request) :-
97 | memberchk(path(Path), Request),
98 | file_base_name(Path, Base),
99 | resource_file(Base, File), !,
100 | debug(gitweb, 'Sending resource ~q', [File]),
101 | http_reply_file(File, [], Request).
102 | gitweb(Request) :-
103 | absolute_file_name(gitweb('gitweb.cgi'), ScriptPath,
104 | [ access(execute)
105 | ]),
106 | http_run_cgi(ScriptPath, [], Request).
107 |
108 |
109 | resource_file('gitweb.css', gitweb('static/gitweb.css')).
110 | resource_file('gitweb.js', gitweb('static/gitweb.js')).
111 | resource_file('git-logo.png', gitweb('static/git-logo.png')).
112 | resource_file('git-favicon.png', gitweb('static/git-favicon.png')).
113 |
114 |
115 | :- multifile
116 | http_cgi:environment/2.
117 |
118 | http_cgi:environment('PROJECT_ROOT', Root) :- % gitweb
119 | git_project_root(Root).
120 | http_cgi:environment('GIT_PROJECT_ROOT', Root) :- % git-http
121 | git_project_root(Root).
122 | http_cgi:environment('GITWEB_CONFIG', Config) :-
123 | absolute_file_name(gitweb('gitweb.conf'), Config,
124 | [ access(read)
125 | ]).
126 | http_cgi:environment('PATH', '/bin:/usr/bin:/usr/local/bin').
127 |
128 |
129 | git_project_root(Root) :-
130 | absolute_file_name(plgit(.), RootDir,
131 | [ access(read),
132 | file_type(directory)
133 | ]),
134 | atom_concat(RootDir, /, Root),
135 | debug(gitweb, 'PROJECT_ROOT = ~q', [Root]).
136 |
137 |
138 | %% git_http(+Request) is det.
139 | %
140 | % Server files from the git tree to make this work:
141 | %
142 | % ==
143 | % git clone http://www.swi-prolog.org/nl/home/pl/git/pl.git
144 | % ==
145 | %
146 | % The comment "git http-backend" does not provide much meaningful
147 | % info when accessed from a browser. Therefore we run "git
148 | % http-backend" only if w think this the request comes from a git
149 | % backend. Otherwise we redirect to the gitweb page.
150 |
151 | git_http(Request) :-
152 | ( memberchk(method(post), Request)
153 | ; memberchk(search(Search), Request),
154 | memberchk(service=_, Search)
155 | ; memberchk(user_agent(Agent), Request),
156 | sub_atom(Agent, 0, _, _, git)
157 | ), !,
158 | http_run_cgi(path(git),
159 | [ argv(['http-backend']),
160 | transfer_encoding(chunked),
161 | buffer(line)
162 | ],
163 | Request).
164 | git_http(Request) :-
165 | memberchk(request_uri(URI), Request),
166 | atom_concat('/home/pl', GitWebURI, URI),
167 | throw(http_reply(see_other(GitWebURI))).
168 |
169 | :- endif.
170 |
--------------------------------------------------------------------------------
/holidays.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Anne Ogborn
4 | WWW: http://www.swi-prolog.org
5 |
6 | This program is free software; you can redistribute it and/or
7 | modify it under the terms of the GNU General Public License
8 | as published by the Free Software Foundation; either version 2
9 | of the License, or (at your option) any later version.
10 |
11 | This program is distributed in the hope that it will be useful,
12 | but WITHOUT ANY WARRANTY; without even the implied warranty of
13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 | GNU General Public License for more details.
15 |
16 | You should have received a copy of the GNU General Public
17 | License along with this library; if not, write to the Free Software
18 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19 |
20 | As a special exception, if you link this library with other files,
21 | compiled with a Free Software compiler, to produce an executable, this
22 | library does not by itself cause the resulting executable to be covered
23 | by the GNU General Public License. This exception does not however
24 | invalidate any other reasons why the executable file might be covered by
25 | the GNU General Public License.
26 | */
27 | :- module(holidays, [
28 | todays_holiday/1
29 | ]).
30 |
31 | :- dynamic current_holiday/2.
32 |
33 | current_holiday(0, none).
34 |
35 | /** todays_holiday(-Holiday:atom) is det
36 | *
37 | * succeeds if Holiday is 'todays holiday'
38 | *
39 | * This is none on 'ordinary' days, or
40 | * one of
41 | *
42 | * april_fools_day
43 | * christmas
44 | * koningsdag
45 | * santiklaas
46 | *
47 | * succeeds only within 12 hours either
48 | * side of April 1
49 | *
50 | * April fools day is a traditional holiday celebrated
51 | * by playing hoaxes and practical jokes. A common form
52 | * of this is to substitute nonsensical information where
53 | * useful info is normally displayed.
54 | *
55 | * Koningsdag is 'Kings day' in the Netherlands
56 | * Santiklaas is St. Nicholas' feast
57 | *
58 | */
59 | todays_holiday(Holiday) :-
60 | current_holiday(Time, Holiday),
61 | get_time(Now),
62 | Now - Time < 3600, !.
63 | todays_holiday(Holiday) :-
64 | year(Year),
65 | todays_holiday(Year, Holiday),
66 | get_time(Now),
67 | retractall(current_holiday(_, _)),
68 | asserta(current_holiday(Now, Holiday)).
69 |
70 | todays_holiday(YY, april_fools_day) :-
71 | date_between(YY-03-30, 12:00:00,
72 | YY-04-02, 12:00:00).
73 | todays_holiday(YY, christmas) :-
74 | date_between(YY-12-20, 12:00:00,
75 | YY-12-27, 12:00:00).
76 | todays_holiday(YY, koningsdag) :-
77 | date_between(YY-04-26, 12:00:00,
78 | YY-04-28, 12:00:00).
79 | todays_holiday(YY, santiklaas) :-
80 | date_between(YY-12-05, 12:00:00,
81 | YY-12-06, 12:00:00).
82 | todays_holiday(YY, halloween) :-
83 | date_between(YY-10-30, 12:00:00,
84 | YY-11-01, 12:00:00).
85 | todays_holiday(YY, liberation_day) :-
86 | date_between(YY-05-04, 12:00:00,
87 | YY-05-06, 12:00:00).
88 | todays_holiday(YY, carnival) :-
89 | carnival_date(Start, End),
90 | Start = (YY-_-_),
91 | End = (YY-_-_),
92 | date_between(Start, 12:00:00,
93 | End, 12:00:00).
94 | todays_holiday(YY, chinese_new_year) :-
95 | chinese_new_year_date(Start, End),
96 | Start = (YY-_-_),
97 | End = (YY-_-_),
98 | date_between(Start, 12:00:00,
99 | End, 12:00:00).
100 | todays_holiday(_, none).
101 |
102 | carnival_date(2015-2-15, 2015-2-17).
103 | carnival_date(2016-2-07, 2016-2-09).
104 | carnival_date(2017-2-26, 2017-2-28).
105 | carnival_date(2018-2-11, 2018-2-13).
106 | carnival_date(2019-3-03, 2019-3-05).
107 | carnival_date(2020-2-23, 2020-2-25).
108 | carnival_date(2021-2-14, 2021-2-16).
109 | carnival_date(2022-2-27, 2022-2-29).
110 | carnival_date(2023-2-19, 2023-2-21).
111 | carnival_date(2024-2-11, 2025-2-13).
112 | carnival_date(2025-3-02, 2025-3-04).
113 |
114 | chinese_new_year_date(2015-02-19,2015-02-20).
115 | chinese_new_year_date(2016-02-08,2016-02-09).
116 | chinese_new_year_date(2017-01-28,2017-01-29).
117 | chinese_new_year_date(2018-02-16,2018-02-17).
118 | chinese_new_year_date(2019-02-05,2019-02-06).
119 | chinese_new_year_date(2020-01-25,2020-01-26).
120 | chinese_new_year_date(2021-02-12,2021-02-13).
121 | chinese_new_year_date(2022-02-01,2022-02-02).
122 | chinese_new_year_date(2023-01-22,2023-01-23).
123 | chinese_new_year_date(2024-02-10,2024-02-11).
124 | chinese_new_year_date(2025-01-29,2025-01-30).
125 | chinese_new_year_date(2026-02-17,2026-02-18).
126 | chinese_new_year_date(2027-02-06,2027-02-07).
127 | chinese_new_year_date(2028-01-26,2028-01-27).
128 | chinese_new_year_date(2029-02-13,2029-02-14).
129 | chinese_new_year_date(2030-02-03,2030-02-04).
130 |
131 | /**
132 | * chinese_new_year_animal(?Year, ?Animal).
133 | *
134 | * Succeeds iff Animal matches the Chinese zodiac animal for Year.
135 | */
136 | chinese_new_year_animal(2015, 'Sheep').
137 | chinese_new_year_animal(2016, 'Monkey').
138 | chinese_new_year_animal(2017, 'Rooster').
139 | chinese_new_year_animal(2018, 'Dog').
140 | chinese_new_year_animal(2019, 'Pig').
141 | chinese_new_year_animal(2020, 'Rat').
142 | chinese_new_year_animal(2021, 'Ox').
143 | chinese_new_year_animal(2022, 'Tiger').
144 | chinese_new_year_animal(2023, 'Rabbit').
145 | chinese_new_year_animal(2024, 'Dragon').
146 | chinese_new_year_animal(2025, 'Snake').
147 | chinese_new_year_animal(2026, 'Horse').
148 | chinese_new_year_animal(2027, 'Sheep').
149 | chinese_new_year_animal(2028, 'Monkey').
150 | chinese_new_year_animal(2029, 'Rooster').
151 | chinese_new_year_animal(2030, 'Dog').
152 |
153 |
154 | %% year(-Year)
155 | %
156 | % True when Year is the current year
157 |
158 | year(Year) :-
159 | get_time(Now),
160 | stamp_date_time(Now, Term, 'UTC'),
161 | date_time_value(year, Term, Year).
162 |
163 | date_between(SDate, STime, EDate, ETime) :-
164 | get_time(Now),
165 | stamp(SDate, STime, Start), Now >= Start,
166 | stamp(EDate, ETime, End), Now =< End.
167 |
168 | stamp(YY-MM-DD, H:M:S, Time) :-
169 | date_time_stamp(date(YY,MM,DD,H,M,S,0,'UTC',-), Time).
170 |
--------------------------------------------------------------------------------
/http_fork.pl:
--------------------------------------------------------------------------------
1 | :- module(http_fork,
2 | [ forked_server/2 % +Port, +Options
3 | ]).
4 | :- use_module(library(unix)).
5 | :- use_module(library(socket)).
6 | :- use_module(library(option)).
7 | :- use_module(library(debug)).
8 | :- use_module(library(http/thread_httpd)).
9 | :- use_module(library(http/http_dispatch)).
10 |
11 | /** Manage HTTP servers using forking
12 |
13 | This module is designed to create robust Prolog-based HTTP servers. The
14 | main Prolog process loads the program and preforks _N_ times, each of
15 | the childs runs a normal multi-threaded HTTP server. If a child dies,
16 | the main server forks again to create a new server.
17 |
18 | @compat This library is limited to systems providing a proper
19 | copy-on-write implementation of the POSIX fork() system call.
20 | In practice, these are Unix versions (including Linux, MacOSX, etc.
21 | but excluding Windows).
22 |
23 | @tbd The current implementation does not support session-management
24 | if multiple servers are preforked because sessions may `hop'
25 | between servers. This could be fixed using TIPC to establish
26 | a distributed communication service between the cooperating
27 | clients.
28 |
29 | @tbd Deal with logging of the clients. Apache does so using a log
30 | process. The main server creates a pipe. The input is used
31 | by each client for writing the log. The output is processed
32 | by the log process. This process merely combines all terms
33 | and writes them to the logfile. Note that we cannot use
34 | threads because fork() doesn't play well with threads, so
35 | the main server must remain single-threaded.
36 |
37 | @tbd At a next step, the threaded HTTP server must be extended
38 | to support scheduled graceful suicide. By gracefully comitting
39 | suicide, the server can avoid suffering too much from memory leaks.
40 | */
41 |
42 |
43 | %% forked_server(+Port, +Options)
44 | %
45 | % Similar to http_server/2 from library(http/thread_httpd), but
46 | % the main process starts and monitors a pool of processes.
47 | % Additional options processed:
48 | %
49 | % * prefork(+Count)
50 | % The number of servers to fork (default 1)
51 | % * init(:Goal)
52 | % Goal to run in a new server after the fork and before
53 | % starting the HTTP server.
54 |
55 | forked_server(Port, Options) :-
56 | tcp_socket(Socket),
57 | tcp_setopt(Socket, reuseaddr),
58 | tcp_bind(Socket, Port),
59 | tcp_listen(Socket, 5),
60 | thread_httpd:make_addr_atom('httpd@', Port, Queue),
61 | prefork_servers([ queue(Queue),
62 | tcp_socket(Socket),
63 | port(Port)
64 | | Options
65 | ]).
66 |
67 | prefork_servers(Options) :-
68 | option(prefork(Count), Options, 1),
69 | prefork_servers(Count, Options, PIDS),
70 | monitor_servers(PIDS, Options).
71 |
72 | prefork_servers(Count, Options, [PID|PIDS]) :-
73 | Count > 0, !,
74 | prefork_server(Options, PID),
75 | Count2 is Count - 1,
76 | prefork_servers(Count2, Options, PIDS).
77 | prefork_servers(_, _, []).
78 |
79 | prefork_server(Options, PID) :-
80 | fork(PID),
81 | ( PID == child
82 | -> option(goal(Goal), Options, http_dispatch),
83 | option(init(Init), Options, true),
84 | call(Init),
85 | http_server(Goal, Options),
86 | forall(thread_get_message(Goal),
87 | Goal)
88 | ; debug(http(fork), 'Preforked server (PID=~d)', [PID])
89 | ).
90 |
91 | :- multifile
92 | thread_httpd:make_socket_hook/3.
93 |
94 | thread_httpd:make_socket_hook(_Port, Options, Options) :-
95 | memberchk(tcp_socket(_), Options), !.
96 |
97 | monitor_servers(PIDS, Options) :-
98 | wait(PID, Status),
99 | debug(http(fork), 'Forked server ~d died with status ~p',
100 | [PID, Status]),
101 | delete(PIDS, PID, Rest),
102 | prefork_server(Options, New),
103 | monitor_servers([New|Rest], Options).
104 |
--------------------------------------------------------------------------------
/load.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog web site
2 |
3 | Author: Jan Wielemaker
4 | E-mail: jan@swi-prolog.org
5 | WWW: https://www.swi-prolog.org
6 | Copyright (C): 2009-2025, SWI-Prolog Solutions b.v.
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalidate any other reasons why the executable file might be covered by
27 | the GNU General Public License.
28 | */
29 |
30 | :- dynamic
31 | pre_files/1.
32 | :- findall(F, source_file(F), FL),
33 | assertz(pre_files(FL)).
34 | :- doc_collect(true).
35 | :- attach_packs(packs, [duplicate(replace)]).
36 | :- load_files([ library(pldoc/doc_library),
37 | library(thread_pool),
38 | library(http/http_session),
39 | library(http/http_unix_daemon),
40 | library(http/http_dyn_workers),
41 | library(prolog_source),
42 | plweb,
43 | examples,
44 | blog,
45 | api,
46 | wiki_edit,
47 | stats,
48 | pack,
49 | register,
50 | changelog,
51 | tagit,
52 | forum,
53 | make,
54 | test_recaptcha,
55 | watchdog
56 | ]).
57 |
58 | :- if(exists_source(library(ssh_server))).
59 | :- use_module(library(ssh_server)).
60 | :- use_module(library(broadcast)).
61 | :- listen(http(pre_server_start),
62 | start_sshd).
63 |
64 | start_sshd :-
65 | absolute_file_name(private('etc/ssh/authorized_keys'), File,
66 | [ access(read)]),
67 | absolute_file_name(private('etc/ssh/ssh_host_ecdsa_key'), HostKey,
68 | [ access(read)]),
69 | ssh_server([ port(2022),
70 | bind_address(*),
71 | authorized_keys_file(File),
72 | host_key_file(HostKey)
73 | ]).
74 | :- endif.
75 |
76 | %! read_comments(+File)
77 | %
78 | % Reads PlDoc comments for a file that was already loaded before
79 | % the server was started.
80 |
81 | read_comments(File) :-
82 | access_file(File, read),
83 | source_file_property(File, module(M)),
84 | !,
85 | setup_call_cleanup(
86 | ( prolog_open_source(File, In),
87 | set_prolog_flag(xref, true),
88 | '$set_source_module'(Old, M)
89 | ),
90 | ( repeat,
91 | prolog_read_source_term(In, Term, _,
92 | [ process_comment(true)
93 | ]),
94 | Term == end_of_file,
95 | !
96 | ),
97 | ( '$set_source_module'(_, Old),
98 | set_prolog_flag(xref, false),
99 | prolog_close_source(In)
100 | )).
101 | read_comments(_). % not a module, we do not care
102 |
103 | reload_pre_files :-
104 | pre_files(FL),
105 | forall(member(F, FL),
106 | read_comments(F)).
107 |
108 | :- reload_pre_files.
109 | :- doc_load_library.
110 | :- http_set_session_options([enabled(false)]).
111 | :- send(@(pce), catch_error_signals, @(off)).
112 |
113 | %! show_fd
114 | %
115 | % Show open file descriptors. Sanity-check that works only on
116 | % Linux systems.
117 |
118 | show_fd :-
119 | current_prolog_flag(pid, Pid),
120 | format(string(Cmd),
121 | '/bin/sh -c "(cd /proc/~w/fd && ls -l | grep socket)"',
122 | [Pid]),
123 | shell(Cmd).
124 |
125 | show_pools :-
126 | format('~`-t~52|~n'),
127 | format('~w~t~20|~t~w~8+~t~w~8+~t~w~8+~t~w~8+~n',
128 | [ 'Pool name', 'Running', 'Size', 'Waiting', 'Backlog' ]),
129 | format('~`-t~52|~n'),
130 | forall(current_thread_pool(Pool), show_pool(Pool)),
131 | format('~`-t~52|~n').
132 |
133 | show_pool(Pool) :-
134 | findall(P, thread_pool_property(Pool, P), List),
135 | memberchk(size(Size), List),
136 | memberchk(running(Running), List),
137 | memberchk(backlog(Waiting), List),
138 | memberchk(options(Options), List),
139 | option(backlog(MaxBackLog), Options, infinite),
140 | format('~w~t~20|~t~D ~8+~t~D ~8+~t~D ~8+~t~w ~8+~n',
141 | [Pool, Running, Size, Waiting, MaxBackLog]).
142 |
143 | stop :-
144 | halt(42).
145 |
--------------------------------------------------------------------------------
/log.pl:
--------------------------------------------------------------------------------
1 | log :-
2 | catch(delete_file(log), _, true),
3 | debug_message_context(+time),
4 | debug(http(request)),
5 | % debug(http(_)>log),
6 | tmon.
7 |
--------------------------------------------------------------------------------
/logs/.gitignore:
--------------------------------------------------------------------------------
1 | *.log
2 | dns_cache
3 | *.hist
4 |
--------------------------------------------------------------------------------
/logs/Makefile:
--------------------------------------------------------------------------------
1 | all: sync convert webalize upload
2 |
3 | sync::
4 | rsync -av ec:/home/vnc/prolog/src/plweb/httpd.log .
5 |
6 | convert::
7 | pl -G1g -s log2clf.pl -q -g main -- -o apache.log httpd.log
8 |
9 | webalize::
10 | webalizer apache.log
11 |
12 | upload::
13 | rsync -aCv --delete report/ ec:/home/vnc/prolog/src/plweb/www/logs
14 |
--------------------------------------------------------------------------------
/logs/README:
--------------------------------------------------------------------------------
1 | rsync -av ec:/home/vnc/prolog/src/plweb/httpd.log .
2 | swipl -s log2clf.pl -q -g main -- -o apache.log httpd.log
3 | webalizer apache.log
4 | rsync -aCv report/ ec:/home/vnc/prolog/src/plweb/www/logs
5 |
6 |
7 | Update graphics:
8 |
9 | ./dl-summary httpd.log
10 | ./dl-stat -o swi-prolog-downloads.jpeg *.dat
11 | rsync -av swi-prolog-downloads.jpeg ec:~vnc/prolog/src/plweb/www/logs
12 |
--------------------------------------------------------------------------------
/logs/dl-stat:
--------------------------------------------------------------------------------
1 | #!/home/swipl/bin/swipl
2 |
3 | :- set_prolog_flag(verbose, silent).
4 | :- initialization main, halt.
5 |
6 | :- use_module(stat).
7 | :- use_module(plstat).
8 |
9 | load_data_files(Files, [End|ByMonth]) :-
10 | maplist(read_file_to_terms, Files, NestTerms),
11 | append(NestTerms, AllTerms),
12 | partition(month_term, AllTerms, AllMonths, Ends),
13 | sort(Ends, AllEnds),
14 | last(AllEnds, End),
15 | map_list_to_pairs(month_key, AllMonths, Keyed),
16 | keysort(Keyed, SortedMonths),
17 | group_pairs_by_key(SortedMonths, Grouped),
18 | make_months(Grouped, ByMonth).
19 |
20 | read_file_to_terms(File, Terms) :-
21 | read_file_to_terms(File, Terms, []).
22 |
23 | month_term(downloads(_Y, _M, _C)).
24 |
25 | month_key(downloads(Y, M, _C), Y/M).
26 |
27 | make_months([], []).
28 | make_months([_-List|T0], [M|T]) :-
29 | sum_counts(List, M),
30 | make_months(T0, T).
31 |
32 | sum_counts([One], One) :- !.
33 | sum_counts([H1,H2|T], Sum) :-
34 | sum_count(H1, H2, H),
35 | sum_counts([H|T], Sum).
36 |
37 | sum_count(downloads(Y,M,Cs1),
38 | downloads(Y,M,Cs2),
39 | downloads(Y,M,Cs)) :-
40 | sort(Cs1, Css1),
41 | sort(Cs2, Css2),
42 | sum(Css1, Css2, Cs).
43 |
44 | sum([], [], []) :- !.
45 | sum(L, [], L) :- !.
46 | sum([], L, L) :- !.
47 | sum([N=V1|T1], [N=V2|T2], [N=V|T]) :- !,
48 | V is V1+V2,
49 | sum(T1, T2, T).
50 | sum([N1=V1|T1], [N2=V2|T2], [N1=V1|T]) :-
51 | N1 @< N2, !,
52 | sum(T1, [N2=V2|T2], T).
53 | sum(L1, [H|T2], [H|T]) :-
54 | sum(L1, T2, T).
55 |
56 | sums(Options, Terms) :-
57 | option(sum_year(Y), Options), !,
58 | findall(C, member(downloads(Y, _, C), Terms), L),
59 | flatten(L, List),
60 | aggregate_all(sum(X), member(_=X, List), Count),
61 | format('Total downloads over ~d: ~D~n', [Y, Count]).
62 | sums(_,_).
63 |
64 |
65 | :- prolog_load_context(directory, Dir),
66 | working_directory(_, Dir).
67 |
68 | main :- catch(run, E, print_message(error, E)).
69 | run :-
70 | current_prolog_flag(argv, Argv),
71 | main_options(Argv, Options, Files),
72 | option(out(Out), Options, _),
73 | ( var(Out)
74 | -> Out = '../www/logs/swi-prolog-downloads.jpeg'
75 | ; true
76 | ),
77 | load_data_files(Files, Terms),
78 | sums(Options, Terms),
79 | stat2jpeg(Out, Terms).
80 |
81 | main_options(['-o', Out|T0], [out(Out)|OT], T) :- !,
82 | main_options(T0, OT, T).
83 | main_options(['-s', YA|T0], [sum_year(Y)|OT], T) :- !,
84 | atom_number(YA, Y),
85 | main_options(T0, OT, T).
86 | main_options(Files, [], Files).
87 |
88 |
--------------------------------------------------------------------------------
/logs/dl-summary:
--------------------------------------------------------------------------------
1 | #!/home/swipl/bin/swipl
2 |
3 | :- initialization main.
4 |
5 | :- use_module(logstat).
6 | :- use_module(plstat).
7 |
8 | terms([ date(Year, Month, Day)
9 | | Terms
10 | ]) :-
11 | Term = downloads(_Year, _Month, _Counts),
12 | findall(Term, Term, Terms),
13 | get_time(Stamp),
14 | stamp_date_time(Stamp, Date, 'UTC'),
15 | date_time_value(year, Date, Year),
16 | date_time_value(month, Date, Month),
17 | date_time_value(day, Date, Day).
18 |
19 | save_terms(File, Terms) :-
20 | setup_call_cleanup(open(File, write, Out),
21 | ( format(Out,
22 | '%%\tdownloads(Year, Month, Counts)~n~n',
23 | []),
24 | forall(member(T, Terms),
25 | format(Out, '~q.~n', [T]))
26 | ),
27 | close(Out)).
28 |
29 | usage :-
30 | format(user_error, 'Usage: dl-summary logfile [out]~n', []),
31 | fail.
32 |
33 | main :-
34 | catch(run, E, (print_message(error, E), fail)).
35 |
36 |
37 | run :-
38 | current_prolog_flag(argv, Argv),
39 | ( Argv = [LogFile, Out]
40 | -> true
41 | ; Argv = [LogFile]
42 | -> file_name_extension(Base, log, LogFile),
43 | file_name_extension(Base, dat, Out)
44 | ; usage
45 | ),
46 | read_log(LogFile, [skip_bad_requests(true)]),
47 | terms(Terms),
48 | save_terms(Out, Terms).
49 |
50 |
--------------------------------------------------------------------------------
/logs/httpd-2009-02-20.dat:
--------------------------------------------------------------------------------
1 | %% downloads(Year, Month, Counts)
2 |
3 | date(2009, 2, 20).
4 | downloads(2009, 2, [doc=35, linux=382, mac=387, source=558, win32=5465, win64=545]).
5 |
--------------------------------------------------------------------------------
/logs/httpd-2009-08-12.dat:
--------------------------------------------------------------------------------
1 | %% downloads(Year, Month, Counts)
2 |
3 | date(2009, 8, 12).
4 | downloads(2009, 2, [doc=19, linux=197, mac=175, source=251, win32=2469, win64=294]).
5 | downloads(2009, 3, [doc=38, linux=851, mac=832, source=1177, win32=10550, win64=1375]).
6 | downloads(2009, 4, [doc=10, linux=753, mac=787, source=937, win32=9014, win64=1232]).
7 | downloads(2009, 5, [doc=15, linux=706, mac=533, source=923, win32=8246, win64=1186]).
8 | downloads(2009, 6, [doc=47, linux=459, mac=421, source=772, win32=6664, win64=906]).
9 | downloads(2009, 7, [doc=62, linux=321, mac=358, source=606, win32=4336, win64=651]).
10 | downloads(2009, 8, [doc=19, linux=104, mac=123, source=240, win32=1243, win64=207]).
11 |
--------------------------------------------------------------------------------
/logs/log2clf.pl:
--------------------------------------------------------------------------------
1 | %#!/home/janw/bin/pl -q -g main -s
2 |
3 | % You can make this program executable by removing the % from the first
4 | % line and update the path the SWI-Prolog interpreter
5 |
6 | % Convert Prolog logs to apache's Combined Log Format
7 | % http://httpd.apache.org/docs/1.3/logs.html#combined
8 |
9 | :- use_module(logstat).
10 | :- use_module(library(http/http_header)).
11 | :- use_module(library(main)).
12 |
13 | :-dynamic
14 | outfile/1,
15 | logfile/1.
16 |
17 | main([]) :- !,
18 | usage.
19 | main(Argv) :-
20 | retractall(outfile(_)),
21 | retractall(logfile(_)),
22 | ( process_argv(Argv, Options)
23 | -> true
24 | ; usage
25 | ),
26 | ( outfile(Out)
27 | -> write_clf(Out, Options)
28 | ; write_records(current_output, Options)
29 | ).
30 |
31 | usage :-
32 | format(user_error,
33 | 'Usage: log2clf [-o out] [-a date] [-b date] file ...~n', []),
34 | halt(1).
35 |
36 | process_argv([], []).
37 | process_argv(['-o', OutFile|T], Options) :-
38 | assert(outfile(OutFile)), !,
39 | process_argv(T, Options).
40 | process_argv(['-a', After|T0], [after(Date)|T]) :- !,
41 | text_to_data(After, Date),
42 | process_argv(T0, T).
43 | process_argv(['-b', Before|T0], [before(Date)|T]) :- !,
44 | text_to_data(Before, Date),
45 | process_argv(T0, T).
46 | process_argv([F|T], Options) :-
47 | assert(logfile(F)),
48 | read_log(F),!,
49 | process_argv(T, Options).
50 |
51 | text_to_data(Text, Y/M/D) :-
52 | atomic_list_concat([YA, MA, DA], /, Text),
53 | atom_number(YA, Y),
54 | atom_number(MA, M),
55 | atom_number(DA, D).
56 |
57 |
58 | writerecord(Out, LogRecord) :-
59 | memberchk(ip(IP), LogRecord),
60 | memberchk(time(Time), LogRecord),
61 | memberchk(path(Path), LogRecord),
62 | memberchk(referer(Referer), LogRecord),
63 | memberchk(result(Result), LogRecord),
64 | memberchk(extra(Extra), LogRecord),
65 | (memberchk(user_agent(Agent), Extra) -> true; Agent='-'),
66 | memberchk(http_version(Http1-Http2), Extra),
67 | format_time(atom(TimeStamp), "[%d/%b/%Y:%H:%M:%S %z]",Time),
68 | result_code(LogRecord, Extra, Result, ResultCode),
69 | (memberchk(bytes(Bytes), Extra) -> true; Bytes='-'),
70 | format(Out, '~w - - ~w "GET ~w HTTP/~w.~w" ~w ~w "~w" "~w"~n',
71 | [IP, TimeStamp, Path, Http1, Http2, ResultCode, Bytes, Referer, Agent]),
72 | !.
73 |
74 | writerecord(_, LogRecord) :-
75 | format(user_error, "Could not convert log record ~w~n", [LogRecord]).
76 |
77 | write_clf(Out, Options):-
78 | open(Out, write, OutS, [encoding(utf8)]),
79 | call_cleanup(write_records(OutS, Options), close(OutS)).
80 |
81 | %% write_records(+Stream) is det.
82 | %
83 | % Write the records. If we have multiple files, we must sort them.
84 | % Possibly this should be an option. It was designed to deal with
85 | % multiple files from a load-balancer, but it could of course also
86 | % be used with multiple files from a single server.
87 |
88 | write_records(OutS, Options) :-
89 | Queries = [ ip(_),
90 | path(_),
91 | referer(_),
92 | result(_),
93 | code(_),
94 | extra(_)
95 | | Options
96 | ],
97 | findall(F, logfile(F), Fs),
98 | length(Fs, NFiles),
99 | ( NFiles =< 1
100 | -> Params = [time(Time)|Queries],
101 | forall(logrecord(Params),
102 | writerecord(OutS,Params))
103 | ; findall(Time-logrecord([time(Time)|Queries]),
104 | logrecord([time(Time)|Queries]),
105 | Logrecords),
106 | keysort(Logrecords, Sorted),
107 | forall(member(_-logrecord(Params),Sorted),
108 | writerecord(OutS,Params))
109 | ).
110 |
111 |
112 | result_code(Record, _, _, Code) :-
113 | memberchk(code(Code), Record), !.
114 | result_code(_, Extra, _, Code) :-
115 | memberchk(code(Code), Extra), !.
116 | result_code(_, _, Status, Code) :-
117 | status_to_code(Status, Code).
118 |
119 | status_to_code(ok,200) :- !.
120 | status_to_code(true,200) :- !.
121 | status_to_code(file(_,_), 200) :- !.
122 | status_to_code(tmp_file(_,_), 200) :- !.
123 | status_to_code(moved(_), 301) :- !.
124 | status_to_code(not_modified, 304) :- !.
125 | status_to_code(moved_temporary(_), 307) :- !.
126 | status_to_code(error(404,_), 404) :- !.
127 | status_to_code(forbidden(_), 403) :- !.
128 | status_to_code(error(_R), 400) :- !.
129 | status_to_code(unavailable(_), 503) :- !.
130 | status_to_code(no_reply, 500) :- !.
131 | status_to_code(busy, 503) :- !.
132 | status_to_code(R,-) :-
133 | format('Error: No map for result ~w~n', [R]),!.
134 |
135 |
--------------------------------------------------------------------------------
/logs/plstat.pl:
--------------------------------------------------------------------------------
1 | :- module(plstat,
2 | [ downloads/3 % -Term
3 | ]).
4 | :- use_module(logstat).
5 | :- use_module(library(aggregate)).
6 |
7 | % downloads(Month, Year, Counts:pairs)
8 |
9 | downloads(Year, Month, Pairs) :-
10 | setof(Platform=Count,
11 | aggregate(count, download(Year, Month, Platform), Count),
12 | Pairs).
13 |
14 |
15 | download(Year, Month, Platform) :-
16 | ( logrecord([time(Stamp), path(Path), code(200)])
17 | *-> true
18 | ; logrecord([time(Stamp), path(Path), result(file(_,_))])
19 | ),
20 | atom_concat('/download/', More, Path),
21 | atom_codes(More, Codes),
22 | phrase(file_details(_Version, Platform), Codes),
23 | stamp_date_time(Stamp, Date, 'UTC'),
24 | date_time_value(year, Date, Year),
25 | date_time_value(month, Date, Month).
26 |
27 | file_details(Version, Platform) -->
28 | string(_), "/", !,
29 | file_details(Version, Platform).
30 | file_details(Version, win32) -->
31 | "w32pl",
32 | short_version(Version),
33 | ".exe".
34 | file_details(Version, win64) -->
35 | "w64pl",
36 | short_version(Version),
37 | ".exe".
38 | file_details(Version, linux) -->
39 | "pl-",
40 | long_version(Version),
41 | "-", integer(_), ".", identifier(_), ".rpm".
42 | file_details(Version, source) -->
43 | "pl-",
44 | long_version(Version),
45 | ".tar.gz".
46 | file_details(Version, doc) -->
47 | "pl-doc-",
48 | long_version(Version),
49 | ".tar.gz".
50 | file_details(Version, mac) -->
51 | "swi-prolog-",
52 | long_version(Version),
53 | mac.
54 | file_details(Version, mac) -->
55 | "swi-prolog-devel-",
56 | long_version(Version),
57 | mac.
58 |
59 | mac --> "-mac", !, skip_rest(_).
60 | mac --> macos, macarch, ".mpkg", !, skip_rest(_).
61 |
62 | macos --> "-tiger".
63 | macos --> "-leopard".
64 | macos --> "".
65 | macarch --> "-powerpc".
66 | macarch --> "-intel".
67 | macarch --> "".
68 |
69 | integer(I) -->
70 | digit(D0),
71 | digits(DT),
72 | { number_codes(I, [D0|DT])
73 | }.
74 |
75 | digit(D) -->
76 | [D],
77 | { code_type(D, digit)
78 | }.
79 |
80 | digits([H|T]) -->
81 | digit(H), !,
82 | digits(T).
83 | digits([]) -->
84 | [].
85 |
86 | identifier(Atom) -->
87 | [C0],
88 | { code_type(C0, alpha)
89 | },
90 | alnums(CT),
91 | { atom_codes(Atom, [C0|CT])
92 | }.
93 |
94 | alnums([H|T]) -->
95 | [H],
96 | { code_type(H, alnum)
97 | }, !,
98 | alnums(T).
99 | alnums([]) -->
100 | [].
101 |
102 | string([]) -->
103 | [].
104 | string([H|T]) -->
105 | [H],
106 | string(T).
107 |
108 | skip_rest(Rest, Rest, "").
109 |
110 | long_version(V) -->
111 | integer(Major), ".", integer(Minor), ".", integer(Patch),
112 | { concat_atom([Major, Minor, Patch], '.', V)
113 | }.
114 |
115 | short_version(V) -->
116 | digit(Major),
117 | digit(Minor),
118 | digits(Patch),
119 | { atom_codes(V, [Major, 0'., Minor, 0'. | Patch])
120 | }.
121 |
--------------------------------------------------------------------------------
/logs/report/.gitignore:
--------------------------------------------------------------------------------
1 | *.html
2 | *.png
3 | *.db
4 |
--------------------------------------------------------------------------------
/logs/report/webalizer.css:
--------------------------------------------------------------------------------
1 | /* -----------------------------------------------------------------------
2 | * Stone Steps Webalizer Style Sheet
3 | * Copyright 2004-2007 Stone Steps Inc. (www.stonesteps.ca)
4 | * ----------------------------------------------------------------------- */
5 |
6 | /*
7 | * Basic HTML Styles
8 | */
9 | body {background-color: white; color: black; font: 10pt Arial, sans-serif; margin: 0; padding: 0;}
10 | table {font: 9pt Arial, sans-serif;}
11 | h1 {font-size: 14pt; margin: 0.5em 0;}
12 | a {color: blue;}
13 | a:visited {color: red;}
14 | img {margin: 0 auto; display: block;}
15 |
16 | /*
17 | * Shared Classes
18 | */
19 | pre.details_pre {font-size: 8pt; margin-left: 5px;}
20 | p.note_p {margin: auto 30px; color: #606060; font: 8pt Arial, sans-serif; text-align: center;}
21 |
22 | /*
23 | *
24 | */
25 | td.spammer, span.spammer {color: red;}
26 | td.robot, span.robot {color: green;}
27 | td.converted, span.converted {color: inherit;}
28 | td.target, span.target {color: inherit;}
29 |
30 | /*
31 | * Graph Holders
32 | */
33 | div.graph_holder {margin: 1em auto; padding: 0; border: 1px solid #333333; background-color: #E3E3E3;}
34 | div#monthly_summary_graph {}
35 | div#daily_usage_graph, div#hourly_usage_graph, div#country_usage_graph {width: 512px;}
36 |
37 | /*
38 | * Colorized Header Cells (Hits, Pages, Visits, etc)
39 | */
40 | th.counter_th, .counter {background-color: #C0C0C0;}
41 | th.hits_th, .hits {background-color: #008040;}
42 | th.files_th, .files {background-color: #0080FF;}
43 | th.pages_th, .pages {background-color: #00E0FF;}
44 | th.visits_th, .visits {background-color: #FFFF00;}
45 | th.duration_th, .duration {background-color: #FFD700;}
46 | th.hosts_th, .hosts {background-color: #FF8000;}
47 | th.kbytes_th, .xfer {background-color: #FF2F2F;}
48 | th.time_th, .time {background-color: #66A1FF;}
49 | th.errors_th, .errors {background-color: #FFD700;}
50 | th.count_th, .count {background-color: #FFD700;}
51 | th.item_th, .item {background-color: #00E0FF;}
52 | th.method_th, .method {background-color: #8FBC8F;}
53 | th.dlname_th, .dlname {background-color: #8FBC8F;}
54 | th.country_th, .country {background-color: #B0E0E6;}
55 |
56 | tr.weekend_tr, .weekend {background-color: #D2EDF1;}
57 |
58 | /*
59 | * Highlight the row under the mouse pointer (IE doesn't support this)
60 | */
61 | tbody.summary_data_tbody tr:hover th,
62 | tbody.summary_data_tbody tr:hover td,
63 | tbody.totals_data_tbody tr:hover th,
64 | tbody.totals_data_tbody tr:hover td,
65 | tbody.stats_data_tbody tr:hover td,
66 | tbody.stats_data_tbody tr:hover th {background-color: #FFFFD4;}
67 | tbody tr.group_shade_tr:hover td,
68 | tbody tr.group_shade_tr:hover th {background-color: #ADD8E6;}
69 |
70 | /*
71 | * Search Type Span
72 | */
73 | span.search_type {color: gray;}
74 |
75 | /*
76 | * Page Header & Footer Classes
77 | */
78 | div.page_header_div {background-color: #E5E5E5; border-bottom: 1px solid #CCCCCC; margin: 0; padding: .5em;}
79 |
80 | div.usage_summary_div {font-size: 8pt; margin: 0;}
81 | div.usage_summary_div em {font-size: 10pt; font-weight: bold; font-style: normal;}
82 |
83 | div.page_footer_div {border-top: 1px solid #CCCCCC; margin-top: 1em; padding: .5em 1em;}
84 | div.page_footer_div div {float: right;}
85 | div.page_footer_div a,
86 | div.page_footer_div a:visited {color: black;}
87 | div.page_footer_div a:hover {color: red;}
88 |
89 | /*
90 | * Page Links
91 | */
92 | table.page_links_table {font-size: 9pt; margin: 1em auto 0; border-collapse: collapse; text-align: center; border-style: none;}
93 | table.page_links_table td {padding: 0; border: 1px solid #578EBE; background: #EEE url("page-links-bg.png") repeat-x;}
94 | table.page_links_table a {color: blue; text-decoration: none; border-style: none; display: block; padding: 1px 5px; margin: 0;}
95 | table.page_links_table a:visited {color: blue;}
96 | table.page_links_table a:hover {color: red; background: #FFF6BF url("page-links-hover-bg.png") repeat-x;}
97 |
98 | /*
99 | * Report table base classes
100 | */
101 | table.report_table {border-collapse: collapse; background-color: #FAFAFA; margin: 1em auto; border-spacing: 1px;}
102 | table.report_table thead {background-color: #CCC;}
103 | table.report_table th,
104 | table.report_table td {padding: 2px 4px; border: 1px solid #888;}
105 | table.report_table thead th {border-color: #333;}
106 | table.report_table tr.table_title_tr {text-align: center; font-size: 12pt; background-color: #DDD;}
107 | table.report_table tr.table_footer_tr {background-color: #DDD;}
108 | table.report_table tr.all_items_tr {background-color: #D8D9E6;}
109 | /* anchors are not links in XML reports, so style them to look like links */
110 | table.report_table tr.all_items_tr a {cursor: pointer;}
111 | table.report_table tr.all_items_tr a:hover {text-decoration: underline;}
112 | /* turn off highlighting for the max-items-displayed row */
113 | table.report_table tr.max_items_tr {background-color: #D8D9E6;}
114 | table.report_table tr.max_items_tr:hover th {background-color: inherit;}
115 |
116 | table.report_table th.small_font_th {font-size: 7pt;}
117 | table.report_table tr.group_shade_tr {background-color: #D8D9E6;}
118 |
119 | /*
120 | * Monthly Summary Table
121 | */
122 | table.monthly_summary_table {width: 600px;}
123 | table.monthly_summary_table tbody.summary_data_tbody {text-align: right;}
124 | table.monthly_summary_table tbody.summary_data_tbody th {text-align: left; font-weight: normal; white-space: nowrap;}
125 | table.monthly_summary_table tbody.summary_footer_tbody td {text-align: right; font-weight: bold;}
126 | table.monthly_summary_table tbody.summary_footer_tbody th {text-align: left;}
127 |
128 | /*
129 | * Monthly Totals Table
130 | */
131 | table.monthly_totals_table {width: 510px;}
132 | table.monthly_totals_table tbody.totals_data_tbody th {text-align: left; font-weight: normal;}
133 | table.monthly_totals_table tbody.totals_data_tbody td {text-align: right; font-weight: bold;}
134 | table.monthly_totals_table tbody.totals_header_tbody {background-color: #DDD;}
135 | table.monthly_totals_table tbody.totals_header_tbody th {text-align: left;}
136 | table.monthly_totals_table tbody.totals_header_tbody td {text-align: right; font-weight: bold;}
137 | table.monthly_totals_table col.totals_data_col {width: 65px;}
138 |
139 | /*
140 | * Daily and Hourly Totals Tables
141 | */
142 | table.totals_table {width: 510px;}
143 | table.totals_table tbody.totals_data_tbody td {text-align: right; font-weight: bold;}
144 | table.totals_table tbody.totals_data_tbody td.data_percent_td {font-size: 7pt; font-weight: normal;}
145 |
146 | /*
147 | * Stats Table
148 | */
149 | table.stats_table {width: 510px;}
150 | table.stats_table tbody.stats_data_tbody td {text-align: right; font-weight: bold;}
151 | table.stats_table tbody.stats_data_tbody td.data_percent_td {font-size: 7pt; font-weight: normal;}
152 | table.stats_table tbody.stats_data_tbody td.stats_data_item_td {font-weight: normal; text-align: left; white-space: nowrap;}
153 | table.stats_table tbody.stats_footer_tbody td {text-align: center;}
154 | table.stats_table tbody.all_items_tbody {display: none;}
155 |
--------------------------------------------------------------------------------
/logs/stat.pl:
--------------------------------------------------------------------------------
1 | :- module(stat,
2 | [ stat/1,
3 | stat2jpeg/2 % +Out, +Terms
4 | ]).
5 | :- use_module(library(pce)).
6 | :- use_module(library(autowin)).
7 | :- use_module(library('plot/barchart')).
8 | :- use_module(library(gradient)).
9 | :- use_module(library(lists)).
10 |
11 | :- ensure_x_server(125, 24).
12 |
13 | stat(Terms) :-
14 | Win = @stats,
15 | free(Win),
16 | stat(Terms, BarChart),
17 | new(Win, auto_sized_picture('Statistics')),
18 | send(Win, display, BarChart),
19 | send(Win, open).
20 |
21 | stat2jpeg(Jpeg, Terms) :-
22 | stat(Terms, BarChart),
23 | get(@pce, convert, BarChart, pixmap, Img),
24 | send(Img, save, Jpeg, jpeg).
25 |
26 | stat(Terms, BC) :-
27 | length(Terms, N),
28 | new(BC, bar_chart(vertical, 0, 15000, 300, N, 15, 2)),
29 | title(BC, Terms),
30 | legenda(Legenda),
31 | send(BC, display, Legenda, point(50, 50)),
32 | ( member(downloads(Y, Mon, Counts), Terms),
33 | sum_counts(Counts, T),
34 | T > 0,
35 | Y >= 2000,
36 | count(source, Counts, S),
37 | count(linux, Counts, L),
38 | count(mac, Counts, M),
39 | count(win32, Counts, W32),
40 | count(win64, Counts, W64),
41 | count(doc, Counts, DOC),
42 | month_name(Mon, Month),
43 | atomic_list_concat([Month, -, Y], Label),
44 | ( member(date(Y, Mon, Day), Terms)
45 | -> Day > 2,
46 | XS is round(S * 30/Day) - S,
47 | XL is round(L * 30/Day) - L,
48 | XM is round(M * 30/Day) - M,
49 | XW32 is round(W32 * 30/Day) - W32,
50 | XW64 is round(W64 * 30/Day) - W64,
51 | XDOC is round(DOC * 30/Day) - DOC,
52 | send(BC, append,
53 | bar_stack(Label,
54 | download_bar(source, true, XS),
55 | download_bar(source, false, S),
56 | download_bar(linux, true, XL),
57 | download_bar(linux, false, L),
58 | download_bar(mac, true, XM),
59 | download_bar(mac, false, M),
60 | download_bar(win32, true, XW32),
61 | download_bar(win32, false, W32),
62 | download_bar(win64, true, XW64),
63 | download_bar(win64, false, W64),
64 | download_bar(doc, true, XDOC),
65 | download_bar(doc, false, XDOC)))
66 | ; send(BC, append,
67 | bar_stack(Label,
68 | download_bar(source, false, S),
69 | download_bar(linux, false, L),
70 | download_bar(mac, false, M),
71 | download_bar(win32, false, W32),
72 | download_bar(win64, false, W64),
73 | download_bar(doc, false, DOC)))
74 | ),
75 | fail
76 | ; send(BC, nbars)
77 | ).
78 |
79 | sum_counts([], 0).
80 | sum_counts([_=C|T], Sum) :-
81 | sum_counts(T, Sum0),
82 | Sum is C+Sum0.
83 |
84 | count(Which, Counts, Count) :-
85 | memberchk(Which=Count, Counts), !.
86 | count(_, _, 0).
87 |
88 | month_name(1, jan).
89 | month_name(2, feb).
90 | month_name(3, mar).
91 | month_name(4, apr).
92 | month_name(5, may).
93 | month_name(6, jun).
94 | month_name(7, jul).
95 | month_name(8, aug).
96 | month_name(9, sep).
97 | month_name(10, oct).
98 | month_name(11, nov).
99 | month_name(12, dec).
100 |
101 | title(BC, Terms) :-
102 | member(date(Y, Mon, Day), Terms), !,
103 | send(BC, display,
104 | text(string('SWI-Prolog downloads until %d %s %s',
105 | Day, Mon, Y),
106 | left,
107 | boldlarge),
108 | point(50, 15)).
109 | title(BC, _) :-
110 | send(BC, display,
111 | text(string('SWI-Prolog downloads'), left, boldlarge),
112 | point(50, 15)).
113 |
114 |
115 | legenda(Dev) :-
116 | new(Dev, figure),
117 | send(Dev, format, new(F, format(horizontal, 2, @on))),
118 | send(F, row_sep, 0),
119 | legenda_entry(Dev, source, false, 'Source'),
120 | legenda_entry(Dev, doc, false, 'Documentation'),
121 | legenda_entry(Dev, linux, false, 'Linux RPM (exluding CD-distributions)'),
122 | legenda_entry(Dev, mac, false, 'MacOS X'),
123 | legenda_entry(Dev, win32, false, 'MS-Windows'),
124 | legenda_entry(Dev, win64, false, 'MS-Windows 64-bit edition'),
125 | legenda_entry(Dev, win64, true, 'interpolated (current month)').
126 |
127 | legenda_entry(Dev, Id, Invert, Label) :-
128 | send(Dev, display, new(B, box(15, 10))),
129 | send(B, fill_offset, point(0,0)),
130 | bar_colour(Id, Invert, Gradient),
131 | send(B, fill_pattern, Gradient),
132 | send(Dev, display, text(Label)).
133 |
134 | :- pce_begin_class(download_bar, bar).
135 |
136 | initialise(Bar, Type:name, Estimate, Value:int) :->
137 | bar_colour(Type, Estimate, Colour),
138 | send_super(Bar, initialise, Type, Value, Colour).
139 |
140 | :- pce_end_class(download_bar).
141 |
142 |
143 | /*******************************
144 | * COLOURS *
145 | *******************************/
146 |
147 |
148 | % nth_bar_gradient(N, Hue, S, Vtop, VBottom)
149 |
150 | bar_gradient(source, 193, 80, 100, 20).
151 | bar_gradient(doc, 250, 80, 100, 20).
152 | bar_gradient(linux, 300, 80, 100, 20).
153 | bar_gradient(mac, 160, 80, 100, 20).
154 | bar_gradient(win32, 54, 80, 100, 20).
155 | bar_gradient(win64, 340, 80, 100, 20).
156 | bar_gradient( 5, 80, 80, 100, 20).
157 | bar_gradient( 6, 45, 80, 100, 20).
158 | bar_gradient( 7, 61, 80, 100, 20).
159 | bar_gradient( 8, 280, 80, 100, 20).
160 | bar_gradient( 9, 225, 80, 100, 20).
161 |
162 | :- dynamic
163 | colour_cache/2.
164 |
165 | bar_colour(Name, Inverse, Img) :-
166 | bar_gradient(Name, H, S0, VT, VB), !,
167 | ( Inverse == true
168 | -> Va = VT, Vz = VB, S = 30
169 | ; Va = VB, Vz = VT, S = S0
170 | ),
171 | new(Img, gradient(@nil,
172 | colour(@default, H, S, Va, hsv),
173 | colour(@default, H, S, Vz, hsv),
174 | 15, horizontal)),
175 | asserta(colour_cache(Name, Img)).
176 |
177 |
--------------------------------------------------------------------------------
/logs/webalizer.conf:
--------------------------------------------------------------------------------
1 | LogType clf
2 | HostName www.swi-prolog.org
3 | OutputDir report
4 | DNSCache dns_cache
5 | DNSChildren 5
6 | GeoIPDBPath /usr/local/webalizer/GeoIP.dat
7 | AllURLs yes
8 | AllSearchStr yes
9 | AllHosts yes
10 | MangleAgents 5
11 | TopCountries 300
12 |
--------------------------------------------------------------------------------
/make.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Jan Wielemaker
4 | E-mail: J.Wielemaker@cs.vu.nl
5 | WWW: http://www.swi-prolog.org
6 | Copyright (C): 2015, VU University Amsterdam
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalidate any other reasons why the executable file might be covered by
27 | the GNU General Public License.
28 | */
29 |
30 | :- module(web_make, []).
31 | :- use_module(library(option)).
32 | :- use_module(library(http/http_dispatch)).
33 | :- use_module(library(make)).
34 | :- use_module(library(broadcast)).
35 |
36 | :- use_module(messages).
37 | :- use_module(openid).
38 |
39 | :- http_handler(root(make), web_make, []).
40 |
41 | web_make(_Request) :-
42 | site_user_logged_in(User),
43 | site_user_property(User, granted(admin)), !,
44 | call_showing_messages(update, []).
45 | web_make(Request) :-
46 | option(path(Path), Request),
47 | throw(http_reply(forbidden(Path))).
48 |
49 | update :-
50 | make,
51 | broadcast(modified(wiki(reindex))).
52 |
--------------------------------------------------------------------------------
/markdown.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Jan Wielemaker
4 | E-mail: J.Wielemaker@cs.vu.nl
5 | WWW: http://www.swi-prolog.org
6 | Copyright (C): 2013, VU University Amsterdam
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalidate any other reasons why the executable file might be covered by
27 | the GNU General Public License.
28 | */
29 |
30 | :- module(markdown,
31 | [ markdown_dom/2 % +MarkDown, -DOM
32 | ]).
33 | :- use_module(library(sgml)).
34 | :- use_module(library(process)).
35 | :- use_module(library(error)).
36 |
37 | /** Parse markdown documents into a DOM
38 | */
39 |
40 | :- create_prolog_flag(markdown_program, markdown, []).
41 |
42 | %% markdown_dom(+Input, -DOM) is det.
43 | %
44 | % Process markdown input into an HTML DOM structure compatible to
45 | % load_structure/3 and html//1 as provided by
46 | % library(http/html_write).
47 | %
48 | % @param Input is either a term stream(+Stream) or the name of a
49 | % file.
50 |
51 | markdown_dom(stream(Stream), DOM) :- !,
52 | must_be(stream, Stream),
53 | current_prolog_flag(markdown_program, Prog),
54 | process_create(path(Prog), [],
55 | [ stdin(pipe(In)),
56 | stdout(pipe(Out)),
57 | process(PID)
58 | ]),
59 | thread_create(( copy_stream_data(Stream, In),
60 | close(In)
61 | ), _, [detached(true)]),
62 | load_structure(Out, DOM, [dialect(xml)]),
63 | process_wait(PID, _).
64 | markdown_dom(File, DOM) :-
65 | current_prolog_flag(markdown_program, Prog),
66 | process_create(path(Prog), [file(File)],
67 | [ stdout(pipe(Out)),
68 | process(PID)
69 | ]),
70 | load_structure(Out, DOM, [dialect(xml)]),
71 | process_wait(PID, _).
72 |
73 |
--------------------------------------------------------------------------------
/markitup.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Jan Wielemaker
4 | E-mail: J.Wielemaker@cs.vu.nl
5 | WWW: http://www.swi-prolog.org
6 | Copyright (C): 2013, VU University Amsterdam
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalidate any other reasons why the executable file might be covered by
27 | the GNU General Public License.
28 | */
29 |
30 | :- module(markitup,
31 | [ markitup//1
32 | ]).
33 | :- use_module(library(http/http_dispatch)).
34 | :- use_module(library(http/html_head)).
35 | :- use_module(library(http/http_parameters)).
36 | :- use_module(library(http/html_write)).
37 | :- use_module(library(http/js_write)).
38 | :- use_module(library(option)).
39 | :- use_module(library(debug)).
40 | :- use_module(markdown).
41 | :- use_module(wiki).
42 |
43 | /** Wrapper for markItUp ajax markup editor
44 |
45 | @see http://markitup.jaysalvat.com/home/
46 | */
47 |
48 | :- http_handler(root('markitup/preview/markdown'), preview_markdown, []).
49 | :- http_handler(root('markitup/preview/pldoc'), preview_pldoc, []).
50 |
51 | :- html_resource(js('markitup/jquery.markitup.js'),
52 | [ requires([ jquery
53 | ])
54 | ]).
55 | :- html_resource(js('markitup/sets/markdown/set.js'),
56 | [ requires([ js('markitup/jquery.markitup.js'),
57 | js('markitup/skins/markitup/style.css'),
58 | js('markitup/sets/markdown/style.css')
59 | ])
60 | ]).
61 | :- html_resource(markdown,
62 | [ virtual(true),
63 | requires([ js('markitup/sets/markdown/set.js')
64 | ])
65 | ]).
66 | :- html_resource(js('markitup/sets/pldoc/set.js'),
67 | [ requires([ js('markitup/jquery.markitup.js'),
68 | js('markitup/skins/markitup/style.css'),
69 | js('markitup/sets/pldoc/style.css')
70 | ])
71 | ]).
72 | :- html_resource(pldoc,
73 | [ virtual(true),
74 | requires([ js('markitup/sets/pldoc/set.js')
75 | ])
76 | ]).
77 |
78 | %% markitup(Options)// is det.
79 | %
80 | % Insert a =textarea= with markItUp support.
81 |
82 | markitup(Options) -->
83 | { option(markup(Language), Options, markdown),
84 | option(id(Id), Options, markdown),
85 | option(name(Name), Options, Id),
86 | option(cols(Cols), Options, 80),
87 | option(rows(Rows), Options, 20),
88 | option(value(Content), Options, []),
89 | option(preview(Preview), Options, false)
90 | },
91 | html_requires(Language),
92 | html(textarea([id(Id), name(Name), cols(Cols), rows(Rows)], Content)),
93 | js_script({|javascript(Id,Language,Preview)||
94 | $(document).ready(function() {
95 | $("#"+Id).markItUp(eval(Language+"_settings"));
96 | if ( eval(Preview) ) {
97 | $('a[title="Preview"]').trigger("mouseup");
98 | }
99 | });
100 | |}).
101 |
102 |
103 | %% preview_markdown(+Request)
104 | %
105 | % Handle preview requests from markItUp. The data is send using
106 | % a POST request, where the =data= field contains the content of
107 | % the textarea.
108 |
109 | preview_markdown(Request) :-
110 | http_parameters(Request,
111 | [ data(Data, [optional(true), default('')])
112 | ]),
113 | debug(markitup(preview), 'Preview:~n~w~n', [Data]),
114 | open_atom_stream(Data, In),
115 | markdown_dom(stream(In), DOM),
116 | phrase(html(DOM), Tokens),
117 | format('Content-type: text/html; charset=UTF-8\n\n'),
118 | print_html(Tokens).
119 |
120 | %% preview_pldoc(+Request)
121 | %
122 | % Handle preview requests from markItUp. The data is send using
123 | % a POST request, where the =data= field contains the content of
124 | % the textarea.
125 |
126 | preview_pldoc(Request) :-
127 | http_parameters(Request,
128 | [ data(Data, [optional(true), default('')])
129 | ]),
130 | debug(markitup(preview), 'Preview:~n~w~n', [Data]),
131 | atom_codes(Data, Codes),
132 | wiki_file_codes_to_dom(Codes, '/', DOM), % FIXME: What file to pass?
133 | phrase(page(plain, [], [\html_requires(pldoc)|DOM]), Tokens),
134 | format('Content-type: text/html; charset=UTF-8\n\n'),
135 | print_html(Tokens).
136 |
137 |
138 | /*******************************
139 | * UTIL *
140 | *******************************/
141 |
142 | open_atom_stream(Atom, Stream) :-
143 | atom_to_memory_file(Atom, MF),
144 | open_memory_file(MF, read, Stream,
145 | [ free_on_close(true)
146 | ]).
147 |
--------------------------------------------------------------------------------
/messages.pl:
--------------------------------------------------------------------------------
1 | /* Part of ClioPatria
2 |
3 | Author: Jan Wielemaker
4 | E-mail: J.Wielemaker@cs.vu.nl
5 | WWW: http://www.swi-prolog.org
6 | Copyright (C): 2010, VU University Amsterdam
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalidate any other reasons why the executable file might be covered by
27 | the GNU General Public License.
28 | */
29 |
30 | :- module(html_messages,
31 | [ call_showing_messages/2
32 | ]).
33 | :- use_module(library(http/html_write)).
34 | :- use_module(library(http/html_head)).
35 | :- use_module(library(option)).
36 |
37 | /** Run goals that produce messages
38 |
39 | This module allows executing (long running) Prolog goals and see the
40 | messages appear in the browser.
41 | */
42 |
43 | :- meta_predicate
44 | call_showing_messages(0, +).
45 |
46 | %% call_showing_messages(:Goal, +Options) is det.
47 | %
48 | % Execute Goal, showing the feedback in the browser. This
49 | % predicate builds a default application page with a placeholder
50 | % for the messages. It then sends all HTML upto the placeholder
51 | % and flushes the output to the browser. During execution, all
52 | % output from Goal emitted through print_message/2 is caught in
53 | % the message-box. After completion of Goal the page is completed.
54 | %
55 | % This predicate is intended for action such as loading RDF files,
56 | % while providing feedback on files loaded and possible error
57 | % messages. Note that this call creates a complete page.
58 | %
59 | % @bug This call uses =chunked= transfer encoding to send the
60 | % page in parts. Not all browsers support this and not
61 | % all browsers update the page incrementally.
62 |
63 | :- create_prolog_flag(html_messages, false, [type(boolean)]).
64 |
65 | assert_message_hook :-
66 | Head = message_hook(_Term, Level, Lines),
67 | Body = send_message(Level, Lines),
68 | ( clause(user:Head, Body)
69 | -> true
70 | ; asserta((user:Head :- Body))
71 | ).
72 |
73 | :- initialization
74 | assert_message_hook.
75 |
76 | call_showing_messages(Goal, Options) :-
77 | option(style(Style), Options, default),
78 | option(head(Head), Options, title('SWI-Prolog -- make')),
79 | option(header(Header), Options,
80 | div(class(msg_header),
81 | h4('Messages ...'))),
82 | ( option(footer(Footer), Options)
83 | -> true
84 | ; ( option(return_to(ReturnURI), Options)
85 | -> FooterRest = [ p(['Go ', a(href(ReturnURI), 'back'),
86 | ' to the previous page']) ]
87 | ; FooterRest = []
88 | ),
89 | Footer = div(class(msg_footer), [ h4('Done') | FooterRest ])
90 | ),
91 | format('Content-Type: text/html~n'),
92 | format('Transfer-Encoding: chunked~n~n'),
93 | header(Style, Head, Header, Footer, FooterTokens),
94 | setup_call_cleanup(
95 | set_prolog_flag(html_messages, true),
96 | catch(Goal, E, print_message(error, E)),
97 | set_prolog_flag(html_messages, false)), !,
98 | footer(FooterTokens).
99 |
100 | send_message(Level, Lines) :-
101 | current_prolog_flag(html_messages, true),
102 | level_css_class(Level, Class),
103 | phrase(html(pre(class(Class), \html_message_lines(Lines))), Tokens),
104 | with_mutex(html_messages, print_html(Tokens)),
105 | flush_output,
106 | fail.
107 |
108 | level_css_class(informational, msg_informational).
109 | level_css_class(warning, msg_warning).
110 | level_css_class(error, msg_error).
111 |
112 | html_message_lines([]) -->
113 | [].
114 | html_message_lines([nl|T]) --> !,
115 | html('\n'), % we are in a environment
116 | html_message_lines(T).
117 | html_message_lines([flush]) -->
118 | [].
119 | html_message_lines([H|T]) --> !,
120 | html(H),
121 | html_message_lines(T).
122 |
123 |
124 | %% header(+Style, +Head, +Header, +Footer, -FooterTokens)
125 | %
126 | % Emit all tokens upto the placeholder for the actual messages and
127 | % return the remaining page-tokens in FooterTokens. Style and Head
128 | % are passed
129 |
130 | header(Style, Head, Header, Footer, FooterTokens) :-
131 | Magic = '$$$MAGIC$$$',
132 | Body = [ Header,
133 | \(html_messages:html_requires(css('messages.css'))),
134 | div(class(messages), Magic),
135 | Footer
136 | ],
137 | phrase(html_write:page(Style, Head, Body), Tokens),
138 | html_write:mailman(Tokens),
139 | append(HeaderTokens, [Magic|FooterTokens], Tokens), !,
140 | current_output(Out),
141 | html_write:write_html(HeaderTokens, Out),
142 | flush_output(Out).
143 |
144 | footer(Footer) :-
145 | current_output(Out),
146 | html_write:write_html(Footer, Out).
147 |
--------------------------------------------------------------------------------
/news.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Wouter Beek & Jan Wielemaker
4 | E-mail: J.Wielemaker@cs.vu.nl
5 | WWW: http://www.swi-prolog.org
6 | Copyright (C): 2013-2014, VU University Amsterdam
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalidate any other reasons why the executable file might be covered by
27 | the GNU General Public License.
28 | */
29 |
30 | :- module(news,
31 | [ random_news//0
32 | ]).
33 | :- use_module(generics).
34 | :- use_module(library(aggregate)).
35 | :- use_module(library(random)).
36 | :- use_module(library(http/html_head)).
37 | :- use_module(library(http/html_write)).
38 | :- use_module(library(http/http_dispatch)).
39 | :- use_module(library(pldoc/doc_html)).
40 | :- use_module(post).
41 |
42 | :- html_resource(css('news.css'), [requires([css('post.css')])]).
43 |
44 | :- http_handler(root(news), news_process, [prefix]).
45 | :- http_handler(root(news/archive), news_archive, []).
46 |
47 | /** News on the SWI-Prolog Web site
48 |
49 | @author Wouter Beek
50 | @tbd Calculate relevance based on freshness lifetime and importance.
51 | @tbd User-specific influencing of relevance. Based on login/based on cookies.
52 | @version 2013/12
53 | */
54 |
55 |
56 |
57 |
58 | %% news_process(+Request)
59 | %
60 | % HTTP handler for /news/. Distinguishes three cases:
61 | %
62 | % 1. GET to /news// to render a single news item.
63 | % 2. GET to /news/ to render the _fresh_ news.
64 | % 3. POST provides a REST API for managing news.
65 |
66 | news_process(Request) :- % list specific article
67 | memberchk(method(get), Request),
68 | request_to_id(Request, news, Post),
69 | Post \== '', !,
70 | post(Post, title, Title1),
71 | post(Post, kind, Kind),
72 | ( post(Post, object, Object)
73 | -> true
74 | ; Object = null
75 | ),
76 | atomic_list_concat(['News',Title1], ' -- ', Title2),
77 | reply_html_page(
78 | news(Post),
79 | title(Title2),
80 | [ \post(Post, []),
81 | \news_backlink(Kind, Object)
82 | ]).
83 | news_process(Request) :- % list fresh news
84 | memberchk(method(get), Request), !,
85 | find_posts(news, fresh, Ids),
86 | Title = 'News',
87 | reply_html_page(
88 | news(fresh),
89 | title(Title),
90 | [ \html_requires(css('news.css')),
91 | \posts(news, null, Ids,
92 | [ order_by(created),
93 | add_add_link(false)
94 | ]),
95 | \news_archive_link(news, Ids),
96 | \add_post_link(news, null)
97 | ]).
98 | news_process(Request) :- % handle editing news
99 | post_process(Request, news).
100 |
101 | news_archive_link(Kind, Ids) -->
102 | { find_posts(Kind, all, All),
103 | length(All, Total)
104 | },
105 | ( { length(Ids, Total) }
106 | -> []
107 | ; { http_link_to_id(news_archive, [], HREF)
108 | },
109 | html(div(class('news-archive-link'),
110 | a(href(HREF), 'View all ~D news articles'-[Total])))
111 | ).
112 |
113 |
114 | %% news_archive(+Request) is det.
115 | %
116 | % Show all available news.
117 |
118 | news_archive(_Request):-
119 | find_posts(news, all, Ids),
120 |
121 | reply_html_page(
122 | news(all),
123 | title('News archive'),
124 | [ \posts(news, null, Ids,
125 | [ order_by(created),
126 | add_add_link(false)
127 | ]),
128 | \news_backlink(news, null),
129 | \add_post_link(news, null)
130 | ]).
131 |
132 | news_backlink(news, _Object) --> !,
133 | { http_link_to_id(news_process, [], Link) },
134 | html(a(href=Link, 'Back to fresh news items')).
135 | news_backlink(_Kind, Object) -->
136 | html('View annotation in context of '),
137 | object_ref(Object, [style(title)]).
138 |
139 | %! random_news// is semidet.
140 | %
141 | % Emit a random news item for the Did You Know place of the page.
142 | % Fails if there is no news.
143 |
144 | random_news -->
145 | { random_new_item(Id, Title),
146 | http_link_to_id(news_process, path_postfix(Id), Link)
147 | },
148 | html([ span(class(lbl), 'News: '),
149 | span(id(dyknow), a(href=Link, Title))
150 | ]).
151 |
152 | %% random_new_item(-Id:atom, -Title:atom) is det.
153 |
154 | random_new_item(Id, Title):-
155 | aggregate_all(
156 | sum(Relevance),
157 | ( post(Id, kind, news),
158 | relevance(Id, Relevance)
159 | ),
160 | SummedRelevance),
161 | random(0.0, SummedRelevance, R),
162 | find_posts(news, fresh, Ids),
163 | random_new_item(0.0, R, Ids, Id, Title).
164 |
165 | random_new_item(_V, _R, [Id], Id, Title):- !,
166 | post(Id, title, Title).
167 | random_new_item(V1, R, [Id|_], Id, Title):-
168 | relevance(Id, Relevance),
169 | V2 is V1 + Relevance,
170 | R =< V2, !,
171 | post(Id, title, Title).
172 | random_new_item(V1, R, [Id0|Ids], Id, Title):-
173 | relevance(Id0, Relevance),
174 | V2 is V1 + Relevance,
175 | random_new_item(V2, R, Ids, Id, Title).
176 |
177 |
--------------------------------------------------------------------------------
/object_support.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Jan Wielemaker
4 | E-mail: J.Wielemaker@cs.vu.nl
5 | WWW: http://www.swi-prolog.org
6 | Copyright (C): 2014, VU University Amsterdam
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalidate any other reasons why the executable file might be covered by
27 | the GNU General Public License.
28 | */
29 |
30 | :- module(object_support,
31 | [ object_label/2, % +Object:compound
32 | % -Label:atom
33 | object_id/2 % ?Object:compound
34 | % ?Id:atom
35 | ]).
36 |
37 | /** Object support
38 |
39 | */
40 |
41 | :- use_module(wiki).
42 |
43 | :- dynamic
44 | object_id_cache/2.
45 |
46 | %! object_id(+Object:compound, -Id:atom) is det.
47 | %! object_id(-Object:compound, +Id:atom) is semidet.
48 | %
49 | % True when Id is a (hash) id for Object.
50 |
51 | object_id(Object, Id) :-
52 | object_id_cache(Object, Id), !.
53 | object_id(Object, Id) :-
54 | ground(Object),
55 | variant_sha1(Object, Id),
56 | assertz(object_id_cache(Object, Id)).
57 |
58 |
59 | %! object_label(+Object:compound, -Label:atom) is det.
60 | %
61 | % True when Label is a label for Object.
62 |
63 | object_label(Name/Arity, Label) :- !,
64 | format(atom(Label), 'predicate ~w/~w', [Name, Arity]).
65 | object_label(Name//Arity, Label) :- !,
66 | format(atom(Label), 'non-terminal ~w/~w', [Name, Arity]).
67 | object_label(M:Name/Arity, Label) :- !,
68 | format(atom(Label), 'predicate ~w:~w/~w', [M, Name, Arity]).
69 | object_label(M:Name//Arity, Label) :- !,
70 | format(atom(Label), 'non-terminal ~w:~w//~w', [M, Name, Arity]).
71 | object_label(f(Name/Arity), Label) :- !,
72 | format(atom(Label), 'function ~w/~w', [Name, Arity]).
73 | object_label(c(Function), Label) :- !,
74 | format(atom(Label), 'C API function ~w()', [Function]).
75 | object_label(Module:module(_Title), Label) :-
76 | module_property(Module, file(File)), !,
77 | file_base_name(File, Base),
78 | format(atom(Label), 'module ~w', [Base]).
79 | object_label(section(ID), Label) :-
80 | prolog:doc_object_summary(section(_Level, _No, ID, _File),_,_,Title), !,
81 | format(atom(Label), 'Section "~w"', [Title]).
82 | object_label(wiki(Location), Label) :-
83 | wiki_page_title(Location, Title),
84 | format(atom(Label), 'Wiki page "~w"', [Title]).
85 | object_label(Obj, Label) :-
86 | term_to_atom(Obj, Label).
87 |
88 |
--------------------------------------------------------------------------------
/parms.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Jan Wielemaker
4 | E-mail: J.Wielemaker@cs.vu.nl
5 | WWW: http://www.swi-prolog.org
6 | Copyright (C): 2009-2024, VU University Amsterdam
7 | SWI-Prolog Solutions b.v.
8 |
9 | This program is free software; you can redistribute it and/or
10 | modify it under the terms of the GNU General Public License
11 | as published by the Free Software Foundation; either version 2
12 | of the License, or (at your option) any later version.
13 |
14 | This program is distributed in the hope that it will be useful,
15 | but WITHOUT ANY WARRANTY; without even the implied warranty of
16 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 | GNU General Public License for more details.
18 |
19 | You should have received a copy of the GNU General Public
20 | License along with this library; if not, write to the Free Software
21 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
22 |
23 | As a special exception, if you link this library with other files,
24 | compiled with a Free Software compiler, to produce an executable, this
25 | library does not by itself cause the resulting executable to be covered
26 | by the GNU General Public License. This exception does not however
27 | invalidate any other reasons why the executable file might be covered by
28 | the GNU General Public License.
29 | */
30 |
31 | :- module(plweb_parms,
32 | [ server/2, % ?Role, ?Host
33 | server/3 % ?Role, ?Host, -HostName
34 | ]).
35 | :- use_module(library(http/http_log)).
36 | :- use_module(library(http/http_path)).
37 | :- use_module(library(http/http_dispatch)).
38 | :- use_module(library(http/http_cors)).
39 | :- use_module(library(http/html_head)).
40 | :- use_module(library(www_browser)).
41 | :- use_module(library(settings)).
42 | :- use_module(library(pengines)).
43 |
44 |
45 | :- setting(http:served_file_extensions,
46 | list(atom),
47 | [ html, gif, png, jpeg, jpg, css, js, tgz, exe, c, zip ],
48 | 'List of extensions that are served as plain files').
49 | :- setting(http:index_files,
50 | list(atom),
51 | [ 'index.html', 'index.md' ],
52 | 'List of files that provide a directory index').
53 | :- setting(http:port,
54 | integer,
55 | 3040,
56 | 'Default port').
57 | :- setting(http:workers,
58 | integer,
59 | 10,
60 | 'Number of worker threads').
61 |
62 | :- set_setting_default(pengines:allow_from, []).
63 | :- set_setting_default(http:logfile, log('httpd.log')).
64 | :- set_setting_default(http:cors, [*]).
65 |
66 |
67 | /*******************************
68 | * LOCATIONS *
69 | *******************************/
70 |
71 | http:location(pldoc, root(pldoc), [priority(10)]).
72 | http:location(download, root(download), []).
73 | http:location(icons, root(icons), []).
74 | http:location(css, root(css), []).
75 | http:location(jq, root('js/jquery'), []).
76 |
77 |
78 | /*******************************
79 | * EXTERNAL URLS *
80 | *******************************/
81 |
82 | :- multifile
83 | user:url_path/2.
84 |
85 | user:url_path(swi, '/').
86 | user:url_path(pkg, swi('pldoc/package/')).
87 | user:url_path(pack, swi('pack/list/')).
88 | user:url_path(swipub, swi('download/publications/')).
89 | user:url_path(fsf, 'https://www.fsf.org').
90 | user:url_path(gnu, 'https://www.gnu.org').
91 | user:url_path(gpl, gnu('licences/gpl.html')).
92 | user:url_path(lgpl, gnu('licences/lgpl.html')).
93 | user:url_path(wordnet, 'https://wordnet.princeton.edu/').
94 | user:url_path(gmp, 'https://gmplib.org/').
95 | user:url_path(gitweb, 'https://github.com/SWI-Prolog').
96 | user:url_path(swieditor, 'https://arbeitsplattform.bildung.hessen.de/fach/informatik/swiprolog/indexe.html').
97 | user:url_path(git, 'https://git-scm.com/').
98 | user:url_path(macports, 'https://www.macports.org/').
99 | user:url_path(xquartz, 'https://www.xquartz.org/').
100 | user:url_path(json, 'https://json.org/').
101 | user:url_path(thea, 'http://vangelisv.github.io/thea/').
102 | user:url_path(dig, 'https://dl.kr.org/dig/').
103 | user:url_path(sparql, 'https://www.w3.org/TR/sparql11-query/').
104 |
105 |
106 | /*******************************
107 | * RESOURCES *
108 | *******************************/
109 |
110 | :- html_resource(swipl_css,
111 | [ virtual(true),
112 | requires([ css('swipl.css') ])
113 | ]).
114 | :- html_resource(plweb,
115 | [ virtual(true),
116 | requires([ pldoc_css,
117 | css('plweb.css')
118 | ])
119 | ]).
120 | :- if(\+html_current_resource(jquery)).
121 | :- html_resource(jquery,
122 | [ virtual(true),
123 | requires([ jq('jquery.js')
124 | ])
125 | ]).
126 | :- endif.
127 | :- html_resource(js('jquery/ui/jquery-ui.min.js'),
128 | [ requires([ jquery
129 | ])
130 | ]).
131 | :- html_resource(jquery_ui,
132 | [ virtual(true),
133 | requires([ js('jquery/ui/jquery-ui.min.js'),
134 | js('jquery/ui/jquery-ui.min.css')
135 | ])
136 | ]).
137 | :- html_resource(jq('menu.js'),
138 | [ requires([ jquery
139 | ])
140 | ]).
141 |
142 |
143 | /*******************************
144 | * FILES *
145 | *******************************/
146 |
147 | :- multifile user:file_search_path/2.
148 | :- dynamic user:file_search_path/2.
149 |
150 | :- prolog_load_context(directory, Dir),
151 | ( user:file_search_path(plweb, Dir)
152 | -> true
153 | ; asserta(user:file_search_path(plweb, Dir))
154 | ).
155 |
156 | user:file_search_path(data, plweb(data)).
157 | user:file_search_path(git_data, data(git)).
158 | user:file_search_path(git_data, plweb(.)).
159 | user:file_search_path(document_root, git_data(www)).
160 | user:file_search_path(examples, git_data(examples)).
161 | user:file_search_path(blog, git_data(blog)).
162 | user:file_search_path(private, data(private)).
163 | user:file_search_path(log, data(log)).
164 | user:file_search_path(download, data(download)).
165 | user:file_search_path(icons, document_root(icons)).
166 | user:file_search_path(css, document_root(css)).
167 | user:file_search_path(js, document_root(js)).
168 |
169 |
170 | /*******************************
171 | * MASTER/SLAVE *
172 | *******************************/
173 |
174 | %% server(?Type, ?Host) is nondet.
175 | %% server(?Type, ?Host, ?HostName) is nondet.
176 | %
177 | % Describe known servers and their role. Currently, the only
178 | % important role is `master`. Logged in sessions are redirected to
179 | % the master to simplify keeping one view of the data. In future
180 | % versions we might go for a more distributed database.
181 |
182 | server(Type, Host) :-
183 | server(Type, Host, _HostName).
184 |
185 | server(cdn, 'www.swi-prolog.org', -).
186 | server(slave, 'us.swi-prolog.org', 'swi-prolog.osuosl.org').
187 | server(master, 'eu.swi-prolog.org', -).
188 | %server(master, 'localhost', -).
189 |
--------------------------------------------------------------------------------
/proxy.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Jan Wielemaker
4 | E-mail: J.Wielemaker@cs.vu.nl
5 | WWW: http://www.swi-prolog.org
6 | Copyright (C): 2015, VU University Amsterdam
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalidate any other reasons why the executable file might be covered by
27 | the GNU General Public License.
28 | */
29 |
30 | :- module(plweb_proxy,
31 | [ proxy/2, % +Target, +Request
32 | proxy/3 % +Target, +Request, +HdrExtra
33 | ]).
34 | :- use_module(library(http/http_open)).
35 | :- use_module(library(option)).
36 | :- use_module(library(apply)).
37 |
38 | %% proxy(+To, +Request) is det.
39 | %% proxy(+To, +Request, +Options) is det.
40 | %
41 | % Proxy a request to a remote server. This proxies all methods,
42 | % including those carrying data such as POST and PUT. Options:
43 | %
44 | % - request_headers(+List)
45 | % Additional headers for the request. List is of the form
46 | % Name = Value.
47 | % - reply_headers+List)
48 | % Additional headers for the reply
49 |
50 | proxy(To, Request) :-
51 | proxy(To, Request, []).
52 | proxy(To, Request, Options) :-
53 | memberchk(method(Method), Request),
54 | proxy(Method, To, Request, Options).
55 |
56 | proxy(Method, To, Request, Options) :-
57 | data_method(Method), !,
58 | read_data(Request, Data),
59 | memberchk(request_uri(URI), Request),
60 | atomic_list_concat([To,URI], Target),
61 | option(request_headers(ReqHrd0), Options, []),
62 | maplist(request_header, ReqHrd0, ReqHrd),
63 | http_open(Target, In,
64 | [ method(Method),
65 | post(Data),
66 | header(content_type, ContentType)
67 | | ReqHrd
68 | ]),
69 | call_cleanup(
70 | read_string(In, _, Bytes),
71 | close(In)),
72 | option(reply_headers(HdrExtra0), Options, []),
73 | maplist(reply_header, HdrExtra0, HdrExtra),
74 | throw(http_reply(bytes(ContentType, Bytes), HdrExtra)).
75 | proxy(Method, To, Request, Options) :-
76 | memberchk(request_uri(URI), Request),
77 | atomic_list_concat([To,URI], Target),
78 | option(request_headers(ReqHrd0), Options, []),
79 | maplist(request_header, ReqHrd0, ReqHrd),
80 | http_open(Target, In,
81 | [ method(Method),
82 | header(content_type, ContentType)
83 | | ReqHrd
84 | ]),
85 | call_cleanup(
86 | read_string(In, _, Bytes),
87 | close(In)),
88 | option(reply_headers(HdrExtra0), Options, []),
89 | maplist(reply_header, HdrExtra0, HdrExtra),
90 | throw(http_reply(bytes(ContentType, Bytes), HdrExtra)).
91 |
92 | read_data(Request, bytes(ContentType, Bytes)) :-
93 | memberchk(input(In), Request),
94 | memberchk(content_type(ContentType), Request),
95 | ( memberchk(content_length(Len), Request)
96 | -> read_string(In, Len, Bytes)
97 | ; read_string(In, _, Bytes)
98 | ).
99 |
100 | data_method(post).
101 | data_method(put).
102 |
103 | request_header(Name = Value, request_header(Name = Value)).
104 |
105 | reply_header(Name = Value, Term) :-
106 | Term =.. [Name,Value].
107 |
--------------------------------------------------------------------------------
/rating.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Jan Wielemaker
4 | E-mail: J.Wielemaker@cs.vu.nl
5 | WWW: http://www.swi-prolog.org
6 | Copyright (C): 2013, VU University Amsterdam
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalidate any other reasons why the executable file might be covered by
27 | the GNU General Public License.
28 | */
29 |
30 | :- module(rating,
31 | [ rate//1
32 | ]).
33 | :- use_module(library(http/http_path)).
34 | :- use_module(library(http/http_dispatch), []).
35 | :- use_module(library(http/html_head)).
36 | :- use_module(library(http/html_write)).
37 | :- use_module(library(option)).
38 |
39 | :- html_resource(jq('jRating.jquery.js'),
40 | [ requires([ jquery,
41 | jq('jRating.jquery.css')
42 | ])
43 | ]).
44 |
45 |
46 | /** Provide a star-rating widget
47 |
48 | @see http://www.myjqueryplugins.com/jquery-plugin/jrating
49 | */
50 |
51 | rate(Options) -->
52 | { option(class(Class), Options, jrating),
53 | select_option(data_id(Id), Options, Options1, rating),
54 | ( select_option(data_average(Avg), Options1, Options2)
55 | -> Extra = ['data-average'(Avg)]
56 | ; Extra = [],
57 | Options2 = Options
58 | )
59 | },
60 | html_requires(jq('jRating.jquery.js')),
61 | html(div([ class(Class), 'data-id'(Id)| Extra], [])),
62 | ( { option(post(Post), Options2) }
63 | -> html_post(Post, \script(Options2))
64 | ; script(Options2)
65 | ).
66 |
67 | script(Options) -->
68 | { option(length(Length), Options, 5),
69 | option(rate_max(RateMax), Options, 20),
70 | option(step(Step), Options, false),
71 | option(type(Type), Options, big),
72 | option(class(Class), Options, jrating),
73 | option(can_rate_again(CanRateAgain), Options, false),
74 | http_absolute_location(jq('icons/stars.png'), BSP, []),
75 | http_absolute_location(jq('icons/small.png'), SSP, [])
76 | },
77 | html(script(type('text/javascript'),
78 | [ \[ '$(document).ready(function(){\n',
79 | '$(".',Class,'").jRating(\n',
80 | ' { bigStarsPath:"',BSP,'",\n',
81 | ' smallStarsPath:"',SSP,'",\n',
82 | ' step:',Step,',\n',
83 | ' type:"',Type,'",\n',
84 | ' length:',Length,',\n',
85 | ' rateMax:',RateMax,',\n',
86 | ' canRateAgain:',CanRateAgain,',\n'
87 | ],
88 | \set_disabled(Options),
89 | \set_action(Options),
90 | \set_field(Options),
91 | \[ ' });\n',
92 | '});\n'
93 | ]
94 | ])).
95 |
96 | set_disabled(Options) -->
97 | { option(disabled(true), Options) }, !,
98 | html(\[ ' isDisabled:true,\n'
99 | ]).
100 | set_disabled(_) --> [].
101 |
102 | set_action(Options) -->
103 | { option(on_rating(OnRating), Options) }, !,
104 | html(\[ ' phpPath:"',OnRating,'",\n'
105 | ]).
106 | set_action(_) --> [].
107 |
108 | set_field(Options) -->
109 | { option(set_field(Field), Options) }, !,
110 | html(\[ ' onSuccess: function(e,r)\n',
111 | ' { $(\'input[name=~w]\').val(r);\n'-[Field],
112 | ' }\n'
113 | ]).
114 | set_field(_) --> [].
115 |
--------------------------------------------------------------------------------
/register.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Jan Wielemaker
4 | E-mail: J.Wielemaker@cs.vu.nl
5 | WWW: http://www.swi-prolog.org
6 | Copyright (C): 2013, VU University Amsterdam
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalidate any other reasons why the executable file might be covered by
27 | the GNU General Public License.
28 | */
29 |
30 | :- module(register, []).
31 | :- use_module(library(http/html_write)).
32 | :- use_module(library(http/http_dispatch)).
33 | :- use_module(library(http/http_parameters)).
34 | :- use_module(openid).
35 | :- use_module(library(smtp)).
36 |
37 | :- http_handler(root(register), register, []).
38 | :- http_handler(root(submit_registration), submit_registration, []).
39 |
40 | register(Request) :-
41 | http_parameters(Request,
42 | [ for(Kind, [ oneof([wiki,news]),
43 | default(wiki)
44 | ])
45 | ]),
46 | site_user(Request, User),
47 | reg_title(Kind, Title),
48 | reply_html_page(
49 | user(form(register(User, Kind))),
50 | title(Title),
51 | \reg_body(User, Kind)).
52 |
53 | reg_title(wiki, 'Register to edit SWI-Prolog wiki pages').
54 | reg_title(news, 'Register to manage news postings').
55 |
56 | reg_body(User, Kind) -->
57 | reg_explain(Kind),
58 | form(User, Kind).
59 |
60 | reg_explain(wiki) -->
61 | html({|html||
62 | This form allows you to request permission to edit
63 | the SWI-Prolog wiki pages. That is, the pages that have
64 | an Edit this page in the WIKI menu.
65 |
66 |
67 | Registration form
68 | |}).
69 | reg_explain(news) -->
70 | html({|html||
71 | This form allows you to request permission to post
72 | news articles using the menu COMMUNITY/News
73 |
74 |
75 | Registration form
76 | |}).
77 |
78 |
79 | form(UUID, Kind) -->
80 | { http_location_by_id(submit_registration, Action),
81 | PlaceHolder = 'Please tell us your plans, so that we can \c
82 | tell you are a genuine human Prolog user',
83 | site_user_property(UUID, name(Name), 'anonymous'),
84 | site_user_property(UUID, email(Email), 'unknown')
85 | },
86 | html(form(action(Action),
87 | [ input([type(hidden), name(kind), value(Kind)]),
88 | table([ tr([ th([align(right)], 'Name'),
89 | td(input([name(name),
90 | placeholder(
91 | 'Name associated to commits'),
92 | disabled(disabled),
93 | value(Name)
94 | ]))
95 | ]),
96 | tr([ th([align(right)], 'Email'),
97 | td(input([name(email),
98 | placeholder(
99 | 'Displayed with GIT commit'),
100 | disabled(disabled),
101 | value(Email)
102 | ]))
103 | ]),
104 | tr([ th([align(right), valign(top)], 'Comments:'),
105 | td([ class(wiki_text), colspan(2) ],
106 | textarea([ cols(50),rows(10),name(comment),
107 | placeholder(PlaceHolder)
108 | ],
109 | ''))
110 | ]),
111 | tr([ td([ colspan(2), align(right) ],
112 | input([ type(submit),
113 | value('Sent request')
114 | ]))
115 | ])
116 | ])
117 | ])).
118 |
119 |
120 | %% submit_registration(+Request) is det.
121 | %
122 | % Sent E-mail to submit a registration
123 |
124 | submit_registration(Request) :-
125 | site_user(Request, UUID),
126 | http_parameters(Request,
127 | [ comment(Comment, [optional(true)]),
128 | kind(Kind, [])
129 | ]),
130 | mail(UUID, Kind, Comment),
131 | reply_html_page(
132 | user(mailed(admin, permission(Kind))),
133 | title('Mail sent'),
134 | [ p([ 'A mail has been sent to the site adminstrator. ',
135 | 'You will be informed when the account has been ',
136 | 'created.'
137 | ])
138 | ]).
139 |
140 | mail(UUID, Kind, Comment) :-
141 | smtp_send_mail('jan@swi-prolog.org',
142 | message(UUID, Kind, Comment),
143 | [ subject('SWI-Prolog permission request'),
144 | from('jan@swi-prolog.org')
145 | ]).
146 |
147 | message(UUID, Kind, Comment, Out) :-
148 | site_user_property(UUID, name(Name), 'anonymous'),
149 | site_user_property(UUID, email(EMail), 'unknown'),
150 | format(Out, 'New site permission request\n\n', []),
151 | format(Out, '\t Kind: ~w~n', [Kind]),
152 | format(Out, '\t UUID: ~w~n', [UUID]),
153 | format(Out, '\t Name: ~w~n', [Name]),
154 | format(Out, '\tE-Mail: ~w~n', [EMail]),
155 | format(Out, '~n~w~n', [Comment]).
156 |
157 |
158 | site_user_property(UUID, P, Default) :-
159 | ( site_user_property(UUID, P)
160 | -> true
161 | ; arg(1, P, Default)
162 | ).
163 |
164 | :- multifile
165 | plweb:page_title//1.
166 |
167 |
168 | plweb:page_title(user(form(register(_User, Kind)))) -->
169 | { reg_title(Kind, Title) },
170 | html(Title).
171 | plweb:page_title(user(mailed(To, permission(_Kind)))) -->
172 | html('Mail sent to ~w'-[To]).
173 |
--------------------------------------------------------------------------------
/run:
--------------------------------------------------------------------------------
1 | #!/bin/sh
2 |
3 | #avoid interactive behaviour
4 | export GIT_ASKPASS=/bin/false
5 |
6 | while true; do
7 | swipl -s load.pl -g server
8 | if [ "$?" = 42 ]; then
9 | break;
10 | fi
11 | reset
12 | done
13 |
--------------------------------------------------------------------------------
/scripts/fix-permissions:
--------------------------------------------------------------------------------
1 | #!/bin/bash
2 | # fix permissions to run the SWI-Prolog website as www-data, group www-data
3 |
4 | groupshared()
5 | { chgrp -R www-data .
6 | find . -type d | xargs chmod 2775
7 | find refs -type f | xargs chmod 664
8 | git config core.sharedRepository group
9 | }
10 |
11 | fixwiki()
12 | { git config user.email "wiki@swi-prolog.org"
13 | git config user.name "Wiki manager"
14 | chgrp -R www-data .
15 | find . -name '*.txt' | xargs chmod 664
16 | find . -type d | xargs chmod 2775
17 | (cd `git rev-parse --git-dir` && groupshared)
18 | }
19 |
20 | fixerepo()
21 | { ( chgrp -R www-data .
22 | find . -type f | xargs chmod 664
23 | find . -type d | xargs chmod 2775
24 | (cd `git rev-parse --git-dir` && groupshared)
25 | )
26 | }
27 |
28 | for repo in www examples blog; do
29 | [ -d data/git/$repo ] || git clone https://github.com/SWI-Prolog/plweb-$repo.git data/git/$repo
30 | done
31 |
32 | (cd data/git/www && fixwiki)
33 | (cd data/git/blog && fixrepo)
34 | (cd data/git/examples && fixrepo)
35 |
36 | # Create and fix the logfile permissions
37 | datadirs="data/log data/pack"
38 |
39 | for d in $datadirs; do
40 | mkdir -p $d
41 | chgrp -R www-data $d
42 | find $d -type d | xargs chmod 2775
43 | done
44 |
45 | # Make the database writeable
46 | chgrp www-data data/*.db
47 | chmod 664 data/*.db
48 |
49 | [ -d data/private/etc/ssh ] || mkdir -p data/private/etc/ssh
50 | [ -f data/private/etc/ssh/authorized_keys ] || touch data/private/etc/ssh/authorized_keys
51 | [ -f data/private/etc/ssh/ssh_host_ecdsa_key ] || ssh-keygen -A -f data/private
52 |
--------------------------------------------------------------------------------
/scripts/from-line:
--------------------------------------------------------------------------------
1 | #!/bin/bash
2 |
3 | if [ -z "$1" -o -z "$2" ]; then
4 | echo "Usage: $0 line file"
5 | exit 1
6 | fi
7 |
8 | line=$1
9 | shift
10 |
11 | case "$1" in
12 | *.gz) zcat $1 | awk "{if ( FNR >= $line ) "'print $0}'
13 | ;;
14 | *) awk "{if ( FNR >= $line ) "'print $0}' $*
15 | ;;
16 | esac
17 |
--------------------------------------------------------------------------------
/scripts/install-custom:
--------------------------------------------------------------------------------
1 | #!/bin/bash
2 |
3 | for f in `find download-custom -name '*.txt'`; do
4 | target="`echo $f | sed 's@download-custom@data/download@'`"
5 | rm -f $target
6 | cp $f `dirname $target`
7 | done
8 |
9 |
--------------------------------------------------------------------------------
/scripts/ln-install:
--------------------------------------------------------------------------------
1 | #!/bin/bash -f
2 |
3 | mode=755
4 | files=
5 | target=
6 | here=`pwd`
7 |
8 | while [ "$#" != 0 ]; do
9 | case "$1" in
10 | -m) mode="$2"
11 | shift
12 | ;;
13 | *) if [ "$#" = 1 ]; then
14 | target="$1"
15 | done=yes
16 | else
17 | case $1 in
18 | /*) files="$files $1"
19 | ;;
20 | *) files="$files $here/$1"
21 | ;;
22 | esac
23 | fi
24 | shift
25 | ;;
26 | esac
27 | done
28 |
29 | #echo files = $files
30 | #echo target = $target
31 |
32 | if [ -d "$target" ]; then
33 | for f in $files; do
34 | rm -f "$target"/`basename $f`
35 | (cd $target >/dev/null && ln -v -s $f .)
36 | done
37 | else
38 | rm -f $target
39 | ln -v -s $files $target
40 | fi
41 |
--------------------------------------------------------------------------------
/scripts/sync-server:
--------------------------------------------------------------------------------
1 | source=ops:/home/swipl/src/plweb
2 |
3 | mkdir -p data/private
4 | mkdir -p data/log
5 |
6 | rsync -auv $source/{annotations,openid,packs,post,reviews,tags}.db data
7 | rsync -auv $source/{passwd,plweb.conf} data/private
8 | rsync -avk $source/download data
9 |
--------------------------------------------------------------------------------
/stress/hg:
--------------------------------------------------------------------------------
1 | #!/bin/bash
2 |
3 | valgrind --tool=helgrind --gen-suppressions=all $*
4 |
--------------------------------------------------------------------------------
/stress/http_cookie.pl:
--------------------------------------------------------------------------------
1 | /* This file is part of ClioPatria.
2 |
3 | Author:
4 | HTTP: http://e-culture.multimedian.nl/
5 | GITWEB: http://gollem.science.uva.nl/git/ClioPatria.git
6 | GIT: git://gollem.science.uva.nl/home/git/ClioPatria.git
7 | GIT: http://gollem.science.uva.nl/home/git/ClioPatria.git
8 | Copyright: 2007, E-Culture/MultimediaN
9 |
10 | ClioPatria is free software: you can redistribute it and/or modify
11 | it under the terms of the GNU General Public License as published by
12 | the Free Software Foundation, either version 2 of the License, or
13 | (at your option) any later version.
14 |
15 | ClioPatria is distributed in the hope that it will be useful,
16 | but WITHOUT ANY WARRANTY; without even the implied warranty of
17 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 | GNU General Public License for more details.
19 |
20 | You should have received a copy of the GNU General Public License
21 | along with ClioPatria. If not, see .
22 | */
23 |
24 | :- module(http_cookie,
25 | [ http_get/4, % +ClientId, +Request, -Reply, +Options
26 | http_remove_client/1, % +ClientId
27 | http_remove_all_clients/0,
28 | http_current_cookie/4 % ?ClientId, ?Name, ?Value, ?Options
29 | ]).
30 | :- use_module(library('http/http_client')).
31 | :- use_module(library(url)).
32 | :- use_module(library(debug)).
33 |
34 | /** HTTP client cookie handling
35 |
36 | This module defines http_get/4, a wrapper around http_get/3 where we can
37 | define multiple `virtual' clients, each managing a cookie database.
38 |
39 | It was designed to deal with cookie-based session management in the
40 | client, where the same Prolog process is client in multiple concurrent
41 | sessions.
42 | */
43 |
44 | :- dynamic
45 | client_cookie/4. % Id, Name, Value, Options
46 |
47 |
48 | %% http_get(+ClientId, +Request, -Reply, +Options) is det.
49 | %
50 | % Add cookie handling to http_get/3. ClientId is a ground term
51 | % representing the client. The library takes care of cookies send
52 | % by the server and updates its cookie information.
53 |
54 | http_get(ClientId, Request0, Reply, Options) :-
55 | break_url(Request0, Request),
56 | ( memberchk(reply_header(Header), Options)
57 | -> GetOptions = Options
58 | ; GetOptions = [reply_header(Header)|Options]
59 | ),
60 | add_cookies(ClientId, Request, GetOptions, AllOptions),
61 | http_get(Request, Reply, AllOptions),
62 | update_cookies(ClientId, Request, Header).
63 |
64 | %% break_url(+UrlOrRequest, -Parts) is det.
65 | %
66 | % Break a URL into parts. Returns input if it already contains
67 | % parts. See parse_url/2 for the format.
68 |
69 | break_url(URL, Request) :-
70 | atomic(URL), !,
71 | parse_url(URL, Request).
72 | break_url(Request, Request).
73 |
74 | %% add_cookies(+ClientId, +Request, +Options0, -Options) is det.
75 | %
76 | % Add cookies to an HTTP request.
77 |
78 | add_cookies(ClientId, Request, Options,
79 | [request_header('Cookie'=Cookie)|Options]) :-
80 | request_host(Request, Host),
81 | request_path(Request, Path),
82 | findall(N=V, current_cookie(ClientId, Host, Path, N, V), Cookies),
83 | Cookies \== [], !,
84 | debug(cookie, 'Cookies for ~w at ~w~w: ~p',
85 | [ClientId, Host, Path, Cookies]),
86 | cookie_value(Cookies, Cookie).
87 | add_cookies(_, _, Options, Options).
88 |
89 | request_host(Request, Host) :-
90 | ( memberchk(host(Host), Request)
91 | -> true
92 | ; throw(error(existence_error(parameter, host), _))
93 | ).
94 |
95 | request_path(Request, Path) :-
96 | ( memberchk(path(Path), Request)
97 | -> true
98 | ; Path = (/)
99 | ).
100 |
101 | %% cookie_value(+NameValueList, -CookieString) is det.
102 | %
103 | % Create a cookie value string with name=value, seperated by ";".
104 |
105 | cookie_value(List, Cookie) :-
106 | with_output_to(string(Cookie),
107 | write_cookies(List)).
108 |
109 | write_cookies([]).
110 | write_cookies([Name=Value|T]) :-
111 | format('~w=~w', [Name, Value]),
112 | ( T == []
113 | -> true
114 | ; format('; ', []),
115 | write_cookies(T)
116 | ).
117 |
118 | %% update_cookies(+ClientId, +Request, +Header) is det.
119 | %
120 | % Update the client cookie database. Request is the original
121 | % request. Header is the HTTP reply-header.
122 |
123 | update_cookies(ClientId, Request, Header) :-
124 | memberchk(set_cookie(set_cookie(Name, Value, Options)), Header), !,
125 | request_host(Request, Host),
126 | request_path(Request, Path),
127 | with_mutex(http_cookie,
128 | update_cookie(ClientId, Host, Path, Name, Value, Options)).
129 | update_cookies(_, _, _).
130 |
131 | update_cookie(ClientId, Host, Path, Name, Value, Options) :-
132 | remove_cookies(ClientId, Host, Path, Name, Options),
133 | debug(cookie, 'New for ~w: ~w=~p', [ClientId, Name, Value]),
134 | assert(client_cookie(ClientId, Name, Value, [host=Host|Options])).
135 |
136 | %% remove_cookies(+ClientId, +Host, +Path, +Name, +SetOptions) is det.
137 | %
138 | % Remove all cookies that conflict with the new set-cookie
139 | % command.
140 |
141 | remove_cookies(ClientId, Host, Path, Name, SetOptions) :-
142 | ( client_cookie(ClientId, Name, Value, OldOptions),
143 | cookie_match_host(Host, SetOptions, OldOptions),
144 | cookie_match_path(Path, SetOptions, OldOptions),
145 | debug(cookie, 'Del for ~w: ~w=~p', [ClientId, Name, Value]),
146 | retract(client_cookie(ClientId, Name, Value, OldOptions)),
147 | fail
148 | ; true
149 | ).
150 |
151 | cookie_match_host(Host, SetOptions, OldOptions) :-
152 | ( memberchk(domain=Domain, SetOptions)
153 | -> cookie_match_host(Domain, OldOptions)
154 | ; cookie_match_host(Host, OldOptions)
155 | ).
156 |
157 | cookie_match_path(Path, SetOptions, OldOptions) :-
158 | ( memberchk(path=PathO, SetOptions)
159 | -> cookie_match_path(PathO, OldOptions)
160 | ; cookie_match_path(Path, OldOptions)
161 | ).
162 |
163 | %% current_cookie(+ClientId, +Host, +Path, -Name, -Value) is nondet.
164 | %
165 | % Find cookies that match the given request.
166 |
167 | current_cookie(ClientId, Host, Path, Name, Value) :-
168 | client_cookie(ClientId, Name, Value, Options),
169 | cookie_match_host(Host, Options),
170 | cookie_match_path(Path, Options),
171 | cookie_match_expire(Options).
172 |
173 | cookie_match_host(Host, Options) :-
174 | ( memberchk(domain=Domain, Options)
175 | -> downcase_atom(Host, LHost),
176 | downcase_atom(Domain, LDomain),
177 | sub_atom(LHost, _, _, 0, LDomain) % TBD: check '.'?
178 | ; memberchk(host=CHost, Options),
179 | downcase_atom(Host, LHost),
180 | downcase_atom(CHost, LHost)
181 | ).
182 |
183 | cookie_match_path(Path, Options) :-
184 | ( memberchk(path=Root, Options)
185 | -> sub_atom(Path, 0, _, _, Root) % TBD: check '/'?
186 | ; true
187 | ).
188 |
189 | cookie_match_expire(Options) :-
190 | ( memberchk(expire=Expire, Options)
191 | -> get_time(Now),
192 | Now =< Expire
193 | ; true
194 | ).
195 |
196 | %% http_remove_client(+ClientId) is det.
197 | %
198 | % Fake user quitting a browser. Removes all cookies that do
199 | % not have an expire date.
200 |
201 | http_remove_client(ClientId) :-
202 | var(ClientId), !,
203 | throw(error(instantiation_error, _)).
204 | http_remove_client(ClientId) :-
205 | ( client_cookie(ClientId, Name, Value, Options),
206 | \+ memberchk(expire=_, Options),
207 | retract(client_cookie(ClientId, Name, Value, Options)),
208 | fail
209 | ; true
210 | ).
211 |
212 | %% http_remove_all_clients is det.
213 | %
214 | % Simply logout all clients. See http_remove_client/1.
215 |
216 | http_remove_all_clients :-
217 | forall(current_client(ClientId),
218 | http_remove_client(ClientId)).
219 |
220 | %% current_client(?ClientId) is nondet.
221 | %
222 | % True if ClientId is the identifier of a client.
223 |
224 | current_client(ClientId) :-
225 | client_cookie(ClientId, _Name, _Value, _Options).
226 |
227 | %% http_current_cookie(?ClientId, ?Name, ?Value, ?Options)
228 | %
229 | % Query current cookie database
230 |
231 | http_current_cookie(ClientId, Name, Value, Options) :-
232 | client_cookie(ClientId, Name, Value, Options).
233 |
--------------------------------------------------------------------------------
/stress/maps.pl:
--------------------------------------------------------------------------------
1 | :- module(procps_maps,
2 | [ maps/2, % +File, -Records
3 | map_size/2,
4 | prot/1,
5 | anon/1
6 | ]).
7 | :- use_module(library(pure_input)).
8 | :- use_module(library(dcg/basics)).
9 |
10 | maps(PID, Records) :-
11 | integer(PID),
12 | !,
13 | format(string(File), "/proc/~w/maps", [PID]),
14 | maps(File, Records).
15 | maps(File, Records) :-
16 | phrase_from_file(maps(Records), File).
17 |
18 | maps([H|T]) --> map(H), !, maps(T).
19 | maps([]) --> [].
20 |
21 | map(map{start:From,
22 | end:To,
23 | access:Access,
24 | flags: f{f1:F1,f2:F2},
25 | inode: INode,
26 | file: File
27 | }) -->
28 | xinteger(From), "-", xinteger(To), " ",
29 | access(Access), " ",
30 | xinteger(_Unknown), " ",
31 | xinteger(F1), ":", xinteger(F2), " ",
32 | integer(INode),
33 | ( {INode == 0}
34 | -> ( blanks_to_nl
35 | -> {File = (-)}
36 | ; blanks,
37 | "[", string(Res), "]", blanks_to_nl
38 | -> { atom_codes(File, Res) }
39 | )
40 | ; blanks,
41 | string(S),
42 | blanks_to_nl
43 | -> { atom_codes(File, S) }
44 | ).
45 |
46 | access([R,W,X,P]) --> r(R), w(W), x(X), p(P).
47 |
48 | r(r) --> "r".
49 | r(-) --> "-".
50 | w(w) --> "w".
51 | w(-) --> "-".
52 | x(x) --> "x".
53 | x(-) --> "-".
54 | p(p) --> "p".
55 | p(s) --> "s".
56 |
57 |
58 | map_size(Map, Size) :-
59 | Size is Map.end - Map.start.
60 |
61 | prot(Map) :-
62 | Map.access = [-,-,-,p].
63 |
64 | anon(Map) :-
65 | Map.access = [r,w,-,p],
66 | Map.inode == 0.
67 |
--------------------------------------------------------------------------------
/stress/stress.pl:
--------------------------------------------------------------------------------
1 | :- use_module(replay).
2 |
3 | r(C) :-
4 | debug(replay),
5 | http_replay('httpd-ec.log',
6 | [host(localhost), port(3040), concurrent(C)]).
7 |
--------------------------------------------------------------------------------
/sw/README:
--------------------------------------------------------------------------------
1 | Semantic modelling of the SWI-Prolog project
2 |
3 | * EvoOnt --- http://www.ifi.uzh.ch/ddis/evo/
4 | * Baetle --- http://code.google.com/p/baetle/
5 | * Mandriva Nepomuk --- http://nepomuk.linbox.org/
6 |
--------------------------------------------------------------------------------
/systemd/plweb.service:
--------------------------------------------------------------------------------
1 | # swi-prolog - SWI-Prolog website server
2 | #
3 | # The SWI-Prolog website server
4 |
5 | [Unit]
6 | Description=SWI-Prolog website
7 |
8 | [Service]
9 | UMask=022
10 | Environment=LANG=en_US.utf8
11 | Environment=LD_LIBRARY_PATH=/usr/lib/jvm/default-java/jre/lib/amd64/server:/usr/lib/jvm/default-java/jre/lib/amd64:/usr/lib/jvm/default-java/lib
12 | Environment=HOME=/var/www
13 | Restart=on-failure
14 | ExecReload=/bin/kill -HUP $MAINPID
15 | StartLimitInterval=60
16 | StartLimitBurst=5
17 | WorkingDirectory=/home/swipl/src/plweb
18 | ExecStart=/home/swipl/bin/swipl daemon.pl --no-fork --port=80 --user=www-data
19 |
20 | [Install]
21 | WantedBy=multi-user.target
22 |
--------------------------------------------------------------------------------
/test_plweb.pl:
--------------------------------------------------------------------------------
1 | :- module(test_plweb,
2 | [ test_links/0
3 | ]).
4 |
5 | :- use_module(library(ansi_term)).
6 | :- use_module(library(apply)).
7 | :- use_module(library(error)).
8 | :- use_module(library(http/http_client)).
9 | :- use_module(library(http/http_ssl_plugin)). % HTTPS support.
10 | :- use_module(library(uri)).
11 |
12 | :- use_module(page).
13 |
14 | /** Test various aspects of plweb
15 |
16 | @author Wouter Beek
17 | @version 2016/05/02
18 | */
19 |
20 | :- meta_predicate
21 | verbose(0, +, +).
22 |
23 |
24 |
25 |
26 |
27 | test_links :-
28 | clause(plweb_page:menu(_,L), _),
29 | maplist(test_links, L).
30 |
31 |
32 | test_links(_=L) :-
33 | is_list(L), !,
34 | maplist(test_links, L).
35 | test_links(_=Uri) :-
36 | is_link(Uri), !,
37 | verbose(test_link(Uri), "Checking URL ‘~a’", [Uri]).
38 | test_links(_).
39 |
40 |
41 | test_link(Uri) :-
42 | http_get(Uri, _, [status_code(Code)]),
43 | (between(200, 299, Code) -> true ; throw(error(Code))).
44 |
45 |
46 |
47 |
48 |
49 | % HELPERS %
50 |
51 | %! is_link(@Term) is semidet.
52 |
53 | is_link(Uri) :-
54 | atom(Uri),
55 | uri_components(Uri, uri_components(Scheme,Auth,_,_,_)),
56 | maplist(atom, [Scheme,Auth]).
57 |
58 |
59 |
60 | %! verbose(:Goal_0, +Format, +Args) is det.
61 |
62 | verbose(Goal_0, Format, Args) :-
63 | get_time(Start),
64 | format(Format, Args),
65 | ( catch(Goal_0, E, true)
66 | -> ( var(E)
67 | -> get_time(End),
68 | Delta is End - Start,
69 | ansi_format([fg(green)], "~`.t success (~2f sec.)~72|", [Delta])
70 | ; message_to_string(E, S),
71 | ansi_format([fg(red)], "~`.t ERROR: ~w~72|", [S])
72 | )
73 | ; ansi_format([fg(red)], "~`.t ERROR: (failed)~72|", [])
74 | ),
75 | nl.
76 |
--------------------------------------------------------------------------------
/test_recaptcha.pl:
--------------------------------------------------------------------------------
1 | :- module(test_recaptcha,
2 | [
3 | ]).
4 | :- use_module(library(http/http_dispatch)).
5 | :- use_module(library(http/http_parameters)).
6 | :- use_module(library(http/html_write)).
7 | :- use_module(library(http/recaptcha)).
8 |
9 | :- http_handler(root(test/recaptcha), captcha_form, []).
10 | :- http_handler(root(test/callback), captcha_callback, []).
11 |
12 | captcha_form(_Request) :-
13 | reply_html_page(
14 | plain,
15 | title('Captcha test'),
16 | \form).
17 |
18 | form -->
19 | { http_link_to_id(captcha_callback, [], HREF)
20 | },
21 | html(h1('Test page for recaptcha configuration')),
22 | html(form([method('POST'), action(HREF)],
23 | [ \recaptcha([]),
24 | input([name(name)]),
25 | input(type(submit))
26 | ])).
27 |
28 | captcha_callback(Request) :-
29 | recaptcha_parameters(RecapthaParams),
30 | http_parameters(Request,
31 | RecapthaParams,
32 | [form_data(Form)]),
33 | format('Content-type: text/plain\n\n'),
34 | print_term(Form, [output(current_output)]),
35 | ( recaptcha_verify(Request, RecapthaParams)
36 | -> format('Welcome human!~n')
37 | ; format('Go away, alien!~n')
38 | ).
39 |
--------------------------------------------------------------------------------
/tests.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Jan Wielemaker
4 | E-mail: J.Wielemaker@cs.vu.nl
5 | WWW: http://www.swi-prolog.org
6 | Copyright (C): 2010, VU University Amsterdam
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalidate any other reasons why the executable file might be covered by
27 | the GNU General Public License.
28 | */
29 |
30 | :- module(http_test_server, []).
31 | :- use_module(library(http/http_dispatch)).
32 |
33 | :- http_handler(root('Tests/chunked/data'), send_chunked, []).
34 |
35 | %% send_chunked(+Request) is det.
36 | %
37 | % HTTP handler that sends a long string in chunked mode. Used to
38 | % test the client.
39 |
40 | send_chunked(_Request) :-
41 | chunked_data(String),
42 | format('Content-type: text/plain; charset=UTF-8~n'),
43 | format('Transfer-encoding: chunked~n~n'),
44 | format('~s', [String]),
45 | flush_output,
46 | format('~s', [String]).
47 |
48 | chunked_data(S) :-
49 | findall(C,
50 | ( between(1, 1000, X),
51 | C is "a" + X mod 26
52 | ), S).
53 |
54 |
--------------------------------------------------------------------------------
/update.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Jan Wielemaker
4 | E-mail: J.Wielemaker@cs.vu.nl
5 | WWW: http://www.swi-prolog.org
6 | Copyright (C): 2009, VU University Amsterdam
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalidate any other reasons why the executable file might be covered by
27 | the GNU General Public License.
28 | */
29 |
30 | :- module(web_update,
31 | [ db_sync_thread/0,
32 | db_sync_thread/1 % +Time
33 | ]).
34 | :- use_module(library(http/http_dispatch)).
35 | :- use_module(library(http/http_authenticate)).
36 | :- use_module(library(http/html_write)).
37 | :- use_module(library(readutil)).
38 | :- use_module(library(process)).
39 | :- use_module(library(persistency)).
40 | :- use_module(library(socket)).
41 |
42 | :- use_module(parms).
43 |
44 | :- http_handler(root(update), update, []).
45 |
46 | :- meta_predicate
47 | collect_messages(0, -).
48 |
49 | %% update(+Request)
50 | %
51 | % HTTP Handler for /update. Performs a GIT pull and a Prolog
52 | % make/0.
53 |
54 | update(Request) :-
55 | ( http_authenticate(basic(private(passwd)), Request, _User)
56 | -> true
57 | ; throw(http_reply(authorise(basic, 'Admin user')))
58 | ),
59 | reply_html_page(title('Server update'),
60 | [ h1('Server update'),
61 | hr([]),
62 | h2('GIT'),
63 | \git_update,
64 | h2('make'),
65 | \make,
66 | h2('Persistent file sync'),
67 | \db_sync
68 | ]).
69 |
70 |
71 | %% git_update//
72 | %
73 | % Run =|git update|=, collecting the output
74 |
75 | git_update -->
76 | { process_create(path(git), [pull],
77 | [ stdout(pipe(Out)),
78 | stderr(pipe(Error))
79 | ]),
80 | read_stream_to_codes(Out, OutCodes),
81 | read_stream_to_codes(Error, ErrorCodes),
82 | close(Out),
83 | close(Error)
84 | },
85 | output('', informational, OutCodes),
86 | output('', error, ErrorCodes).
87 |
88 | output(_Prefix, _Class, Codes) -->
89 | { Codes == [] }, !.
90 | output(Prefix, Class, Codes) -->
91 | html(pre(class(Class),
92 | [ Prefix, '~s'-[Codes] ])).
93 |
94 | %% make//
95 | %
96 | % Run make, collecting output
97 |
98 | make -->
99 | { collect_messages(make, Messages)
100 | },
101 | messages(Messages).
102 |
103 |
104 | :- thread_local
105 | message/2.
106 |
107 | collect_messages(Goal, Messages) :-
108 | asserta((user:thread_message_hook(_Term, Level, Lines) :-
109 | assert(message(Level, Lines))), Ref),
110 | call_cleanup(Goal, erase(Ref)),
111 | findall(Level-Lines, retract(message(Level, Lines)), Messages).
112 |
113 | messages([]) -->
114 | [].
115 | messages([H|T]) -->
116 | message(H),
117 | messages(T).
118 |
119 | message(Level-Lines) -->
120 | html(div(class(Level), \html_message_lines(Lines))).
121 |
122 | html_message_lines([]) -->
123 | [].
124 | html_message_lines([nl|T]) --> !,
125 | html([br([])]),
126 | html_message_lines(T).
127 | html_message_lines([flush]) -->
128 | [].
129 | html_message_lines([Fmt-Args|T]) --> !,
130 | { format(string(S), Fmt, Args)
131 | },
132 | html([S]),
133 | html_message_lines(T).
134 | html_message_lines([Fmt|T]) --> !,
135 | { format(string(S), Fmt, [])
136 | },
137 | html([S]),
138 | html_message_lines(T).
139 |
140 | db_sync -->
141 | { db_sync_all(reload) }.
142 |
143 | db_sync_thread :-
144 | gethostname(HostName),
145 | server(slave, _, HostName), !,
146 | db_sync_thread(3600).
147 | db_sync_thread.
148 |
149 | %% db_sync_thread(+Time)
150 | %
151 | % Sync the persistency database every Time seconds.
152 |
153 | db_sync_thread(Time) :-
154 | catch(thread_create(sync_loop(Time), _,
155 | [ alias('__sync_db') ]),
156 | E, print_message(warning, E)).
157 |
158 | sync_loop(Time) :-
159 | repeat,
160 | sleep(Time),
161 | catch(db_sync_all(reload),
162 | E, print_message(warning, E)),
163 | fail.
164 |
165 |
--------------------------------------------------------------------------------
/watchdog.pl:
--------------------------------------------------------------------------------
1 | /* Part of SWI-Prolog
2 |
3 | Author: Jan Wielemaker
4 | E-mail: J.Wielemaker@cs.vu.nl
5 | WWW: http://www.swi-prolog.org
6 | Copyright (C): 2020, VU University Amsterdam
7 |
8 | This program is free software; you can redistribute it and/or
9 | modify it under the terms of the GNU General Public License
10 | as published by the Free Software Foundation; either version 2
11 | of the License, or (at your option) any later version.
12 |
13 | This program is distributed in the hope that it will be useful,
14 | but WITHOUT ANY WARRANTY; without even the implied warranty of
15 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 | GNU General Public License for more details.
17 |
18 | You should have received a copy of the GNU General Public
19 | License along with this library; if not, write to the Free Software
20 | Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21 |
22 | As a special exception, if you link this library with other files,
23 | compiled with a Free Software compiler, to produce an executable, this
24 | library does not by itself cause the resulting executable to be covered
25 | by the GNU General Public License. This exception does not however
26 | invalidate any other reasons why the executable file might be covered by
27 | the GNU General Public License.
28 | */
29 |
30 | :- module(http_watchdog, []).
31 | :- use_module(library(http/http_exception), []).
32 | :- autoload(library(broadcast), [broadcast/1]).
33 | :- autoload(library(aggregate), [aggregate_all/3]).
34 |
35 | :- multifile http:map_exception_to_http_status_hook/4.
36 |
37 | http:map_exception_to_http_status_hook(error(resource_error(Which),_), _, _, _) :-
38 | outof(Which),
39 | fail.
40 |
41 | :- dynamic
42 | outof/2.
43 |
44 | outof(Which) :-
45 | get_time(Now),
46 | Del is Now - 3600,
47 | forall(( outof(Which, Then),
48 | Then < Del
49 | ),
50 | retractall(outof(Which, Then))),
51 | aggregate_all(count, outof(Which, _), Count),
52 | Count > 3,
53 | !,
54 | broadcast(http(watchdog(Which))),
55 | halt(1).
56 | outof(Which) :-
57 | get_time(Now),
58 | asserta(outof(Which, Now)).
59 |
60 |
--------------------------------------------------------------------------------