1 | package BookmarksApp; |
---|
2 | |
---|
3 | =head1 NAME |
---|
4 | |
---|
5 | BookmarksApp |
---|
6 | |
---|
7 | =head1 SYNOPSIS |
---|
8 | |
---|
9 | use BookmarksApp; |
---|
10 | use Digest::MD5 qw{md5_hex}; |
---|
11 | |
---|
12 | my $username = '...'; |
---|
13 | my $password = '...'; |
---|
14 | my $app = BookmarksApp->new({ |
---|
15 | config => { |
---|
16 | dbname => 'bookmarks.db', |
---|
17 | |
---|
18 | # set these if you want non-GET requests to require authentication |
---|
19 | auth => 1, |
---|
20 | digest_key => 'secret', |
---|
21 | digest_password => md5_hex("$username:Bookmarks:$password"), |
---|
22 | |
---|
23 | # set this if the app is running behind a proxy server |
---|
24 | proxy_ip => '...', |
---|
25 | }, |
---|
26 | }); |
---|
27 | |
---|
28 | # returns the coderef appropriate for use in an app.psgi, |
---|
29 | # or for passing the Plack::Runner, etc. |
---|
30 | $app->to_app; |
---|
31 | |
---|
32 | =cut |
---|
33 | |
---|
34 | use strict; |
---|
35 | use warnings; |
---|
36 | |
---|
37 | use parent qw{Plack::Component}; |
---|
38 | use Plack::Util::Accessor qw{config _app _controller}; |
---|
39 | |
---|
40 | use YAML; |
---|
41 | use Plack::Builder; |
---|
42 | use Plack::Request; |
---|
43 | use Router::Resource; |
---|
44 | use File::Basename qw{dirname}; |
---|
45 | use File::Spec::Functions qw{catfile}; |
---|
46 | |
---|
47 | use Bookmarks::Controller; |
---|
48 | |
---|
49 | sub prepare_app { |
---|
50 | my $self = shift; |
---|
51 | |
---|
52 | my $config = $self->config; |
---|
53 | |
---|
54 | my $router = router { |
---|
55 | resource '/' => sub { |
---|
56 | GET { |
---|
57 | # check for a uri param, and if there is one present, |
---|
58 | # see if a bookmark for that URI already exists; if so |
---|
59 | # redirect to that bookmark, and if not, show the form |
---|
60 | # to create a new bookmark |
---|
61 | if (defined $self->_controller->request->param('uri')) { |
---|
62 | return $self->_controller->find_or_new; |
---|
63 | } |
---|
64 | |
---|
65 | # otherwise return the sidebar |
---|
66 | return $self->_controller->sidebar; |
---|
67 | }; |
---|
68 | POST { |
---|
69 | # create the bookmark and redirect to the new bookmark's edit form |
---|
70 | return $self->_controller->create_and_redirect; |
---|
71 | }; |
---|
72 | }; |
---|
73 | |
---|
74 | resource '/list' => sub { |
---|
75 | GET { |
---|
76 | return $self->_controller->list; |
---|
77 | }; |
---|
78 | }; |
---|
79 | |
---|
80 | resource '/feed' => sub { |
---|
81 | GET { |
---|
82 | return $self->_controller->feed; |
---|
83 | }; |
---|
84 | }; |
---|
85 | |
---|
86 | resource '/tags' => sub { |
---|
87 | GET { |
---|
88 | my ($env, $params) = @_; |
---|
89 | return $self->_controller->tag_tree; |
---|
90 | }; |
---|
91 | }; |
---|
92 | resource '/tags/*' => sub { |
---|
93 | GET { |
---|
94 | my ($env, $params) = @_; |
---|
95 | my $tag_path = (@{ $params->{splat} })[0]; |
---|
96 | return $self->_controller->tag_tree([ split m{/}, $tag_path ]); |
---|
97 | }; |
---|
98 | }; |
---|
99 | |
---|
100 | resource '/{id}' => sub { |
---|
101 | GET { |
---|
102 | my ($env, $params) = @_; |
---|
103 | return $self->_controller->view($params->{id}); |
---|
104 | }; |
---|
105 | POST { |
---|
106 | my ($env, $params) = @_; |
---|
107 | return $self->_controller->update_and_redirect($params->{id}); |
---|
108 | }; |
---|
109 | }; |
---|
110 | |
---|
111 | resource '/{id}/{field}' => sub { |
---|
112 | GET { |
---|
113 | my ($env, $params) = @_; |
---|
114 | return $self->_controller->view_field($params->{id}, $params->{field}); |
---|
115 | }; |
---|
116 | }; |
---|
117 | |
---|
118 | }; |
---|
119 | |
---|
120 | # if configured for auth, read in the htdigest database file |
---|
121 | # and store the password hashes keyed by username |
---|
122 | my %password_hash_for; |
---|
123 | if ($config->{auth}) { |
---|
124 | $config->{realm} ||= 'Bookmarks'; |
---|
125 | $config->{htdigest} or die "No htdigest configured for authentication\n"; |
---|
126 | |
---|
127 | # if authentication is enabled and no digest_key is provided, generate one |
---|
128 | # don't do this if it isn't needed, since this is sometimes not a fast operation |
---|
129 | if (!$config->{digest_key}) { |
---|
130 | warn "Generating digest authentication secret...\n"; |
---|
131 | require Bytes::Random::Secure; |
---|
132 | $config->{digest_key} = Bytes::Random::Secure::random_bytes_base64(16, ''); |
---|
133 | } |
---|
134 | |
---|
135 | open my $htdigest, '<', $config->{htdigest} or die "Can't open $$config{htdigest}\n"; |
---|
136 | while (my $credentials = <$htdigest>) { |
---|
137 | chomp $credentials; |
---|
138 | my ($username, $realm, $password_hash) = split /:/, $credentials; |
---|
139 | # only add password digests for the configured realm |
---|
140 | if ($realm eq $config->{realm}) { |
---|
141 | $password_hash_for{$username} = $password_hash; |
---|
142 | } |
---|
143 | } |
---|
144 | close $htdigest; |
---|
145 | } |
---|
146 | |
---|
147 | $self->_app( |
---|
148 | builder { |
---|
149 | enable_if { $_[0]->{REMOTE_ADDR} eq $config->{proxy_ip} } 'ReverseProxy' |
---|
150 | if $config->{proxy_ip}; |
---|
151 | enable_if { $_[0]->{REQUEST_METHOD} ne 'GET' } 'Auth::Digest', ( |
---|
152 | realm => $config->{realm}, |
---|
153 | secret => $config->{digest_key}, |
---|
154 | password_hashed => 1, |
---|
155 | authenticator => sub { |
---|
156 | my ($username, $env) = @_; |
---|
157 | return $password_hash_for{$username}; |
---|
158 | }, |
---|
159 | ) if $config->{auth}; |
---|
160 | enable 'Static', ( |
---|
161 | path => qr{^/assets/}, |
---|
162 | root => catfile(dirname(__FILE__), 'htdocs'), |
---|
163 | ); |
---|
164 | sub { $router->dispatch(shift); }; |
---|
165 | } |
---|
166 | ); |
---|
167 | $self->_controller( |
---|
168 | Bookmarks::Controller->new({ |
---|
169 | dbname => $self->config->{dbname}, |
---|
170 | }) |
---|
171 | ); |
---|
172 | } |
---|
173 | |
---|
174 | sub call { |
---|
175 | my $self = shift; |
---|
176 | my $env = shift; |
---|
177 | |
---|
178 | # initialize the controller based on this request |
---|
179 | $self->_controller->request(Plack::Request->new($env)); |
---|
180 | |
---|
181 | # dispatch to the app |
---|
182 | $self->_app->($env); |
---|
183 | } |
---|
184 | |
---|
185 | # module return |
---|
186 | 1; |
---|
187 | |
---|
188 | =head1 AUTHOR |
---|
189 | |
---|
190 | Peter Eichman <peichman@cpan.org> |
---|
191 | |
---|
192 | =cut |
---|