/* Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: J.Wielemaker@cs.vu.nl
WWW: http://www.swi-prolog.org
Copyright (C): 2015, VU University Amsterdam
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
As a special exception, if you link this library with other files,
compiled with a Free Software compiler, to produce an executable, this
library does not by itself cause the resulting executable to be covered
by the GNU General Public License. This exception does not however
invalidate any other reasons why the executable file might be covered by
the GNU General Public License.
*/
:- module(gitty_driver_files,
[ gitty_close/1, % +Store
gitty_file/3, % +Store, ?Name, ?Hash
gitty_update_head/4, % +Store, +Name, +OldCommit, +NewCommit
delete_head/2, % +Store, +Name
set_head/3, % +Store, +Name, +Hash
store_object/4, % +Store, +Hash, +Header, +Data
delete_object/2, % +Store, +Hash
gitty_hash/2, % +Store, ?Hash
load_plain_commit/3, % +Store, +Hash, -Meta
load_object/5, % +Store, +Hash, -Data, -Type, -Size
gitty_rescan/1 % Store
]).
:- use_module(library(zlib)).
:- use_module(library(filesex)).
:- use_module(library(lists)).
:- use_module(library(apply)).
:- use_module(library(dcg/basics)).
/** <module> 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.
*/
:- dynamic
head/3, % Store, Name, Hash
store/2, % Store, Updated
heads_input_stream_cache/2. % Store, Stream
:- volatile
head/3,
store/2,
heads_input_stream_cache/2. % Store, Stream
% enable/disable syncing remote servers running on the same file store.
% This facility requires shared access to files and thus doesn't work on
% Windows.
:- if(current_prolog_flag(windows, true)).
remote_sync(false).
:- else.
remote_sync(true).
:- endif.
%% gitty_close(+Store) is det.
%
% Close resources associated with a store.
gitty_close(Store) :-
( retract(heads_input_stream_cache(Store, In))
-> close(In)
; true
),
retractall(head(Store,_,_)),
retractall(store(Store,_)).
%% gitty_file(+Store, ?File, ?Head) is nondet.
%
% True when File entry in the gitty store and Head is the HEAD
% revision.
gitty_file(Store, Head, Hash) :-
gitty_scan(Store),
head(Store, Head, Hash).
%% load_plain_commit(+Store, +Hash, -Meta:dict) is semidet.
%
% Load the commit data as a dict.
load_plain_commit(Store, Hash, Meta) :-
load_object(Store, Hash, String, _, _),
term_string(Meta, String, []).
%% 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.
store_object(Store, Hash, Hdr, Data) :-
sub_atom(Hash, 0, 2, _, Dir0),
sub_atom(Hash, 2, 2, _, Dir1),
sub_atom(Hash, 4, _, 0, File),
directory_file_path(Store, Dir0, D0),
ensure_directory(D0),
directory_file_path(D0, Dir1, D1),
ensure_directory(D1),
directory_file_path(D1, File, Path),
( exists_file(Path)
-> true
; setup_call_cleanup(
gzopen(Path, write, Out, [encoding(utf8)]),
format(Out, '~s~s', [Hdr, Data]),
close(Out))
).
ensure_directory(Dir) :-
exists_directory(Dir), !.
ensure_directory(Dir) :-
make_directory(Dir).
%% load_object(+Store, +Hash, -Data, -Type, -Size) is det.
%
% Load the given object.
load_object(Store, Hash, Data, Type, Size) :-
hash_file(Store, Hash, Path),
setup_call_cleanup(
gzopen(Path, read, In, [encoding(utf8)]),
read_object(In, Data, Type, Size),
close(In)).
read_object(In, Data, Type, Size) :-
get_code(In, C0),
read_hdr(C0, In, Hdr),
phrase((nonblanks(TypeChars), " ", integer(Size)), Hdr),
atom_codes(Type, TypeChars),
read_string(In, _, Data).
read_hdr(C, In, [C|T]) :-
C > 0, !,
get_code(In, C1),
read_hdr(C1, In, T).
read_hdr(_, _, []).
%% gitty_rescan(?Store) is det.
%
% Update our view of the shared storage for all stores matching
% Store.
gitty_rescan(Store) :-
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.
gitty_scan(Store) :-
store(Store, _), !,
( remote_sync(true)
-> with_mutex(gitty, remote_updates(Store))
; true
).
gitty_scan(Store) :-
with_mutex(gitty, gitty_scan_sync(Store)).
:- thread_local
latest/3.
gitty_scan_sync(Store) :-
store(Store, _), !.
gitty_scan_sync(Store) :-
remote_sync(true), !,
restore_heads_from_remote(Store).
gitty_scan_sync(Store) :-
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.
read_heads_from_objects(Store) :-
gitty_scan_latest(Store),
forall(retract(latest(Name, Hash, _Time)),
assert(head(Store, Name, Hash))),
get_time(Now),
assertz(store(Store, Now)).
%% gitty_scan_latest(+Store)
%
% Scans the gitty store, extracting the latest version of each
% named entry.
gitty_scan_latest(Store) :-
retractall(head(Store, _, _)),
retractall(latest(_, _, _)),
( gitty_hash(Store, Hash),
load_object(Store, Hash, Data, commit, _Size),
term_string(Meta, Data, []),
_{name:Name, time:Time} :< Meta,
( latest(Name, _, OldTime),
OldTime > Time
-> true
; retractall(latest(Name, _, _)),
assertz(latest(Name, Hash, Time))
),
fail
; true
).
%% gitty_hash(+Store, ?Hash) is nondet.
%
% True when Hash is an object in the store.
gitty_hash(Store, Hash) :-
var(Hash), !,
access_file(Store, exist),
directory_files(Store, Level0),
member(E0, Level0),
E0 \== '..',
atom_length(E0, 2),
directory_file_path(Store, E0, Dir0),
directory_files(Dir0, Level1),
member(E1, Level1),
E1 \== '..',
atom_length(E1, 2),
directory_file_path(Dir0, E1, Dir),
directory_files(Dir, Files),
member(File, Files),
atom_length(File, 36),
atomic_list_concat([E0,E1,File], Hash).
gitty_hash(Store, Hash) :-
hash_file(Store, Hash, File),
exists_file(File).
%% delete_object(+Store, +Hash)
%
% Delete an existing object
delete_object(Store, Hash) :-
hash_file(Store, Hash, File),
delete_file(File).
hash_file(Store, Hash, Path) :-
sub_atom(Hash, 0, 2, _, Dir0),
sub_atom(Hash, 2, 2, _, Dir1),
sub_atom(Hash, 4, _, 0, File),
atomic_list_concat([Store, Dir0, Dir1, File], /, Path).
/*******************************
* SYNCING *
*******************************/
%% 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.
gitty_update_head(Store, Name, OldCommit, NewCommit) :-
with_mutex(gitty,
gitty_update_head_sync(Store, Name, OldCommit, NewCommit)).
gitty_update_head_sync(Store, Name, OldCommit, NewCommit) :-
remote_sync(true), !,
setup_call_cleanup(
heads_output_stream(Store, HeadsOut),
gitty_update_head_sync(Store, Name, OldCommit, NewCommit, HeadsOut),
close(HeadsOut)).
gitty_update_head_sync(Store, Name, OldCommit, NewCommit) :-
gitty_update_head_sync2(Store, Name, OldCommit, NewCommit).
gitty_update_head_sync(Store, Name, OldCommit, NewCommit, HeadsOut) :-
gitty_update_head_sync2(Store, Name, OldCommit, NewCommit),
format(HeadsOut, '~q.~n', [head(Name, OldCommit, NewCommit)]).
gitty_update_head_sync2(Store, Name, OldCommit, NewCommit) :-
gitty_scan(Store), % fetch remote changes
( OldCommit == (-)
-> ( head(Store, Name, _)
-> throw(error(gitty(file_exists(Name),_)))
; assertz(head(Store, Name, NewCommit))
)
; ( retract(head(Store, Name, OldCommit))
-> assertz(head(Store, Name, NewCommit))
; throw(error(gitty(not_at_head(Name, OldCommit)), _))
)
).
remote_updates(Store) :-
remote_updates(Store, List),
maplist(update_head(Store), List).
update_head(Store, head(Name, OldCommit, NewCommit)) :-
( OldCommit == (-)
-> \+ head(Store, Name, _)
; retract(head(Store, Name, OldCommit))
), !,
assert(head(Store, Name, NewCommit)).
update_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.
remote_updates(Store, List) :-
heads_input_stream(Store, Stream),
setup_call_cleanup(
'$push_input_context'(gitty_sync),
read_new_terms(Stream, List),
'$pop_input_context').
read_new_terms(Stream, Terms) :-
read(Stream, First),
read_new_terms(First, Stream, Terms).
read_new_terms(end_of_file, _, List) :- !,
List = [].
read_new_terms(Term, Stream, [Term|More]) :-
read(Stream, Term2),
read_new_terms(Term2, Stream, More).
heads_output_stream(Store, Out) :-
heads_file(Store, HeadsFile),
open(HeadsFile, append, Out,
[ encoding(utf8),
lock(exclusive)
]).
heads_input_stream(Store, Stream) :-
heads_input_stream_cache(Store, Stream0), !,
Stream = Stream0.
heads_input_stream(Store, Stream) :-
heads_file(Store, File),
between(1, 2, _),
catch(open(File, read, In,
[ encoding(utf8),
eof_action(reset)
]),
_,
create_heads_file(Store)), !,
assert(heads_input_stream_cache(Store, In)),
Stream = In.
create_heads_file(Store) :-
call_cleanup(
heads_output_stream(Store, Out),
close(Out)),
fail. % always fail!
heads_file(Store, HeadsFile) :-
ensure_directory(Store),
directory_file_path(Store, ref, RefDir),
ensure_directory(RefDir),
directory_file_path(RefDir, head, HeadsFile).
%% restore_heads_from_remote(Store)
%
% Restore the known heads by reading the remote sync file.
restore_heads_from_remote(Store) :-
heads_file(Store, File),
exists_file(File),
setup_call_cleanup(
open(File, read, In, [encoding(utf8)]),
restore_heads(Store, In),
close(In)), !,
get_time(Now),
assertz(store(Store, Now)).
restore_heads_from_remote(Store) :-
read_heads_from_objects(Store),
heads_file(Store, File),
setup_call_cleanup(
open(File, write, Out, [encoding(utf8)]),
save_heads(Store, Out),
close(Out)), !.
restore_heads(Store, In) :-
read(In, Term0),
Term0 = epoch(_),
read(In, Term1),
restore_heads(Term1, In, Store).
restore_heads(end_of_file, _, _) :- !.
restore_heads(head(File, _, Hash), In, Store) :-
retractall(head(Store, File, _)),
assertz(head(Store, File, Hash)),
read(In, Term),
restore_heads(Term, In, Store).
save_heads(Store, Out) :-
get_time(Now),
format(Out, 'epoch(~0f).~n~n', [Now]),
forall(head(Store, File, Hash),
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?
delete_head(Store, Head) :-
retractall(head(Store, Head, _)).
%% set_head(+Store, +File, +Hash) is det.
%
% Set the head of the given File to Hash
set_head(Store, File, Hash) :-
retractall(head(Store, File, _)),
asserta(head(Store, File, Hash)).