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_bdb,
   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:- use_module(library(zlib)).   50:- use_module(library(dcg/basics)).   51:- use_module(library(memfile)).   52:- use_module(library(bdb)).   53
   54/** <module> Gitty BDB driver
   55
   56This version of the driver  uses   library(bdb),  the BerkeyDB database.
   57This driver is particularly suited for large numbers of files. The store
   58uses less disk space and starts much   faster on large numbers of files.
   59
   60The BDB database file contains two databases:
   61
   62  - =heads= maps a file name to the hash of the last object
   63  - =objects= contains the object blobs.
   64*/
   65
   66
   67:- dynamic
   68	bdb_env/2,			% Store, Env
   69	bdb_db/3.			% Store, Database, Handle
   70:- volatile
   71	bdb_env/2,
   72	bdb_db/3.   73
   74
   75bdb_handle(Store, Database, Handle) :-
   76	bdb_db(Store, Database, Handle), !.
   77bdb_handle(Store, Database, Handle) :-
   78	with_mutex(gitty_bdb, bdb_handle_sync(Store, Database, Handle)).
   79
   80bdb_handle_sync(Store, Database, Handle) :-
   81	bdb_db(Store, Database, Handle), !.
   82bdb_handle_sync(Store, Database, Handle) :-
   83	bdb_store(Store, Env),
   84	db_types(Database, KeyType, ValueType),
   85	bdb_open(Database, update, Handle,
   86		 [ environment(Env),
   87		   key(KeyType),
   88		   value(ValueType)
   89		 ]),
   90	asserta(bdb_db(Store, Database, Handle)).
   91
   92db_types(heads,   atom, atom).		% Name --> Hash
   93db_types(objects, atom, c_blob).	% Hash --> Blob
   94
   95%%	bdb_store(+Store, -Env) is det.
   96%
   97%	Get the BDB environment for Store.
   98
   99bdb_store(Store, Env) :-
  100	bdb_env(Store, Env), !.
  101bdb_store(Store, Env) :-
  102	with_mutex(gitty_bdb, bdb_store_sync(Store, Env)).
  103
  104bdb_store_sync(Store, Env) :-
  105	bdb_env(Store, Env), !.
  106bdb_store_sync(Store, Env) :-
  107	ensure_directory(Store),
  108	bdb_init(Env,
  109		 [ home(Store),
  110		   create(true),
  111		   thread(true),
  112		   init_txn(true),
  113		   recover(true),
  114		   register(true)
  115		 ]),
  116	asserta(bdb_env(Store, Env)).
  117
  118ensure_directory(Dir) :-
  119	exists_directory(Dir), !.
  120ensure_directory(Dir) :-
  121	make_directory(Dir).
  122
  123%%	gitty_close(+Store) is det.
  124%
  125%	Close the BDB environment associated with a gitty store
  126
  127gitty_close(Store) :-
  128	with_mutex(gitty_bdb, gitty_close_sync(Store)).
  129
  130gitty_close_sync(Store) :-
  131	(   retract(bdb_env(Store, Env))
  132	->  bdb_close_environment(Env)
  133	;   true
  134	).
  135
  136
  137%%	gitty_file(+Store, ?File, ?Head) is nondet.
  138%
  139%	True when File entry in the  gitty   store  and Head is the HEAD
  140%	revision.
  141
  142gitty_file(Store, Head, Hash) :-
  143	bdb_handle(Store, heads, H),
  144	(   nonvar(Head)
  145	->  bdb_get(H, Head, Hash)
  146	;   bdb_enum(H, Head, Hash)
  147	).
  148
  149%%	gitty_update_head(+Store, +Name, +OldCommit, +NewCommit) is det.
  150%
  151%	Update the head of a gitty  store   for  Name.  OldCommit is the
  152%	current head and NewCommit is the new  head. If Name is created,
  153%	and thus there is no head, OldCommit must be `-`.
  154%
  155%	This operation can fail because another   writer has updated the
  156%	head.  This can both be in-process or another process.
  157%
  158%	@error gitty(file_exists(Name) if the file already exists
  159%	@error gitty(not_at_head(Name, OldCommit) if the head was moved
  160%	       by someone else.
  161
  162gitty_update_head(Store, Name, OldCommit, NewCommit) :-
  163	bdb_store(Store, Env),
  164	bdb_transaction(
  165	    Env,
  166	    gitty_update_head_sync(Store, Name, OldCommit, NewCommit)).
  167
  168gitty_update_head_sync(Store, Name, OldCommit, NewCommit) :-
  169	bdb_handle(Store, heads, BDB),
  170	(   OldCommit == (-)
  171	->  (   bdb_get(BDB, Name, _)
  172	    ->	throw(error(gitty(file_exists(Name),_)))
  173	    ;	bdb_put(BDB, Name, NewCommit)
  174	    )
  175	;   (   bdb_get(BDB, Name, OldCommit)
  176	    ->	bdb_put(BDB, Name, NewCommit)
  177	    ;	throw(error(gitty(not_at_head(Name, OldCommit)), _))
  178	    )
  179	).
  180
  181%%	delete_head(+Store, +Name) is det.
  182%
  183%	Delete the named head.
  184
  185delete_head(Store, Name) :-
  186	bdb_handle(Store, heads, BDB),
  187	bdb_del(BDB, Name, _Old).
  188
  189%%	set_head(+Store, +File, +Hash) is det.
  190%
  191%	Set the head of the given File to Hash
  192
  193set_head(Store, File, Hash) :-
  194	bdb_handle(Store, heads, BDB),
  195	bdb_put(BDB, File, Hash).
  196
  197%%	load_plain_commit(+Store, +Hash, -Meta:dict) is semidet.
  198%
  199%	Load the commit data as a dict. Fails  if Hash does not exist or
  200%	is not a commit.
  201
  202load_plain_commit(Store, Hash, Meta) :-
  203	load_object(Store, Hash, String, commit, _Size),
  204	term_string(Meta, String, []).
  205
  206%%	store_object(+Store, +Hash, +Header:string, +Data:string) is det.
  207%
  208%	Store the actual object. The store  must associate Hash with the
  209%	concatenation of Hdr and Data.
  210
  211store_object(Store, Hash, Hdr, Data) :-
  212	compress_string(Hdr, Data, Object),
  213	bdb_handle(Store, objects, BDB),
  214	bdb_put(BDB, Hash, Object).
  215
  216compress_string(Header, Data, String) :-
  217	setup_call_cleanup(
  218	    new_memory_file(MF),
  219	    ( setup_call_cleanup(
  220		  open_memory_file(MF, write, Out, [encoding(utf8)]),
  221		  setup_call_cleanup(
  222		      zopen(Out, OutZ, [ format(gzip),
  223					 close_parent(false)
  224				       ]),
  225		      format(OutZ, '~s~s', [Header, Data]),
  226		    close(OutZ)),
  227		  close(Out)),
  228	      memory_file_to_string(MF, String, octet)
  229	    ),
  230	    free_memory_file(MF)).
  231
  232%%	load_object(+Store, +Hash, -Data, -Type, -Size) is det.
  233%
  234%	Load an object given its  Hash.  Data   holds  the  content as a
  235%	string, Type is the object type (an   atom) and Size is the size
  236%	of the object in bytes.
  237
  238load_object(Store, Hash, Data, Type, Size) :-
  239	bdb_handle(Store, objects, BDB),
  240	bdb_get(BDB, Hash, Blob),
  241	setup_call_cleanup(
  242	    open_string(Blob, In),
  243	    setup_call_cleanup(
  244		zopen(In, InZ, [ format(gzip),
  245				 close_parent(false)
  246			       ]),
  247		( set_stream(InZ, encoding(utf8)),
  248		  read_object(InZ, Data, Type, Size)
  249		),
  250		close(InZ)),
  251	    close(In)).
  252
  253read_object(In, Data, Type, Size) :-
  254	get_code(In, C0),
  255	read_hdr(C0, In, Hdr),
  256	phrase((nonblanks(TypeChars), " ", integer(Size)), Hdr),
  257	atom_codes(Type, TypeChars),
  258	read_string(In, _, Data).
  259
  260read_hdr(C, In, [C|T]) :-
  261	C > 0, !,
  262	get_code(In, C1),
  263	read_hdr(C1, In, T).
  264read_hdr(_, _, []).
  265
  266%%	gitty_hash(+Store, ?Hash) is nondet.
  267%
  268%	True when Hash is an object in the store.
  269
  270gitty_hash(Store, Hash) :-
  271	bdb_handle(Store, objects, BDB),
  272	(   nonvar(Hash)
  273	->  bdb_get(BDB, Hash, _)
  274	;   bdb_enum(BDB, Hash, _)
  275	).
  276
  277%%	delete_object(+Store, +Hash)
  278%
  279%	Delete an existing object
  280
  281delete_object(Store, Hash) :-
  282	bdb_handle(Store, objects, BDB),
  283	bdb_del(BDB, Hash, _)