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-2017, VU University Amsterdam
    7			      CWI Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(gitty_driver_files,
   37	  [ gitty_close/1,		% +Store
   38	    gitty_file/4,		% +Store, ?Name, ?Ext, ?Hash
   39
   40	    gitty_update_head/4,	% +Store, +Name, +OldCommit, +NewCommit
   41	    delete_head/2,		% +Store, +Name
   42	    set_head/3,			% +Store, +Name, +Hash
   43	    store_object/4,		% +Store, +Hash, +Header, +Data
   44	    delete_object/2,		% +Store, +Hash
   45
   46	    gitty_hash/2,		% +Store, ?Hash
   47	    load_plain_commit/3,	% +Store, +Hash, -Meta
   48	    load_object/5,		% +Store, +Hash, -Data, -Type, -Size
   49	    gitty_object_file/3,	% +Store, +Hash, -File
   50
   51	    repack_objects/2,           % +Store, +Options
   52            pack_objects/6,             % +Store, +Objs, +Packs, +PackDir,
   53					% -File, +Opts
   54            unpack_packs/1,             % +Store
   55            unpack_pack/2,              % +Store, +PackFile
   56
   57            attach_pack/2,		% +Store, +PackFile
   58            gitty_fsck/1,               % +Store
   59            fsck_pack/1,                % +PackFile
   60            load_object_from_pack/4,	% +Hash, -Data, -Type, -Size
   61
   62	    gitty_rescan/1		% Store
   63	  ]).   64:- use_module(library(apply)).   65:- use_module(library(zlib)).   66:- use_module(library(filesex)).   67:- use_module(library(lists)).   68:- use_module(library(apply)).   69:- use_module(library(error)).   70:- use_module(library(debug)).   71:- use_module(library(zlib)).   72:- use_module(library(hash_stream)).   73:- use_module(library(option)).   74:- use_module(library(dcg/basics)).

   94:- dynamic
   95    head/4,				% Store, Name, Ext, Hash
   96    store/2,				% Store, Updated
   97    commit/3,				% Store, Hash, Meta
   98    heads_input_stream_cache/2,		% Store, Stream
   99    pack_object/6,                      % Hash, Type, Size, Offset, Store,PackFile
  100    attached_packs/1,                   % Store
  101    attached_pack/2.                    % Store, PackFile
  102
  103:- volatile
  104    head/4,
  105    store/2,
  106    commit/3,
  107    heads_input_stream_cache/2,
  108    pack_object/6,
  109    attached_packs/1,
  110    attached_pack/2.  111
  112:- multifile
  113    gitty:check_object/4.  114
  115% enable/disable syncing remote servers running on  the same file store.
  116% This facility requires shared access to files and thus doesn't work on
  117% Windows.
  118
  119:- if(current_prolog_flag(windows, true)).  120remote_sync(false).
  121:- else.  122remote_sync(true).
  123:- endif.

 gitty_close(+Store) is det

Close resources associated with a store.

  129gitty_close(Store) :-
  130    (   retract(heads_input_stream_cache(Store, In))
  131    ->  close(In)
  132    ;   true
  133    ),
  134    retractall(head(Store,_,_,_)),
  135    retractall(store(Store,_)),
  136    retractall(pack_object(_,_,_,_,Store,_)).

 gitty_file(+Store, ?File, ?Ext, ?Head) is nondet

True when File entry in the gitty store and Head is the HEAD revision.

  144gitty_file(Store, Head, Ext, Hash) :-
  145	gitty_scan(Store),
  146	head(Store, Head, Ext, Hash).

 load_plain_commit(+Store, +Hash, -Meta:dict) is semidet

