User Tools

Site Tools


Differences

This shows you the differences between two versions of the page.

Link to this comparison view

mojo:bird [2017-11-23 14:49] (current)
Line 1: Line 1:
 +=====Sample Mojo application=====
 +
 + {{ :​mojo:​screenshot-2017-11-23-14-47-42.png?​nolink }}
 +
 +<code perl bird.pl>
 +#!@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
 +</​code>​
 +
 +
 +----
 +[<>]