View source with raw comments or as raw
    1/*  Part of SWISH
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2015, VU University Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(gitty_driver_files,
   36	  [ gitty_close/1,		% +Store
   37	    gitty_file/3,		% +Store, ?Name, ?Hash
   38
   39	    gitty_update_head/4,	% +Store, +Name, +OldCommit, +NewCommit
   40	    delete_head/2,		% +Store, +Name
   41	    set_head/3,			% +Store, +Name, +Hash
   42	    store_object/4,		% +Store, +Hash, +Header, +Data
   43	    delete_object/2,		% +Store, +Hash
   44
   45	    gitty_hash/2,		% +Store, ?Hash
   46	    load_plain_commit/3,	% +Store, +Hash, -Meta
   47	    load_object/5,		% +Store, +Hash, -Data, -Type, -Size
   48
   49	    gitty_rescan/1		% Store
   50	  ]).   51:- use_module(library(zlib)).   52:- use_module(library(filesex)).   53:- use_module(library(lists)).   54:- use_module(library(apply)).   55:- use_module(library(error)).   56:- use_module(library(dcg/basics)).

Gitty plain files driver

This version of the driver uses plain files to store the gitty data. It consists of a nested directory structure with files named after the hash. Objects and hash computation is the same as for git. The heads (files) are computed on startup by scanning all objects. There is a file ref/head that is updated if a head is updated. Other clients can watch this file and update their notion of the head. This implies that the store can handle multiple clients that can access a shared file system, optionally shared using NFS from different machines.

The store is simple and robust. The main disadvantages are long startup times as the store holds more objects and relatively high disk usage due to rounding the small objects to disk allocation units.

bug
- Shared access does not work on Windows. */
   76:- dynamic
   77	head/3,				% Store, Name, Hash
   78	store/2,			% Store, Updated
   79	commit/3,			% Store, Hash, Meta
   80	heads_input_stream_cache/2.	% Store, Stream
   81:- volatile
   82	head/3,
   83	store/2,
   84	commit/3,
   85	heads_input_stream_cache/2.   86
   87% enable/disable syncing remote servers running on  the same file store.
   88% This facility requires shared access to files and thus doesn't work on
   89% Windows.
   90
   91:- if(current_prolog_flag(windows, true)).   92remote_sync(false).
   93:- else.   94remote_sync(true).
   95:- endif.
 gitty_close(+Store) is det
Close resources associated with a store.
  101gitty_close(Store) :-
  102	(   retract(heads_input_stream_cache(Store, In))
  103	->  close(In)
  104	;   true
  105	),
  106	retractall(head(Store,_,_)),
  107	retractall(store(Store,_)).
 gitty_file(+Store, ?File, ?Head) is nondet
True when File entry in the gitty store and Head is the HEAD revision.
  115gitty_file(Store, Head, Hash) :-
  116	gitty_scan(Store),
  117	head(Store, Head, Hash).
 load_plain_commit(+Store, +Hash, -Meta:dict) is semidet
Load the commit data as a dict.
  123load_plain_commit(Store, Hash, Meta) :-
  124	must_be(atom, Store),
  125	must_be(atom, Hash),
  126	commit(Store, Hash, Meta), !.
  127load_plain_commit(Store, Hash, Meta) :-
  128	load_object(Store, Hash, String, _, _),
  129	term_string(Meta0, String, []),
  130	assertz(commit(Store, Hash, Meta0)),
  131	Meta = Meta0.
 store_object(+Store, +Hash, +Header:string, +Data:string) is det
Store the actual object. The store must associate Hash with the concatenation of Hdr and Data.
  138store_object(Store, Hash, Hdr, Data) :-
  139	sub_atom(Hash, 0, 2, _, Dir0),
  140	sub_atom(Hash, 2, 2, _, Dir1),
  141	sub_atom(Hash, 4, _, 0, File),
  142	directory_file_path(Store, Dir0, D0),
  143	ensure_directory(D0),
  144	directory_file_path(D0, Dir1, D1),
  145	ensure_directory(D1),
  146	directory_file_path(D1, File, Path),
  147	(   exists_file(Path)
  148	->  true
  149	;   setup_call_cleanup(
  150		gzopen(Path, write, Out, [encoding(utf8)]),
  151		format(Out, '~s~s', [Hdr, Data]),
  152		close(Out))
  153	).
  154
  155ensure_directory(Dir) :-
  156	exists_directory(Dir), !.
  157ensure_directory(Dir) :-
  158	make_directory(Dir).
 load_object(+Store, +Hash, -Data, -Type, -Size) is det