Load the commit data as a dict. Loaded commits are cached in commit/3. Note that only adding a fact to the cache is synchronized. This means that during a race situation we may load the same object multiple times from disk, but this is harmless while a lock around the whole predicate serializes loading different objects, which is not needed.

  157load_plain_commit(Store, Hash, Meta) :-
  158	must_be(atom, Store),
  159	must_be(atom, Hash),
  160	commit(Store, Hash, Meta), !.
  161load_plain_commit(Store, Hash, Meta) :-
  162	load_object(Store, Hash, String, _, _),
  163	term_string(Meta0, String, []),
  164	with_mutex(gitty_commit_cache,
  165		   assert_cached_commit(Store, Hash, Meta0)),
  166	Meta = Meta0.
  167
  168assert_cached_commit(Store, Hash, Meta) :-
  169	commit(Store, Hash, Meta0), !,
  170	assertion(Meta0 =@= Meta).
  171assert_cached_commit(Store, Hash, Meta) :-
  172	assertz(commit(Store, Hash, Meta)).

 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.

  179store_object(Store, Hash, _Hdr, _Data) :-
  180        pack_object(Hash, _Type, _Size, _Offset, Store, _Pack), !.
  181store_object(Store, Hash, Hdr, Data) :-
  182        gitty_object_file(Store, Hash, Path),
  183        with_mutex(gitty_file, exists_or_create(Path, Out0)),
  184	(   var(Out0)
  185	->  true
  186	;   setup_call_cleanup(
  187		zopen(Out0, Out, [format(gzip)]),
  188		format(Out, '~s~s', [Hdr, Data]),
  189		close(Out))
  190	).
  191
  192exists_or_create(Path, _Out) :-
  193	exists_file(Path), !.
  194exists_or_create(Path, Out) :-
  195        file_directory_name(Path, Dir),
  196        make_directory_path(Dir),
  197        open(Path, write, Out, [encoding(utf8), lock(write)]).
  198
  199ensure_directory(Dir) :-
  200	exists_directory(Dir), !.
  201ensure_directory(Dir) :-
  202	make_directory(Dir).

 load_object(+Store, +Hash, -Data, -Type, -Size) is det

Load the given object.

  208load_object(_Store, Hash, Data, Type, Size) :-
  209        load_object_from_pack(Hash, Data0, Type0, Size0), !,
  210        f(Data0, Type0, Size0) = f(Data, Type, Size).
  211load_object(Store, Hash, Data, Type, Size) :-
  212	gitty_object_file(Store, Hash, Path),
  213        exists_file(Path),
  214	setup_call_cleanup(
  215	    gzopen(Path, read, In, [encoding(utf8)]),
  216	    read_object(In, Data, Type, Size),
  217	    close(In)).

 load_object_header(+Store, +Hash, -Type, -Size) is det

Load the header of an object

  223load_object_header(Store, Hash, Type, Size) :-
  224	gitty_object_file(Store, Hash, Path),
  225	setup_call_cleanup(
  226	    gzopen(Path, read, In, [encoding(utf8)]),
  227	    read_object_hdr(In, Type, Size),
  228	    close(In)).
  229
  230read_object(In, Data, Type, Size) :-
  231	read_object_hdr(In, Type, Size),
  232	read_string(In, _, Data).
  233
  234read_object_hdr(In, Type, Size) :-
  235	get_code(In, C0),
  236	read_hdr(C0, In, Hdr),
  237	phrase((nonblanks(TypeChars), " ", integer(Size)), Hdr),
  238	atom_codes(Type, TypeChars).
  239
  240read_hdr(C, In, [C|T]) :-
  241	C > 0, !,
  242	get_code(In, C1),
  243	read_hdr(C1, In, T).
  244read_hdr(_, _, []).

 gitty_rescan(?Store) is det

Update our view of the shared storage for all stores matching Store.

  251gitty_rescan(Store) :-
  252	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.

  263gitty_scan(Store) :-
  264	store(Store, _), !,
  265	remote_updates(Store).
  266gitty_scan(Store) :-
  267	with_mutex(gitty, gitty_scan_sync(Store)).
  268
  269:- thread_local
  270	latest/3.  271
  272gitty_scan_sync(Store) :-
  273	store(Store, _), !.
  274gitty_scan_sync(Store) :-
  275	remote_sync(true), !,
  276        gitty_attach_packs(Store),
  277	restore_heads_from_remote(Store).
  278gitty_scan_sync(Store) :-
  279        gitty_attach_packs(Store),
  280	read_heads_from_objects(Store).

 read_heads_from_objects(+Store) is det

Establish the head(Store,File,Ext,Hash) relation by reading all objects and adding a fact for the most recent commit.

  287read_heads_from_objects(Store) :-
  288	gitty_scan_latest(Store),
  289	forall(retract(latest(Name, Hash, _Time)),
  290	       assert_head(Store, Name, Hash)),
  291	get_time(Now),
  292	assertz(store(Store, Now)).
  293
  294assert_head(Store, Name, Hash) :-
  295	file_name_extension(_, Ext, Name),
  296        assertz(head(Store, Name, Ext, Hash)).

 gitty_scan_latest(+Store)

