2 # InspIRCd -- Internet Relay Chat Daemon
4 # Copyright (C) 2016-2020 Sadie Powell <sadie@witchery.services>
6 # This file is part of InspIRCd. InspIRCd is free software: you can
7 # redistribute it and/or modify it under the terms of the GNU General Public
8 # License as published by the Free Software Foundation, version 2.
10 # This program is distributed in the hope that it will be useful, but WITHOUT
11 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 # FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
15 # You should have received a copy of the GNU General Public License
16 # along with this program. If not, see <http://www.gnu.org/licenses/>.
20 package make::directive;
24 use warnings FATAL => qw(all);
26 use File::Basename qw(dirname);
27 use File::Spec::Functions qw(catdir);
28 use Exporter qw(import);
33 use constant DIRECTIVE_ERROR_PIPE => $ENV{INSPIRCD_VERBOSE} ? '' : '2>/dev/null';
34 use constant VENDOR_DIRECTORY => catdir(dirname(dirname(__FILE__)), 'vendor');
36 our @EXPORT = qw(get_directive
39 sub get_directive($$;$)
41 my ($file, $property, $default) = @_;
42 open(my $fh, $file) or return $default;
46 if ($_ =~ /^\/\* \$(\S+): (.+) \*\/$/ || $_ =~ /^\/\/\/ \$(\S+): (.+)/) {
47 next unless $1 eq $property;
48 $value .= ' ' . execute_functions($file, $1, $2);
53 # Strip all extraneous whitespace.
54 $value =~ s/^\s+|\s+$//g;
55 return $value || $default;
58 sub execute_functions($$$) {
59 my ($file, $name, $line) = @_;
61 # NOTE: we have to use 'our' instead of 'my' here because of a Perl bug.
62 for (our @parameters = (); $line =~ /([a-z_]+)\((?:\s*"([^"]*)(?{push @parameters, $2})"\s*)*\)/; undef @parameters) {
63 my $sub = make::directive->can("__function_$1");
64 print_error "unknown $name directive '$1' in $file!" unless $sub;
66 # Call the subroutine and replace the function.
67 my $result = $sub->($file, @parameters);
68 if (defined $result) {
69 $line = $` . $result . $';
73 # If the subroutine returns undef then it is a sign that we should
74 # disregard the rest of the line and stop processing it.
82 my ($prefix, $suffix) = @_;
83 $suffix =~ s/[-.]/_/g;
84 $suffix =~ s/[^A-Za-z0-9_]//g;
85 return $prefix . uc $suffix;
89 my ($file, @message) = @_;
92 # If we have package details then suggest to the user that they check
93 # that they have the packages installed.=
94 my $dependencies = get_directive($file, 'PackageInfo');
95 if (defined $dependencies) {
96 my @packages = sort grep { /^\S+$/ } split /\s/, $dependencies;
97 push @message, 'You should make sure you have the following packages installed:';
99 push @message, " * $_";
102 push @message, 'You should make sure that you have all of the required dependencies';
103 push @message, 'for this module installed.';
107 # If we have author information then tell the user to report the bug
108 # to them. Otherwise, assume it is a bundled module and tell the user
109 # to report it to the InspIRCd issue tracker.
110 my $author = get_directive($file, 'ModAuthor');
111 if (defined $author) {
112 push @message, 'If you believe this error to be a bug then you can try to contact the';
113 push @message, 'author of this module:';
114 my $author_mail = get_directive($file, 'ModAuthorMail');
115 if (defined $author_mail) {
116 push @message, " * $author <$author_mail>";
118 push @message, " * $author";
121 push @message, 'If you believe this error to be a bug then you can file a bug report';
122 push @message, 'at https://github.com/inspircd/inspircd/issues';
124 push @message, 'You can also refer to the documentation page for this module at';
125 push @message, "https://docs.inspircd.org/3/modules/${\module_shrink $file}";
129 push @message, 'If you would like help with fixing this problem then visit our IRC';
130 push @message, 'channel at irc.inspircd.org #InspIRCd or create a support discussion';
131 push @message, 'at https://github.com/inspircd/inspircd/discussions.';
134 print_error @message;
137 sub __function_error {
138 my ($file, @messages) = @_;
139 __error $file, @messages;
142 sub __function_execute {
143 my ($file, $command, $environment, $defaults) = @_;
145 # Try to execute the command...
146 chomp(my $result = `$command ${\DIRECTIVE_ERROR_PIPE}`);
148 say console_format "Execution of `<|GREEN $command|>` succeeded: <|BOLD $result|>";
152 # If looking up with pkg-config fails then check the environment...
153 if (defined $environment && $environment ne '') {
154 $environment = __environment 'INSPIRCD_', $environment;
155 if (defined $ENV{$environment}) {
156 say console_format "Execution of `<|GREEN $command|>` failed; using the environment: <|BOLD $ENV{$environment}|>";
157 return $ENV{$environment};
161 # If all else fails then look for the defaults..
162 if (defined $defaults) {
163 say console_format "Execution of `<|GREEN $command|>` failed; using the defaults: <|BOLD $defaults|>";
167 # Executing the command failed and we don't have any defaults so give up.
168 __error $file, "`<|GREEN $command|>` exited with a non-zero exit code!";
171 sub __function_find_compiler_flags {
172 my ($file, $name, $defaults) = @_;
174 # Try to look up the compiler flags with pkg-config...
175 chomp(my $flags = `pkg-config --cflags $name ${\DIRECTIVE_ERROR_PIPE}`);
177 say console_format "Found the <|GREEN $name|> compiler flags for <|GREEN ${\module_shrink $file}|> using pkg-config: <|BOLD $flags|>";
181 # If looking up with pkg-config fails then check the environment...
182 my $key = __environment 'INSPIRCD_CXXFLAGS_', $name;
183 if (defined $ENV{$key}) {
184 say console_format "Found the <|GREEN $name|> compiler flags for <|GREEN ${\module_shrink $file}|> using the environment: <|BOLD $ENV{$key}|>";
188 # If all else fails then look for the defaults..
189 if (defined $defaults) {
190 say console_format "Using the default <|GREEN $name|> compiler flags for <|GREEN ${\module_shrink $file}|>: <|BOLD $defaults|>";
194 # We can't find it via pkg-config, via the environment, or via the defaults so give up.
195 __error $file, "unable to find the <|GREEN $name|> compiler flags for <|GREEN ${\module_shrink $file}|>!";
198 sub __function_find_linker_flags {
199 my ($file, $name, $defaults) = @_;
201 # Try to look up the linker flags with pkg-config...
202 chomp(my $flags = `pkg-config --libs $name ${\DIRECTIVE_ERROR_PIPE}`);
204 say console_format "Found the <|GREEN $name|> linker flags for <|GREEN ${\module_shrink $file}|> using pkg-config: <|BOLD $flags|>";
208 # If looking up with pkg-config fails then check the environment...
209 my $key = __environment 'INSPIRCD_CXXFLAGS_', $name;
210 if (defined $ENV{$key}) {
211 say console_format "Found the <|GREEN $name|> linker flags for <|GREEN ${\module_shrink $file}|> using the environment: <|BOLD $ENV{$key}|>";
215 # If all else fails then look for the defaults..
216 if (defined $defaults) {
217 say console_format "Using the default <|GREEN $name|> linker flags for <|GREEN ${\module_shrink $file}|>: <|BOLD $defaults|>";
221 # We can't find it via pkg-config, via the environment, or via the defaults so give up.
222 __error $file, "unable to find the <|GREEN $name|> linker flags for <|GREEN ${\module_shrink $file}|>!";
225 sub __function_require_compiler {
226 my ($file, $name, $minimum, $maximum) = @_;
228 # Look up information about the compiler.
229 return undef unless $ENV{CXX};
230 my %compiler = get_compiler_info($ENV{CXX});
232 # Check whether the current compiler is suitable.
233 return undef unless $compiler{NAME} eq $name;
234 return undef if defined $minimum && $compiler{VERSION} < $minimum;
235 return undef if defined $maximum && $compiler{VERSION} > $maximum;
237 # Requirement directives don't change anything directly.
241 sub __function_require_system {
242 my ($file, $name, $minimum, $maximum) = @_;
243 my ($system, $version);
245 # Linux is special and can be compared by distribution names.
246 if ($^O eq 'linux' && $name ne 'linux') {
247 chomp($system = lc `lsb_release --id --short 2>/dev/null`);
248 chomp($version = lc `lsb_release --release --short 2>/dev/null`);
251 # Gather information on the system if we don't have it already.
252 chomp($system ||= lc `uname -s 2>/dev/null`);
253 chomp($version ||= lc `uname -r 2>/dev/null`);
255 # We only care about the important bit of the version number so trim the rest.
256 $version =~ s/^(\d+\.\d+).+/$1/;
258 # Check whether the current system is suitable.
259 return undef if $name ne $system;
260 return undef if defined $minimum && $version < $minimum;
261 return undef if defined $maximum && $version > $maximum;
263 # Requirement directives don't change anything directly.
267 sub __function_require_version {
268 my ($file, $name, $minimum, $maximum) = @_;
270 # If pkg-config isn't installed then we can't do anything here.
271 if (system "pkg-config --exists $name ${\DIRECTIVE_ERROR_PIPE}") {
272 print_warning "unable to look up the version of <|GREEN $name|> using pkg-config!";
276 # Check with pkg-config whether we have the required version.
277 return undef if defined $minimum && system "pkg-config --atleast-version $minimum $name";
278 return undef if defined $maximum && system "pkg-config --max-version $maximum $name";
280 # Requirement directives don't change anything directly.
284 sub __function_vendor_directory {
285 my ($file, $name) = @_;
287 # Try to look the directory up in the environment...
288 my $key = __environment 'INSPIRCD_VENDOR_', $name;
289 if (defined $ENV{$key}) {
290 say console_format "Found the <|GREEN $name|> vendor directory for <|GREEN ${\module_shrink $file}|> using the environment: <|BOLD $ENV{$key}|>";
294 my $directory = catdir(VENDOR_DIRECTORY, $name);
296 say console_format "Using the default <|GREEN $name|> vendor directory for <|GREEN ${\module_shrink $file}|>: <|BOLD $directory|>";
300 # We can't find it via the environment or via the filesystem so give up.
301 __error $file, "unable to find the <|GREEN $name|> vendor directory for <|GREEN ${\module_shrink $file}|>!";
304 sub __function_warning {
305 my ($file, @messages) = @_;
306 print_warning @messages;