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
   64plweb: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)]).

 gitroot(+Request) is det

Some toplevel requests are send to /git, while working inside the repository asks for /git/. This is a hack to work around these problems.

   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(_)).

 gitweb(+Request)

Call gitweb script

   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_cgi:environment('PROJECT_ROOT', Root) :-		% gitweb
  119	git_project_root(Root).
  120http_cgi:environment('GIT_PROJECT_ROOT', Root) :-	% git-http
  121	git_project_root(Root).
  122http_cgi:environment('GITWEB_CONFIG', Config) :-
  123	absolute_file_name(gitweb('gitweb.conf'), Config,
  124			   [ access(read)
  125			   ]).
  126http_cgi:environment('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_http(+Request) is det

Server files from the git tree to make this work:

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.