view release on metacpan or  search on metacpan

lib/App/Netdisco/Web.pm  view on Meta::CPAN

package App::Netdisco::Web;

use Dancer ':syntax';
use Dancer::Plugin::Ajax;

use Dancer::Plugin::DBIC;
use Dancer::Plugin::Auth::Extensible;
use Dancer::Plugin::Swagger;

use Dancer::Error;
use Dancer::Continuation::Route::ErrorSent;

use URI ();
use Socket6 (); # to ensure dependency is met
use HTML::Entities (); # to ensure dependency is met
use URI::QueryParam (); # part of URI, to add helper methods
use URI::Escape 'uri_escape_utf8';
use MIME::Base64 'encode_base64';
use Path::Class 'dir';
use Module::Load ();
use Data::Visitor::Tiny;
use Scalar::Util 'blessed';
use Storable 'dclone';
use URI::Based;

use App::Netdisco::Util::Web qw/
  escape_results_token
  interval_to_daterange
  page_title
  pane_chrome
  pane_history_header
  request_is_api
  request_is_api_report
  request_is_api_search
/;
use App::Netdisco::Util::Permission qw/acl_matches acl_matches_only/;
use App::Netdisco::Util::SiteLocal qw/scan_shadowed_files site_local_paths/;

BEGIN {
  no warnings 'redefine';

  # https://github.com/PerlDancer/Dancer/issues/967
  *Dancer::_redirect = sub {
      my ($destination, $status) = @_;
      my $response = Dancer::SharedData->response;
      $response->status($status || 302);
      $response->headers('Location' => $destination);
  };

  # neater than using Dancer::Plugin::Res to handle JSON differently
  *Dancer::send_error = sub {
      my ($body, $status) = @_;
      if (request_is_api) {
        status $status || 400;
        $body = '' unless defined $body;
        Dancer::Continuation::Route::ErrorSent->new(
            return_value => to_json { error => $body, return_url => param('return_url') }
        )->throw;
      }
      Dancer::Continuation::Route::ErrorSent->new(
          return_value => Dancer::Error->new(
              message => $body,
              code => $status || 500)->render()
      )->throw;
  };

  # behind_proxy is documented as a setting nobody needs, since
  # Plack::Middleware::ReverseProxy is always in the stack, but a site that
  # sets it makes Dancer answer with the X-Forwarded-For header verbatim, and
  # more than one proxy makes that a chain rather than an address. Take the
  # last element, as ReverseProxy does: anything left of it is client supplied.
  *Dancer::Request::address = sub {
      my $self = shift;
      return $self->env->{REMOTE_ADDR} unless setting('behind_proxy');
      my $forwarded = $self->forwarded_for_address;
      my ($client) = (defined $forwarded ? ($forwarded =~ m/([^,\s]+)\s*$/) : ());
      return ($client || $self->env->{REMOTE_ADDR});
  };

  # to insert /t/$tenant if set
  # which is fine for building links, but not fine for
  # comparison to request->path, because when is_forward() the
  # request->path is changed...
  *Dancer::Request::uri_for = sub {
    my ($self, $part, $params, $dont_escape) = @_;
    my $uri = $self->base;

    if (vars->{'tenant'}) {
        $part = '/t/'. vars->{'tenant'} . $part;
    }

    # Make sure there's exactly one slash between the base and the new part
    my $base = $uri->path;
    $base =~ s|/$||;
    $part =~ s|^/||;
    $uri->path("$base/$part");

    $uri->query_form($params) if $params;

    return $dont_escape ? uri_unescape($uri->canonical) : $uri->canonical;
  };

  # ...so here we are monkeypatching request->path as well
  *Dancer::Request::path = sub {
    die "path is accessor not mutator" if scalar @_ > 1;
    my $self = shift;
    $self->_build_path() unless $self->{path};

    if (vars->{'tenant'} and $self->{path} !~ m{/t/}) {
        my $path = $self->{path};
        my $base = setting('path');
        my $tenant = '/t/' . vars->{'tenant'};

        $tenant = ($base . $tenant) if $base ne '/';
        $tenant .= '/' if $base eq '/';
        $path =~ s/^$base/$tenant/;

        return $path;
    }
    return $self->{path};
  };

  # implement same_site
  # from https://github.com/PerlDancer/Dancer-Session-Cookie/issues/20
  *Dancer::Session::Cookie::_cookie_params = sub {
      my $self     = shift;
      my $name     = $self->session_name;
      my $duration = $self->_session_expires_as_duration;
      my %cookie   = (
          name      => $name,
          value     => $self->_cookie_value,
          path      => setting('session_cookie_path') || '/',
          domain    => setting('session_domain'),
          secure    => setting('session_secure'),
          http_only => setting("session_is_http_only") // 1,
          same_site => setting("session_same_site"),
      );
      if ( defined $duration ) {
          $cookie{expires} = time + $duration;
      }
      return %cookie;
  };
}

