30
31:- module(cpack_repository,
32 [ cpack_add_repository/3, 33 cpack_update_package/2, 34 cpack_refresh_metadata/0,
35 cpack_refresh_metadata/1, 36 cpack_our_mirror/2, 37 cpack_clone_server/3, 38 cpack_uri/3, 39 cpack_log/3, 40 cpack_show/4, 41 commit_data/3 42 ]). 43:- use_module(library(lists)). 44:- use_module(library(record)). 45:- use_module(library(git)). 46:- use_module(library(uri)). 47:- use_module(library(settings)). 48:- use_module(library(option)). 49:- use_module(library(error)). 50:- use_module(library(semweb/rdf_db)). 51:- use_module(library(semweb/rdf_turtle)). 52:- use_module(library(semweb/rdf_label)). 53:- use_module(library(semweb/rdf_foaf)). 54:- use_module(library(filesex)). 55:- use_module(library(http/http_wrapper)). 56:- use_module(library(http/http_host)). 57:- use_module(library(http/http_path)). 58:- use_module(library(http/http_open)). 59:- use_module(library(dcg/basics)). 60:- use_module(user(user_db)). 61:- use_module(library(foaf_schema)). 62:- use_module(xref).
70:- setting(cpack:mirrors, atom, 'cpack-mirrors',
71 'Directory for mirroring external repositories'). 72:- setting(git:http_url, atom, '',
73 'Prefix for git HTPP urls').
84cpack_add_repository(User, URL, Options) :-
85 git_check_url(URL),
86 url_package(URL, Package),
87 package_graph(Package, Graph),
88 file_name_extension(Package, git, BareGit),
89 setting(cpack:mirrors, MirrorDir),
90 make_directory_path(MirrorDir),
91 directory_file_path(MirrorDir, BareGit, BareGitPath),
92 ( exists_directory(BareGitPath)
93 -> cpack_update_repository(User, URL, Options)
94 ; git([clone, '--mirror', URL, BareGitPath], []),
95 rdf_assert(User, cpack:submitted, Graph, User),
96 update_metadata(BareGitPath, Graph,
97 [user(User),cloned(URL)|Options])
98 ).
108git_check_url(URL) :-
109 uri_components(URL, Components),
110 uri_data(scheme, Components, Scheme),
111 safe_scheme(Scheme), !.
112git_check_url(URL) :-
113 permission_error(add_repository_from,
114 url,
115 URL).
116
117safe_scheme(git).
118safe_scheme(http).
119safe_scheme(https).
126cpack_update_package(User, Package) :-
127 rdf_has(Package, cpack:clonedRepository, Cloned),
128 rdf_has(Cloned, cpack:gitURL, GitURL),
129 ( rdf_has(Cloned, cpack:branch, literal(Branch))
130 -> true
131 ; Branch = master
132 ),
133 cpack_update_repository(User, GitURL,
134 [ branch(Branch),
135 allowed(true)
136 ]).
143cpack_update_repository(User, URL, Options) :-
144 option(branch(Branch), Options, master),
145 url_package(URL, PackageName),
146 package_graph(PackageName, Graph),
147 Package = Graph,
148 update_allowed(User, Package, Options),
149 file_name_extension(PackageName, git, BareGit),
150 setting(cpack:mirrors, MirrorDir),
151 directory_file_path(MirrorDir, BareGit, BareGitPath),
152 git_hash(BareGitPath, master, Hash0),
153 atomic_list_concat([Branch, master], :, BranchSpec),
154 git([fetch, URL, BranchSpec], [directory(BareGitPath)]),
155 git_hash(BareGitPath, master, Hash1),
156 print_message(informational, cpack(updated(Graph, Hash0, Hash1))),
157 ( ( Hash1 \== Hash0
158 ; option(update_metadata(always), Options, always)
159 )
160 -> update_metadata(BareGitPath, Graph,
161 [user(User),cloned(URL)|Options])
162 ; true
163 ).
164
165update_allowed(_, _, Options) :-
166 option(allowed(true), Options), !.
167update_allowed(User, Package, _) :-
168 rdf(User, cpack:submitted, Package, User), !.
169update_allowed(_, _, _) :-
170 catch(authorized(admin(cpack)), _, fail).
171update_allowed(_, Package, _) :-
172 permission_error(update, cpack, Package).
179update_metadata(BareGitPath, Graph, Options) :-
180 rdf_retractall(_,_,_,Graph),
181 add_files(BareGitPath, Graph, Options),
182 catch(load_meta_data(BareGitPath, Graph, Options), E,
183 print_message(error, E)),
184 update_decription(BareGitPath, Graph),
185 add_timestamp(Graph, Options),
186 option(branch(Branch), Options, master),
187 git_hash(BareGitPath, Branch, Hash),
188 ( option(cloned(ClonedURL), Options)
189 -> rdf_bnode(Cloned),
190 rdf_assert(Graph, cpack:clonedRepository, Cloned, Graph),
191 rdf_assert(Cloned, rdf:type, cpack:'Repository', Graph),
192 rdf_assert(Cloned, cpack:gitURL, ClonedURL, Graph),
193 rdf_assert(Cloned, cpack:branch, literal(Branch), Graph),
194 rdf_assert(Cloned, cpack:hash, literal(Hash), Graph)
195 ; true
196 ),
197 ( git_export(BareGitPath, MirroredURL)
198 -> rdf_bnode(Mirror),
199 rdf_assert(Graph, cpack:mirrorRepository, Mirror, Graph),
200 rdf_assert(Mirror, rdf:type, cpack:'Repository', Graph),
201 rdf_assert(Mirror, cpack:gitURL, MirroredURL, Graph),
202 rdf_assert(Mirror, cpack:branch, literal(Branch), Graph),
203 rdf_assert(Mirror, cpack:hash, literal(Hash), Graph)
204 ; true
205 ),
206 foaf_merge(_),
207 set_prolog_flag(message_ide, false), 208 xref_cpack(Graph).
209
210add_timestamp(Graph, Options) :-
211 option(submitted_date(DateTime), Options), !,
212 rdf_assert(Graph, cpack:submittedDate, DateTime, Graph).
213add_timestamp(Graph, _Options) :-
214 get_time(Now),
215 format_time(atom(DateTime), '%FT%T%Oz', Now),
216 rdf_assert(Graph, cpack:submittedDate,
217 literal(type(xsd:dateTime, DateTime)), Graph).
218
219update_decription(BareGitPath, Graph) :-
220 rdf_has(Graph, dcterms:title, Literal), !,
221 literal_text(Literal, Title),
222 directory_file_path(BareGitPath, description, DescFile),
223 setup_call_cleanup(open(DescFile, write, Out),
224 format(Out, '~w~n', [Title]),
225 close(Out)).
226update_decription(_, _).
235git_export(BareGitPath, MirroredURL) :-
236 ( setting(git:http_url, Prefix),
237 Prefix \== ''
238 -> true
239 ; ( setting(http:public_host, Public)
240 -> GitHost = Public
241 ; gethostname(GitHost)
242 ),
243 format(string(Prefix), 'http://~w/git/cpack-mirrors/', [GitHost])
244 ),
245 file_base_name(BareGitPath, RepoDir),
246 format(atom(MirroredURL), '~w~w', [Prefix, RepoDir]),
247 directory_file_path(BareGitPath, 'git-daemon-export-ok', ExportOK),
248 ( exists_file(ExportOK)
249 -> true
250 ; setup_call_cleanup(
251 open(ExportOK, write, Out),
252 true,
253 close(Out))
254 ).
261git_hash(BareGitPath, RevSpec, Hash) :-
262 git_process_output(['rev-parse', RevSpec],
263 read_to_atom(Hash),
264 [directory(BareGitPath)]).
265
266read_to_atom(Hash, In) :-
267 read_line_to_codes(In, Line),
268 atom_codes(Hash, Line).
274add_files(BareGitPath, Graph, Options) :-
275 option(branch(Branch), Options, master),
276 git_process_output(['ls-tree', '-lr', Branch],
277 read_files(Graph),
278 [directory(BareGitPath)]),
279 process_ignore_files(BareGitPath, Graph, Options).
280
281read_files(Graph, In) :-
282 read_line_to_codes(In, Line1),
283 read_files(Line1, Graph, In).
284
285read_files(end_of_file, _, _) :- !.
286read_files(Line, Graph, In) :-
287 ( read_file(Line, Graph)
288 -> true
289 ; gtrace,
290 read_file(Line, Graph)
291 ),
292 read_line_to_codes(In, Line2),
293 read_files(Line2, Graph, In).
294
295read_file(Line, Graph) :-
296 phrase(file_l(_Mode, _Type, _Hash, Size, FileName), Line), !,
297 atom_number(SizeAtom, Size),
298 file_base_name(FileName, BaseName),
299 file_base(FileName , BaseID),
300 file_type(BaseName, Class),
301 atomic_list_concat([Graph, /, FileName], File),
302 rdf_assert(File, cpack:path, literal(FileName), Graph),
303 rdf_assert(File, cpack:name, literal(BaseName), Graph),
304 rdf_assert(File, cpack:base, literal(BaseID), Graph),
305 rdf_assert(File, cpack:size, literal(type(xsd:integer, SizeAtom)), Graph),
306 rdf_assert(File, cpack:inPack, Graph, Graph),
307 rdf_assert(File, rdf:type, Class, Graph).
308read_file(Line, _Graph) :-
309 string_codes(String, Line),
310 print_message(warning, cpack(ignored_git_entry(String))).
311
312file_base(Path, Base) :-
313 file_base_name(Path, File),
314 file_name_extension(Base, _Ext, File).
315
316file_l(Mode, Type, Hash, Size, Name) -->
317 string_without(" ", MCodes), blanks,
318 string_without(" ", TCodes), blanks,
319 string_without(" ", HCodes), blanks,
320 integer(Size), blanks,
321 string_without(" \n", NCodes), blanks,
322 { number_codes(Mode, [0'0, 0'o|MCodes]),
323 atom_codes(Type, TCodes),
324 atom_codes(Hash, HCodes),
325 atom_codes(Name, NCodes)
326 }.
327
328
329:- rdf_meta
330 file_type(+, r). 331
332file_type(File, cpack:'PrologFile') :-
333 file_name_extension(_Base, Ext, File),
334 user:prolog_file_type(Ext, prolog), !.
335file_type(File, cpack:'IgnoreFile') :-
336 file_base_name(File, '.cpackignore'), !.
337file_type(_, cpack:'File').
345process_ignore_files(BareGitPath, Graph, Options) :-
346 forall(rdf(IgnFile, rdf:type, cpack:'IgnoreFile', Graph),
347 process_ignore_file(IgnFile, BareGitPath, Graph, Options)).
348
349process_ignore_file(IgnFile, BareGitPath, Graph, Options) :-
350 option(branch(Branch), Options, master),
351 rdf(IgnFile, cpack:path, literal(Path)),
352 file_directory_name(Path, Dir),
353 setup_call_cleanup(
354 git_open_file(BareGitPath, Path, Branch, In),
355 load_ignore_data(In, Dir, Graph),
356 close(In)).
357
358load_ignore_data(In, Dir, Graph) :-
359 read_line_to_string(In, Line),
360 load_ignore_data(Line, In, Dir, Graph).
361
362load_ignore_data(end_of_file, _, _, _) :- !.
363load_ignore_data(Line, In, Dir, Graph) :-
364 directory_file_path(Dir, Line, Pattern),
365 forall(( rdf(File, cpack:path, literal(Path), Graph),
366 wildcard_match(Pattern, Path)
367 ),
368 rdf_assert(File, cpack:ignored, literal(type(xsd:boolean, true)))),
369 read_line_to_string(In, Line2),
370 load_ignore_data(Line2, In, Dir, Graph).
378load_meta_data(BareGitPath, Graph, Options) :-
379 option(branch(Branch), Options, master),
380 url_package(BareGitPath, Package),
381 format(atom(File), '~w:rdf/cpack/~w.ttl', [Branch, Package]),
382 git_process_output([show, File],
383 rdf_load_git_stream(Graph),
384 [directory(BareGitPath)]).
385
386rdf_load_git_stream(Graph, In) :-
387 set_stream(In, file_name(Graph)),
388 atom_concat('__', Graph, BNodePrefix),
389 rdf_read_turtle(stream(In),
390 RDF,
391 [ base_uri(Graph),
392 anon_prefix(BNodePrefix)
393 ]),
394 forall(member(rdf(S,P,O), RDF),
395 rdf_assert(S,P,O,Graph)).
396
397
398
407cpack_refresh_metadata(BareGitPath) :-
408 file_base_name(BareGitPath, BareGit),
409 file_name_extension(PackageName, git, BareGit),
410 package_graph(PackageName, Graph),
411 GitOptions = [askpass(path(echo)), directory(BareGitPath)],
412 ( git_remote_url(origin, Origin, GitOptions),
413 git_default_branch(DefBranch, GitOptions)
414 -> Options = [ cloned(Origin),
415 branch(DefBranch)
416 | Extra
417 ]
418 ; Options = Extra
419 ),
420 ( rdf_has(Graph, cpack:submittedDate, Date)
421 -> Extra = [submitted_date(Date)]
422 ; Extra = []
423 ),
424 update_metadata(BareGitPath, Graph, Options).
432cpack_refresh_metadata :-
433 setting(cpack:mirrors, MirrorDir),
434 directory_file_path(MirrorDir, '*.git', Pattern),
435 expand_file_name(Pattern, BareGits),
436 clear_xref_graphs,
437 maplist(cpack_refresh_metadata, BareGits).
438
439clear_xref_graphs :-
440 clear_xref_graph(prolog),
441 clear_xref_graph(cliopatria),
442 clear_xref_graph('file-references').
443
444clear_xref_graph(Name) :-
445 cpack_uri(graph, Name, URI),
446 rdf_retractall(_,_,_,URI).
447
448
449
457cpack_clone_server(User, Server, _Options) :-
458 atom_concat(Server, '/cpack/clone_data', CloneURL),
459 http_prolog_data(CloneURL, Terms),
460 forall(member(PackInfo, Terms),
461 clone_package(User, PackInfo)).
467clone_package(User, cpack(Name, Options)) :-
468 print_message(informational, cpack(clone(Name, Options))),
469 option(pack_repository(git(GitURL, GitOptions)), Options),
470 cpack_add_repository(User, GitURL, GitOptions).
476http_prolog_data(URL, Terms) :-
477 setup_call_cleanup(http_open(URL, In, []),
478 read_stream_to_terms(In, Terms),
479 close(In)).
480
481read_stream_to_terms(In, Terms) :-
482 read_term(In, Term0, []),
483 read_stream_to_terms(Term0, In, Terms).
484
485read_stream_to_terms(end_of_file, _, []) :- !.
486read_stream_to_terms(Term, In, [Term|T]) :-
487 read_term(In, Term1, []),
488 read_stream_to_terms(Term1, In, T).
489
490
491
492
500cpack_uri(Type, Name, URI) :-
501 ( type_root(Type, RootSpec)
502 -> http_absolute_location(RootSpec, Root0, []),
503 ensure_slash(Root0, Root)
504 ; domain_error(uri_type, Type)
505 ),
506 http_current_request(Request),
507 http_current_host(Request, Host, Port,
508 [ global(true)
509 ]),
510 scheme(Scheme, DefaultPort),
511 uri_authority_data(host, AD, Host),
512 ( Port =:= DefaultPort
513 -> true
514 ; uri_authority_data(port, AD, Port)
515 ),
516 uri_authority_components(Authority, AD),
517 uri_data(scheme, Data, Scheme),
518 uri_data(authority, Data, Authority),
519 uri_data(path, Data, Root),
520 uri_components(Start, Data),
521 atom_concat(Start, Name, URI).
522
523scheme(Scheme, Port) :-
524 setting(http:public_scheme, Scheme), !,
525 scheme_default_port(Scheme, Port).
526scheme(http, 80).
527
528scheme_default_port(https, 443).
529scheme_default_port(http, 80).
530
531ensure_slash(Root0, Root) :-
532 ( sub_atom(Root0, _, _, 0, /)
533 -> Root = Root0
534 ; atom_concat(Root0, /, Root)
535 ).
536
537type_root(package, root(packs)).
538type_root(pack, root(cpack)). 539type_root(file_ref, root(file_ref)).
540type_root(graph, root(graph)).
541type_root(prolog, root(prolog)).
542type_root(cliopatria, root(cliopatria)).
543
544package_graph(Package, Graph) :-
545 cpack_uri(package, Package, Graph).
546
547url_package(URL, Package) :-
548 file_base_name(URL, Base),
549 ( atom_concat(Package0, '.git', Base)
550 -> Package = Package0
551 ; Package = Base
552 ).
553
554
562cpack_our_mirror(Pack, BareGitPath) :-
563 rdf_has(Pack, cpack:packageName, literal(PackageName)),
564 file_name_extension(PackageName, git, BareGit),
565 setting(cpack:mirrors, MirrorDir),
566 directory_file_path(MirrorDir, BareGit, BareGitPath).
567
568
569
586cpack_log(Pack, ShortLog, Options) :-
587 cpack_our_mirror(Pack, BareGitPath),
588 git_shortlog(BareGitPath, ShortLog, Options).
604:- record
605 commit(tree_hash:atom,
606 parent_hashes:list,
607 author_name:atom,
608 author_date:atom,
609 committer_name:atom,
610 committer_date:atom,
611 subject:atom). 612
613cpack_show(Pack, Hash, Commit, Options) :-
614 cpack_our_mirror(Pack, BareGitPath),
615 git_format_string(commit, Fields, Format),
616 option(diff(Diff), Options, patch),
617 diff_arg(Diff, DiffArg),
618 git_process_output([ show, DiffArg, Hash, Format ],
619 read_commit(Fields, Commit, Options),
620 [directory(BareGitPath)]).
621
622diff_arg(patch, '-p').
623diff_arg(stat, '--stat').
624
625read_commit(Fields, Data-Body, Options, In) :-
626 read_line_to_codes(In, Line1),
627 record_from_line(commit, Fields, Line1, Data),
628 read_line_to_codes(In, Line2),
629 Line2 == [],
630 option(max_lines(Max), Options, -1),
631 read_n_lines(In, Max, Body).
632
633read_n_lines(In, Max, Lines) :-
634 read_line_to_codes(In, Line1),
635 read_n_lines(Line1, Max, In, Lines).
636
637read_n_lines(end_of_file, _, _, []) :- !.
638read_n_lines(_, 0, In, []) :- !,
639 setup_call_cleanup(open_null_stream(Out),
640 copy_stream_data(In, Out),
641 close(Out)).
642read_n_lines(Line, Max0, In, [Line|More]) :-
643 read_line_to_codes(In, Line2),
644 Max is Max0-1,
645 read_n_lines(Line2, Max, In, More).
646
647
648record_from_line(RecordName, Fields, Line, Record) :-
649 phrase(fields_from_line(Fields, Values), Line),
650 Record =.. [RecordName|Values].
651
652fields_from_line([], []) --> [].
653fields_from_line([F|FT], [V|VT]) -->
654 to_nul_s(Codes),
655 { field_to_prolog(F, Codes, V) },
656 fields_from_line(FT, VT).
657
658to_nul_s([]) --> [0], !.
659to_nul_s([H|T]) --> [H], to_nul_s(T).
660
661field_to_prolog(ref_names, Line, List) :-
662 phrase(ref_names(List), Line), !.
663field_to_prolog(_, Line, Atom) :-
664 atom_codes(Atom, Line).
665
666ref_names([]) --> [].
667ref_names(List) -->
668 blanks, "(", ref_name_list(List), ")".
669
670ref_name_list([H|T]) -->
671 string_without(",)", Codes),
672 { atom_codes(H, Codes) },
673 ( ",", blanks
674 -> ref_name_list(T)
675 ; {T=[]}
676 ).
685:- meta_predicate
686 git_format_string(:, -, -). 687
688git_format_string(M:RecordName, Fields, Format) :-
689 current_record(RecordName, M:Term),
690 findall(F, record_field(Term, F), Fields),
691 maplist(git_field_format, Fields, Formats),
692 atomic_list_concat(['--format='|Formats], Format).
693
694record_field(Term, Name) :-
695 arg(_, Term, Field),
696 field_name(Field, Name).
697
698field_name(Name:_Type=_Default, Name) :- !.
699field_name(Name:_Type, Name) :- !.
700field_name(Name=_Default, Name) :- !.
701field_name(Name, Name).
702
703git_field_format(Field, Fmt) :-
704 ( git_format(NoPercent, Field)
705 -> atomic_list_concat(['%', NoPercent, '%x00'], Fmt)
706 ; existence_error(git_format, Field)
707 ).
708
709git_format('H', commit_hash).
710git_format('h', abbreviated_commit_hash).
711git_format('T', tree_hash).
712git_format('t', abbreviated_tree_hash).
713git_format('P', parent_hashes).
714git_format('p', abbreviated_parent_hashes).
715
716git_format('an', author_name).
717git_format('aN', author_name_mailcap).
718git_format('ae', author_email).
719git_format('aE', author_email_mailcap).
720git_format('ad', author_date).
721git_format('aD', author_date_rfc2822).
722git_format('ar', author_date_relative).
723git_format('at', author_date_unix).
724git_format('ai', author_date_iso8601).
725
726git_format('cn', committer_name).
727git_format('cN', committer_name_mailcap).
728git_format('ce', committer_email).
729git_format('cE', committer_email_mailcap).
730git_format('cd', committer_date).
731git_format('cD', committer_date_rfc2822).
732git_format('cr', committer_date_relative).
733git_format('ct', committer_date_unix).
734git_format('ci', committer_date_iso8601).
735
736git_format('d', ref_names). 737git_format('e', encoding). 738
739git_format('s', subject).
740git_format('f', subject_sanitized).
741git_format('b', body).
742git_format('N', notes).
743
744git_format('gD', reflog_selector).
745git_format('gd', shortened_reflog_selector).
746git_format('gs', reflog_subject).
747
748
749 752
753:- multifile prolog:message//1. 754
755prolog:message(cpack(updated(Graph, Hash0, Hash1))) -->
756 package_name(Graph),
757 ( { Hash0 == Hash1 }
758 -> [ ' no change'-[] ]
759 ; { sub_atom(Hash0, 0, 6, _, Short0),
760 sub_atom(Hash1, 0, 6, _, Short1)
761 },
762 [ ' g~w..g~w'-[Short0,Short1] ]
763 ).
764prolog:message(cpack(clone(Name, _Options))) -->
765 [ 'Cloning CPACK ~w ...'-[Name] ].
766prolog:message(cpack(ignored_git_entry(Line))) -->
767 [ 'Ignored GIT entry "~s"'-[Line] ].
768
769package_name(Graph) -->
770 { rdf_has(Graph, cpack:name, Literal),
771 literal_text(Literal, Text)
772 }, !,
773 [ '~w'-[Text] ].
774package_name(Graph) -->
775 [ '~p'-[Graph] ]
Manage CPACK repositories
*/