auditing
[scpubgit/App-EzPz.git] / lib / App / EzPz / Web.pm
CommitLineData
e191c67d 1package App::EzPz::Web;
2
3use Module::Runtime qw(use_module);
4use App::EzPz::UserStore;
5use HTML::Zoom;
6use Web::Simple;
7
8has users => (is => 'lazy');
9
10sub _build_users {
11 my ($self) = @_;
12 my $config = $self->config;
13 return App::EzPz::UserStore->new(
14 htpasswd_file => $config->{htpasswd_file},
15 ($config->{ezmlm_bindir}
16 ? (ezmlm_config => {
17 bindir => $config->{ezmlm_bindir},
18 list_base_dir => $config->{list_base_dir},
19 })
20 : ())
21 );
22}
23
24sub default_config {
25 (
3b638626 26 htpasswd_file => 'test-setup/lists/htpasswd',
27 ezmlm_bindir => 'test-setup/ezmlm/bin',
28 list_base_dir => 'test-setup/lists',
e191c67d 29 )
30}
31
32sub dispatch_request {
33 my ($self) = @_;
34 my $users = $self->users;
35 my $current_user;
36 sub () {
37 return if $_[PSGI_ENV]->{REMOTE_USER};
38 return use_module('Plack::Middleware::Auth::Basic')->new(
39 authenticator => sub { $users->check_password(@_) }
40 )
41 },
42 sub () {
43 $current_user = $users->get(my $name = $_[PSGI_ENV]->{REMOTE_USER});
44 return [
45 401, [ 'Content-type' => 'text/plain' ], [ "No such user $name" ]
46 ] unless $current_user;
47 return;
48 },
49 sub (/) {
50 $self->_render_front_page($current_user);
51 },
52 sub (/list/*/...) {
53 my $list = $current_user->get_list($_[1]);
54 return unless $list;
0a0e9549 55 my $error;
e191c67d 56 sub (/) {
2603aa88 57 $self->_list_dispatchers($current_user, $list, \$error),
0a0e9549 58 sub () { $self->_render_list_page($list, $error) };
e191c67d 59 },
60 sub (/deny/|/allow/|/mod/|/digest/) {
61 sub (/*/) {
62 my $sublist = $list->${\$_[1]};
2603aa88 63 $self->_list_dispatchers($current_user, $sublist, \$error),
0a0e9549 64 sub () { $self->_render_sublist_page($sublist, $error) };
e191c67d 65 },
66 },
67 }
68}
69
2603aa88 70sub audit_action {
71 my ($self, $user, $list, $action, $on) = @_;
72 print STDERR "${user} called ${action} ${on} for ${list}\n";
73}
74
e191c67d 75sub _list_dispatchers {
2603aa88 76 my ($self, $current_user, $list, $error_ref) = @_;
77 my $name = $current_user->username;
e191c67d 78 sub (POST) {
79 sub (%add=) {
2603aa88 80 $self->audit_action($name, $list->name, 'add', $_[1]);
0a0e9549 81 eval { $list->add_member($_[1]); 1 }
82 or ${$error_ref} = $@;
e191c67d 83 return;
84 },
85 sub (%remove=) {
2603aa88 86 $self->audit_action($name, $list->name, 'remove', $_[1]);
0a0e9549 87 eval { $list->remove_member($_[1]); 1 }
88 or ${$error_ref} = $@;
e191c67d 89 return;
90 },
91 }
92}
93
94sub _zoom_for {
95 my ($self, $name) = @_;
96 my $my_file = __FILE__;
97 $my_file =~ s/\.pm//;
98 return HTML::Zoom->from_file("${my_file}/_templates/${name}.html");
99}
100
101sub _render_page {
102 my ($self, $name, $code) = @_;
103 return [
104 200, [ 'Content-type' => 'text/html' ],
105 [ $self->_zoom_for($name)->${\sub { local $_ = $_[0]; &$code }}->to_html ]
106 ];
107}
108
109sub _render_front_page {
110 my ($self, $user) = @_;
111 return $self->_render_page(index => sub {
112 $_->replace_content('.user-name',$user->username)
113 ->repeat('.list', [
114 map {
115 my $name = $_;
116 sub {
117 $_->select('.list-link')
118 ->replace_content($name)
119 ->then
120 ->set_attribute(href => "/list/${name}/");
121 }
122 } $user->list_names
123 ]);
124 });
125}
126
127sub _render_list_page {
0a0e9549 128 shift->_render_listcore_page(
129 @_, [
e191c67d 130 map [ ucfirst($_)." list", "${_}/" ], qw(allow deny mod digest)
131 ]
132 );
133}
134
135sub _render_sublist_page {
0a0e9549 136 shift->_render_listcore_page(
137 @_, [ [ "Back to list", "../" ] ],
e191c67d 138 );
139}
140
141sub _render_listcore_page {
0a0e9549 142 my ($self, $list, $error, $links) = @_;
e191c67d 143 $self->_render_page(list => sub {
144 $_->replace_content('.list-name', $list->name)
0a0e9549 145 ->replace_content('.error', $error||'')
e191c67d 146 ->repeat('.list-link', [
147 map {
148 my ($name, $href) = @$_;
149 sub {
150 $_->select('.list-link-anchor')
151 ->replace_content($name)
152 ->then
153 ->set_attribute(href => $href);
154 }
155 } @$links
156 ])
157 ->repeat('.list-member', [
158 map {
159 my $email = $_;
160 sub {
161 $_->replace_content('.list-member-name', $email)
162 ->set_attribute('.list-member-remove', value => $email);
163 }
164 } $list->members
165 ]);
166 });
167}
168
169__PACKAGE__->run_if_script;