use App::Netdisco::Web::AuthN;
use App::Netdisco::Web::Static;
use App::Netdisco::Web::Search;
use App::Netdisco::Web::Device;
use App::Netdisco::Web::Report;
use App::Netdisco::Web::API::Objects;
use App::Netdisco::Web::API::Queue;
use App::Netdisco::Web::API::Statistics;
use App::Netdisco::Web::API::User;
use App::Netdisco::Web::Health;
use App::Netdisco::Web::Metrics;
use App::Netdisco::Web::AdminTask;
use App::Netdisco::Web::TypeAhead;
use App::Netdisco::Web::PortControl;
use App::Netdisco::Web::Statistics;
use App::Netdisco::Web::Password;

lib/App/Netdisco/Web.pm  view on Meta::CPAN

            { tag => 'netdisco', displayname => (setting('database')->{displayname} || 'Default') }
    });
    config->{'tenant_data'}->{'netdisco'}->{'path'}
      = URI::Based->new((config->{path} eq '/') ? '' : config->{path})->path;
    set('tenant_tags' => [  map { $_->{'tag'} }
                           sort { $a->{'displayname'} cmp $b->{'displayname'} }
                                values %{ config->{'tenant_data'} } ]);
}

hook 'before' => sub {
  my $key = request->path;
  if (param('tab') and ($key !~ m/ajax/)) {
      $key .= ('/' . param('tab'));
  }
  $key =~ s|.*/(\w+)/(\w+)$|${1}_${2}|;

  # the admin pages are served from /admin/<task> but their sidebar options
  # are configured, and read by the sidebar templates, under admintask_<task>
  $key =~ s/^admin_/admintask_/;

  var(sidebar_key => $key);

  # trim whitespace
  params->{'q'} =~ s/^\s+|\s+$//g if param('q');

  # copy sidebar defaults into vars so we can mess about with it
  foreach my $sidebar (keys %{setting('sidebar_defaults')}) {
    vars->{'sidebar_defaults'}->{$sidebar} = { map {
      ($_ => setting('sidebar_defaults')->{$sidebar}->{$_}->{'default'})
    } keys %{setting('sidebar_defaults')->{$sidebar}} };
  }
};

# swagger submits "false" params whereas web UI does not - remove them
# so that code testing for param existence as truth still works.
hook 'before' => sub {
  return unless request_is_api_report or request_is_api_search;
  map {delete params->{$_} if params->{$_} eq 'false'} keys %{params()};
};

hook 'before_template' => sub {
  # search or report from navbar, or reset of sidebar, can ignore params
  return if param('firstsearch')
    or var('sidebar_key') !~ m/^\w+_\w+$/;

  # update defaults to contain the passed url params
  # (this follows initial copy from config.yml, then cookie restore)
  var('sidebar_defaults')->{var('sidebar_key')}->{$_} = param($_)
    for keys %{ var('sidebar_defaults')->{var('sidebar_key')} || {} };
};

