moved qdb here because matt is lazy
[public/www-new.git] / pub / qdb / src / modules / Chirpy / UI / WebApp / Captcha / GD_SecurityImage.pm
1 ###############################################################################\r
2 # Chirpy! 0.3, a quote management system                                      #\r
3 # Copyright (C) 2005-2007 Tim De Pauw <ceetee@users.sourceforge.net>          #\r
4 ###############################################################################\r
5 # This program is free software; you can redistribute it and/or modify it     #\r
6 # under the terms of the GNU General Public License as published by the Free  #\r
7 # Software Foundation; either version 2 of the License, or (at your option)   #\r
8 # any later version.                                                          #\r
9 #                                                                             #\r
10 # This program is distributed in the hope that it will be useful, but WITHOUT #\r
11 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or       #\r
12 # FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for   #\r
13 # more details.                                                               #\r
14 #                                                                             #\r
15 # You should have received a copy of the GNU General Public License along     #\r
16 # with this program; if not, write to the Free Software Foundation, Inc., 51  #\r
17 # Franklin St, Fifth Floor, Boston, MA  02110-1301  USA                       #\r
18 ###############################################################################\r
19 \r
20 ###############################################################################\r
21 # $Id:: GD_SecurityImage.pm 301 2007-02-06 20:20:50Z ceetee                 $ #\r
22 ###############################################################################\r
23 \r
24 =head1 NAME\r
25 \r
26 Chirpy::UI::WebApp::Captcha::GD_SecurityImage - Captcha provider interface\r
27 using L<GD::SecurityImage>\r
28 \r
29 =head1 CONFIGURATION\r
30 \r
31 The following parameters from your configuration file affect the behavior of\r
32 this module. Please see L<GD::SecurityImage's documentation|GD::SecurityImage>\r
33 for a detailed explanation. Setting a value is optional for every parameter.\r
34 \r
35 =over 4\r
36 \r
37 =item webapp.gd_securityimage_width\r
38 \r
39 =item webapp.gd_securityimage_height\r
40 \r
41 =item webapp.gd_securityimage_ptsize\r
42 \r
43 =item webapp.gd_securityimage_lines\r
44 \r
45 =item webapp.gd_securityimage_font\r
46 \r
47 =item webapp.gd_securityimage_gd_font\r
48 \r
49 =item webapp.gd_securityimage_bgcolor\r
50 \r
51 =item webapp.gd_securityimage_send_ctobg\r
52 \r
53 =item webapp.gd_securityimage_frame\r
54 \r
55 =item webapp.gd_securityimage_scramble\r
56 \r
57 =item webapp.gd_securityimage_angle\r
58 \r
59 =item webapp.gd_securityimage_thickness\r
60 \r
61 =item webapp.gd_securityimage_rndmax\r
62 \r
63 =item webapp.gd_securityimage_rnd_data\r
64 \r
65 =item webapp.gd_securityimage_method\r
66 \r
67 =item webapp.gd_securityimage_style\r
68 \r
69 =item webapp.gd_securityimage_text_color\r
70 \r
71 =item webapp.gd_securityimage_line_color\r
72 \r
73 =item webapp.gd_securityimage_particle_density\r
74 \r
75 =item webapp.gd_securityimage_particle_maxdots\r
76 \r
77 =back\r
78 \r
79 The value for C<rnd_data> should simply be a sequence of characters to use.\r
80 Colors can only be passed as their hex values.\r
81 \r
82 =head1 NOTES\r
83 \r
84 This implementation is preliminary. You might have to set quite a few parameters\r
85 to get it in a usable state.\r
86 \r
87 If you have previously used C<Authen_Captcha> as a captcha provider, this module\r
88 should adapt its stored captcha information flawlessly. Therefore,\r
89 theoretically, you can switch back and forth between the two without any major\r
90 problems. \r
91 \r
92 =head1 AUTHOR\r
93 \r
94 Tim De Pauw E<lt>ceetee@users.sourceforge.netE<gt>\r
95 \r
96 =head1 SEE ALSO\r
97 \r
98 L<Chirpy::UI::WebApp::Captcha>, L<Chirpy>, L<http://chirpy.sourceforge.net/>\r
99 \r
100 =head1 COPYRIGHT\r
101 \r
102 Copyright 2005-2007 Tim De Pauw. All rights reserved.\r
103 \r
104 This program is free software; you can redistribute it and/or modify it under\r
105 the terms of the GNU General Public License as published by the Free Software\r
106 Foundation; either version 2 of the License, or (at your option) any later\r
107 version.\r
108 \r
109 This program is distributed in the hope that it will be useful, but WITHOUT ANY\r
110 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A\r
111 PARTICULAR PURPOSE.  See the GNU General Public License for more details.\r
112 \r
113 =cut\r
114 \r
115 package Chirpy::UI::WebApp::Captcha::GD_SecurityImage;\r
116 \r
117 use strict;\r
118 use warnings;\r
119 \r
120 use vars qw($VERSION @ISA);\r
121 \r
122 $VERSION = '0.3';\r
123 @ISA = qw(Chirpy::UI::WebApp::Captcha);\r
124 \r
125 use Chirpy 0.3;\r
126 use Chirpy::UI::WebApp::Captcha 0.3;\r
127 use GD::SecurityImage;\r
128 use Digest::MD5 qw(md5_hex);\r
129 \r
130 sub create {\r
131         my ($self, $expire) = @_;\r
132         my ($image, $hash) = $self->_generate();\r
133         $self->_write_img($hash, $image);\r
134         $self->_add_entry($hash, $expire);\r
135         my $url = $self->_img_url($hash);\r
136         my $width = $self->param('gd_securityimage_width');\r
137         my $height = $self->param('gd_securityimage_height');\r
138         return ($hash, $url, $width, $height);\r
139 }\r
140 \r
141 sub verify {\r
142         my ($self, $code) = @_;\r
143         my $hash = $self->hash();\r
144         return 0 unless (defined $hash);\r
145         return $self->_check_entry($hash, $code);\r
146 }\r
147 \r
148 sub _add_entry {\r
149         my ($self, $hash, $expire) = @_;\r
150         my ($list, $update) = $self->_get_list();\r
151         my $list_file = $self->_list_file();\r
152         local *LIST;\r
153         if ($update) {\r
154                 open(LIST, '>', $list_file)\r
155                         or Chirpy::die('Failed to open "' . $list . '" for writing: ' . $!);\r
156                 foreach my $line (@$list) {\r
157                         print LIST $line, $/;\r
158                 }\r
159         }\r
160         else {\r
161                 open(LIST, '>>', $list_file)\r
162                         or Chirpy::die('Failed to open "' . $list . '" for writing: ' . $!);\r
163         }\r
164         print LIST $expire, '::', $hash, $/;\r
165         close(LIST);\r
166 }\r
167 \r
168 sub _check_entry {\r
169         my ($self, $hash, $code) = @_;\r
170         my ($list, $update, $found) = $self->_get_list($hash);\r
171         $self->_write_list($list) if ($update);\r
172         return ($found && md5_hex($code) eq $hash);\r
173 }\r
174 \r
175 sub _get_list {\r
176         my ($self, $hash) = @_;\r
177         my $list_file = $self->_list_file();\r
178         return ([], 0, 0) unless (-f $list_file);\r
179         my @list = ();\r
180         my $update = 0;\r
181         my $found = 0;\r
182         my $now = time();\r
183         local *LIST;\r
184         open(LIST, '<', $list_file)\r
185                 or Chirpy::die('Failed to read from "' . $list_file . '": ' . $!);\r
186         while (<LIST>) {\r
187                 chomp;\r
188                 my ($exp, $h) = split /::/;\r
189                 if ($exp < $now) {\r
190                         $update = 1;\r
191                         unlink $self->_img_path($h);\r
192                 }\r
193                 elsif (defined $hash && $hash eq $h) {\r
194                         $found = 1;\r
195                         $update = 1;\r
196                         unlink $self->_img_path($h);\r
197                 }\r
198                 else {\r
199                         push @list, $_;\r
200                 }\r
201         }\r
202         close(LIST);\r
203         return (\@list, $update, $found);\r
204 }\r
205 \r
206 sub _write_list {\r
207         my ($self, $list) = @_;\r
208         my $list_file = $self->_list_file();\r
209         open(LIST, '>', $list_file)\r
210                 or Chirpy::die('Failed to open "' . $list_file . '" for writing: ' . $!);\r
211         foreach my $line (@$list) {\r
212                 print LIST $line, $/;\r
213         }\r
214         close LIST;\r
215 }\r
216 \r
217 sub _generate {\r
218         my $self = shift;\r
219         my $gdsi = $self->_gdsi();\r
220         my $method = $self->param('gd_securityimage_method');\r
221         my $style = $self->param('gd_securityimage_style');\r
222         my $text_color = $self->param('gd_securityimage_text_color');\r
223         my $line_color = $self->param('gd_securityimage_line_color');\r
224         my $density = $self->param('gd_securityimage_particle_density');\r
225         my $maxdots = $self->param('gd_securityimage_particle_maxdots');\r
226         my ($image, $type, $rnd) = $gdsi->random()\r
227                 ->create($method, $style, $text_color, $line_color)\r
228                 ->particle($density, $maxdots)\r
229                 ->out('force' => 'png', 'compress' => 1);\r
230         my $hash = md5_hex($rnd);\r
231         return ($image, $hash);\r
232 }\r
233 \r
234 sub _gdsi {\r
235         my $self = shift;\r
236         my @params = qw(width height ptsize lines font gd_font bgcolor send_ctobg\r
237                 frame scramble angle thickness rndmax);\r
238         my %config = ();\r
239         foreach my $param (@params) {\r
240                 my $value = $self->param('gd_securityimage_' . $param);\r
241                 $config{$param} = $value if (defined $value);\r
242         }\r
243         my $rnd_data = $self->param('gd_securityimage_rnd_data');\r
244         if (defined $rnd_data) {\r
245                 $config{'rnd_data'} = [ split(//, $rnd_data) ];\r
246         }\r
247         return new GD::SecurityImage(%config);\r
248 }\r
249 \r
250 sub _write_img {\r
251         my ($self, $hash, $image) = @_;\r
252         my $path = $self->_img_path($hash);\r
253         local *FILE;\r
254         open(FILE, '>', $path)\r
255                 or Chirpy::die('Failed to open "' . $path . '" for writing: ' . $!);\r
256         binmode FILE;\r
257         print FILE $image;\r
258         close FILE;\r
259 }\r
260 \r
261 sub _list_file {\r
262         my $self = shift;\r
263         return $self->data_path() . '/codes.txt';\r
264 }\r
265 \r
266 sub _img_path {\r
267         my ($self, $hash) = @_;\r
268         return $self->base_path() . '/' . $hash . '.png';\r
269 }\r
270 \r
271 sub _img_url {\r
272         my ($self, $hash) = @_;\r
273         return $self->base_url() . '/' . $hash . '.png';\r
274 }\r
275 \r
276 1;\r
277 \r
278 ###############################################################################