Scans the gitty store, extracting the latest version of each named entry.

  304gitty_scan_latest(Store) :-
  305	retractall(head(Store, _, _, _)),
  306	retractall(latest(_, _, _)),
  307	(   gitty_hash(Store, Hash),
  308	    load_object(Store, Hash, Data, commit, _Size),
  309	    term_string(Meta, Data, []),
  310	    _{name:Name, time:Time} :< Meta,
  311	    (	latest(Name, _, OldTime),
  312		OldTime > Time
  313	    ->	true
  314	    ;	retractall(latest(Name, _, _)),
  315		assertz(latest(Name, Hash, Time))
  316	    ),
  317	    fail
  318	;   true
  319	).

 gitty_hash(+Store, ?Hash) is nondet

True when Hash is an object in the store.

  326gitty_hash(Store, Hash) :-
  327	var(Hash), !,
  328        (   gitty_attach_packs(Store),
  329            pack_object(Hash, _Type, _Size, _Offset, Store, _Pack)
  330        ;   gitty_file_object(Store, Hash)
  331        ).
  332gitty_hash(Store, Hash) :-
  333        (   gitty_attach_packs(Store),
  334            pack_object(Hash, _Type, _Size, _Offset, Store, _Pack)
  335        ->  true
  336        ;   gitty_object_file(Store, Hash, File),
  337            exists_file(File)
  338        ).
  339
  340gitty_file_object(Store, Hash) :-
  341	access_file(Store, exist),
  342	directory_files(Store, Level0),
  343	member(E0, Level0),
  344	E0 \== '..',
  345	atom_length(E0, 2),
  346	directory_file_path(Store, E0, Dir0),
  347	directory_files(Dir0, Level1),
  348	member(E1, Level1),
  349	E1 \== '..',
  350	atom_length(E1, 2),
  351	directory_file_path(Dir0, E1, Dir),
  352	directory_files(Dir, Files),
  353	member(File, Files),
  354	atom_length(File, 36),
  355	atomic_list_concat([E0,E1,File], Hash).

 delete_object(+Store, +Hash)

Delete an existing object

  361delete_object(Store, Hash) :-
  362	gitty_object_file(Store, Hash, File),
  363	delete_file(File).

 gitty_object_file(+Store, +Hash, -Path) is det

True when Path is the file at which the object with Hash is stored.

  370gitty_object_file(Store, Hash, Path) :-
  371	sub_string(Hash, 0, 2, _, Dir0),
  372	sub_string(Hash, 2, 2, _, Dir1),
  373	sub_string(Hash, 4, _, 0, File),
  374	atomic_list_concat([Store, Dir0, Dir1, File], /, Path).
  375
  376
  377		 /*******************************
  378		 *	      SYNCING		*
  379		 *******************************/

 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.

  390gitty_update_head(Store, Name, OldCommit, NewCommit) :-
  391	with_mutex(gitty,
  392		   gitty_update_head_sync(Store, Name, OldCommit, NewCommit)).
  393
  394gitty_update_head_sync(Store, Name, OldCommit, NewCommit) :-
  395	remote_sync(true), !,
  396	setup_call_cleanup(
  397	    heads_output_stream(Store, HeadsOut),
  398	    gitty_update_head_sync(Store, Name, OldCommit, NewCommit, HeadsOut),
  399	    close(HeadsOut)).
  400gitty_update_head_sync(Store, Name, OldCommit, NewCommit) :-
  401	gitty_update_head_sync2(Store, Name, OldCommit, NewCommit).
  402
  403gitty_update_head_sync(Store, Name, OldCommit, NewCommit, HeadsOut) :-
  404	gitty_update_head_sync2(Store, Name, OldCommit, NewCommit),
  405	format(HeadsOut, '~q.~n', [head(Name, OldCommit, NewCommit)]).
  406
  407gitty_update_head_sync2(Store, Name, OldCommit, NewCommit) :-
  408	gitty_scan(Store),		% fetch remote changes
  409	(   OldCommit == (-)
  410	->  (   head(Store, Name, _, _)
  411	    ->	throw(error(gitty(file_exists(Name),_)))
  412	    ;	assert_head(Store, Name, NewCommit)
  413	    )
  414	;   (   retract(head(Store, Name, _, OldCommit))
  415	    ->	assert_head(Store, Name, NewCommit)
  416	    ;	throw(error(gitty(not_at_head(Name, OldCommit)), _))
  417	    )
  418	).

 remote_updates(+Store)

