| [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 |
|---|