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 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/ interval_to_daterange request_is_api request_is_api_report request_is_api_search /; 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; }; # 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}; }; } 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::AdminTask; use App::Netdisco::Web::TypeAhead; use App::Netdisco::Web::PortControl; use App::Netdisco::Web::Statistics; use App::Netdisco::Web::Password; use App::Netdisco::Web::CustomFields; use App::Netdisco::Web::GenericReport; sub _load_web_plugins { my $plugin_list = shift; foreach my $plugin (@$plugin_list) { $plugin =~ s/^X::/+App::NetdiscoX::Web::Plugin::/; $plugin = 'App::Netdisco::Web::Plugin::'. $plugin if $plugin !~ m/^\+/; $plugin =~ s/^\+//; $ENV{ND2_LOG_PLUGINS} && debug "loading web plugin $plugin"; Module::Load::load $plugin; } } if (setting('web_plugins') and ref [] eq ref setting('web_plugins')) { _load_web_plugins( setting('web_plugins') ); } if (setting('extra_web_plugins') and ref [] eq ref setting('extra_web_plugins')) { unshift @INC, dir(($ENV{NETDISCO_HOME} || $ENV{HOME}), 'site_plugins')->stringify; _load_web_plugins( setting('extra_web_plugins') ); } # after plugins are loaded, add our own template path push @{ config->{engines}->{netdisco_template_toolkit}->{INCLUDE_PATH} }, setting('views'); # sort the reports which have been loaded, by their label foreach my $cat (@{ setting('_report_order') }) { setting('_reports_menu')->{ $cat } ||= []; setting('_reports_menu')->{ $cat } = [ sort { setting('_reports')->{$a}->{'label'} cmp setting('_reports')->{$b}->{'label'} } @{ setting('_reports_menu')->{ $cat } } ]; } # any template paths in deployment.yml (should override plugins) if (setting('template_paths') and ref [] eq ref setting('template_paths')) { if (setting('site_local_files')) { push @{setting('template_paths')}, dir(($ENV{NETDISCO_HOME} || $ENV{HOME}), 'nd-site-local', 'share')->stringify, dir(($ENV{NETDISCO_HOME} || $ENV{HOME}), 'nd-site-local', 'share', 'views')->stringify; } unshift @{ config->{engines}->{netdisco_template_toolkit}->{INCLUDE_PATH} }, @{setting('template_paths')}; } # load cookie key from database setting('session_cookie_key' => undef); setting('session_cookie_key' => 'this_is_for_testing_only') if $ENV{HARNESS_ACTIVE}; eval { my $sessions = schema('netdisco')->resultset('Session'); my $skey = $sessions->find({id => 'dancer_session_cookie_key'}); setting('session_cookie_key' => $skey->get_column('a_session')) if $skey; }; Dancer::Session::Cookie::init(session); # workaround for https://github.com/PerlDancer/Dancer/issues/935 hook after_error_render => sub { setting('layout' => 'main') }; # build list of port detail columns { my @port_columns = sort { $a->{idx} <=> $b->{idx} } map {{ name => $_, %{ setting('sidebar_defaults')->{'device_ports'}->{$_} } }} grep { $_ =~ m/^c_/ } keys %{ setting('sidebar_defaults')->{'device_ports'} }; splice @port_columns, setting('device_port_col_idx_right') + 1, 0, grep {$_->{position} eq 'right'} @{ setting('_extra_device_port_cols') }; splice @port_columns, setting('device_port_col_idx_mid') + 1, 0, grep {$_->{position} eq 'mid'} @{ setting('_extra_device_port_cols') }; splice @port_columns, setting('device_port_col_idx_left') + 1, 0, grep {$_->{position} eq 'left'} @{ setting('_extra_device_port_cols') }; set('port_columns' => \@port_columns); # update sidebar_defaults so hooks scanning params see new plugin cols setting('sidebar_defaults')->{'device_ports'}->{ $_->{name} } = $_ for @port_columns; } # build lookup for tenancies { set('tenant_data' => { map { ( $_->{tag} => { displayname => $_->{'displayname'}, tag => $_->{'tag'}, path => config->{'url_base'}->with("/t/$_->{tag}")->path } ) } @{ setting('tenant_databases') }, { tag => 'netdisco', 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}|; 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; # allow portable static content $tokens->{uri_base} = request->base->path if request->base->path ne '/'; $tokens->{uri_base} .= ('/t/'. vars->{'tenant'}) if vars->{'tenant'}; # 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(); # access to logged in user's roles $tokens->{user_has_role} = sub { user_has_role(@_) }; # 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"); } 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; }; # 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 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 { my $r = shift; # a Dancer::Response if (request->path =~ m{/swagger\.json} and request->path eq uri_for('/swagger.json')->path and ref {} eq ref $r->content) { my $spec = dclone $r->content; if (vars->{'tenant'}) { my $base = setting('path'); my $tenant = '/t/' . vars->{'tenant'}; $tenant = ($base . $tenant) if $base ne '/'; $tenant .= '/' if $base eq '/'; foreach my $path (sort keys %{ $spec->{paths} }) { (my $newpath = $path) =~ s/^$base/$tenant/; $spec->{paths}->{$newpath} = delete $spec->{paths}->{$path}; } } $r->content( to_json( $spec ) ); header('Content-Type' => 'application/json'); } # instead of setting serialiser # and also to handle some plugins just returning undef if search fails if (request_is_api) { header('Content-Type' => 'application/json'); $r->content( $r->content || '[]' ); } }; # setup for swagger API my $swagger = Dancer::Plugin::Swagger->instance; my $swagger_doc = $swagger->doc; $swagger_doc->{consumes} = 'application/json'; $swagger_doc->{produces} = 'application/json'; $swagger_doc->{tags} = [ {name => 'General', description => 'Log in and Log out'}, {name => 'Search', description => 'Search Operations'}, {name => 'Objects', description => 'Device, Port, and associated Node Data'}, {name => 'Reports', description => 'Canned and Custom Reports'}, {name => 'Queue', description => 'Operations on the Job Queue'}, ]; $swagger_doc->{securityDefinitions} = { APIKeyHeader => { type => 'apiKey', name => 'Authorization', in => 'header' }, BasicAuth => { type => 'basic' }, }; $swagger_doc->{security} = [ { APIKeyHeader => [] } ]; if (setting('trust_x_remote_user')) { foreach my $path (keys %{ $swagger_doc->{paths} }) { foreach my $method (keys %{ $swagger_doc->{paths}->{$path} }) { unshift @{ $swagger_doc->{paths}->{$path}->{$method}->{parameters} }, { name => 'X-REMOTE_USER', description => 'API client user name', in => 'header', required => false, type => 'string', }; } } } # manually install Swagger UI routes because plugin doesn't handle non-root # hosting, so we cannot use show_ui(1) my $swagger_base = config->{plugins}->{Swagger}->{ui_url}; get $swagger_base => sub { Dancer::Plugin::Swagger->instance->doc->{schemes} = [ request->scheme ]; redirect uri_for($swagger_base)->path . '/?url=' . uri_for('/swagger.json')->path; }; get $swagger_base.'/' => sub { Dancer::Plugin::Swagger->instance->doc->{schemes} = [ request->scheme ]; # user might request /swagger-ui/ initially (Plugin doesn't handle this) params->{url} or redirect uri_for($swagger_base)->path; send_file( 'swagger-ui/index.html' ); }; # omg the plugin uses system_path and we don't want to go there get $swagger_base.'/**' => sub { Dancer::Plugin::Swagger->instance->doc->{schemes} = [ request->scheme ]; send_file( join '/', 'swagger-ui', @{ (splat())[0] } ); }; # remove empty lines from CSV response # this makes writing templates much more straightforward! hook 'after' => sub { my $r = shift; # a Dancer::Response if ($r->content_type and $r->content_type eq 'text/comma-separated-values') { my @newlines = (); my @lines = split m/\n/, $r->content; foreach my $line (@lines) { push @newlines, $line if $line !~ m/^\s*$/; } $r->content(join "\n", @newlines); } }; # support for tenancies any qr{^/t/(?[^/]+)/?$} => sub { my $capture = captures; var tenant => $capture->{'tenant'}; forward '/'; }; any '/t/*/**' => sub { my ($tenant, $path) = splat; var tenant => $tenant; forward (join '/', '', @$path, (request->path =~ m{/$} ? '' : ())); }; any qr{.*} => sub { var('notfound' => true); status 'not_found'; template 'index', {}, { layout => 'main' }; }; true;