Watch for remote updates to the store. We only do this if we did not do so the last second.

  425:- dynamic
  426	last_remote_sync/2.  427
  428remote_updates(_) :-
  429	remote_sync(false), !.
  430remote_updates(Store) :-
  431	remote_up_to_data(Store), !.
  432remote_updates(Store) :-
  433	with_mutex(gitty, remote_updates_sync(Store)).
  434
  435remote_updates_sync(Store) :-
  436	remote_up_to_data(Store), !.
  437remote_updates_sync(Store) :-
  438	retractall(last_remote_sync(Store, _)),
  439	get_time(Now),
  440	asserta(last_remote_sync(Store, Now)),
  441	remote_update(Store).
  442
  443remote_up_to_data(Store) :-
  444	last_remote_sync(Store, Last),
  445	get_time(Now),
  446	Now-Last < 1.
  447
  448remote_update(Store) :-
  449	remote_updates(Store, List),
  450	maplist(update_head(Store), List).
  451
  452update_head(Store, head(Name, OldCommit, NewCommit)) :-
  453	(   OldCommit == (-)
  454	->  \+ head(Store, Name, _, _)
  455	;   retract(head(Store, Name, _, OldCommit))
  456	), !,
  457	assert_head(Store, Name, NewCommit).
  458update_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.

  467remote_updates(Store, List) :-
  468	heads_input_stream(Store, Stream),
  469	setup_call_cleanup(
  470	    '$push_input_context'(gitty_sync),
  471	    read_new_terms(Stream, List),
  472	    '$pop_input_context').
  473
  474read_new_terms(Stream, Terms) :-
  475	read(Stream, First),
  476	read_new_terms(First, Stream, Terms).
  477
  478read_new_terms(end_of_file, _, List) :- !,
  479	List = [].
  480read_new_terms(Term, Stream, [Term|More]) :-
  481	read(Stream, Term2),
  482	read_new_terms(Term2, Stream, More).
  483
  484heads_output_stream(Store, Out) :-
  485	heads_file(Store, HeadsFile),
  486	open(HeadsFile, append, Out,
  487	     [ encoding(utf8),
  488	       lock(exclusive)
  489	     ]).
  490
  491heads_input_stream(Store, Stream) :-
  492	heads_input_stream_cache(Store, Stream0), !,
  493	Stream = Stream0.
  494heads_input_stream(Store, Stream) :-
  495	heads_file(Store, File),
  496	between(1, 2, _),
  497	catch(open(File, read, In,
  498		   [ encoding(utf8),
  499		     eof_action(reset)
  500		   ]),
  501	      _,
  502	      create_heads_file(Store)), !,
  503	assert(heads_input_stream_cache(Store, In)),
  504	Stream = In.
  505
  506create_heads_file(Store) :-
  507	call_cleanup(
  508	    heads_output_stream(Store, Out),
  509	    close(Out)),
  510	fail.					% always fail!
  511
  512heads_file(Store, HeadsFile) :-
  513	ensure_directory(Store),
  514	directory_file_path(Store, ref, RefDir),
  515	ensure_directory(RefDir),
  516	directory_file_path(RefDir, head, HeadsFile).

 restore_heads_from_remote(Store)

