File Coverage

File:lib/Geo/Coder/Free/Display.pm
Coverage:63.7%

linestmtbrancondsubpodtimecode
1package Geo::Coder::Free::Display;
2
3# Display a page. Certain variables are available to all templates, such as
4# the stuff in the configuration file
5
6 - 10
=head1 VERSION

Version 0.01

=cut
11
12our $VERSION = '0.01';
13
14
1
1
1
312637
1
use v5.20;
15
1
1
1
1
1
0
7
use strict;
16
1
1
1
1
2
1
23
use warnings;
17
1
1
1
1
2
1
54
use feature qw(signatures);
18
1
1
1
1
1
0
12
no warnings qw(experimental::signatures);
19
20
1
1
1
1
1
1
11
use Config::Abstraction;
21
1
1
1
1
193
24185
32
use CGI::Info;
22
1
1
1
1
5
0
24
use Data::Dumper;
23
1
1
1
1
1
1
12
use Digest::MD5 qw(md5_hex);
24
1
1
1
1
150
909
36
use Digest::SHA qw(sha256_hex);
25
1
1
1
1
2
1
7
use File::Spec;
26
1
1
1
1
1
1
7
use Object::Configure;
27
1
1
1
1
3
1
10
use Params::Get;
28
1
1
1
1
151
1708
14
use Template::Filters;
29
1
1
1
1
126
172
10
use Template::Plugin::EnvHash;
30
1
1
1
1
102
5080
16
use Template::Plugin::Math;
31
1
1
1
1
2
1
10
use Template::Plugin::JSON;
32
1
1
1
1
2
0
13
use HTML::SocialMedia;
33
1
1
1
1
138
3
33
use Geo::Coder::Free::Utils qw(create_memory_cache);
34
1
1
1
1
2
1
2
use Error;
35
1
1
1
1
232
4423
2
use Fatal qw(:void open);
36
1
1
1
1
471
175
17
use File::pfopen;
37
1
1
1
1
1
1
10
use Params::Get;
38
1
1
1
1
1
1
2180
use Scalar::Util;
39
40# TODO: read this from the config file
41my %blacklist = (
42        'MD' => 1,
43        'RU' => 1,
44        'CN' => 1,
45        'BR' => 1,
46        'UY' => 1,
47        'TR' => 1,
48        'MA' => 1,
49        'VE' => 1,
50        'SA' => 1,
51        'CY' => 1,
52        'CO' => 1,
53        'MX' => 1,
54        'IN' => 1,
55        'RS' => 1,
56        'PK' => 1,
57);
58
59our $sm;
60
61# Main display handler for generating web pages using Template Toolkit
62# Handles security, throttling, localization, and template selection
63sub new
64{
65
1
1
0
184732
        my $class = shift;
66
67        # Handle hash or hashref arguments
68
1
4
        my $params = Params::Get::get_params(undef, @_);
69
70
1
50
50
19
        if(!defined($class)) {
71                # Using Geo::Coder::Free::Display->new(), not Geo::Coder::Free::Display::new()
72                # carp(__PACKAGE__, ' use ->new() not ::new() to instantiate');
73                # return;
74
75                # FIXME: this only works when no arguments are given
76
0
0
                $class = __PACKAGE__;
77        } elsif(Scalar::Util::blessed($class)) {
78                # If $class is an object, clone it with new arguments
79
0
0
0
0
0
0
                return bless { %{$class}, %{$params} }, ref($class);
80        }
81
82
1
50
2
        if(defined($ENV{'HTTP_REFERER'})) {
83                # Protect against Shellshocker
84
1
50
6
                unless(Data::Validate::URI->can('new')) {
85
0
0
                        require Data::Validate::URI;
86
0
0
                        Data::Validate::URI->import();
87                }
88
89
1
50
56
                unless(Data::Validate::URI->new()->is_uri($ENV{'HTTP_REFERER'})) {
90
0
0
                        return; # Block invalid referrers
91                }
92        }
93
94
1
505
        $params = Object::Configure::configure($class, $params);
95
96
1
33
5918
        my $info = $params->{info} || CGI::Info->new();
97
98        # Configuration loading
99
1
2895
        my $config_dir = _find_config_dir($params, $info);
100
1
50
2
        if($params->{'logger'}) {
101
1
3
                $params->{'logger'}->debug(__PACKAGE__, ' (', __LINE__, "): path = $config_dir");
102        }
103
1
10
        my $config;
104
1
1
        eval {
105                # Try default first, then domain-specific config first
106
1
50
4
                if($config = Config::Abstraction->new(config_dirs => [$config_dir], config_files => ['default', $info->domain_name()], logger => $params->{'logger'})) {
107
1
844
                        $config = $config->all();
108                }
109        };
110
1
50
33
12
        if($@ || !defined($config)) {
111
0
0
                die "Configuration error: $@: $config_dir/", $info->domain_name();
112        }
113
114        # The values in config are defaults which can be overridden by
115        # the values in params->{config}
116
1
50
2
        if(defined($params->{'config'})) {
117
1
1
1
1
1
3
                $config = { %{$config}, %{$params->{'config'}} };
118        }
119
120
1
50
33
3
        unless($info->is_search_engine() || !defined($ENV{'REMOTE_ADDR'})) {
121
1
50
11
                if(my $params = $info->params()) {
122                        # Intrusion Detection System integration
123
1
3974
                        require CGI::IDS;
124
1
12682
                        CGI::IDS->import();
125
126
1
2
                        my $ids = CGI::IDS->new();
127
1
30924
                        $ids->set_scan_keys(scan_keys => 1);
128
129
1
6
                        my $impact = $ids->detect_attacks(request => $params);
130
1
50
192
                        my $threshold = $config->{security}->{ids_threshold} // 50;
131
1
50
87
                        if($impact > $threshold) {
132
0
0
                                die $ENV{'REMOTE_ADDR'}, ": IDS impact is $impact";   # Block detected attacks
133                        }
134                }
135
136
1
50
4
                if($ENV{'REMOTE_ADDR'}) {
137                        # Connection throttling system
138
1
275
                        require Data::Throttler;
139
140
1
33
2563
                        my $db_file = $config->{'throttle'}->{'file'} // File::Spec->catdir($info->tmpdir(), 'throttle');
141
1
50
                        eval {  # Handle YAML Errors
142                                my %options = (
143                                        max_items => $config->{'throttle'}->{'max_items'} // 30,       # Allow 30 requests
144
1
50
50
8
                                        interval => $config->{'throttle'}->{'interval'} // 90, # Per 90 second window
145                                        backend => 'YAML',
146                                        backend_options => {
147                                                db_file => $db_file
148                                        }
149                                );
150
151
1
50
5
                                if(my $throttler = Data::Throttler->new(%options)) {
152                                        # Block if over the limit
153
1
0
22112
                                        if(!$throttler->try_push(key => $ENV{'REMOTE_ADDR'})) {
154
0
0
                                                $info->status(429);  # Too many requests
155
0
0
                                                sleep(1);       # Slow down attackers
156
0
0
0
                                                if($params->{'logger'}) {
157
0
0
                                                        $params->{'logger'}->info("$ENV{REMOTE_ADDR} connexion throttled");
158                                                }
159
0
0
                                                return;
160                                        }
161                                }
162                        };
163
1
50
16329
                        if($@) {
164
1
50
2
                                if($params->{'logger'}) {
165
1
4
                                        $params->{'logger'}->notice("Removing unparsable YAML file $db_file: $@");
166                                }
167
1
68
                                unlink($db_file);
168                        }
169
170                        # Country based blocking
171
1
50
3
                        if(my $lingua = $params->{lingua}) {
172
0
0
0
                                if($blacklist{uc($lingua->country())}) {
173
0
0
0
                                        if($params->{'logger'}) {
174
0
0
                                                $params->{'logger'}->warn("$ENV{REMOTE_ADDR} is from a blacklisted country " . $lingua->country());
175                                        }
176
0
0
                                        die "$ENV{REMOTE_ADDR} is from a blacklisted country ", $lingua->country();
177                                }
178                        }
179                }
180        }
181
182        # Initialise the template system
183
1
6
        Template::Filters->use_html_entities();
184
185        # _ names included for legacy reasons, they will go away
186        my $self = {
187                _cachedir => $params->{cachedir},
188                config => $config,
189                _config => $config,
190                info => $info,
191                _info => $info,
192                _logger => $params->{logger},
193
1
1
5
9
                %{$params},
194        };
195
196
1
50
2
        if(my $lingua = $params->{'lingua'}) {
197
0
0
                $self->{'lingua'} = $lingua;
198
0
0
                $self->{'_lingua'} = $lingua;
199        }
200
1
50
4
        if(my $key = $info->param('key')) {
201
0
0
                $self->{'key'} = $key;
202
0
0
                $self->{'_key'} = $key;
203        }
204
1
50
111
        if(my $page = $info->param('page')) {
205
0
0
                $self->{'page'} = $page;
206
0
0
                $self->{'_page'} = $page;
207        }
208
209        # Social media integration
210
1
50
50
61
        if(my $twitter = $config->{'twitter'}) {
211
0
0
                my $smcache = create_memory_cache(config => $config, logger => $params->{'logger'}, namespace => 'HTML::SocialMedia');
212
0
0
0
                $sm ||= HTML::SocialMedia->new({ twitter => $twitter, cache => $smcache, lingua => $params->{lingua}, logger => $params->{logger} });
213
0
0
                $self->{'_social_media'}->{'twitter_tweet_button'} = $sm->as_string(twitter_tweet_button => 1);
214        } elsif(!defined($sm)) {
215
1
4
                my $smcache = create_memory_cache(config => $config, logger => $params->{'logger'}, namespace => 'HTML::SocialMedia');
216
1
45163
                $sm = HTML::SocialMedia->new({ cache => $smcache, lingua => $params->{lingua}, logger => $params->{logger} });
217        }
218
1
6399
        $self->{'_social_media'}->{'facebook_share_button'} = $sm->as_string(facebook_share_button => 1);
219        # $self->{'_social_media'}->{'google_plusone'} = $sm->as_string(google_plusone => 1);
220
221        # Return the blessed object
222
1
370246
        return bless $self, $class;
223}
224
225# Internal method to determine the configuration directory
226sub _find_config_dir
227{
228
1
1
1
        my($args, $info) = @_;
229
230
1
50
2
        if($ENV{'CONFIG_DIR'}) {
231
0
0
                return $ENV{'CONFIG_DIR'};
232        }
233
234        # Look first in $root_dir/conf
235
236
1
1
        my $config_dir = $ENV{'root_dir'};
237
1
50
33
3
        if(defined($config_dir) && (-d $config_dir)) {
238
0
0
                $config_dir = File::Spec->catdir($config_dir, 'conf');
239
240
0
0
0
                if(-d $config_dir) {
241
0
0
                        return $config_dir;
242                }
243        }
244
245
1
3
        $config_dir = File::Spec->catdir(
246                        $info->script_dir(),
247                        File::Spec->updir(),
248                        File::Spec->updir(),
249                        'conf'
250                );
251
252
1
50
148
        if(!-d $config_dir) {
253
1
1
                $config_dir = File::Spec->catdir(
254                                $info->script_dir(),
255                                File::Spec->updir(),
256                                'conf'
257                        );
258        }
259
260
1
50
9
        if(!-d $config_dir) {
261
0
0
0
                if($ENV{'DOCUMENT_ROOT'}) {
262
0
0
                        $config_dir = File::Spec->catdir(
263                                # $ENV{'DOCUMENT_ROOT'},
264                                $info->rootdir(),
265                                File::Spec->updir(),
266                                'lib',
267                                'conf'
268                        );
269                } else {
270                        $config_dir = File::Spec->catdir(
271
0
0
                                $ENV{'HOME'},
272                                'lib',
273                                'conf'
274                        );
275                }
276        }
277
278
1
50
2
        if(!-d $config_dir) {
279
0
0
0
                if($args->{config_directory}) {
280
0
0
                        return $args->{config_directory};
281                }
282
0
0
0
                if($args->{logger}) {
283
0
0
                        while(my ($k, $v) = each %ENV) {
284
0
0
                                $args->{logger}->debug("$k=$v");
285                        }
286                }
287        }
288
289
1
9
        return $config_dir;
290}
291
292# Call this to display the page
293# It calls http() to create the HTTP headers, then html() to create the body
294sub as_string {
295
2
2
0
3
        my ($self, $args) = @_;
296
297        # TODO: Get all cookies and send them to the template.
298        # 'cart' is an example
299
2
50
67
5
        unless($args && $args->{cart}) {
300
2
50
8
                if(my $purchases = $self->{_info}->get_cookie(cookie_name => 'cart')) {
301
0
0
                        my %cart = split(/:/, $purchases);
302
0
0
                        $args->{cart} = \%cart;
303                }
304        }
305
306        # Calculate items in cart if not already present in $args
307
2
50
67
213
        unless($args && $args->{itemsincart}) {
308
2
50
3
                if($args->{cart}) {
309
0
0
                        my $itemsincart;
310
0
0
0
0
                        foreach my $key(keys %{$args->{cart}}) {
311
0
0
0
0
                                if(defined($args->{cart}{$key}) && ($args->{cart}{$key} ne '')) {
312
0
0
                                        $itemsincart += $args->{cart}{$key};
313                                } else {
314
0
0
                                        delete $args->{cart}{$key};
315                                }
316                        }
317
0
0
                        $args->{itemsincart} = $itemsincart;
318                }
319        }
320
321
2
2
        my($cache, $key);
322
323
2
50
2
        if(!$args->{itemsincart}) {
324
2
8
                $cache = create_memory_cache(config => $self->{config}, logger => $self->{'logger'}, namespace => ref($self));
325
2
946
                $key = cache_key_from_hashref($args);
326
2
50
4
                if(my $rc = $cache->get($key)) {
327
0
0
                        return $rc;
328                }
329        }
330
331        # my $html = $self->html($args);
332        # unless($html) {
333                # return;
334        # }
335        # return $self->http() . $html;
336
337        # Build the HTTP response
338
2
90
        my $rc = $self->http($args);
339
2
50
5
        if($rc =~ /^Location:\s/ms) {
340
0
0
                return $rc;
341        }
342
2
3
        $rc .= $self->html($args);
343
2
50
5
        if($cache) {
344
2
100
4
                $self->{cache_duration} ||= '5 minutes';
345
2
5
                $cache->set($key, $rc, $self->{cache_duration});
346        }
347
2
262
        return $rc;
348}
349
350# Determine the path to the correct template file based on various criteria such as language settings, browser type, and module path
351sub get_template_path
352{
353
6
6
0
359
        my $self = shift;
354
6
1
100
11
2
        my %args = (ref($_[0]) eq 'HASH') ? %{$_[0]} : @_;
355
356
6
50
10
        if($self->{_logger}) {
357
6
10
                $self->{_logger}->trace('Entering get_template_path');
358        }
359
360
6
100
61
        if($self->{_filename}) {
361
5
50
5
                if($self->{_logger}) {
362
5
10
                        $self->{_logger}->trace({ message => 'returning ' . $self->{_filename} });
363                }
364
5
40
                return $self->{_filename};
365        }
366
367
1
33
5
        my $dir = $ENV{'root_dir'} || $self->{_config}->{root_dir} || $self->{_info}->root_dir();
368
1
50
7
        if($self->{_logger}) {
369
1
2
                $self->{_logger}->debug(__PACKAGE__, ': ', __LINE__, ": root_dir $dir");
370
1
14
                $self->{_logger}->debug(Data::Dumper->new([$self->{_config}])->Dump());
371        }
372
1
78
        $dir .= '/templates';
373
374
1
1
        my $prefix;
375
376        # Look in .../robot or .../mobile first, if appropriate
377        # Look in .../en/gb/web, then .../en/web then /web
378
1
2
        foreach my $browser_type($self->_types()) {
379
1
50
1
                if(my $lingua = $self->{_lingua}) {
380
0
0
                        $self->_debug({ message => 'Requested language: ' . $lingua->requested_language() });
381                        # FIXME: look for lower priority languages if the highest isn't found
382
0
0
0
                        if(my $language = $lingua->language_code_alpha2()) {
383
0
0
0
                                if(my $dialect = $lingua->sublanguage_code_alpha2()) {
384
0
0
                                        $prefix .= "$dir/$browser_type/$language/$dialect:";
385
0
0
                                        $prefix .= "$dir/$browser_type/$language/default:";
386                                }
387
0
0
0
                                $prefix .= "$dir/$language/$browser_type:" if(-d "$dir/$language/$browser_type");
388
0
0
0
                                $prefix .= "$dir/$browser_type/$language:" if(-d "$dir/$browser_type/$language");
389                        }
390                }
391
1
50
7
                $prefix .= "$dir/$browser_type/default:" if(-d "$dir/$browser_type/default");
392
1
50
4
                $prefix .= "$dir/default/$browser_type/:" if(-d "$dir/default/$browser_type");
393
1
50
2
                $prefix .= "$dir/$browser_type:" if(-d "$dir/$browser_type");
394        }
395
396        # Fall back to .../web, or if that fails, assume no web, robot or
397        # mobile variant
398
1
3
        $prefix .= "$dir/web:$dir/default/web:$dir/default:$dir";
399
400
1
3
        $self->_debug({ message => "prefix: $prefix" });
401
402
1
33
2
        my $modulepath = $args{'modulepath'} || ref($self);
403
1
1
        $modulepath =~ s/::/\//g;
404
405
1
50
2
        if($prefix =~ /\.\.\//) {
406
0
0
                throw Error::Simple("Prefix must not contain ../ ($prefix)");
407        }
408
409        # Untaint the prefix value which may have been read in from a configuration file
410
1
4
        ($prefix) = ($prefix =~ m/^([A-Z0-9_\.\-\/:]+)$/ig);
411
412
1
3
        my ($fh, $filename) = File::pfopen::pfopen($prefix, $modulepath, 'tmpl:tt:html:htm:txt');
413
1
50
33
47
        if((!defined($filename)) || (!defined($fh))) {
414
0
0
0
0
                throw Error::Simple("Can't find suitable $modulepath html or tmpl/tt file in $prefix in $dir or a subdir (check " . join(':', @{$self->{'config'}->{'config_path'}}) . ')');
415        }
416
1
3
        close($fh);
417
1
3
        $self->_debug({ message => "Using $filename" });
418
1
1
        $self->{_filename} = $filename;
419
420        # Remember the template filename
421
1
50
1
        if($self->{'log'}) {
422
0
0
                $self->{'log'}->template($filename);
423        }
424
425
1
6
        return $filename;
426}
427
428 - 436
=head2 set_cookie