Load the given object.
  164load_object(Store, Hash, Data, Type, Size) :-
  165	hash_file(Store, Hash, Path),
  166	setup_call_cleanup(
  167	    gzopen(Path, read, In, [encoding(utf8)]),
  168	    read_object(In, Data, Type, Size),
  169	    close(In)).
  170
  171read_object(In, Data, Type, Size) :-
  172	get_code(In, C0),
  173	read_hdr(C0, In, Hdr),
  174	phrase((nonblanks(TypeChars), " ", integer(Size)), Hdr),
  175	atom_codes(Type, TypeChars),
  176	read_string(In, _, Data).
  177
  178read_hdr(C, In, [C|T]) :-
  179	C > 0, !,
  180	get_code(In, C1),
  181	read_hdr(C1, In, T).
  182read_hdr(_, _, []).
 gitty_rescan(?Store) is det
Update our view of the shared storage for all stores matching Store.
  189gitty_rescan(Store) :-
  190	retractall(store(Store, _)).
 gitty_scan(+Store) is det
Scan gitty store for files (entries), filling head/3. This is performed lazily at first access to the store.
@tdb Possibly we need to maintain a cached version of this index to avoid having to open all objects of the gitty store.
  201gitty_scan(Store) :-
  202	store(Store, _), !,
  203	remote_updates(Store).
  204gitty_scan(Store) :-
  205	with_mutex(gitty, gitty_scan_sync(Store)).
  206
  207:- thread_local
  208	latest/3.  209
  210gitty_scan_sync(Store) :-
  211	store(Store, _), !.
  212gitty_scan_sync(Store) :-
  213	remote_sync(true), !,
  214	restore_heads_from_remote(Store).
  215gitty_scan_sync(Store) :-
  216	read_heads_from_objects(Store).
 read_heads_from_objects(+Store) is det
Establish the head(Store,File,Hash) relation by reading all objects and adding a fact for the most recent commit.
  223read_heads_from_objects(Store) :-
  224	gitty_scan_latest(Store),
  225	forall(retract(latest(Name, Hash, _Time)),
  226	       assert(head(Store, Name, Hash))),
  227	get_time(Now),
  228	assertz(store(Store, Now)).
 gitty_scan_latest(+Store)
Scans the gitty store, extracting the latest version of each named entry.
  235gitty_scan_latest(Store) :-
  236	retractall(head(Store, _, _)),
  237	retractall(latest(_, _, _)),
  238	(   gitty_hash(Store, Hash),
  239	    load_object(Store, Hash, Data, commit, _Size),
  240	    term_string(Meta, Data, []),
  241	    _{name:Name, time:Time} :< Meta,
  242	    (	latest(Name, _, OldTime),
  243		OldTime > Time
  244	    ->	true
  245	    ;	retractall(latest(Name, _, _)),
  246		assertz(latest(Name, Hash, Time))
  247	    ),
  248	    fail
  249	;   true
  250	).
 gitty_hash(+Store, ?Hash) is nondet
True when Hash is an object in the store.
  257gitty_hash(Store, Hash) :-
  258	var(Hash), !,
  259	access_file(Store, exist),
  260	directory_files(Store, Level0),
  261	member(E0, Level0),
  262	E0 \== '..',
  263	atom_length(E0, 2),
  264	directory_file_path(Store, E0, Dir0),
  265	directory_files(Dir0, Level1),
  266	member(E1, Level1),
  267	E1 \== '..',
  268	atom_length(E1, 2),
  269	directory_file_path(Dir0, E1, Dir),
  270	directory_files(Dir, Files),
  271	member(File, Files),
  272	atom_length(File, 36),
  273	atomic_list_concat([E0,E1,File], Hash).
  274gitty_hash(Store, Hash) :-
  275	hash_file(Store, Hash, File),
  276	exists_file(File).
 delete_object(+Store, +Hash)