Restore the known heads by reading the remote sync file.

  522restore_heads_from_remote(Store) :-
  523	heads_file(Store, File),
  524	exists_file(File),
  525	setup_call_cleanup(
  526	    open(File, read, In, [encoding(utf8)]),
  527	    restore_heads(Store, In),
  528	    close(In)), !,
  529	get_time(Now),
  530	assertz(store(Store, Now)).
  531restore_heads_from_remote(Store) :-
  532	read_heads_from_objects(Store),
  533	heads_file(Store, File),
  534	setup_call_cleanup(
  535	    open(File, write, Out, [encoding(utf8)]),
  536	    save_heads(Store, Out),
  537	    close(Out)), !.
  538
  539restore_heads(Store, In) :-
  540	read(In, Term0),
  541	Term0 = epoch(_),
  542	read(In, Term1),
  543	restore_heads(Term1, In, Store).
  544
  545restore_heads(end_of_file, _, _) :- !.
  546restore_heads(head(File, _, Hash), In, Store) :-
  547	retractall(head(Store, File, _, _)),
  548	assert_head(Store, File, Hash),
  549	read(In, Term),
  550	restore_heads(Term, In, Store).
  551
  552save_heads(Store, Out) :-
  553	get_time(Now),
  554	format(Out, 'epoch(~0f).~n~n', [Now]),
  555	forall(head(Store, File, _, Hash),
  556	       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?

  565delete_head(Store, Head) :-
  566	retractall(head(Store, Head, _, _)).

 set_head(+Store, +File, +Hash) is det

Set the head of the given File to Hash

  572set_head(Store, File, Hash) :-
  573	file_name_extension(_, Ext, File),
  574        (   head(Store, File, _, Hash0)
  575        ->  (   Hash == Hash0
  576            ->  true
  577            ;   asserta(head(Store, File, Ext, Hash)),
  578                retractall(head(Store, File, _, Hash0))
  579            )
  580        ;   asserta(head(Store, File, Ext, Hash))
  581        ).
  582
  583
  584		 /*******************************
  585		 *	      PACKS		*
  586		 *******************************/
  587
  588/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  589
  590<pack file> := <header>
  591               <file>*
  592<header>    := "gitty(Version).\n" <object>* "end_of_header.\n"
  593<object>    := obj(Hash, Type, Size, FileSize)
  594- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  595
  596pack_version(1).

 repack_objects(+Store, +Options) is det

Repack objects of Store for reduced disk usage and enhanced performance. By default this picks up all file objects of the store and all existing small pack files. Options:

small_pack(+Bytes)

Consider all packs with less than Bytes as small and repack them. Default 10Mb

min_files(+Count)

Do not repack if there are less than Count new files. Default 1,000.

  611:- debug(gitty(pack)).  612
  613repack_objects(Store, Options) :-
  614    option(min_files(MinFiles), Options, 1_000),
  615    findall(Object, gitty_file_object(Store, Object), Objects),
  616    length(Objects, NewFiles),
  617    debug(gitty(pack), 'Found ~D file objects', [NewFiles]),
  618    (   NewFiles >= MinFiles
  619    ->  pack_files(Store, ExistingPacks),
  620        option(small_pack(MaxSize), Options, 10_000_000),
  621        include(small_file(MaxSize), ExistingPacks, PackFiles),
  622        (   debugging(gitty(pack))
  623        ->  length(PackFiles, PackCount),
  624            debug(gitty(pack), 'Found ~D small packs', [PackCount])
  625        ;   true
  626        ),
  627        directory_file_path(Store, pack, PackDir),
  628        make_directory_path(PackDir),
  629        pack_objects(Store, Objects, PackFiles, PackDir, _PackFile, Options)
  630    ;   debug(gitty(pack), 'Nothing to do', [])
  631    ).
  632
  633small_file(MaxSize, File) :-
  634    size_file(File, Size),
  635    Size < MaxSize.

 pack_objects(+Store, +Objects, +Packs, +PackDir, -PackFile, +Options) is det

Pack the given objects and pack files into a new pack.

  642pack_objects(Store, Objects, Packs, PackDir, PackFile, Options) :-
  643    with_mutex(gitty_pack,
  644	       pack_objects_sync(Store, Objects, Packs, PackDir,
  645                                 PackFile, Options)).
  646
  647pack_objects_sync(_Store, [], [Pack], _, [Pack], _) :-
  648    !.
  649pack_objects_sync(Store, Objects, Packs, PackDir, PackFilePath, Options) :-
  650    length(Objects, ObjCount),
  651    length(Packs, PackCount),
  652    debug(gitty(pack), 'Repacking ~D objects and ~D packs',
  653          [ObjCount, PackCount]),
  654    maplist(object_info(Store), Objects, FileInfo),
  655    maplist(pack_info(Store), Packs, PackInfo),
  656    append([FileInfo|PackInfo], Info0),
  657    sort(1, @<, Info0, Info),           % remove possible duplicates
  658    (   debugging(gitty(pack))
  659    ->  (   PackCount > 0
  660        ->  length(Info, FinalObjCount),
  661            debug(gitty(pack), 'Total ~D objects', [FinalObjCount])
  662        ;   true
  663        )
  664    ;   true
  665    ),
  666    directory_file_path(PackDir, 'pack-create', TmpPack),
  667    setup_call_cleanup(
  668	(   open(TmpPack, write, Out0, [type(binary), lock(write)]),
  669	    open_hash_stream(Out0, Out, [algorithm(sha1)])
  670	),
  671        (   write_signature(Out),
  672            maplist(write_header(Out), Info),
  673            format(Out, 'end_of_header.~n', []),
  674            maplist(add_file(Out, Store), Info),
  675	    stream_hash(Out, SHA1)
  676        ),
  677        close(Out)),
  678    format(atom(PackFile), 'pack-~w.pack', [SHA1]),
  679    directory_file_path(PackDir, PackFile, PackFilePath),
  680    rename_file(TmpPack, PackFilePath),
  681    debug(gitty(pack), 'Attaching ~p', [PackFilePath]),
  682    attach_pack(Store, PackFilePath),
  683    remove_objects_after_pack(Store, Objects, Options),
  684    delete(Packs, PackFilePath, RmPacks),
  685    remove_repacked_packs(Store, RmPacks, Options),
  686    debug(gitty(pack), 'Packing completed', []).
  687
  688object_info(Store, Object, obj(Object, Type, Size, FileSize)) :-
  689    gitty_object_file(Store, Object, File),
  690    load_object_header(Store, Object, Type, Size),
  691    size_file(File, FileSize).
  692
  693pack_info(Store, PackFile, Objects) :-
  694    attach_pack(Store, PackFile),
  695    pack_read_header(PackFile, _Version, _DataOffset, Objects).
  696
  697write_signature(Out) :-
  698    pack_version(Version),
  699    format(Out, "gitty(~d).~n", [Version]).
  700
  701write_header(Out, obj(Object, Type, Size, FileSize)) :-
  702    format(Out, 'obj(~q,~q,~d,~d).~n', [Object, Type, Size, FileSize]).

 add_file(+Out, +Store, +Object) is det

Add Object from Store to the pack stream Out.

  708add_file(Out, Store, obj(Object, _Type, _Size, _FileSize)) :-
  709    gitty_object_file(Store, Object, File),
  710    exists_file(File),
  711    !,
  712    setup_call_cleanup(
  713        open(File, read, In, [type(binary)]),
  714        copy_stream_data(In, Out),
  715        close(In)).
  716add_file(Out, Store, obj(Object, Type, Size, FileSize)) :-
  717    pack_object(Object, Type, Size, Offset, Store, PackFile),
  718    setup_call_cleanup(
  719        open(PackFile, read, In, [type(binary)]),
  720        (   seek(In, Offset, bof, Offset),
  721            copy_stream_data(In, Out, FileSize)
  722        ),
  723        close(In)).

 gitty_fsck(+Store) is det

Validate all packs associated with Store

  730gitty_fsck(Store) :-
  731    pack_files(Store, PackFiles),
  732    maplist(fsck_pack, PackFiles).

 fsck_pack(+File) is det

Validate the integrity of the pack file File.

  738fsck_pack(File) :-
  739    debug(gitty(pack), 'fsck ~p', [File]),
  740    check_pack_hash(File),
  741    debug(gitty(pack), 'fsck ~p: checking objects', [File]),
  742    check_pack_objects(File),
  743    debug(gitty(pack), 'fsck ~p: done', [File]).
  744
  745check_pack_hash(File) :-
  746    file_base_name(File, Base),
  747    file_name_extension(Plain, Ext, Base),
  748    must_be(oneof([pack]), Ext),
  749    atom_concat('pack-', Hash, Plain),
  750    setup_call_cleanup(
  751        (   open(File, read, In0, [type(binary)]),
  752            open_hash_stream(In0, In, [algorithm(sha1)])
  753        ),
  754        (   setup_call_cleanup(
  755                open_null_stream(Null),
  756                copy_stream_data(In, Null),
  757                close(Null)),
  758            stream_hash(In, SHA1)
  759        ),
  760        close(In)),
  761    assertion(Hash == SHA1).
  762
  763check_pack_objects(PackFile) :-
  764    setup_call_cleanup(
  765        open(PackFile, read, In, [type(binary)]),
  766        (  read_header(In, Version, DataOffset, Objects),
  767           set_stream(In, encoding(utf8)),
  768           foldl(check_object(In, PackFile, Version), Objects, DataOffset, _)
  769        ),
  770        close(In)).
  771
  772check_object(In, PackFile, _Version,
  773             obj(Object, Type, Size, FileSize),
  774             Offset0, Offset) :-
  775    Offset is Offset0+FileSize,
  776    byte_count(In, Here),
  777    (   Here == Offset0
  778    ->  true
  779    ;   print_message(warning, pack(reposition(Here, Offset0))),
  780        seek(In, Offset0, bof, Offset0)
  781    ),
  782    (   setup_call_cleanup(
  783            zopen(In, In2, [multi_part(false), close_parent(false)]),
  784            catch(read_object(In2, Data, _0RType, _0RSize), E,
  785                  ( print_message(error,
  786                                  gitty(PackFile, fsck(read_object(Object, E)))),
  787                    fail)),
  788            close(In2))
  789    ->  byte_count(In, End),
  790        (   End == Offset
  791        ->  true
  792        ;   print_message(error,
  793                          gitty(PackFile, fsck(object_end(Object, End,
  794                                                          Offset0, Offset,
  795                                                          Data))))
  796        ),
  797        assertion(Type == _0RType),
  798        assertion(Size == _0RSize),
  799        gitty:check_object(Object, Data, Type, Size)
  800    ;   true
  801    ).

 gitty_attach_packs(+Store) is det

Attach all packs for Store

  808gitty_attach_packs(Store) :-
  809    attached_packs(Store),
  810    !.
  811gitty_attach_packs(Store) :-
  812    with_mutex(gitty_attach_packs,
  813               gitty_attach_packs_sync(Store)).
  814
  815gitty_attach_packs_sync(Store) :-
  816    attached_packs(Store),
  817    !.
  818gitty_attach_packs_sync(Store) :-
  819    pack_files(Store, PackFiles),
  820    maplist(attach_pack(Store), PackFiles),
  821    asserta(attached_packs(Store)).
  822
  823pack_files(Store, Packs) :-
  824    directory_file_path(Store, pack, PackDir),
  825    exists_directory(PackDir),
  826    !,
  827    directory_files(PackDir, Files),
  828    convlist(is_pack(PackDir), Files, Packs).
  829pack_files(_, []).
  830
  831is_pack(PackDir, File, Path) :-
  832    file_name_extension(_, pack, File),
  833    directory_file_path(PackDir, File, Path).

 attach_pack(+Store, +PackFile)

Load the index of Pack into memory.

  839attach_pack(Store, PackFile) :-
  840    attached_pack(Store, PackFile),
  841    !.
  842attach_pack(Store, PackFile) :-
  843    retractall(pack_object(_,_,_,_,_,PackFile)),
  844    pack_read_header(PackFile, Version, DataOffset, Objects),
  845    foldl(assert_object(Store, PackFile, Version), Objects, DataOffset, _),
  846    assertz(attached_pack(Store, PackFile)).
  847
  848pack_read_header(PackFile, Version, DataOffset, Objects) :-
  849    setup_call_cleanup(
  850        open(PackFile, read, In, [type(binary)]),
  851        read_header(In, Version, DataOffset, Objects),
  852        close(In)).
  853
  854read_header(In, Version, DataOffset, Objects) :-
  855    read(In, Signature),
  856    (   Signature = gitty(Version)
  857    ->  true
  858    ;   domain_error(gitty_pack_file, Objects)
  859    ),
  860    read(In, Term),
  861    read_index(Term, In, Objects),
  862    get_code(In, Code),
  863    assertion(Code == 0'\n),
  864    byte_count(In, DataOffset).
  865
  866read_index(end_of_header, _, []) :-
  867    !.
  868read_index(Object, In, [Object|T]) :-
  869    read(In, Term2),
  870    read_index(Term2, In, T).
  871
  872assert_object(Store, Pack, _Version,
  873              obj(Object, Type, Size, FileSize),
  874              Offset0, Offset) :-
  875    Offset is Offset0+FileSize,
  876    assertz(pack_object(Object, Type, Size, Offset0, Store, Pack)).

 detach_pack(+Store, +Pack) is det

Remove a pack file from the memory index.

  882detach_pack(Store, Pack) :-
  883    retractall(pack_object(_, _, _, _, Store, Pack)),
  884    retractall(attached_pack(Store, Pack)).

 load_object_from_pack(+Hash, -Data, -Type, -Size) is semidet

True when Hash is in a pack and can be loaded.

  890load_object_from_pack(Hash, Data, Type, Size) :-
  891    pack_object(Hash, Type, Size, Offset, _Store, Pack),
  892    setup_call_cleanup(
  893        open(Pack, read, In, [type(binary)]),
  894        read_object_at(In, Offset, Data, Type, Size),
  895        close(In)).
  896
  897read_object_at(In, Offset, Data, Type, Size) :-
  898    seek(In, Offset, bof, Offset),
  899    read_object_here(In, Data, Type, Size).
  900
  901read_object_here(In, Data, Type, Size) :-
  902    stream_property(In, encoding(Enc)),
  903    setup_call_cleanup(
  904        ( set_stream(In, encoding(utf8)),
  905          zopen(In, In2, [multi_part(false), close_parent(false)])
  906        ),
  907        read_object(In2, Data, Type, Size),
  908        ( close(In2),
  909          set_stream(In, encoding(Enc))
  910        )).

 unpack_packs(+Store) is det

Unpack all packs.

  916unpack_packs(Store) :-
  917    absolute_file_name(Store, AbsStore, [file_type(directory),
  918                                         access(read)]),
  919    pack_files(AbsStore, Packs),
  920    maplist(unpack_pack(AbsStore), Packs).

 unpack_pack(+Store, +Pack) is det

Turn a pack back into a plain object files

  926unpack_pack(Store, PackFile) :-
  927    pack_read_header(PackFile, _Version, DataOffset, Objects),
  928    setup_call_cleanup(
  929        open(PackFile, read, In, [type(binary)]),
  930        foldl(create_file(Store, In), Objects, DataOffset, _),
  931        close(In)),
  932    detach_pack(Store, PackFile),
  933    delete_file(PackFile).
  934
  935create_file(Store, In, obj(Object, _Type, _Size, FileSize), Offset0, Offset) :-
  936    Offset is Offset0+FileSize,
  937    gitty_object_file(Store, Object, Path),
  938    with_mutex(gitty_file, exists_or_recreate(Path, Out)),
  939	(   var(Out)
  940	->  true
  941	;   setup_call_cleanup(
  942                seek(In, Offset0, bof, Offset0),
  943                copy_stream_data(In, Out, FileSize),
  944                close(Out))
  945	).
  946
  947exists_or_recreate(Path, _Out) :-
  948	exists_file(Path), !.
  949exists_or_recreate(Path, Out) :-
  950        file_directory_name(Path, Dir),
  951        make_directory_path(Dir),
  952        open(Path, write, Out, [type(binary), lock(write)]).

 remove_objects_after_pack(+Store, +Objects, +Options) is det

Remove the indicated (file) objects from Store.

  959remove_objects_after_pack(Store, Objects, Options) :-
  960    debug(gitty(pack), 'Deleting plain files', []),
  961    maplist(delete_object(Store), Objects),
  962    (   option(prune_empty_directories(true), Options, true)
  963    ->  debug(gitty(pack), 'Pruning empty directories', []),
  964        prune_empty_directories(Store)
  965    ;   true
  966    ).

 remove_repacked_packs(+Store, +Packs, +Options)

Remove packs that have been repacked.

  972remove_repacked_packs(Store, Packs, Options) :-
  973    maplist(remove_pack(Store, Options), Packs).
  974
  975remove_pack(Store, _Options, Pack) :-
  976    detach_pack(Store, Pack),
  977    delete_file(Pack).

 prune_empty_directories(+Dir) is det

Prune directories that are empty below Dir. Dir itself is not removed, even if it is empty.

  984prune_empty_directories(Dir) :-
  985    prune_empty_directories(Dir, 0).
  986
  987prune_empty_directories(Dir, Level) :-
  988    directory_files(Dir, AllFiles),
  989    exclude(hidden, AllFiles, Files),
  990    (   Files == [],
  991        Level > 0
  992    ->  delete_directory_async(Dir)
  993    ;   convlist(prune_empty_directories(Dir, Level), Files, Left),
  994        (   Left == [],
  995            Level > 0
  996        ->  delete_directory_async(Dir)
  997        ;   true
  998        )
  999    ).
 1000
 1001hidden(.).
 1002hidden(..).
 1003
 1004prune_empty_directories(Parent, Level0, File, _) :-
 1005    directory_file_path(Parent, File, Path),
 1006    exists_directory(Path),
 1007    !,
 1008    Level is Level0 + 1,
 1009    prune_empty_directories(Path, Level),
 1010    fail.
 1011prune_empty_directories(_, _, File, File).
 1012
 1013delete_directory_async(Dir) :-
 1014    with_mutex(gitty_file, delete_directory_async2(Dir)).
 1015
 1016delete_directory_async2(Dir) :-
 1017    catch(delete_directory(Dir), E,
 1018          (   \+ exists_directory(Dir)
 1019          ->  true
 1020          ;   \+ empty_directory(Dir)
 1021          ->  true
 1022          ;   throw(E)
 1023          )).
 1024
 1025empty_directory(Dir) :-
 1026    directory_files(Dir, AllFiles),
 1027    exclude(hidden, AllFiles, [])