← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Tue Nov 7 05:38:10 2017
Reported on Tue Nov 7 06:16:05 2017

Filename/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/Plugin/ImageInfo.pm
StatementsExecuted 30 statements in 4.57ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
111154µs365µsMail::SpamAssassin::Plugin::ImageInfo::::newMail::SpamAssassin::Plugin::ImageInfo::new
11150µs50µsMail::SpamAssassin::Plugin::ImageInfo::::BEGIN@83Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@83
11138µs70µsMail::SpamAssassin::Plugin::ImageInfo::::BEGIN@86Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@86
11133µs123µsMail::SpamAssassin::Plugin::ImageInfo::::BEGIN@88Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@88
11129µs36µsMail::SpamAssassin::Plugin::ImageInfo::::BEGIN@85Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@85
11123µs189µsMail::SpamAssassin::Plugin::ImageInfo::::BEGIN@84Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@84
11121µs26µsMail::SpamAssassin::Plugin::ImageInfo::::BEGIN@87Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@87
11120µs95µsMail::SpamAssassin::Plugin::ImageInfo::::BEGIN@90Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@90
0000s0sMail::SpamAssassin::Plugin::ImageInfo::::__ANON__[:141]Mail::SpamAssassin::Plugin::ImageInfo::__ANON__[:141]
0000s0sMail::SpamAssassin::Plugin::ImageInfo::::__ANON__[:179]Mail::SpamAssassin::Plugin::ImageInfo::__ANON__[:179]
0000s0sMail::SpamAssassin::Plugin::ImageInfo::::__ANON__[:216]Mail::SpamAssassin::Plugin::ImageInfo::__ANON__[:216]
0000s0sMail::SpamAssassin::Plugin::ImageInfo::::_get_imagesMail::SpamAssassin::Plugin::ImageInfo::_get_images
0000s0sMail::SpamAssassin::Plugin::ImageInfo::::image_countMail::SpamAssassin::Plugin::ImageInfo::image_count
0000s0sMail::SpamAssassin::Plugin::ImageInfo::::image_name_regexMail::SpamAssassin::Plugin::ImageInfo::image_name_regex
0000s0sMail::SpamAssassin::Plugin::ImageInfo::::image_namedMail::SpamAssassin::Plugin::ImageInfo::image_named
0000s0sMail::SpamAssassin::Plugin::ImageInfo::::image_size_exactMail::SpamAssassin::Plugin::ImageInfo::image_size_exact
0000s0sMail::SpamAssassin::Plugin::ImageInfo::::image_size_rangeMail::SpamAssassin::Plugin::ImageInfo::image_size_range
0000s0sMail::SpamAssassin::Plugin::ImageInfo::::image_to_text_ratioMail::SpamAssassin::Plugin::ImageInfo::image_to_text_ratio
0000s0sMail::SpamAssassin::Plugin::ImageInfo::::pixel_coverageMail::SpamAssassin::Plugin::ImageInfo::pixel_coverage
0000s0sMail::SpamAssassin::Plugin::ImageInfo::::result_checkMail::SpamAssassin::Plugin::ImageInfo::result_check
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# <@LICENSE>
2# Licensed to the Apache Software Foundation (ASF) under one or more
3# contributor license agreements. See the NOTICE file distributed with
4# this work for additional information regarding copyright ownership.
5# The ASF licenses this file to you under the Apache License, Version 2.0
6# (the "License"); you may not use this file except in compliance with
7# the License. You may obtain a copy of the License at:
8#
9# http://www.apache.org/licenses/LICENSE-2.0
10#
11# Unless required by applicable law or agreed to in writing, software
12# distributed under the License is distributed on an "AS IS" BASIS,
13# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
14# See the License for the specific language governing permissions and
15# limitations under the License.
16# </@LICENSE>
17#
18# -------------------------------------------------------
19# ImageInfo Plugin for SpamAssassin
20# Version: 0.7
21# Created: 2006-08-02
22# Modified: 2007-01-17
23#
24# Changes:
25# 0.7 - added image_name_regex to allow pattern matching on the image name
26# - added support for image/pjpeg content types (progressive jpeg)
27# - updated imageinfo.cf with a few sample rules for using image_name_regex()
28# 0.6 - fixed dems_ bug in image_size_range_
29# 0.5 - added image_named and image_to_text_ratio
30# 0.4 - added image_size_exact and image_size_range
31# 0.3 - added jpeg support
32# 0.2 - optimized by theo
33# 0.1 - added gif/png support
34#
35#
36# Usage:
37# image_count()
38#
39# body RULENAME eval:image_count(<type>,<min>,[max])
40# type: 'all','gif','png', or 'jpeg'
41# min: required, message contains at least this
42# many images
43# max: optional, if specified, message must not
44# contain more than this number of images
45#
46# image_count() examples
47#
48# body ONE_IMAGE eval:image_count('all',1,1)
49# body ONE_OR_MORE_IMAGES eval:image_count('all',1)
50# body ONE_PNG eval:image_count('png',1,1)
51# body TWO_GIFS eval:image_count('gif',2,2)
52# body MANY_JPEGS eval:image_count('gif',5)
53#
54# pixel_coverage()
55#
56# body RULENAME eval:pixel_coverage(<type>,<min>,[max])
57# type: 'all','gif','png', or 'jpeg'
58# min: required, message contains at least this
59# much pixel area
60# max: optional, if specified, message must not
61# contain more than this much pixel area
62#
63# pixel_coverage() examples
64#
65# body LARGE_IMAGE_AREA eval:pixel_coverage('all',150000) # catches any images that are 150k pixel/sq or higher
66# body SMALL_GIF_AREA eval:pixel_coverage('gif',1,40000) # catches only gifs that 1 to 40k pixel/sql
67#
68# image_name_regex()
69#
70# body RULENAME eval:image_name_regex(<regex>)
71# regex: full quoted regexp, see examples below
72#
73# image_name_regex() examples
74#
75# body CG_DOUBLEDOT_GIF eval:image_name_regex('/^\w{2,9}\.\.gif$/i') # catches double dot gifs abcd..gif
76#
77#
78#
79# -------------------------------------------------------
80
81package Mail::SpamAssassin::Plugin::ImageInfo;
82
83271µs150µs
# spent 50µs within Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@83 which was called: # once (50µs+0s) by Mail::SpamAssassin::PluginHandler::load_plugin at line 83
use Mail::SpamAssassin::Plugin;
# spent 50µs making 1 call to Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@83
84265µs2355µs
# spent 189µs (23+166) within Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@84 which was called: # once (23µs+166µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 84
use Mail::SpamAssassin::Logger;
# spent 189µs making 1 call to Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@84 # spent 166µs making 1 call to Exporter::import
85275µs244µs
# spent 36µs (29+8) within Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@85 which was called: # once (29µs+8µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 85
use strict;
# spent 36µs making 1 call to Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@85 # spent 8µs making 1 call to strict::import
86272µs2102µs
# spent 70µs (38+32) within Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@86 which was called: # once (38µs+32µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 86
use warnings;
# spent 70µs making 1 call to Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@86 # spent 32µs making 1 call to warnings::import
87289µs231µs
# spent 26µs (21+5) within Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@87 which was called: # once (21µs+5µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 87
use bytes;
# spent 26µs making 1 call to Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@87 # spent 5µs making 1 call to bytes::import
88265µs2213µs
# spent 123µs (33+90) within Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@88 which was called: # once (33µs+90µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 88
use re 'taint';
# spent 123µs making 1 call to Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@88 # spent 90µs making 1 call to re::import
89
9023.99ms2170µs
# spent 95µs (20+75) within Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@90 which was called: # once (20µs+75µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 90
use vars qw(@ISA);
# spent 95µs making 1 call to Mail::SpamAssassin::Plugin::ImageInfo::BEGIN@90 # spent 75µs making 1 call to vars::import
91113µs@ISA = qw(Mail::SpamAssassin::Plugin);
92
93# constructor: register the eval rule
94
# spent 365µs (154+210) within Mail::SpamAssassin::Plugin::ImageInfo::new which was called: # once (154µs+210µs) by Mail::SpamAssassin::PluginHandler::load_plugin at line 1 of (eval 109)[Mail/SpamAssassin/PluginHandler.pm:129]
sub new {
9512µs my $class = shift;
9612µs my $mailsaobject = shift;
97
98 # some boilerplate...
9912µs $class = ref($class) || $class;
100121µs128µs my $self = $class->SUPER::new($mailsaobject);
# spent 28µs making 1 call to Mail::SpamAssassin::Plugin::new
10112µs bless ($self, $class);
102
103110µs131µs $self->register_eval_rule ("image_count");
# spent 31µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
10416µs119µs $self->register_eval_rule ("pixel_coverage");
# spent 19µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
10516µs128µs $self->register_eval_rule ("image_size_exact");
# spent 28µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
10616µs126µs $self->register_eval_rule ("image_size_range");
# spent 26µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
10716µs124µs $self->register_eval_rule ("image_named");
# spent 24µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
10816µs127µs $self->register_eval_rule ("image_name_regex");
# spent 27µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
10915µs128µs $self->register_eval_rule ("image_to_text_ratio");
# spent 28µs making 1 call to Mail::SpamAssassin::Plugin::register_eval_rule
110
111118µs return $self;
112}
113
114# -----------------------------------------
115
116my %get_details = (
117 'gif' => sub {
118 my ($pms, $part) = @_;
119 my $header = $part->decode(13);
120
121 # make sure this is actually a valid gif..
122 return unless $header =~ s/^GIF(8[79]a)//;
123 my $version = $1;
124
125 my ($width, $height, $packed, $bgcolor, $aspect) = unpack("vvCCC", $header);
126 my $color_table_size = 1 << (($packed & 0x07) + 1);
127
128 # for future enhancements
129 #my $global_color_table = $packed & 0x80;
130 #my $has_global_color_table = $global_color_table ? 1 : 0;
131 #my $sorted_colors = ($packed & 0x08)?1:0;
132 #my $resolution = ((($packed & 0x70) >> 4) + 1);
133
134 if ($height && $width) {
135 my $area = $width * $height;
136 $pms->{imageinfo}->{pc_gif} += $area;
137 $pms->{imageinfo}->{dems_gif}->{"${height}x${width}"} = 1;
138 $pms->{imageinfo}->{names_all}->{$part->{'name'}} = 1 if $part->{'name'};
139 dbg("imageinfo: gif image ".($part->{'name'} ? $part->{'name'} : '')." is $height x $width pixels ($area pixels sq.), with $color_table_size color table");
140 }
141 },
142
143 'png' => sub {
144 my ($pms, $part) = @_;
145 my $data = $part->decode();
146
147 return unless (substr($data, 0, 8) eq "\x89PNG\x0d\x0a\x1a\x0a");
148
149 my $datalen = length $data;
150 my $pos = 8;
151 my $chunksize = 8;
152 my ($width, $height) = ( 0, 0 );
153 my ($depth, $ctype, $compression, $filter, $interlace);
154
155 while ($pos < $datalen) {
156 my ($len, $type) = unpack("Na4", substr($data, $pos, $chunksize));
157 $pos += $chunksize;
158
159 last if $type eq "IEND"; # end of png image.
160
161 next unless ( $type eq "IHDR" && $len == 13 );
162
163 my $bytes = substr($data, $pos, $len + 4);
164 my $crc = unpack("N", substr($bytes, -4, 4, ""));
165
166 if ($type eq "IHDR" && $len == 13) {
167 ($width, $height, $depth, $ctype, $compression, $filter, $interlace) = unpack("NNCCCCC", $bytes);
168 last;
169 }
170 }
171
172 if ($height && $width) {
173 my $area = $width * $height;
174 $pms->{imageinfo}->{pc_png} += $area;
175 $pms->{imageinfo}->{dems_png}->{"${height}x${width}"} = 1;
176 $pms->{imageinfo}->{names_all}->{$part->{'name'}} = 1 if $part->{'name'};
177 dbg("imageinfo: png image ".($part->{'name'} ? $part->{'name'} : '')." is $height x $width pixels ($area pixels sq.)");
178 }
179 },
180
181 'jpeg' => sub {
182 my ($pms, $part) = @_;
183
184 my $data = $part->decode();
185
186 my $index = substr($data, 0, 2);
187 return unless $index eq "\xFF\xD8";
188
189 my $pos = 2;
190 my $chunksize = 4;
191 my ($prec, $height, $width, $comps) = (undef,0,0,undef);
192 while (1) {
193 my ($xx, $mark, $len) = unpack("CCn", substr($data, $pos, $chunksize));
194 last if (!defined $xx || $xx != 0xFF);
195 last if (!defined $mark || $mark == 0xDA || $mark == 0xD9);
196 last if (!defined $len || $len < 2);
197 $pos += $chunksize;
198 my $block = substr($data, $pos, $len - 2);
199 my $blocklen = length($block);
200 if ( ($mark >= 0xC0 && $mark <= 0xC3) || ($mark >= 0xC5 && $mark <= 0xC7) ||
201 ($mark >= 0xC9 && $mark <= 0xCB) || ($mark >= 0xCD && $mark <= 0xCF) ) {
202 ($prec, $height, $width, $comps) = unpack("CnnC", substr($block, 0, 6, ""));
203 last;
204 }
205 $pos += $blocklen;
206 }
207
208 if ($height && $width) {
209 my $area = $height * $width;
210 $pms->{imageinfo}->{pc_jpeg} += $area;
211 $pms->{imageinfo}->{dems_jpeg}->{"${height}x${width}"} = 1;
212 $pms->{imageinfo}->{names_all}->{$part->{'name'}} = 1 if $part->{'name'};
213 dbg("imageinfo: jpeg image ".($part->{'name'} ? $part->{'name'} : '')." is $height x $width pixels ($area pixels sq.)");
214 }
215
216 },
217
218127µs);
219
220sub _get_images {
221 my ($self,$pms) = @_;
222 my $result = 0;
223
224 foreach my $type ( 'all', keys %get_details ) {
225 $pms->{'imageinfo'}->{"pc_$type"} = 0;
226 $pms->{'imageinfo'}->{"count_$type"} = 0;
227 }
228
229 foreach my $p ($pms->{msg}->find_parts(qr@^image/(?:gif|png|jpeg)$@, 1)) {
230 # make sure its base64 encoded
231 my $cte = lc($p->get_header('content-transfer-encoding') || '');
232 next if ($cte !~ /^base64$/);
233
234 my ($type) = $p->{'type'} =~ m@/(\w+)$@;
235 if ($type && exists $get_details{$type}) {
236 $get_details{$type}->($pms,$p);
237 $pms->{'imageinfo'}->{"count_$type"} ++;
238 }
239 }
240
241 foreach my $name ( keys %{$pms->{'imageinfo'}->{"names_all"}} ) {
242 dbg("imageinfo: image name $name found");
243 }
244
245 foreach my $type ( keys %get_details ) {
246 $pms->{'imageinfo'}->{'pc_all'} += $pms->{'imageinfo'}->{"pc_$type"};
247 $pms->{'imageinfo'}->{'count_all'} += $pms->{'imageinfo'}->{"count_$type"};
248 foreach my $dem ( keys %{$pms->{'imageinfo'}->{"dems_$type"}} ) {
249 dbg("imageinfo: adding $dem to dems_all");
250 $pms->{'imageinfo'}->{'dems_all'}->{$dem} = 1;
251 }
252 }
253}
254
255# -----------------------------------------
256
257sub image_named {
258 my ($self,$pms,$body,$name) = @_;
259 return unless (defined $name);
260
261 # make sure we have image data read in.
262 if (!exists $pms->{'imageinfo'}) {
263 $self->_get_images($pms);
264 }
265
266 return 0 unless (exists $pms->{'imageinfo'}->{"names_all"});
267 return 1 if (exists $pms->{'imageinfo'}->{"names_all"}->{$name});
268 return 0;
269}
270
271# -----------------------------------------
272
273sub image_name_regex {
274 my ($self,$pms,$body,$re) = @_;
275 return unless (defined $re);
276
277 # make sure we have image data read in.
278 if (!exists $pms->{'imageinfo'}) {
279 $self->_get_images($pms);
280 }
281
282 return 0 unless (exists $pms->{'imageinfo'}->{"names_all"});
283
284 my $hit = 0;
285 foreach my $name (keys %{$pms->{'imageinfo'}->{"names_all"}}) {
286 dbg("imageinfo: checking image named $name against regex $re");
287 if (eval { $name =~ /$re/ }) { $hit = 1 }
288 dbg("imageinfo: error in regex /$re/ - $@") if $@;
289 if ($hit) {
290 dbg("imageinfo: image_name_regex hit on $name");
291 return 1;
292 }
293 }
294 return 0;
295
296}
297
298# -----------------------------------------
299
300sub image_count {
301 my ($self,$pms,$body,$type,$min,$max) = @_;
302
303 return unless defined $min;
304
305 # make sure we have image data read in.
306 if (!exists $pms->{'imageinfo'}) {
307 $self->_get_images($pms);
308 }
309
310 # dbg("imageinfo: count: $min, ".($max ? $max:'').", $type, ".$pms->{'imageinfo'}->{"count_$type"});
311 return result_check($min, $max, $pms->{'imageinfo'}->{"count_$type"});
312}
313
314# -----------------------------------------
315
316sub pixel_coverage {
317 my ($self,$pms,$body,$type,$min,$max) = @_;
318
319 return unless (defined $type && defined $min);
320
321 # make sure we have image data read in.
322 if (!exists $pms->{'imageinfo'}) {
323 $self->_get_images($pms);
324 }
325
326 # dbg("imageinfo: pc_$type: $min, ".($max ? $max:'').", $type, ".$pms->{'imageinfo'}->{"pc_$type"});
327 return result_check($min, $max, $pms->{'imageinfo'}->{"pc_$type"});
328}
329
330# -----------------------------------------
331
332sub image_to_text_ratio {
333 my ($self,$pms,$body,$type,$min,$max) = @_;
334 return unless (defined $type && defined $min && defined $max);
335
336 # make sure we have image data read in.
337 if (!exists $pms->{'imageinfo'}) {
338 $self->_get_images($pms);
339 }
340
341 # depending on how you call this eval (body vs rawbody),
342 # the $textlen will differ.
343 my $textlen = length(join('',@$body));
344
345 return 0 unless ( $textlen > 0 && exists $pms->{'imageinfo'}->{"pc_$type"} && $pms->{'imageinfo'}->{"pc_$type"} > 0);
346
347 my $ratio = $textlen / $pms->{'imageinfo'}->{"pc_$type"};
348 dbg("imageinfo: image ratio=$ratio, min=$min max=$max");
349 return result_check($min, $max, $ratio, 1);
350}
351
352# -----------------------------------------
353
354sub image_size_exact {
355 my ($self,$pms,$body,$type,$height,$width) = @_;
356 return unless (defined $type && defined $height && defined $width);
357
358 # make sure we have image data read in.
359 if (!exists $pms->{'imageinfo'}) {
360 $self->_get_images($pms);
361 }
362
363 return 0 unless (exists $pms->{'imageinfo'}->{"dems_$type"});
364 return 1 if (exists $pms->{'imageinfo'}->{"dems_$type"}->{"${height}x${width}"});
365 return 0;
366}
367
368# -----------------------------------------
369
370sub image_size_range {
371 my ($self,$pms,$body,$type,$minh,$minw,$maxh,$maxw) = @_;
372 return unless (defined $type && defined $minh && defined $minw);
373
374 # make sure we have image data read in.
375 if (!exists $pms->{'imageinfo'}) {
376 $self->_get_images($pms);
377 }
378
379 my $name = 'dems_'.$type;
380 return unless (exists $pms->{'imageinfo'}->{$name});
381
382 foreach my $dem ( keys %{$pms->{'imageinfo'}->{"dems_$type"}}) {
383 my ($h,$w) = split(/x/,$dem);
384 next if ($h < $minh); # height less than min height
385 next if ($w < $minw); # width less than min width
386 next if (defined $maxh && $h > $maxh); # height more than max height
387 next if (defined $maxw && $w > $maxw); # width more than max width
388
389 # if we make it here, we have a match
390 return 1;
391 }
392
393 return 0;
394}
395
396# -----------------------------------------
397
398sub result_check {
399 my ($min, $max, $value, $nomaxequal) = @_;
400 return 0 unless defined $value;
401 return 0 if ($value < $min);
402 return 0 if (defined $max && $value > $max);
403 return 0 if (defined $nomaxequal && $nomaxequal && $value == $max);
404 return 1;
405}
406
407# -----------------------------------------
408
409112µs1;
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.