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).
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 50github(_Request) :- 51 reply_html_page( 52 git(github), 53 title('SWI-Prolog git services moved to github'), 54 \github). 55 56github --> 57 html({|html|| 58<p>The SWI-Prolog source repository has been moved to 59<a href="https://github.com/SWI-Prolog">GitHub</a>. 60 |}). 61 62:- multifile plweb:page_title//1. 63 64plwebpage_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)]).
82gitroot(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 89local(search(_)). 90local(fragment(_)).
96gitweb(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). 102gitweb(Request) :- 103 absolute_file_name(gitweb('gitweb.cgi'), ScriptPath, 104 [ access(execute) 105 ]), 106 http_run_cgi(ScriptPath, [], Request). 107 108 109resource_file('gitweb.css', gitweb('static/gitweb.css')). 110resource_file('gitweb.js', gitweb('static/gitweb.js')). 111resource_file('git-logo.png', gitweb('static/git-logo.png')). 112resource_file('git-favicon.png', gitweb('static/git-favicon.png')). 113 114 115:- multifile 116 http_cgi:environment/2. 117 118http_cgienvironment('PROJECT_ROOT', Root) :- % gitweb 119 git_project_root(Root). 120http_cgienvironment('GIT_PROJECT_ROOT', Root) :- % git-http 121 git_project_root(Root). 122http_cgienvironment('GITWEB_CONFIG', Config) :- 123 absolute_file_name(gitweb('gitweb.conf'), Config, 124 [ access(read) 125 ]). 126http_cgienvironment('PATH', '/bin:/usr/bin:/usr/local/bin'). 127 128 129git_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]).
git clone http://www.swi-prolog.org/nl/home/pl/git/pl.git
The comment "git http-backend" does not provide much meaningful info when accessed from a browser. Therefore we run "git http-backend" only if w think this the request comes from a git backend. Otherwise we redirect to the gitweb page.
151git_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). 164git_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.
Provide gitweb support