Delete an existing object
  282delete_object(Store, Hash) :-
  283	hash_file(Store, Hash, File),
  284	delete_file(File).
  285
  286hash_file(Store, Hash, Path) :-
  287	sub_atom(Hash, 0, 2, _, Dir0),
  288	sub_atom(Hash, 2, 2, _, Dir1),
  289	sub_atom(Hash, 4, _, 0, File),
  290	atomic_list_concat([Store, Dir0, Dir1, File], /, Path).
  291
  292
  293		 /*******************************
  294		 *	      SYNCING		*
  295		 *******************************/
 gitty_update_head(+Store, +Name, +OldCommit, +NewCommit) is det
Update the head of a gitty store for Name. OldCommit is the current head and NewCommit is the new head. If Name is created, and thus there is no head, OldCommit must be -.

This operation can fail because another writer has updated the head. This can both be in-process or another process.

  306gitty_update_head(Store, Name, OldCommit, NewCommit) :-
  307	with_mutex(gitty,
  308		   gitty_update_head_sync(Store, Name, OldCommit, NewCommit)).
  309
  310gitty_update_head_sync(Store, Name, OldCommit, NewCommit) :-
  311	remote_sync(true), !,
  312	setup_call_cleanup(
  313	    heads_output_stream(Store, HeadsOut),
  314	    gitty_update_head_sync(Store, Name, OldCommit, NewCommit, HeadsOut),
  315	    close(HeadsOut)).
  316gitty_update_head_sync(Store, Name, OldCommit, NewCommit) :-
  317	gitty_update_head_sync2(Store, Name, OldCommit, NewCommit).
  318
  319gitty_update_head_sync(Store, Name, OldCommit, NewCommit, HeadsOut) :-
  320	gitty_update_head_sync2(Store, Name, OldCommit, NewCommit),
  321	format(HeadsOut, '~q.~n', [head(Name, OldCommit, NewCommit)]).
  322
  323gitty_update_head_sync2(Store, Name, OldCommit, NewCommit) :-
  324	gitty_scan(Store),		% fetch remote changes
  325	(   OldCommit == (-)
  326	->  (   head(Store, Name, _)
  327	    ->	throw(error(gitty(file_exists(Name),_)))
  328	    ;	assertz(head(Store, Name, NewCommit))
  329	    )
  330	;   (   retract(head(Store, Name, OldCommit))
  331	    ->	assertz(head(Store, Name, NewCommit))
  332	    ;	throw(error(gitty(not_at_head(Name, OldCommit)), _))
  333	    )
  334	).
 remote_updates(+Store)
Watch for remote updates to the store. We only do this if we did not do so the last second.
  341:- dynamic
  342	last_remote_sync/2.  343
  344remote_updates(_) :-
  345	remote_sync(false), !.
  346remote_updates(Store) :-
  347	remote_up_to_data(Store), !.
  348remote_updates(Store) :-
  349	with_mutex(gitty, remote_updates_sync(Store)).
  350
  351remote_updates_sync(Store) :-
  352	remote_up_to_data(Store), !.
  353remote_updates_sync(Store) :-
  354	retractall(last_remote_sync(Store, _)),
  355	get_time(Now),
  356	asserta(last_remote_sync(Store, Now)),
  357	remote_update(Store).
  358
  359remote_up_to_data(Store) :-
  360	last_remote_sync(Store, Last),
  361	get_time(Now),
  362	Now-Last < 1.
  363
  364remote_update(Store) :-
  365	remote_updates(Store, List),
  366	maplist(update_head(Store), List).
  367
  368update_head(Store, head(Name, OldCommit, NewCommit)) :-
  369	(   OldCommit == (-)
  370	->  \+ head(Store, Name, _)
  371	;   retract(head(Store, Name, OldCommit))
  372	), !,
  373	assert(head(Store, Name, NewCommit)).
  374update_head(_, _).
 remote_updates(+Store, -List) is det
