wi12.unix7.org

#!@PERL@
 
#------------
#--- CRON ---
#------------
 
package Cron;
 
use strict;
use warnings;
 
 
sub new {
    my ($class, %args) = @_;
    my $self = {};
    bless $self, $class;
    return $self;
}
 
sub ping {
    my $self = shift;
    my $res = "Pong!";
    $res;
}
 
1;
 
#----------
#--- DB ---
#----------
 
package DB;
 
use strict;
use warnings;
use DBI;
 
sub new {
    my ($class, %args) = @_;
    my $self = {
        hostname => $args{hostname},
        username => $args{username},
        password => $args{password},
        database => $args{database},
        engine => 'SQLite',
        error => ''
    };
    bless $self, $class;
    return $self;
}
 
sub username {
    my ($self, $username) = @_; 
    return $self->{username} unless $username;
    $self->{username} = $username;
    $self;
}
 
sub password {
    my ($self, $password) = @_; 
    return $self->{password} unless $password;
    $self->{password} = $password;
    $self;
}
 
sub hostname {
    my ($self, $hostname) = @_; 
    return $self->{hostname} unless $hostname;
    $self->{hostname} = $hostname;
    $self;
}
 
sub database {
    my ($self, $database) = @_; 
    return $self->{database} unless $database;
    $self->{database} = $database;
    $self;
}
 
sub error {
    my ($self, $error) = @_; 
    return $self->{error} unless $error;
    $self->{error} = $error;
    $self;
}
 
sub engine {
    my ($self, $engine) = @_; 
    return $self->{engine} unless $engine;
    $self->{engine} = $engine;
    $self;
}
 
 
sub exec {
    my ($self, $query) = @_;
    return undef unless $query;
 
    my $dsn = 'dbi:'.$self->engine.
                ':dbname='.$self->database.
                ';host='.$self->hostname;
    my $dbi;
    eval {
        $dbi = DBI->connect($dsn, $self->username, $self->password, { 
            RaiseError => 1,
            PrintError => 0,
            AutoCommit => 1 
        });
    };
    $self->error($@);
    return undef if $@;
 
    my $sth;
    eval {
        $sth = $dbi->prepare($query);
    };
    $self->error($@);
    return undef if $@;
 
    my $rows = $sth->execute;
    my @list;
 
    while (my $row = $sth->fetchrow_hashref) {
        push @list, $row;
    }
    $sth->finish;
    $dbi->disconnect;
    \@list;
}
 
sub do {
    my ($self, $query) = @_;
    return undef unless $query;
    my $dsn = 'dbi:'.$self->engine.
                ':dbname='.$self->database.
                ';host='.$self->hostname;
    my $dbi;
    eval {
        $dbi = DBI->connect($dsn, $self->username, $self->password, { 
            RaiseError => 1,
            PrintError => 0,
            AutoCommit => 1 
        });
    };
    $self->error($@);
    return undef if $@;
    my $rows;
    eval {
        $rows = $dbi->do($query) or return undef;
    };
    $self->error($@);
    return undef if $@;
 
    $dbi->disconnect;
    $rows*1;
}
 
1;
 
#------------
#--- USER ---
#------------
 
package User;
 
use strict;
use warnings;
 
sub new {
    my ($class, $db) = @_;
    my $self = { db => $db};
    bless $self, $class;
    return $self;
}
 
sub db {
    my ($self, $db) = @_; 
    return $self->{db} unless $db;
    $self->{db} = $db;
    $self;
}
 
sub list {
    my $self = shift;
    $self->db->exec('select * from user');
}
 
sub nextid {
    my $self = shift;
    my $res = $self->db->exec('select id from user order by id desc limit 1');
    my $hash = pop @{$res};
    my $i = $hash->{id};
    $i += 1;
}
 
1;
 
#--------------
#--- DAEMON ---
#--------------
 
package Daemon;
 
use strict;
use warnings;
use POSIX qw(getpid setuid setgid geteuid getegid);
use Cwd qw(cwd getcwd chdir);
use Mojo::Util qw(dumper);
 
sub new {
    my $class = shift;
    my $self = {};
    bless $self, $class;
    return $self;
}
 
sub fork {
    my $self = shift;
    my $pid = fork;
    if ($pid > 0) {
        exit;
    }
    chdir("/");
    open(my $stdout, '>&', STDOUT); 
    open(my $stderr, '>&', STDERR);
    open(STDOUT, '>>', '/dev/null');
    open(STDERR, '>>', '/dev/null');
    getpid;
}
 