hook 'before_template' => sub {
    my $tokens = shift;

    # quick b64 encode
    $tokens->{atob} = sub { encode_base64(shift, '') };

    # allow portable static content
    $tokens->{uri_base} = request->base->path
      if request->base->path ne '/';
    $tokens->{uri_base} .= ('/t/'. uri_escape_utf8(vars->{'tenant'}))
      if vars->{'tenant'};

    # cache-busting suffix for the stylesheets and scripts in the layout.
    # bin/netdisco-web-fg asks browsers to hold css, javascript, images and
    # fonts for a day without revalidating, and the filenames never carry a
    # version, so after an upgrade a returning visitor renders the new markup
    # with the previous release's stylesheet until that day is up.
    $tokens->{asset_version} = ($App::Netdisco::VERSION || 'HEAD');

    # allow portable dynamic content
    $tokens->{uri_for} = sub { uri_for(@_)->path_query };

    # current query string to all resubmit from within ajax template
    my $queryuri = URI->new();
    $queryuri->query_param($_ => param($_))
      for grep {$_ ne 'return_url'} keys %{params()};
    $tokens->{my_query} = $queryuri->query();

    # hide custom fields according to only/no settings
    $tokens->{permitted_by_acl} = sub {
        my ($thing, $config) = @_;
        return false unless $thing and $config;

        return if acl_matches($thing, ($config->{no} || []));
        return unless acl_matches_only($thing, ($config->{only} || []));
        return true;
    };

    # access to logged in user's roles (modulo RBAC)
    # role will be "admin" "port_control" "radius" or "ldap"
    $tokens->{user_has_role} = sub {
        my ($role, $device) = @_;
        return false unless $role;

        return user_has_role($role) if $role ne 'port_control';
        return false unless user_has_role('port_control');
        return true if not $device;

        my $user = logged_in_user or return false;
        return true unless $user->portctl_role;

        # this has the merged yaml and database config
        my $acl = setting('portctl_by_role')->{$user->portctl_role};
        if ($acl and (ref $acl eq q{} or ref $acl eq ref [])) {
            return true if acl_matches($device, $acl);
        }
        elsif ($acl and ref $acl eq ref {}) {
            foreach my $key (grep { defined } keys %$acl) {
                # lhs matches device, rhs matches port
                # but we are not interested in the ports
                return true if acl_matches($device, $key);
            }
        }

        # assigned an unknown role
        return false;
    };

    # create date ranges from within templates
    $tokens->{to_daterange}  = sub { interval_to_daterange(@_) };

    # data structure for DataTables records per page menu
    $tokens->{table_showrecordsmenu} =
      to_json( setting('table_showrecordsmenu') );

    # linked searches will use these default url path params
    foreach my $sidebar_key (keys %{ var('sidebar_defaults') }) {
        my ($mode, $report) = ($sidebar_key =~ m/(\w+)_(\w+)/);
        if ($mode =~ m/^(?:search|device)$/) {
            $tokens->{$sidebar_key} = uri_for("/$mode", {tab => $report});
        }
        elsif ($mode =~ m/^report$/) {
            $tokens->{$sidebar_key} = uri_for("/$mode/$report");
        }
        elsif ($mode =~ m/^admintask$/) {
            $tokens->{$sidebar_key} = uri_for("/$mode/$report");
        }

        foreach my $col (keys %{ var('sidebar_defaults')->{$sidebar_key} }) {
            $tokens->{$sidebar_key}->query_param($col,
              var('sidebar_defaults')->{$sidebar_key}->{$col});
        }

        # fix Plugin Template Variables to be only path+query
        $tokens->{$sidebar_key} = $tokens->{$sidebar_key}->path_query;
    }

    # helper from NetAddr::MAC for the MAC formatting
    $tokens->{mac_format_call} = 'as_'. lc(param('mac_format'))
      if param('mac_format');

    # allow very long lists of ports
    $Template::Directive::WHILE_MAX = 10_000;

    # allow hash keys with leading underscores
    $Template::Stash::PRIVATE = undef;
};

# The report and search templates embed their result set as a JavaScript
# literal inside a <script> element, which they must opt out of AutoFilter to
# do. Escaping happens here rather than in each of the templates so that a
# site-local template or a third-party report plugin gets it too, without its
# author having to know.
hook 'before_template' => sub {
    escape_results_token( shift );
};

# prevent Template::AutoFilter taking action on CSV output
hook 'before_template' => sub {
    my $template_engine = engine 'template';
    if (not request->is_ajax
        and header('Content-Type')
        and header('Content-Type') eq 'text/comma-separated-values' ) {

        $template_engine->{config}->{AUTO_FILTER} = 'none';
        $template_engine->init();
    }
    # debug $template_engine->{config}->{AUTO_FILTER};
};
hook 'after_template_render' => sub {
    my $template_engine = engine 'template';
    if (not request->is_ajax
        and header('Content-Type')
        and header('Content-Type') eq 'text/comma-separated-values' ) {

        $template_engine->{config}->{AUTO_FILTER} = 'html_entity';
        $template_engine->init();
    }
    # debug $template_engine->{config}->{AUTO_FILTER};
};

# support for report api which is basic table result in json
#
# The branch is chosen on the presence of the token, not its value. Node search
# is the only handler that renders without a `results` token, and the second
# branch exists for it. Creating the key here or in any earlier hook silently
# moves it onto the first branch and empties the response: #732 in 2020, #1649
# in 2026.
hook before_layout_render => sub {
  my ($tokens, $html_ref) = @_;
  return unless request_is_api_report or request_is_api_search;

  if (ref {} eq ref $tokens and exists $tokens->{results}) {
      ${ $html_ref } = to_json $tokens->{results};
  }
  elsif (ref {} eq ref $tokens) {
      map {delete $tokens->{$_}}
           grep {not blessed $tokens->{$_} or not $tokens->{$_}->isa('App::Netdisco::DB::ResultSet')}
                keys %$tokens;

      visit( $tokens, sub {
          my ( $key, $valueref ) = @_;
          $$valueref = [$$valueref->hri->all]
            if blessed $$valueref and $$valueref->isa('App::Netdisco::DB::ResultSet');
      });

      ${ $html_ref } = to_json $tokens;
  }
  else {
      ${ $html_ref } = '[]';
  }
};

# workaround for Swagger plugin weird response body
hook 'after' => sub {