From 43eff3d52217b3a1043b2d9d5d481ccf346da833 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Se=C3=A1n=20Healy?= Date: Mon, 20 Apr 2026 14:50:51 +0100 Subject: [PATCH] Add the central server file. --- server.pl | 363 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 363 insertions(+) create mode 100755 server.pl diff --git a/server.pl b/server.pl new file mode 100755 index 0000000..6e0f689 --- /dev/null +++ b/server.pl @@ -0,0 +1,363 @@ +#!/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'), + format(user_error, 'Received POST request with JSON data: ~w~n', [JSON]), + 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]), + format(user_error, 'Default Branch: ~w~n', [DefaultBranch]), + 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(_).