File Coverage

blib/lib/Mail/MtPolicyd/Request.pm
Criterion Covered Total %
statement 40 71 56.3
branch 15 32 46.8
condition 10 24 41.6
subroutine 7 9 77.7
pod 6 6 100.0
total 78 142 54.9


line stmt bran cond sub pod time code
1             package Mail::MtPolicyd::Request;
2              
3 21     21   1051573 use Moose;
  21         4779306  
  21         127  
4 21     21   107241 use namespace::autoclean;
  21         102935  
  21         77  
5              
6 21     21   8487 use Mail::MtPolicyd::Plugin::Result;
  21         63  
  21         14729  
7              
8             our $VERSION = '2.01'; # VERSION
9             # ABSTRACT: the request object
10              
11              
12             has 'attributes' => (
13             is => 'ro', isa => 'HashRef', required => 1,
14             traits => [ 'Hash' ],
15             handles => { 'attr' => 'get' },
16             );
17              
18              
19             # gets attached later
20             has 'session' => ( is => 'rw', isa => 'Maybe[HashRef]' );
21              
22              
23             has 'server' => (
24             is => 'ro', isa => 'Net::Server', required => 1,
25             handles => {
26             'log' => 'log',
27             }
28             );
29              
30              
31             has 'type' => (
32             is => 'ro',
33             isa => 'Str',
34             lazy => 1,
35             default => sub {
36             my $self = shift;
37             return( $self->attr('request') );
38             }
39             );
40              
41              
42             has 'use_caching' => ( is => 'rw', isa => 'Bool', default => 1 );
43              
44              
45             sub dump_attr {
46 0     0 1 0 my $self = shift;
47 0         0 my $attr = $self->attributes;
48 0         0 return( join(', ', map { $_.'='.$attr->{$_} } keys %$attr ) );
  0         0  
49             }
50              
51              
52             sub get {
53 11     11 1 16 my ( $self, $value ) = @_;
54 11         10 my ($scope, $name);
55              
56 11 50 33     51 if( ! defined $value || $value eq '' ) { return; }
  0         0  
57              
58 11         27 my @params = split(':', $value, 2);
59 11 100       23 if( scalar(@params) == 2 ) {
    50          
60 10         14 ( $scope, $name ) = @params;
61             } elsif( scalar(@params) == 1) {
62 1         2 ( $scope, $name ) = ( 'request', @params );
63             }
64              
65 11 100 100     60 if( $scope eq 'session' || $scope eq 's' ) {
    50 66        
66 6 50       152 if( ! defined $self->session ) {
67 0         0 return;
68             }
69 6         131 return $self->session->{$name};
70             } elsif( $scope eq 'request' || $scope eq 'r' ) {
71 5         167 return $self->attr( $name );
72             }
73              
74 0         0 die("unknown scope $scope while retrieving variable for $value");
75              
76 0         0 return;
77             }
78              
79              
80             sub new_from_fh {
81 0     0 1 0 my ( $class, $fh ) = ( shift, shift );
82 0         0 my $attr = {};
83 0         0 my $complete = 0;
84 0         0 my $line;
85 0         0 while( defined( $line = $fh->getline ) ) {
86 0         0 $line =~ s/\r?\n$//;
87 0 0       0 if( $line eq '') { $complete = 1 ; last; }
  0         0  
  0         0  
88 0         0 my ( $name, $value ) = split('=', $line, 2);
89 0 0       0 if( ! defined $value ) {
90 0         0 die('error parsing request');
91             }
92 0         0 $attr->{$name} = $value;
93             }
94 0 0       0 if( $fh->error ) {
95 0         0 die('while reading request: '.$fh->error);
96             }
97 0 0 0     0 if( ! defined $line && ! $complete ) {
98 0         0 die('connection closed by peer');
99             }
100 0 0       0 if( ! $complete ) {
101 0         0 die('could not parse request');
102             }
103 0         0 my $obj = $class->new(
104             'attributes' => $attr,
105             @_
106             );
107 0         0 return $obj;
108             }
109              
110              
111             sub do_cached {
112 17     17 1 26 my ( $self, $key, $call ) = @_;
113 17         471 my $session = $self->session;
114              
115             # we cant cache a result without session
116 17 100 33     510 if( ! defined $session || ! $self->use_caching ) {
117 16         39 return( $call->() );
118             }
119 1 50       5 if( ! defined $session->{$key} ) {
120 1         3 $session->{$key} = [ $call->() ];
121             }
122 1         26428 return( @{$session->{$key}} );
  1         6  
123             }
124              
125              
126             sub is_already_done {
127 47     47 1 66 my ( $self, $key ) = @_;
128 47         1116 my $session = $self->session;
129              
130             # we cant cache a result without session
131 47 100 33     1261 if( ! defined $session || ! $self->use_caching ) {
132 44         150 return 0;
133             }
134 3 50       10 if( defined $session->{$key} ) {
135 0         0 return(1);
136             }
137 3         7 $session->{$key} = 1;
138 3         42 return 0;
139             }
140              
141              
142             sub is_attr_defined {
143 6     6 1 11 my ( $self, @fields ) = @_;
144 6         162 my $a = $self->attributes;
145              
146 6         11 foreach my $field ( @fields ) {
147 6 50 33     56 if( ! defined $a->{$field}
      33        
148             || $a->{$field} eq ''
149             || $a->{$field} =~ /^\s+$/ ) {
150 0         0 return 0;
151             }
152             }
153              
154 6         70 return 1;
155             }
156              
157             __PACKAGE__->meta->make_immutable;
158              
159             1;
160              
161             __END__
162              
163             =pod
164              
165             =encoding UTF-8
166              
167             =head1 NAME
168              
169             Mail::MtPolicyd::Request - the request object
170              
171             =head1 VERSION
172              
173             version 2.01
174              
175             =head1 ATTRIBUTES
176              
177             =head2 attributes
178              
179             Contains an HashRef with all attributes of the request.
180              
181             To retrieve a single attribute the attr method could be used:
182              
183             $obj->attr('sender');
184              
185             =head2 session
186              
187             Contains a HashRef with all values stored in the session.
188              
189             mtpolicyd will persist the content of this HashRef across requests with the same instance_id.
190              
191             =head2 server
192              
193             Contains the Net::Server object of mtpolicyd.
194              
195             =head2 type
196              
197             The type of the request. Postfix will always use 'smtpd_access_policy'.
198              
199             =head2 use_caching
200              
201             Could be used to disable caching. Only used within the unit tests.
202              
203             =head1 METHODS
204              
205             =head2 dump_attr
206              
207             Returns an string to dump the content of a request.
208              
209             =head2 get($variable_name)
210              
211             Retrieve value of a session or request variable.
212              
213             The format for the variable name is
214              
215             (<scope>:)?<variable>
216              
217             If no scope is given it default to the request scope.
218              
219             Valid scopes are:
220              
221             =over
222              
223             =item session, s
224              
225             Session variables.
226              
227             =item request, r
228              
229             Request attributes.
230              
231             =back
232              
233             For example:
234              
235             $r->get('request:sender'); # retrieve sender from request
236             $r->get('r:sender'); # short format
237             $r->get('sender'); # scope defaults to request
238              
239             $r->get('session:user_policy'); # retrieve session variable user_policy
240             $r->get('s:user_policy'); # the same
241              
242             =head2 new_from_fh($fh)
243              
244             An object constructor for creating an request object with the content read
245             for the supplied filehandle $fh.
246              
247             Will die if am error ocours:
248              
249             =over
250              
251             =item error parsing request
252              
253             A line in the request could not be parsed.
254              
255             =item while reading request: <io-error>
256              
257             The filehandle had an error while reading the request.
258              
259             =item connection closed by peer
260              
261             Connection has been closed while reading the request.
262              
263             =item could not parse request
264              
265             The client did not send a complete request.
266              
267             =back
268              
269             =head2 do_cached( $key, $sub )
270              
271             This method will execute the function reference give in $sub and store
272             the return values in $key within the session.
273             If there is already a cached result stored within $key of the session
274             it will return the content instead of calling the reference again.
275              
276             Returns an Array with the return values of the function call.
277              
278             Example:
279              
280             my ( $ip_result, $info ) = $r->do_cached('rbl-'.$self->name.'-result',
281             sub { $self->_rbl->check( $ip ) } );
282              
283             =head2 is_already_done( $key )
284              
285             This function will raise an flag with name of $key within the session and return true if the
286             flag is already set. False otherwise.
287              
288             This could be used to prevent scores or headers from being applied a second time.
289              
290             Example:
291              
292             if( defined $self->score && ! $r->is_already_done('rbl-'.$self->name.'-score') ) {
293             $self->add_score($r, $self->name => $self->score);
294             }
295              
296             =head2 is_attr_defined
297              
298             Returns true if all given attribute names are defined and non-empty.
299              
300             =head1 AUTHOR
301              
302             Markus Benning <ich@markusbenning.de>
303              
304             =head1 COPYRIGHT AND LICENSE
305              
306             This software is Copyright (c) 2014 by Markus Benning <ich@markusbenning.de>.
307              
308             This is free software, licensed under:
309              
310             The GNU General Public License, Version 2, June 1991
311              
312             =cut