Bug 33146: Unit tests
[koha-ffzg.git] / C4 / Templates.pm
index b7f770d..dd54a6e 100644 (file)
@@ -2,9 +2,9 @@ package C4::Templates;
 
 use strict;
 use warnings;
-use Carp;
+use Carp qw( carp );
 use CGI qw ( -utf8 );
-use List::MoreUtils qw/ any uniq /;
+use List::MoreUtils qw( uniq );
 
 # Copyright 2009 Chris Cormack and The Koha Dev Team
 #
@@ -25,17 +25,19 @@ use List::MoreUtils qw/ any uniq /;
 
 =head1 NAME 
 
-    Koha::Templates - Object for manipulating templates for use with Koha
+C4::Templates - Object for manipulating templates for use with Koha
 
 =cut
 
 use base qw(Class::Accessor);
 use Template;
-use Template::Constants qw( :debug );
-use C4::Languages qw(getTranslatedLanguages get_bidi regex_lang_subtags language_get_description accept_language );
+use C4::Languages qw( get_bidi getTranslatedLanguages regex_lang_subtags );
 
 use C4::Context;
 
+use Koha::Cache::Memory::Lite;
+use Koha::Exceptions;
+
 __PACKAGE__->mk_accessors(qw( theme activethemes preferredtheme lang filename htdocs interface vars));
 
 
