362 lines
12 KiB
Prolog
Executable File
362 lines
12 KiB
Prolog
Executable File
#!/usr/bin/swipl
|
|
:- use_module(library(http/thread_httpd)).
|
|
:- use_module(library(http/http_dispatch)).
|
|
:- use_module(library(http/http_parameters)).
|
|
:- use_module(library(http/http_client)).
|
|
:- use_module(library(http/http_json)).
|
|
|
|
newline_if_needed([]) --> newline, !.
|
|
newline_if_needed(_) --> [].
|
|
|
|
rules(Rules) --> rules(0, Rules).
|
|
rules(IndentLevel, [Rule|MoreRules]) -->
|
|
rule(IndentLevel, Rule),
|
|
{ Rule = [_, _, SubRules] },
|
|
newline_if_needed(SubRules),
|
|
rules(IndentLevel, MoreRules).
|
|
rules(_, []) --> [].
|
|
rule(IndentLevel, [ScriptName, Condition, SubRules]) -->
|
|
indent(IndentLevel),
|
|
script_name(ScriptName),
|
|
optional_condition(Condition),
|
|
newline,
|
|
{ NewIndentLevel is IndentLevel + 1 },
|
|
rules(NewIndentLevel, SubRules).
|
|
|
|
optional_condition(Condition) -->
|
|
space, when, space, condition(Condition, top_level).
|
|
optional_condition(true) --> [].
|
|
|
|
when --> [w, h, e, n].
|
|
space --> [' '].
|
|
newline --> ['\n'].
|
|
indent(0) --> [].
|
|
indent(N) --> ['\t'], {N > 0, N1 is N - 1}, indent(N1).
|
|
|
|
script_name(ScriptName) -->
|
|
[FirstChar],
|
|
{char_type(FirstChar, alpha); FirstChar = '_'},
|
|
script_name_chars(RemainingChars),
|
|
{atom_codes(ScriptName, [FirstChar|RemainingChars])}.
|
|
script_name_chars([Char|Chars]) -->
|
|
[Char],
|
|
{char_type(Char, alnum); Char = '_'},
|
|
script_name_chars(Chars).
|
|
script_name_chars([]) --> [].
|
|
condition(Condition, Level) -->
|
|
disjunction(Condition, Level).
|
|
disjunction(Disjunction, Level) -->
|
|
disjunction_inner(or(InnerDisjunction), Level),
|
|
{
|
|
length(InnerDisjunction, Length),
|
|
Length > 1 ->
|
|
Disjunction = or(InnerDisjunction) ;
|
|
[Disjunction] = InnerDisjunction
|
|
}.
|
|
disjunction_inner(or([Part|MoreParts]), Level) -->
|
|
conjunction(Part, Level),
|
|
disjunction_tail(MoreParts, Level).
|
|
disjunction_tail(Parts, Level) -->
|
|
space, or, space, !,
|
|
disjunction_inner(or(Parts), Level).
|
|
disjunction_tail([], _) --> [].
|
|
or --> [o, r].
|
|
conjunction(Conjunction, Level) -->
|
|
conjunction_inner(and(InnerConjunction), Level),
|
|
{
|
|
length(InnerConjunction, Length),
|
|
Length > 1 ->
|
|
Conjunction = and(InnerConjunction) ;
|
|
[Conjunction] = InnerConjunction
|
|
}.
|
|
conjunction_inner(and([Part|MoreParts]), top_level) -->
|
|
matcher(Part),
|
|
conjunction_tail(MoreParts, top_level).
|
|
conjunction_inner(and([Part|MoreParts]), in_matcher) -->
|
|
file_handle(Part), conjunction_tail(MoreParts, in_matcher).
|
|
conjunction_tail(Parts, Level) -->
|
|
space, and, space, !,
|
|
conjunction_inner(and(Parts), Level).
|
|
conjunction_tail([], _) --> [].
|
|
and --> [a, n, d].
|
|
matcher(Key:Value) -->
|
|
key(Key),
|
|
[':'],
|
|
value(Value).
|
|
key(Key) -->
|
|
[FirstChar],
|
|
{char_type(FirstChar, alpha); FirstChar = '_'},
|
|
key_chars(RemainingChars),
|
|
{atom_codes(Key, [FirstChar|RemainingChars])}.
|
|
key_chars([Char|Chars]) -->
|
|
[Char],
|
|
{char_type(Char, alnum); Char = '_'},
|
|
key_chars(Chars).
|
|
key_chars([]) --> [].
|
|
open_bracket --> ['('].
|
|
close_bracket --> [')'].
|
|
value(Value) --> open_bracket, disjunction(Value, in_matcher), close_bracket, !.
|
|
value(Value) --> file_handle(Value).
|
|
file_handle(File) -->
|
|
[Char],
|
|
{ \+member(Char, ['\n', '\t', ' ', ':', '(', ')']) },
|
|
file_handle_chars(RemainingChars),
|
|
{atom_codes(File, [Char|RemainingChars])}.
|
|
file_handle_chars([Char|Chars]) -->
|
|
[Char],
|
|
{ \+member(Char, ['\n', '\t', ' ', ':', '(', ')']) },
|
|
file_handle_chars(Chars).
|
|
file_handle_chars([]) --> [].
|
|
|
|
% Define a route for "/"
|
|
:- http_handler(root(.), hello_world, [methods([get, post])]).
|
|
|
|
git_url('git.seanhealy.ie').
|
|
|
|
start_server(Port) :-
|
|
http_server(http_dispatch, [port(Port)]).
|
|
|
|
% -----------------------
|
|
% GET + POST handler
|
|
% -----------------------
|
|
hello_world(Request) :-
|
|
( member(method(post), Request)
|
|
-> handle_post(Request)
|
|
; handle_get(Request)
|
|
).
|
|
|
|
% GET response
|
|
handle_get(_Request) :-
|
|
format('Content-type: text/plain~n~n'),
|
|
format('Hello, world! (GET)~n').
|
|
|
|
commits([], []).
|
|
commits([Commit|Rest], [CommitInfo|CommitInfos]) :-
|
|
format(user_error, 'ID: ~w~n', [Commit.id]),
|
|
format(user_error, 'Message: ~w~n', [Commit.message]),
|
|
format(user_error, 'URL: ~w~n', [Commit.url]),
|
|
format(user_error, 'Author Name: ~w~n', [Commit.author.name]),
|
|
format(user_error, 'Author Email: ~w~n', [Commit.author.email]),
|
|
format(user_error, 'Author Username: ~w~n', [Commit.author.email]),
|
|
format(user_error, 'Added Files: ~w~n', [Commit.added]),
|
|
format(user_error, 'Removed Files: ~w~n', [Commit.removed]),
|
|
format(user_error, 'Modified Files: ~w~n', [Commit.modified]),
|
|
format(user_error, 'Timestamp: ~w~n', [Commit.timestamp]),
|
|
CommitInfo = [
|
|
id(Commit.id),
|
|
message(Commit.message),
|
|
url(Commit.url),
|
|
author_name(Commit.author.name),
|
|
author_email(Commit.author.email),
|
|
author_username(Commit.author.email),
|
|
added(Commit.added),
|
|
removed(Commit.removed),
|
|
modified(Commit.modified),
|
|
timestamp(Commit.timestamp)
|
|
],
|
|
commits(Rest, CommitInfos).
|
|
|
|
list_set(ListOfList, Functor, Result) :-
|
|
setof(
|
|
Item,
|
|
(
|
|
member(L, ListOfList),
|
|
Pred =.. [Functor, Item],
|
|
member(Pred, L)
|
|
),
|
|
Result
|
|
).
|
|
filetype_suffix(File, SuffixLower) :-
|
|
split_string(File, ".", "", Parts),
|
|
length(Parts, Length),
|
|
Length > 1,
|
|
last(Parts, Suffix),
|
|
string_lower(Suffix, SuffixLower).
|
|
files_to_filetypes(Files, FileTypes) :-
|
|
setof(
|
|
Suffix,
|
|
(
|
|
member(File, Files),
|
|
format(user_error, 'Processing file for type: ~w~n', [File]),
|
|
filetype_suffix(File, SuffixWithoutDot),
|
|
format(user_error, 'Extracted suffix: ~w~n', [SuffixWithoutDot]),
|
|
format(atom(Suffix), '.~w', [SuffixWithoutDot]),
|
|
format(user_error, 'Formatted suffix with dot: ~w~n', [Suffix])
|
|
),
|
|
FileTypes
|
|
), !.
|
|
files_to_filetypes(_Files, []). % If no file types could be extracted, return an empty list
|
|
file_to_basename(File, BaseName) :-
|
|
split_string(File, "/", "", Parts),
|
|
last(Parts, BaseName).
|
|
files_to_basenames(Files, BaseNames) :-
|
|
setof(
|
|
BaseName,
|
|
(
|
|
member(File, Files),
|
|
file_to_basename(File, BaseName)
|
|
),
|
|
BaseNames
|
|
), !.
|
|
files_to_basenames(_Files, []). % If no basenames could be extracted, return an empty list
|
|
files_with_prefix_slash(Files, PrefixedFiles) :-
|
|
setof(
|
|
PrefixedFile,
|
|
(
|
|
member(File, Files),
|
|
format(atom(PrefixedFile), '/~w', [File])
|
|
),
|
|
PrefixedFiles
|
|
), !.
|
|
files_with_prefix_slash(_Files, []). % If no files could be prefixed, return an empty list
|
|
git_ssh_url(Name, URL) :-
|
|
git_url(BaseURL),
|
|
format(atom(URL), 'git@~w:~w.git', [BaseURL, Name]).
|
|
git_clone_command(
|
|
FullName,
|
|
ShortName,
|
|
DefaultBranch,
|
|
Directory,
|
|
Commit,
|
|
Command,
|
|
Destination
|
|
) :-
|
|
git_ssh_url(FullName, URL),
|
|
format(atom(Destination), '~w/~w-~w', [Directory, ShortName, Commit]),
|
|
format(
|
|
atom(Command),
|
|
'yes | git clone --depth 1 -b ~w --single-branch ~w ~w',
|
|
[DefaultBranch, URL, Destination]
|
|
).
|
|
git_fetch_commit_command(Destination, Commit, Command) :-
|
|
format(
|
|
atom(Command),
|
|
'(cd ~w && git fetch --depth 1 origin ~w && git checkout FETCH_HEAD)',
|
|
[Destination, Commit]
|
|
).
|
|
codes_to_chars([], []).
|
|
codes_to_chars([C|Cs], [A|As]) :- atom_codes(A, [C]), codes_to_chars(Cs, As).
|
|
union_all([], []).
|
|
union_all([X], X).
|
|
union_all([A, B | TheRest], Union) :-
|
|
union(A, B, ABUnion),
|
|
union_all([ABUnion | TheRest], Union).
|
|
matching_condition(true, _) :- !.
|
|
matching_condition(X, List) :- member(X, List).
|
|
matching_condition(or(Disjunction), Commit) :-
|
|
member(Part, Disjunction),
|
|
matching_condition(Part, Commit), !.
|
|
matching_condition(and(Conjunction), Commit) :-
|
|
forall(member(Part, Conjunction), matching_condition(Part, Commit)).
|
|
matching_condition(Key:Condition, Commit) :-
|
|
member(Key:Values, Commit),
|
|
matching_condition(Condition, Values).
|
|
matching_rules([], _Commit, []).
|
|
matching_rules([Rule|Rules], Commit, Matches) :-
|
|
Rule = [ScriptName, Condition, SubRules],
|
|
(
|
|
matching_condition(Condition, Commit) ->
|
|
matching_rules(SubRules, Commit, SubMatches),
|
|
matching_rules(Rules, Commit, NextMatches),
|
|
append([ScriptName], SubMatches, ThisMatches),
|
|
append(ThisMatches, NextMatches, Matches) ;
|
|
matching_rules(Rules, Commit, Matches)
|
|
).
|
|
% POST response
|
|
handle_post(Request) :-
|
|
catch(
|
|
http_read_json_dict(Request, JSON),
|
|
_Error,
|
|
JSON = _{error: "invalid_json"}
|
|
),
|
|
format('Content-type: application/json~n~n'),
|
|
CommitBefore = JSON.before,
|
|
CommitAfter = JSON.after,
|
|
Repository = JSON.repository.full_name,
|
|
ShortName = JSON.repository.name,
|
|
Ref = JSON.ref,
|
|
DefaultBranch = JSON.repository.default_branch,
|
|
% Write the above to a /tmp/log.txt file
|
|
format(user_error, 'Received POST request with data:~n', []),
|
|
format(user_error, 'Commit Before: ~w~n', [CommitBefore]),
|
|
format(user_error, 'Commit After: ~w~n', [CommitAfter]),
|
|
format(user_error, 'Repository: ~w~n', [Repository]),
|
|
format(user_error, 'Ref: ~w~n', [Ref]),
|
|
commits(JSON.commits, CommitList),
|
|
list_set(CommitList, modified, ModifiedFileLists),
|
|
union_all(ModifiedFileLists, ModifiedFiles),
|
|
list_set(CommitList, message, MessageLists),
|
|
union_all(MessageLists, Messages),
|
|
list_set(CommitList, added, AddedFileLists),
|
|
union_all(AddedFileLists, AddedFiles),
|
|
list_set(CommitList, removed, RemovedFileLists),
|
|
union_all(RemovedFileLists, RemovedFiles),
|
|
files_to_filetypes(ModifiedFiles, ModifiedFileTypes),
|
|
files_to_filetypes(AddedFiles, AddedFileTypes),
|
|
files_to_filetypes(RemovedFiles, RemovedFileTypes),
|
|
files_to_basenames(ModifiedFiles, ModifiedBaseNames),
|
|
files_to_basenames(AddedFiles, AddedBaseNames),
|
|
files_to_basenames(RemovedFiles, RemovedBaseNames),
|
|
files_with_prefix_slash(ModifiedFiles, ModifiedFullPaths),
|
|
files_with_prefix_slash(AddedFiles, AddedFullPaths),
|
|
files_with_prefix_slash(RemovedFiles, RemovedFullPaths),
|
|
% Union the file types, basenames, and full paths to form Modified, Added, and Removed sets
|
|
union_all([ModifiedFileTypes, ModifiedBaseNames, ModifiedFullPaths], Modified),
|
|
union_all([AddedFileTypes, AddedBaseNames, AddedFullPaths], Added),
|
|
union_all([RemovedFileTypes, RemovedBaseNames, RemovedFullPaths], Removed),
|
|
union_all([Modified, Added, Removed], Affected),
|
|
union(Modified, Added, Touched),
|
|
list_set(CommitList, author_email, Authors),
|
|
git_clone_command(Repository, ShortName, DefaultBranch, '/tmp', CommitAfter, CloneCommand, Destination),
|
|
shell(CloneCommand),
|
|
git_fetch_commit_command(Destination, CommitAfter, FetchCommand),
|
|
shell(FetchCommand),
|
|
format(atom(RulesFile), '~w/automation/rules', [Destination]),
|
|
read_file_to_codes(RulesFile, ASCIICodes, []),
|
|
codes_to_chars(ASCIICodes, Chars),
|
|
Commit = [
|
|
added:Added,
|
|
removed:Removed,
|
|
modified:Modified,
|
|
affected:Affected,
|
|
touched:Touched,
|
|
authors:Authors,
|
|
messages:Messages
|
|
],
|
|
phrase(rules(Rules), Chars, []),
|
|
format(user_error, 'Parsed rules: ~w~n', [Rules]),
|
|
matching_rules(Rules, Commit, Matches),
|
|
format(user_error, 'Matching scripts: ~w~n', [Matches]),
|
|
findall(
|
|
ScriptPath,
|
|
(
|
|
member(Script, Matches),
|
|
format(atom(ScriptPath), '~w/automation/~w.sh', [Destination, Script])
|
|
),
|
|
Scripts
|
|
),
|
|
forall(
|
|
member(ToRun, Scripts),
|
|
(
|
|
format(user_error, 'Running script: ~w~n', [ToRun]),
|
|
shell(ToRun)
|
|
)
|
|
),
|
|
run_automation_scripts(Matches, Repository, Ref, CommitAfter),
|
|
reply_json_dict(_{
|
|
status: ok,
|
|
received: [
|
|
before(CommitBefore),
|
|
after(CommitAfter),
|
|
repository(Repository),
|
|
ref(Ref),
|
|
default_branch(DefaultBranch)
|
|
]
|
|
}).
|
|
|
|
main :-
|
|
Port = 1111,
|
|
start_server(Port),
|
|
format('Server running on port ~w...~n', [Port]),
|
|
thread_get_message(_).
|