1;
 
#-------------
#--- TAIL ----
#-------------
 
package Tail;
 
use strict;
use warnings;
 
sub new {
    my ($class, $file) = @_;
    my $self = {
        file => $file,
        pos => 0
    };
    bless $self, $class;
    return $self;
}
 
sub file {
    my ($self, $name) = @_;
    return $self->{'file'} unless $name;
    $self->{'file'} = $name;
}
 
sub pos {
    my ($self, $pos) = @_;
    return $self->{'pos'} unless $pos;
    $self->{'pos'} = $pos;
}
 
sub first {
    my $self = shift;
    open my $fh, '<', $self->file;
    seek $fh, -200, 2;
    readline $fh;
    my @res;
    while (my $line = readline $fh) {
        push @res, $line;
    }
    $self->pos(tell $fh);
    \@res;
}
 
sub last {
    my $self = shift;
    open my $fh, '<', $self->file;
    seek $fh, $self->pos, 0;
    my @res;
    while (my $line = readline $fh) {
        push @res, $line;
    }
    $self->pos(tell $fh);
    \@res;
}
 
1;
 
#--------------------
#--- CONTROLLER 1 ---
#--------------------
 
package Bird::Controller;
 
use strict;
use warnings;
use Mojo::Base 'Mojolicious::Controller';
use Mojo::Util qw(dumper);
use Apache::Htpasswd;
 
sub pwfile {
    my ($self, $pwfile) = @_;
    return $self->app->config('pwfile') unless $pwfile;
    $self->app->config(pwfile => $pwfile);
}
 
sub log {
    my ($self, $log) = @_;
    return $self->app->log unless $log;
    $self->app->log = $log;
}
 
sub ucheck {
    my ($self, $username, $password) = @_;
    return undef unless $password;
    return undef unless $username;
    my $pwfile = $self->pwfile or return undef;
    my $res = undef;
    eval {
        my $ht = Apache::Htpasswd->new({ passwdFile => $pwfile, ReadOnly => 1 });
        $res = $ht->htCheckPassword($username, $password);
    };
    $res;
}
 
sub login {
    my $self = shift;
    return $self->redirect_to('/') if $self->session('username');
 
    my $username = $self->req->param('username') || undef;
    my $password = $self->req->param('password') || undef;
 
    return $self->render(template => 'login') unless $username and $password;
 
    if ($self->ucheck($username, $password)) {
        $self->session(username => $username);
        return $self->redirect_to('/');
    }
    $self->render(template => 'login');
}
 
sub logout {
    my $self = shift;
    $self->session(expires => 1);
    $self->redirect_to('/');
}
 
sub index {
    my $self = shift;
    $self->render(template => 'hello');
}
 
sub hello {
    my $self = shift;
    $self->render(template => 'hello');
}
 
sub user {
    my $self = shift;
    $self->render(template => 'user');
}
 
sub tail {
    my $self = shift;
    $self->render(template => 'tail');
}
 
1;
 
#-----------
#--- APP ---
#-----------
 
package Bird;
 
use strict;
use warnings;
use Mojo::Base 'Mojolicious';
 
sub startup {
    my $self = shift;
}
 
1;
 
#-------------
#------------
#--- MAIN ---
#------------
#-------------
 
use strict;
use warnings;
use Mojo::Server::Prefork;
use Mojo::Util qw(dumper);
 
my $appname = 'bird';
 
my $server = Mojo::Server::Prefork->new;
my $app = $server->build_app('Bird');
$app = $app->controller_class('Bird::Controller');
 
$app->secrets(['6d578e43ba88260e0375a1a35fd7954b']);
$app->static->paths(['@APP_LIBDIR@/public']);
$app->renderer->paths(['@APP_LIBDIR@/templs']);
 
$app->config(conffile => '@APP_CONFDIR@/bird.conf');
$app->config(pwfile => '@APP_CONFDIR@/bird.pw');
$app->config(logfile => '@APP_LOGDIR@/bird.log');
$app->config(loglevel => 'info');
$app->config(pidfile => '@APP_RUNDIR@/bird.pid');
$app->config(crtfile => '@APP_CONFDIR@/bird.crt');
$app->config(keyfile => '@APP_CONFDIR@/bird.key');
 
$app->config(listenaddr4 => '0.0.0.0');
$app->config(listenaddr6 => '[::]');
$app->config(listenport => '8082');
 
$app->config(tailfile => '/var/log/debug.log');
$app->config(dbfile => '/var/db/si4/db');
 
