Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 89 lines (67 sloc) 2.192 kb
a6e58f3 @s-aska - ログイン処理 fix
authored
1
2 use lib qw(lib);
3 use Plack::Request;
4 use Plack::Builder;
5 use Plack::Middleware::Session;
6 use Plack::Session::Store::File;
25e96f0 @s-aska password hash + salt, sid gen by /dev/urandom
authored
7 use Plack::Session::State::Cookie;
a6e58f3 @s-aska - ログイン処理 fix
authored
8 use File::Spec::Functions;
9 use File::Stamped;
10 use Log::Minimal;
11 use UNIVERSAL::require;
25e96f0 @s-aska password hash + salt, sid gen by /dev/urandom
authored
12 use String::Urandom;
a6e58f3 @s-aska - ログイン処理 fix
authored
13
14 my $base_class = 'SampleBBS';
15
16 my $basedir = $ENV{'SAMPLE_BBS_BASEDIR'} || './';
17
18 # ログのパスを生成 (/opt/sample-bbs/log/applog.20101127.log)
19 my $log_pattern = catfile($basedir, 'log', 'applog.%Y%m%d.log');
20
21 my $fh = File::Stamped->new(pattern => $log_pattern);
22
23 $Log::Minimal::PRINT = sub {
24 my ( $time, $type, $message, $trace) = @_;
25 $fh->print("$time [$type] $message at $trace\n");
26 };
27
28 my $app = sub {
29 my $env = shift;
30
31 my $req = Plack::Request->new($env);
32
33 my $path = substr($req->path, -1, 1) eq '/' ? $req->path . 'index' : $req->path;
34
35 my $controller = join '::', map { ucfirst($_) } split('/', $path);
36
37 my $args = {
38 basedir => $basedir
39 };
40
41 my $res;
42
43 my $controller = $base_class . '::UI' . $controller;
44
45 infof('controller: %s', $controller);
46
47 $controller->use || die $@;
48 $controller = $controller->new($args);
49 eval {
50 $controller->prepare($req);
51 $res = $controller->process($req);
52 $controller->finalize($req);
53 };if ($@) {
54 if (UNIVERSAL::isa($@, 'SampleBBS::Terminator')) {
55 $res = $@->res;
56 } else {
57 $res = $req->new_response(200);
58 $res->content_type('text/html; charset=UTF-8');
59 $res->body($@);
60 return $res->finalize;
61 }
62 }
63
64 return $res->finalize;
65 };
66
67 my $session_dir = '/tmp/sessions';
68
69 if (!-d $session_dir) {
70 mkdir $session_dir;
71 }
72
25e96f0 @s-aska password hash + salt, sid gen by /dev/urandom
authored
73 my $urandom = String::Urandom->new( LENGTH => 40 );
74 my $sid_generator = sub { $urandom->rand_string };
75 my $sid_validator = qr/\A[0-9a-zA-Z]{40}\Z/;
76
a6e58f3 @s-aska - ログイン処理 fix
authored
77 builder {
78 enable 'Session::Fixation',
79 store => Plack::Session::Store::File->new(
80 dir => $session_dir
25e96f0 @s-aska password hash + salt, sid gen by /dev/urandom
authored
81 ),
82 state => Plack::Session::State::Cookie->new(
83 sid_generator => $sid_generator,
84 sid_validator => $sid_validator
a6e58f3 @s-aska - ログイン処理 fix
authored
85 );
86 $app;
87 };
88
Something went wrong with that request. Please try again.