Find updates from other gitties on the same filesystem. Note that we have to push/pop the input context to avoid creating a notion of an input context which possibly relate messages incorrectly to the sync file.
  383remote_updates(Store, List) :-
  384	heads_input_stream(Store, Stream),
  385	setup_call_cleanup(
  386	    '$push_input_context'(gitty_sync),
  387	    read_new_terms(Stream, List),
  388	    '$pop_input_context').
  389
  390read_new_terms(Stream, Terms) :-
  391	read(Stream, First),
  392	read_new_terms(First, Stream, Terms).
  393
  394read_new_terms(end_of_file, _, List) :- !,
  395	List = [].
  396read_new_terms(Term, Stream, [Term|More]) :-
  397	read(Stream, Term2),
  398	read_new_terms(Term2, Stream, More).
  399
  400heads_output_stream(Store, Out) :-
  401	heads_file(Store, HeadsFile),
  402	open(HeadsFile, append, Out,
  403	     [ encoding(utf8),
  404	       lock(exclusive)
  405	     ]).
  406
  407heads_input_stream(Store, Stream) :-
  408	heads_input_stream_cache(Store, Stream0), !,
  409	Stream = Stream0.
  410heads_input_stream(Store, Stream) :-
  411	heads_file(Store, File),
  412	between(1, 2, _),
  413	catch(open(File, read, In,
  414		   [ encoding(utf8),
  415		     eof_action(reset)
  416		   ]),
  417	      _,
  418	      create_heads_file(Store)), !,
  419	assert(heads_input_stream_cache(Store, In)),
  420	Stream = In.
  421
  422create_heads_file(Store) :-
  423	call_cleanup(
  424	    heads_output_stream(Store, Out),
  425	    close(Out)),
  426	fail.					% always fail!
  427
  428heads_file(Store, HeadsFile) :-
  429	ensure_directory(Store),
  430	directory_file_path(Store, ref, RefDir),
  431	ensure_directory(RefDir),
  432	directory_file_path(RefDir, head, HeadsFile).
 restore_heads_from_remote(Store)
Restore the known heads by reading the remote sync file.
  438restore_heads_from_remote(Store) :-
  439	heads_file(Store, File),
  440	exists_file(File),
  441	setup_call_cleanup(
  442	    open(File, read, In, [encoding(utf8)]),
  443	    restore_heads(Store, In),
  444	    close(In)), !,
  445	get_time(Now),
  446	assertz(store(Store, Now)).
  447restore_heads_from_remote(Store) :-
  448	read_heads_from_objects(Store),
  449	heads_file(Store, File),
  450	setup_call_cleanup(
  451	    open(File, write, Out, [encoding(utf8)]),
  452	    save_heads(Store, Out),
  453	    close(Out)), !.
  454
  455restore_heads(Store, In) :-
  456	read(In, Term0),
  457	Term0 = epoch(_),
  458	read(In, Term1),
  459	restore_heads(Term1, In, Store).
  460
  461restore_heads(end_of_file, _, _) :- !.
  462restore_heads(head(File, _, Hash), In, Store) :-
  463	retractall(head(Store, File, _)),
  464	assertz(head(Store, File, Hash)),
  465	read(In, Term),
  466	restore_heads(Term, In, Store).
  467
  468save_heads(Store, Out) :-
  469	get_time(Now),
  470	format(Out, 'epoch(~0f).~n~n', [Now]),
  471	forall(head(Store, File, Hash),
  472	       format(Out, '~q.~n', [head(File, -, Hash)])).
 delete_head(+Store, +Head) is det
Delete Head from Store. Used by gitty_fsck/1 to remove heads that have no commits. Should we forward this to remotes, or should they do their own thing?
  481delete_head(Store, Head) :-
  482	retractall(head(Store, Head, _)).
 set_head(+Store, +File, +Hash) is det
Set the head of the given File to Hash
  488set_head(Store, File, Hash) :-
  489	retractall(head(Store, File, _)),
  490	asserta(head(Store, File, Hash))