1#@!#!123s

��JFIF�� 1#@!#!123s
: / opt / PUC / lib / PUC / Module /
Filename : WebApp.pm
back
package PUC::Module::WebApp;

use strict;
use warnings;

use Carp;
use Data::Dumper;
use FindBin;
use Safe;
use JSON;
use Try::Tiny;

use PUC::Module::WebApp::SQLiteStore;

use Log::Log4perl;
Log::Log4perl->init_once('/opt/PUC/log4perl.conf');
my $log = Log::Log4perl->get_logger();

my $WEBAPP_CONFIG_FILE = 'webapp_config.conf';

my $instance;

sub get_instance {
    return $instance or croak "Class has not been instantiated yet.";
}

################################################################################

=head2 new

Create a WebApp object from the application config.
Performs any setup required by this module, such as subscribing to another module.

=cut

sub new {
    my $class = shift;

    if ($instance) {
        return $instance;
    }

    my %args = @_;

    my $self = {
        app_config  => $args{app_config},
        datastore   => $args{app_config}->{datastore},
        subscribers => [],
    };

    # Get the config info
    open my $fh, '<', $self->{app_config}->{bindir} . "/" . $WEBAPP_CONFIG_FILE
      or croak "Unable to open " . $WEBAPP_CONFIG_FILE;

    my $contents;
    {
        ## no critic [Variables::RequireInitializationForLocalVars]
        local $/;
        ##
        $contents = <$fh>;
    }
    close $fh;

    my $compartment   = Safe->new();
    my $module_config = $compartment->reval($contents);
    $self->{webapps} = $module_config->{webapps};
    if ( ref $self->{webapps} ne 'HASH' ) {
        croak __PACKAGE__ . ' Error in webapps configuration';
    }

    $self->{datastore_route} = $module_config->{datastore_route};

    # Set up local database so we can detect when webapps change.
    my %local_storage_config = %{ $module_config->{local_storage} };
    $local_storage_config{debug} //= $self->{app_config}->{debug};

    $self->{local_storage} =
      PUC::Module::WebApp::SQLiteStore->new(%local_storage_config);
    $self->{local_storage}->create_local_store();

    if ( $self->{app_config}->{debug} ) {
        $log->info("WebApp config " . Dumper($self));
        print STDERR "WebApp config " . Dumper($self);
    }

    $instance = bless $self, $class;

    return $instance;
}

################################################################################

=head2 process_domain

Main processing function called by the collector script.

=cut

sub process_domain {
    my ( $self, $domain_info ) = @_;

    my $domain_name = $domain_info->{name};

    if ( $self->{app_config}->{debug} ) {

        $log->info("module WebApp processing domain". $domain_name);
        print STDERR "module WebApp processing domain $domain_name\n";
    }

    my $version;

    my $result;
    for my $webapp ( keys %{ $self->{webapps} } ) {
        if ( $self->{app_config}->{debug} ) {
            $log->info("module WebApp processing domain". $domain_name);
            print STDERR "checking $webapp\n";
        }
        $result = $self->find_web_app( $domain_info, $webapp );
        if ($result) {
            if ( not $self->{app_config}->{dryrun} ) {
                $self->log_result($result);
            }
            last;
        }
        $result = undef;
    }

    if ( not $result ) {
        $result = {
            domain   => $domain_info,
            username => $domain_info->{username},
            webApp   => {
                name => "other",
            },
            server => {
                hostname => $self->{app_config}->{hostname},
            }
        };

        delete $result->{domain}->{docroot};
        delete $result->{domain}->{username};

        if ( not $self->{app_config}->{dryrun} ) {
            $self->log_result($result);
        }
    }

    if ( $self->{app_config}->{debug} ) {
        $log->info("WebApp: found " . Dumper($result));
        print STDERR "WebApp: found " . Dumper($result);
    }

    return;
}

################################################################################

=head2 find_web_app

Scans a docroot for a single webapp.

=cut

sub find_web_app {
    my ( $self, $domain, $webapp ) = @_;

    my $docroot = $domain->{docroot};
    $docroot =~ s/^\///;
    $docroot = $self->{app_config}->{dataroot} . $docroot;
    my $result;

    # The id test is the primary.
    my $file = $docroot . '/' . $self->{webapps}->{$webapp}->{id}->{file};
    if ( -f $file ) {
        if ( scan_file( $file, $self->{webapps}->{$webapp}->{id}->{pattern} ) ) {
            my $found = 1;
            if ( $self->{webapps}->{$webapp}->{nofile} ) {
                for my $nofile ( @{ $self->{webapps}->{$webapp}->{nofile} } ) {
                    ## no critic [ValuesAndExpressions::ProhibitMismatchedOperators]
                    if ( -e $docroot . '/' . $nofile ) {
                        $found = 0;
                        last;
                    }
                    ##
                }
            }
            if ($found) {
                $result = {};
                $result->{server} = {
                    hostname => $self->{app_config}->{hostname},
                };
                $result->{domain} = $domain;
                delete $result->{domain}->{docroot};
                $result->{username} = delete $result->{domain}->{username};
                $result->{webApp}   = {
                    name => $webapp,
                };
                if ( exists $self->{webapps}->{$webapp}->{version} ) {
                    my $version = scan_file(
                        $docroot . '/' . $self->{webapps}->{$webapp}->{version}->{file},
                        $self->{webapps}->{$webapp}->{version}->{pattern}
                    );
                    if ($version) {
                        $result->{webApp}->{version} = $version;
                    }
                }
            }
        }
    }

    return $result;
}

################################################################################

=head2 scan_file

Scan a file for a regex match

=cut

sub scan_file {
    my ( $file, $pattern ) = @_;

    my $fh;
    if ( not open $fh, '<', $file ) {
        print STDERR "Unable to read file $file: $!\n";    # need better logging
    }
    else {
        ## no critic [Variables::RequireInitializationForLocalVars]
        local $/;
        ##
        my $contents = <$fh>;
        close $fh;
        if ( $contents =~ /$pattern/ ) {
            return $1;
        }
    }

    return;
}

################################################################################

=head2 log_result

Saves a record of the scan result.

=cut

sub log_result {
    my ( $self, $data ) = @_;

    if ( my $diff = $self->{local_storage}->diff_and_save($data) ) {
        try {
            $self->{datastore}->send_data(
                $self->{datastore_route},
                encode_json($data),
            );
        } catch {
            $log->error( $_ . ' action=PUC::Collector::DataStore->send_data');
        };

        for my $subscriber ( @{ $self->{subscribers} } ) {
            $subscriber->($data);
        }

    }

    return;
}

################################################################################

=head2 subscribe

Used by dependent modules to subscribe to push notifications of found web apps

=cut

sub subscribe {
    my ( $package, $callback ) = @_;
    if ( ref($callback) ne 'CODE' ) {
        croak "Callback is not a code ref";
    }
    push @{ __PACKAGE__->get_instance->{subscribers} }, $callback;
    return;
}

################################################################################

=head2 notify

Used to notify subscribers of found webapps

=cut

sub notify {
    my ( $self, $package, $domain, $data ) = @_;

    for my $subscriber ( @{ $self->{subscribers} } ) {
        $subscriber->( $domain, $data );
    }

    return;
}

1;