@@ -111,13 +113,17 @@ sub output {
     $vars->{opaclayoutstylesheet} =
         C4::Context->preference('opaclayoutstylesheet');
 
-    # add variables set via param to $vars for processing
-    for my $k ( keys %{ $self->{VARS} } ) {
-        $vars->{$k} = $self->{VARS}->{$k};
+    if(exists $self->{VARS}{lang}) {
+        warn "Preventing \$template->lang='" . ($self->{vars}{lang}//'-undef-')
+            . "' to be overwritten by template->{VARS}{lang}='" . ($self->{VARS}{lang}//'-undef-') . "'";
+        delete $self->{VARS}{lang};
     }
 
+    # add variables set via param to $vars for processing
+    $vars = { %$vars, %{ $self->{VARS} } };
+
     my $data;
-    binmode( STDOUT, ":utf8" );
+    binmode( STDOUT, ":encoding(UTF-8)" );
     $template->process( $self->filename, $vars, \$data )
       || die "Template process failed: ", $template->error();
     return $data;
@@ -162,19 +168,54 @@ sub _get_template_file {
     my $htdocs = C4::Context->config($is_intranet ? 'intrahtdocs' : 'opachtdocs');
     my ($theme, $lang, $availablethemes) = themelanguage($htdocs, $tmplbase, $interface, $query);
     $lang //= 'en';
-    my $filename = "$htdocs/$theme/$lang/modules/$tmplbase";
+    $theme //= '';
+    $tmplbase = "$htdocs/$theme/$lang/modules/$tmplbase" if $tmplbase !~ /^\//;
+        # do not prefix an absolute path
 
-    return ($htdocs, $theme, $lang, $filename);
+    return ( $htdocs, $theme, $lang, $tmplbase );
 }
 
+=head2 badtemplatecheck
+
+    badtemplatecheck( $template_path );
+
+    The sub will throw an exception if the template path is not allowed.
+
+    Note: At this moment the sub is actually a helper routine for
+    sub gettemplate.
+
+=cut
+
+sub badtemplatecheck {
+    my ( $template ) = @_;
+    if( !$template || $template !~ m/^[a-zA-Z0-9_\-\/]+\.(tt|pref)$/ ) {
+        # This also includes two dots
+        Koha::Exceptions::NoPermission->throw( 'bad template path' );
+    } else {
+        # Check allowed dirs - make sure we operate on a copy of the config
+        my $dirs = C4::Context->config("pluginsdir");
+        if ( !ref($dirs) ) {
+            $dirs = [ $dirs ];
+        }
+        else {
+            $dirs = [ @$dirs ];
+        }
+        unshift @$dirs, C4::Context->config('opachtdocs'), C4::Context->config('intrahtdocs');
+        my $found = 0;
+        foreach my $dir ( @$dirs ) {
+            $dir .= '/' if $dir !~ m/\/$/;
+            $found++ if $template =~ m/^$dir/;
+            last if $found;
+        }
+        Koha::Exceptions::NoPermission->throw( 'bad template path' ) if !$found;
+    }
+}
 
 sub gettemplate {
-    my ( $tmplbase, $interface, $query, $is_plugin ) = @_;
-    ($query) or warn "no query in gettemplate";
-    my $path = C4::Context->preference('intranet_includes') || 'includes';
+    my ( $tmplbase, $interface, $query ) = @_;
     my ($htdocs, $theme, $lang, $filename)
        =  _get_template_file($tmplbase, $interface, $query);
-    $filename = $tmplbase if ( $is_plugin );
+    badtemplatecheck( $filename ); # single trip for bad templates
     my $template = C4::Templates->new($interface, $filename, $tmplbase, $query);
 
 # NOTE: Commenting these out rather than deleting them so that those who need
@@ -231,11 +272,16 @@ the use case where the DB is not populated already when rewriting/fixing.
 
 sub themelanguage {
     my ($htdocs, $tmpl, $interface, $query) = @_;
-    ($query) or warn "no query in themelanguage";
 
     # Select a language based on cookie, syspref available languages & browser
     my $lang = C4::Languages::getlanguage($query);
 
+    return availablethemes($htdocs, $tmpl, $interface, $lang);
+}
+
+sub availablethemes {
+    my ($htdocs, $tmpl, $interface, $lang) = @_;
+
     # Get theme
     my @themes;
     my $theme_syspref    = ($interface eq 'intranet') ? 'template' : 'opacthemes';
@@ -256,31 +302,30 @@ sub themelanguage {
     my $where = $tmpl =~ /xsl$/ ? 'xslt' : 'modules';
     for my $theme (@themes) {
         if ( -e "$htdocs/$theme/$lang/$where/$tmpl" ) {
-            return ( $theme, $lang, uniq( \@themes ) );
+            return ( $theme, $lang, [ uniq(@themes) ] );
         }
     }
     # Otherwise return theme/'en', last resort fallback/'en'
     for my $theme (@themes) {
         if ( -e "$htdocs/$theme/en/$where/$tmpl" ) {
-            return ( $theme, 'en', uniq( \@themes ) );
+            return ( $theme, 'en', [ uniq(@themes) ] );
         }
     }
     # tmpl is a full path, so this is a template for a plugin
     if ( $tmpl =~ /^\// && -e $tmpl ) {
-        return ( $themes[0], $lang, uniq( \@themes ) );
+        return ( $themes[0], $lang, [ uniq(@themes) ] );
     }
 }
 
-
 sub setlanguagecookie {
     my ( $query, $language, $uri ) = @_;
 
-    my $cookie = $query->cookie(
-        -name    => 'KohaOpacLanguage',
-        -value   => $language,
-        -HttpOnly => 1,
-        -expires => '+3y'
-    );
+    my $cookie = getlanguagecookie( $query, $language );
+
+    # We do not want to set getlanguage in cache, some additional checks are
+    # done in C4::Languages::getlanguage
+    Koha::Cache::Memory::Lite->get_instance()->clear_from_cache( 'getlanguage' );
+
     print $query->redirect(
         -uri    => $uri,
         -cookie => $cookie
@@ -301,57 +346,12 @@ sub getlanguagecookie {
         -name    => 'KohaOpacLanguage',
         -value   => $language,
         -HttpOnly => 1,
-        -expires => '+3y'
+        -expires => '+3y',
+        -sameSite => 'Lax',
+        -secure => ( C4::Context->https_enabled() ? 1 : 0 ),
     );
 
     return $cookie;
 }
 
-=head2 GetColumnDefs
-
-    my $columns = GetColumnDefs( $cgi )
-
-It is passed a CGI object and returns a hash of hashes containing
-the column names and descriptions for each table defined in the
-columns.def file corresponding to the CGI object.
-
-=cut
-
-sub GetColumnDefs {
-
-    my $query = shift;
-
-    my $columns = {};
-
-    my $htdocs = C4::Context->config('intrahtdocs');
-    my $columns_file = 'columns.def';
-
-    # Get theme and language to build the path to columns.def
-    my ($theme, $lang, $availablethemes) =
-        themelanguage($htdocs, 'about.tt', 'intranet', $query);
-    # Build columns.def path
-    my $path = "$htdocs/$theme/$lang/$columns_file";
-    my $fh;
-    if ( ! open ( $fh, q{<}, $path ) )  {
-        carp "Error opening $path. Check your templates.";
-        return;
-    }
-    # Loop through the columns.def file
-    while ( my $input = <$fh> ){
-        chomp $input;
-        if ( $input =~ m|<field name="(.*)">(.*)</field>| ) {
-            my ( $table, $column ) =  split( '\.', $1);
-            my $description        = $2;
-            # Initialize the table array if needed.
-            @{$columns->{ $table }} = () if ! defined $columns->{ $table };
-            # Push field and description
-            push @{$columns->{ $table }},
-                { field => $column, description => $description };
-        }
-    }
-    close $fh;
-
-    return $columns;
-}
-
 1;