Safely set cookie values with validation.

Takes either a hash reference or a list of key-value pairs as input.
Iterates over the parameters and stores them in the object's _cookies hash.
Returns the object itself, allowing for method chaining.

=cut
437
438sub set_cookie
439{
440
1
1
1
1
        my $self = shift;
441
1
1
50
3
1
        my %params = (ref($_[0]) eq 'HASH') ? %{$_[0]} : @_;
442
443        # Validate cookie parameters
444
1
1
        for my $key (keys %params) {
445                # Sanitize cookie names and values
446
1
50
3
                next unless $key =~ /^[a-zA-Z0-9_-]+$/;
447
448
1
1
                my $value = $params{$key};
449
1
50
1
                next unless defined $value;
450
451                # Basic value sanitization
452
1
2
                $value =~ s/[;\r\n]//g;
453
1
1
                $self->{_cookies}->{$key} = $value;
454        }
455
456
1
1
        return $self;
457}
458
459 - 463
=head2 http

Returns the HTTP header section, terminated by an empty line

=cut
464
465sub http
466{
467
3
3
1
3
        my $self = shift;
468
3
6
        my $params = Params::Get::get_params(undef, @_);
469
470        # Handle session cookies
471        # TODO: Only session cookies as the moment
472
3
50
30
        if(my $cookies = $self->{_cookies}) {
473
3
3
2
5
                foreach my $cookie (keys(%{$cookies})) {
474
3
50
4
                        my $value = exists $cookies->{$cookie} ? $cookies->{$cookie} : '0:0';
475
476                        # Secure cookie settings
477
3
50
8
                        my $secure = ($self->{'info'}->protocol() eq 'https') ? '; Secure' : '';
478
3
41
                        print "Set-Cookie: $cookie=$value; path=/; HttpOnly; SameSite=Strict$secure\n";
479                }
480        }
481
482        # Generate CSRF token for forms
483
3
50
50
11
        if($self->{config}->{security}->{csrf}->{enable} // 1) {
484
3
6
                my $csrf_token = $self->_generate_csrf_token();
485
3
5
                print "Set-Cookie: csrf_token=$csrf_token; path=/; HttpOnly; SameSite=Strict\n";
486        }
487
488        # Determine language, defaulting to English
489        # TODO: Change the headers, e.g. character set, based on the language
490        # my $language = $self->{_lingua} ? $self->{_lingua}->language() : 'English';
491
492
3
2
        my $rc;
493
3
50
4
        if($params->{'Content-Type'}) {
494                # Allow the content type to be forceably set
495
0
0
                $rc = $params->{'Content-Type'} . "\n";
496        } else {
497                # Determine content type
498
3
5
                my $filename = $self->get_template_path();
499
3
50
5
                if ($filename =~ /\.txt$/) {
500
0
0
                        $rc = "Content-Type: text/plain\n";
501                } else {
502
3
6
                        binmode(STDOUT, ':utf8');
503
3
3
                        $rc = "Content-Type: text/html; charset=UTF-8\n";
504                }
505        }
506
507
3
50
3
        if($params->{'Retry-After'}) {
508
0
0
                $rc = $params->{'Retry-After'} . "\n";
509        }
510
511        # Security headers
512        # - Clickjacking protection
513        # - MIME type enforcement
514        # - Referrer policy
515        # https://www.owasp.org/index.php/Clickjacking_Defense_Cheat_Sheet
516        # https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/X-Content-Type-Options
517
518        # Enhanced security headers
519
3
10
        return $rc .
520                "X-Frame-Options: SAMEORIGIN\n" .
521                "X-Content-Type-Options: nosniff\n" .
522                "X-XSS-Protection: 1; mode=block\n" .
523                "Referrer-Policy: strict-origin-when-cross-origin\n" .
524                "Content-Security-Policy: default-src 'self'; script-src 'self' 'unsafe-inline'; style-src 'self' 'unsafe-inline'\n" .
525                "Strict-Transport-Security: max-age=31536000; includeSubDomains\n\n";
526}
527
528# Run the given data through the template to create HTML
529
530# Override this routine in a subclass if you wish to create special arguments to
531# send to the template
532sub html {
533
2
2
2
        my $self = shift;
534
2
1
100
3
1
        my %params = (ref($_[0]) eq 'HASH') ? %{$_[0]} : @_;
535
536
2
2
        my $filename = $self->get_template_path();
537
2
2
        my $rc;
538
539        # Handle template files (.tmpl or .tt)
540
2
50
0
5
        if($filename =~ /.+\.t(mpl|t)$/) {
541
2
209
                require Template;
542
2
5224
                Template->import();
543
544
2
21
                my $info = $self->{_info};
545
546                # The values in config are defaults which can be overridden by
547                # the values in info, then the values in params
548
2
1
                my $vals;
549
2
50
0
3
                if(defined($self->{_config})) {
550
2
50
4
                        if($info->params()) {
551
2
2
2
27
5
2
                                $vals = { %{$self->{_config}}, %{$info->params()} };
552                        } else {
553
0
0
                                $vals = $self->{_config};
554                        }
555
2
50
26
                        if(scalar(keys %params)) {
556
0
0
0
0
                                $vals = { %{$vals}, %params };
557                        }
558                } elsif(scalar(keys %params)) {
559
0
0
0
0
                        $vals = { %{$info->params()}, %params };
560                } else {
561
0
0
                        $vals = $info->params();
562                }
563
2
5
                $vals->{script_name} = $info->script_name();
564
565
2
10
                $vals->{cart} = $info->get_cookie(cookie_name => 'cart');
566
2
211
                $vals->{lingua} = $self->{_lingua};
567
2
2
                $vals->{social_media} = $self->{_social_media};
568
2
3
                $vals->{info} = $info;
569
2
3
                $vals->{as_string} = $info->as_string();
570
571
2
200
                my $template = Template->new({
572                        INTERPOLATE => 1,
573                        POST_CHOMP => 1,
574                        ABSOLUTE => 1,
575                        PLUGINS => { JSON => 'Template::Plugin::JSON' },
576                });
577
578
2
2
6103
10
                $self->_debug({ message => __PACKAGE__ . ': ' . __LINE__ . ': Passing these to the template: ' . join(', ', keys %{$vals}) });
579
580                # Process the template
581
2
50
6
                if(!$template->process($filename, $vals, \$rc)) {
582
0
0
0
                        if(my $err = $template->error()) {
583
0
0
                                throw Error::Simple($err);
584                        }
585
0
0
                        throw Error::Simple("Unknown error in template: $filename");
586                }
587        } elsif($filename =~ /\.(html?|txt)$/) {
588                # Handle static HTML or text files
589
0
0
0
                open(my $fin, '<', $filename) || throw Error::Simple("$filename: $!");
590
591
0
0
                my @lines = <$fin>;
592
593
0
0
                close $fin;
594
595
0
0
                $rc = join('', @lines);
596        } else {
597
0
0
                throw Error::Simple("Unhandled file type $filename");
598        }
599
600        # Check for mailto links and log a warning
601
2
0
20
196
        if(($filename !~ /.txt$/) && ($rc =~ /\smailto:(.+?)>/) && ($1 !~ /^&/) && $self->{_logger}) {
602
0
0
                $self->{_logger}->warn({ message => "Found mailto link $1, you should remove it or use " . obfuscate($1) . ' instead' });
603        }
604
605
2
9
        return $rc;
606}
607
608sub _debug
609{
610
4
4
5
        my $self = shift;
611
612
4
50
7
        if(my $logger = $self->{_logger}) {
613
4
4
50
6
4
                my %params = (ref($_[0]) eq 'HASH') ? %{$_[0]} : @_;
614
4
50
8
                if(defined($ENV{'REMOTE_ADDR'})) {
615
4
9
                        $logger->debug("$ENV{'REMOTE_ADDR'}: $params{'message'}");
616                } else {
617
0
0
                        $logger->debug($params{'message'});
618                }
619        }
620
4
41
        return $self;
621}
622
623sub obfuscate {
624
0
0
0
0
0
0
        return map { '&#' . ord($_) . ';' } split(//, shift);
625}
626
627sub _types
628{
629
1
1
1
        my $self = shift;
630
1
2
        my $info = $self->{_info};
631
1
0
        my @rc;
632
633
1
50
50
50
3
        if($info->is_search_engine()) {
634
0
0
                push @rc, 'search', 'robot';
635        } elsif($info->is_mobile()) {
636
0
0
                push @rc, 'mobile';
637        } elsif($info->is_robot()) {
638
0
0
                push @rc, 'robot', 'search';
639        }
640
1
24
        push @rc, 'web';
641
642
1
50
2
        if(my $logger = $self->{'_logger'}) {
643
1
2
                $logger->trace('< ', __PACKAGE__, '::_types returning ', join(':', @rc));
644        }
645
646
1
9
        return @rc;
647}
648
649
3
3
3
3
3
2
5
sub _generate_csrf_token($self) {
650
3
3
        my $timestamp = time();
651
3
7
        my $random = sprintf('%08x', int(rand(0xFFFFFFFF)));
652
3
50
8
        my $secret = $self->{config}->{security}->{csrf}->{secret} // 'default_secret';
653
654
3
3
        my $token_data = "$timestamp:$random";
655
3
13
        my $signature = sha256_hex("$token_data:$secret");
656
657
3
6
        return "$token_data:$signature";
658}
659
660sub cache_key_from_hashref {
661
2
2
0
2
        my $hashref = $_[0];
662
663        # Use Data::Dumper with sorted keys for consistent output
664
2
2
        local $Data::Dumper::Sortkeys = 1;
665
2
1
        local $Data::Dumper::Terse = 1;
666
2
2
        local $Data::Dumper::Indent = 0;
667
668
2
19
        my $dumped = Dumper($hashref);
669
670        # Create an MD5 hash for a compact key
671
2
68
        return md5_hex($dumped);
672}
673
6741;