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/** <module> 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
   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)]).   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
   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(_)).
   91
   92%%	gitweb(+Request)
   93%
   94%	Call gitweb script
   95
   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]).
  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
  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.