[81] | 1 | package BookmarksApp; |
---|
| 2 | |
---|
[101] | 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 | |
---|
[81] | 34 | use strict; |
---|
| 35 | use warnings; |
---|
| 36 | |
---|
| 37 | use parent qw{Plack::Component}; |
---|
[99] | 38 | use Plack::Util::Accessor qw{config _app _controller}; |
---|
[81] | 39 | |
---|
| 40 | use YAML; |
---|
| 41 | use Plack::Builder; |
---|
| 42 | use Plack::Request; |
---|
| 43 | use Router::Resource; |
---|
[119] | 44 | use File::Basename qw{dirname}; |
---|
| 45 | use File::Spec::Functions qw{catfile}; |
---|
[81] | 46 | |
---|
| 47 | use Bookmarks::Controller; |
---|
| 48 | |
---|
| 49 | sub prepare_app { |
---|
| 50 | my $self = shift; |
---|
| 51 | |
---|
[92] | 52 | my $config = $self->config; |
---|
[81] | 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 | |
---|
[112] | 65 | # otherwise return the sidebar |
---|
| 66 | return $self->_controller->sidebar; |
---|
[81] | 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 | |
---|
[107] | 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 | |
---|
[81] | 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 | }; |
---|
[107] | 117 | |
---|
[81] | 118 | }; |
---|
| 119 | |
---|
[114] | 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"; |
---|
[118] | 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 | |
---|
[114] | 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 | |
---|
[81] | 147 | $self->_app( |
---|
| 148 | builder { |
---|
[92] | 149 | enable_if { $_[0]->{REMOTE_ADDR} eq $config->{proxy_ip} } 'ReverseProxy' |
---|
| 150 | if $config->{proxy_ip}; |
---|
[81] | 151 | enable_if { $_[0]->{REQUEST_METHOD} ne 'GET' } 'Auth::Digest', ( |
---|
[114] | 152 | realm => $config->{realm}, |
---|
[81] | 153 | secret => $config->{digest_key}, |
---|
| 154 | password_hashed => 1, |
---|
[114] | 155 | authenticator => sub { |
---|
| 156 | my ($username, $env) = @_; |
---|
| 157 | return $password_hash_for{$username}; |
---|
| 158 | }, |
---|
[92] | 159 | ) if $config->{auth}; |
---|
[119] | 160 | enable 'Static', ( |
---|
| 161 | path => qr{^/assets/}, |
---|
| 162 | root => catfile(dirname(__FILE__), 'htdocs'), |
---|
| 163 | ); |
---|
[81] | 164 | sub { $router->dispatch(shift); }; |
---|
| 165 | } |
---|
| 166 | ); |
---|
[98] | 167 | $self->_controller( |
---|
| 168 | Bookmarks::Controller->new({ |
---|
| 169 | dbname => $self->config->{dbname}, |
---|
| 170 | }) |
---|
| 171 | ); |
---|
[81] | 172 | } |
---|
| 173 | |
---|
| 174 | sub call { |
---|
| 175 | my $self = shift; |
---|
| 176 | my $env = shift; |
---|
| 177 | |
---|
| 178 | # initialize the controller based on this request |
---|
[98] | 179 | $self->_controller->request(Plack::Request->new($env)); |
---|
[81] | 180 | |
---|
| 181 | # dispatch to the app |
---|
| 182 | $self->_app->($env); |
---|
| 183 | } |
---|
| 184 | |
---|
| 185 | # module return |
---|
| 186 | 1; |
---|
[101] | 187 | |
---|
| 188 | =head1 AUTHOR |
---|
| 189 | |
---|
| 190 | Peter Eichman <peichman@cpan.org> |
---|
| 191 | |
---|
| 192 | =cut |
---|