if (-r $app->config('conffile')) {
    $app->log->debug("Load configuration from ".$app->config('conffile'));
    $app->plugin('JSONConfig', { file => $app->config('conffile') });
}
 
#---------------
#--- HELPERS ---
#---------------
$app->helper(
    tail => sub {
        state $tail = Tail->new($app->config('tailfile'));
});
$app->helper(
    db => sub {
        state $db = DB->new(database => $app->config('dbfile'));
});
$app->helper(
    user => sub {
        state $user = User->new($app->db); 
});
$app->helper(
    cron => sub {
        my $cron = Cron->new;
        $cron;
});
 
 
#--------------
#--- ROUTES ---
#--------------
 
my $r = $app->routes;
 
$r->add_condition(
    auth => sub {
        my ($route, $c) = @_;
        $c->session('username');
    }
);
 
$r->any('/login')->to(controller => 'Controller', action => 'login');
 
$r->any('/logout')->
    over('auth')->
    to(controller => 'Controller', action => 'logout');
 
$r->any('/')->
    over('auth')->
    to(controller => 'Controller', action => 'index' );
 
$r->any('/hello')->
    over('auth')->
    to(controller => 'Controller', action => 'hello');
 
$r->any('/user')->
    over('auth')->
    to(controller => 'Controller', action => 'user' );
 
$r->any('/tail')->
    over('auth')->
    to(controller => 'Controller', action => 'tail' );
 
$app->helper('reply.not_found' => sub { 
        my $c = shift; 
        return $c->redirect_to('/login') unless $c->session('username'); 
        $c->render(template => 'not_found.production');
});
 
#----------------
#--- LISTENER ---
#----------------
 
my $tls = '?';
$tls .= 'cert='.$app->config('crtfile');
$tls .= '&key='.$app->config('keyfile');
 
my $listen4;
if ($app->config('listenaddr4')) {
    $listen4 = "https://";
    $listen4 .= $app->config('listenaddr4').':'.$app->config('listenport');
    $listen4 .= $tls;
}
 
my $listen6;
if ($app->config('listenaddr6')) {
    $listen6 = "https://";
    $listen6 .= $app->config('listenaddr6').':'.$app->config('listenport');
    $listen6 .= $tls;
}
 
my @listen;
push @listen, $listen4 if $listen4;
push @listen, $listen6 if $listen6;
 
$server->listen(\@listen);
$server->heartbeat_interval(3);
$server->heartbeat_timeout(60);
 
 
my $d = Daemon->new;
$d->fork;
 
$server->pid_file($app->config('pidfile'));
 
$app->log(Mojo::Log->new( 
                path => $app->config('logfile'),
                level => $app->config('loglevel')
));
$app->hook(before_dispatch => sub {
        my $c = shift;
 
        my $remote_address = $c->tx->remote_address;
        my $method = $c->req->method;
 
        my $base = $c->req->url->base->to_string;
        my $path = $c->req->url->path->to_string;
        my $loglevel = $c->app->log->level;
        my $url = $c->req->url->to_abs->to_string;
 
        my $username  = $c->session('username') || 'undef';
 
        unless ($loglevel eq 'debug') {
            #$c->app->log->info("$remote_address $method $base$path $username");
            $c->app->log->info("$remote_address $method $url $username");
        }
        if ($loglevel eq 'debug') {
            $c->app->log->debug("$remote_address $method $url $username");
        }
});
 
local $SIG{HUP} = sub {
    $app->log->info('Catch HUP signal'); 
    $app->log(Mojo::Log->new(
                    path => $app->config('logfile'),
                    level => $app->config('loglevel')
    ));
};
 
my $sub = Mojo::IOLoop::Subprocess->new;
$sub->run(
    sub {
        my $subproc = shift;
        my $loop = Mojo::IOLoop->singleton;
        my $id = $loop->recurring(
            10 => sub {
                my $res = $app->cron->ping;
                $app->log->info($res);
            }
        );
        $loop->start unless $loop->is_running;
        1;
    },
    sub {
        my ($subprocess, $err, @results) = @_;
        $app->log->info('Exit subprocess');
        1;
    }
);
 
my $pid = $sub->pid;
$app->log->info("Subrocess $pid start ");
 
$server->on(
    finish => sub {
        my ($prefork, $graceful) = @_;
        $app->log->info("Subrocess $pid stop");
        kill('INT', $pid);
    }
);
 
$server->run;
 
#EOF