| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package Mail::MtPolicyd::Request; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 21 |  |  | 21 |  | 1664305 | use Moose; | 
|  | 21 |  |  |  |  | 7299734 |  | 
|  | 21 |  |  |  |  | 151 |  | 
| 4 | 21 |  |  | 21 |  | 162029 | use namespace::autoclean; | 
|  | 21 |  |  |  |  | 160870 |  | 
|  | 21 |  |  |  |  | 111 |  | 
| 5 |  |  |  |  |  |  |  | 
| 6 | 21 |  |  | 21 |  | 13908 | use Mail::MtPolicyd::Plugin::Result; | 
|  | 21 |  |  |  |  | 82 |  | 
|  | 21 |  |  |  |  | 17704 |  | 
| 7 |  |  |  |  |  |  |  | 
| 8 |  |  |  |  |  |  | our $VERSION = '1.23'; # 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 new_from_fh { | 
| 53 | 0 |  |  | 0 | 1 | 0 | my ( $class, $fh ) = ( shift, shift ); | 
| 54 | 0 |  |  |  |  | 0 | my $attr = {}; | 
| 55 | 0 |  |  |  |  | 0 | my $complete = 0; | 
| 56 | 0 |  |  |  |  | 0 | my $line; | 
| 57 | 0 |  |  |  |  | 0 | while( defined( $line = $fh->getline ) ) { | 
| 58 | 0 |  |  |  |  | 0 | $line =~ s/\r?\n$//; | 
| 59 | 0 | 0 |  |  |  | 0 | if( $line eq '') { $complete = 1 ; last; } | 
|  | 0 |  |  |  |  | 0 |  | 
|  | 0 |  |  |  |  | 0 |  | 
| 60 | 0 |  |  |  |  | 0 | my ( $name, $value ) = split('=', $line, 2); | 
| 61 | 0 | 0 |  |  |  | 0 | if( ! defined $value ) { | 
| 62 | 0 |  |  |  |  | 0 | die('error parsing request'); | 
| 63 |  |  |  |  |  |  | } | 
| 64 | 0 |  |  |  |  | 0 | $attr->{$name} = $value; | 
| 65 |  |  |  |  |  |  | } | 
| 66 | 0 | 0 |  |  |  | 0 | if( $fh->error ) { | 
| 67 | 0 |  |  |  |  | 0 | die('while reading request: '.$fh->error); | 
| 68 |  |  |  |  |  |  | } | 
| 69 | 0 | 0 | 0 |  |  | 0 | if( ! defined $line && ! $complete ) { | 
| 70 | 0 |  |  |  |  | 0 | die('connection closed by peer'); | 
| 71 |  |  |  |  |  |  | } | 
| 72 | 0 | 0 |  |  |  | 0 | if( ! $complete ) { | 
| 73 | 0 |  |  |  |  | 0 | die('could not parse request'); | 
| 74 |  |  |  |  |  |  | } | 
| 75 | 0 |  |  |  |  | 0 | my $obj = $class->new( | 
| 76 |  |  |  |  |  |  | 'attributes' => $attr, | 
| 77 |  |  |  |  |  |  | @_ | 
| 78 |  |  |  |  |  |  | ); | 
| 79 | 0 |  |  |  |  | 0 | return $obj; | 
| 80 |  |  |  |  |  |  | } | 
| 81 |  |  |  |  |  |  |  | 
| 82 |  |  |  |  |  |  |  | 
| 83 |  |  |  |  |  |  | sub do_cached { | 
| 84 | 17 |  |  | 17 | 1 | 95 | my ( $self, $key, $call ) = @_; | 
| 85 | 17 |  |  |  |  | 700 | my $session = $self->session; | 
| 86 |  |  |  |  |  |  |  | 
| 87 |  |  |  |  |  |  | # we cant cache a result without session | 
| 88 | 17 | 100 | 33 |  |  | 761 | if( ! defined $session || ! $self->use_caching ) { | 
| 89 | 16 |  |  |  |  | 55 | return( $call->() ); | 
| 90 |  |  |  |  |  |  | } | 
| 91 | 1 | 50 |  |  |  | 7 | if( ! defined $session->{$key} ) { | 
| 92 | 1 |  |  |  |  | 4 | $session->{$key} = [ $call->() ]; | 
| 93 |  |  |  |  |  |  | } | 
| 94 | 1 |  |  |  |  | 53082 | return( @{$session->{$key}} ); | 
|  | 1 |  |  |  |  | 11 |  | 
| 95 |  |  |  |  |  |  | } | 
| 96 |  |  |  |  |  |  |  | 
| 97 |  |  |  |  |  |  |  | 
| 98 |  |  |  |  |  |  | sub is_already_done { | 
| 99 | 47 |  |  | 47 | 1 | 100 | my ( $self, $key ) = @_; | 
| 100 | 47 |  |  |  |  | 1924 | my $session = $self->session; | 
| 101 |  |  |  |  |  |  |  | 
| 102 |  |  |  |  |  |  | # we cant cache a result without session | 
| 103 | 47 | 100 | 33 |  |  | 2094 | if( ! defined $session || ! $self->use_caching ) { | 
| 104 | 44 |  |  |  |  | 221 | return 0; | 
| 105 |  |  |  |  |  |  | } | 
| 106 | 3 | 50 |  |  |  | 19 | if( defined $session->{$key} ) { | 
| 107 | 0 |  |  |  |  | 0 | return(1); | 
| 108 |  |  |  |  |  |  | } | 
| 109 | 3 |  |  |  |  | 11 | $session->{$key} = 1; | 
| 110 | 3 |  |  |  |  | 67 | return 0; | 
| 111 |  |  |  |  |  |  | } | 
| 112 |  |  |  |  |  |  |  | 
| 113 |  |  |  |  |  |  |  | 
| 114 |  |  |  |  |  |  | sub is_attr_defined { | 
| 115 | 6 |  |  | 6 | 1 | 24 | my ( $self, @fields ) = @_; | 
| 116 | 6 |  |  |  |  | 315 | my $a = $self->attributes; | 
| 117 |  |  |  |  |  |  |  | 
| 118 | 6 |  |  |  |  | 19 | foreach my $field ( @fields ) { | 
| 119 | 6 | 50 | 33 |  |  | 84 | if( ! defined $a->{$field} | 
|  |  |  | 33 |  |  |  |  | 
| 120 |  |  |  |  |  |  | || $a->{$field} eq '' | 
| 121 |  |  |  |  |  |  | || $a->{$field} =~ /^\s+$/ ) { | 
| 122 | 0 |  |  |  |  | 0 | return 0; | 
| 123 |  |  |  |  |  |  | } | 
| 124 |  |  |  |  |  |  | } | 
| 125 |  |  |  |  |  |  |  | 
| 126 | 6 |  |  |  |  | 110 | return 1; | 
| 127 |  |  |  |  |  |  | } | 
| 128 |  |  |  |  |  |  |  | 
| 129 |  |  |  |  |  |  | __PACKAGE__->meta->make_immutable; | 
| 130 |  |  |  |  |  |  |  | 
| 131 |  |  |  |  |  |  | 1; | 
| 132 |  |  |  |  |  |  |  | 
| 133 |  |  |  |  |  |  | __END__ | 
| 134 |  |  |  |  |  |  |  | 
| 135 |  |  |  |  |  |  | =pod | 
| 136 |  |  |  |  |  |  |  | 
| 137 |  |  |  |  |  |  | =encoding UTF-8 | 
| 138 |  |  |  |  |  |  |  | 
| 139 |  |  |  |  |  |  | =head1 NAME | 
| 140 |  |  |  |  |  |  |  | 
| 141 |  |  |  |  |  |  | Mail::MtPolicyd::Request - the request object | 
| 142 |  |  |  |  |  |  |  | 
| 143 |  |  |  |  |  |  | =head1 VERSION | 
| 144 |  |  |  |  |  |  |  | 
| 145 |  |  |  |  |  |  | version 1.23 | 
| 146 |  |  |  |  |  |  |  | 
| 147 |  |  |  |  |  |  | =head1 ATTRIBUTES | 
| 148 |  |  |  |  |  |  |  | 
| 149 |  |  |  |  |  |  | =head2 attributes | 
| 150 |  |  |  |  |  |  |  | 
| 151 |  |  |  |  |  |  | Contains an HashRef with all attributes of the request. | 
| 152 |  |  |  |  |  |  |  | 
| 153 |  |  |  |  |  |  | To retrieve a single attribute the attr method could be used: | 
| 154 |  |  |  |  |  |  |  | 
| 155 |  |  |  |  |  |  | $obj->attr('sender'); | 
| 156 |  |  |  |  |  |  |  | 
| 157 |  |  |  |  |  |  | =head2 session | 
| 158 |  |  |  |  |  |  |  | 
| 159 |  |  |  |  |  |  | Contains a HashRef with all values stored in the session. | 
| 160 |  |  |  |  |  |  |  | 
| 161 |  |  |  |  |  |  | mtpolicyd will persist the content of this HashRef across requests with the same instance_id. | 
| 162 |  |  |  |  |  |  |  | 
| 163 |  |  |  |  |  |  | =head2 server | 
| 164 |  |  |  |  |  |  |  | 
| 165 |  |  |  |  |  |  | Contains the Net::Server object of mtpolicyd. | 
| 166 |  |  |  |  |  |  |  | 
| 167 |  |  |  |  |  |  | =head2 type | 
| 168 |  |  |  |  |  |  |  | 
| 169 |  |  |  |  |  |  | The type of the request. Postfix will always use 'smtpd_access_policy'. | 
| 170 |  |  |  |  |  |  |  | 
| 171 |  |  |  |  |  |  | =head2 use_caching | 
| 172 |  |  |  |  |  |  |  | 
| 173 |  |  |  |  |  |  | Could be used to disable caching. Only used within the unit tests. | 
| 174 |  |  |  |  |  |  |  | 
| 175 |  |  |  |  |  |  | =head1 METHODS | 
| 176 |  |  |  |  |  |  |  | 
| 177 |  |  |  |  |  |  | =head2 dump_attr | 
| 178 |  |  |  |  |  |  |  | 
| 179 |  |  |  |  |  |  | Returns an string to dump the content of a request. | 
| 180 |  |  |  |  |  |  |  | 
| 181 |  |  |  |  |  |  | =head2 new_from_fh($fh) | 
| 182 |  |  |  |  |  |  |  | 
| 183 |  |  |  |  |  |  | An object constructor for creating an request object with the content read | 
| 184 |  |  |  |  |  |  | for the supplied filehandle $fh. | 
| 185 |  |  |  |  |  |  |  | 
| 186 |  |  |  |  |  |  | Will die if am error ocours: | 
| 187 |  |  |  |  |  |  |  | 
| 188 |  |  |  |  |  |  | =over | 
| 189 |  |  |  |  |  |  |  | 
| 190 |  |  |  |  |  |  | =item error parsing request | 
| 191 |  |  |  |  |  |  |  | 
| 192 |  |  |  |  |  |  | A line in the request could not be parsed. | 
| 193 |  |  |  |  |  |  |  | 
| 194 |  |  |  |  |  |  | =item while reading request: <io-error> | 
| 195 |  |  |  |  |  |  |  | 
| 196 |  |  |  |  |  |  | The filehandle had an error while reading the request. | 
| 197 |  |  |  |  |  |  |  | 
| 198 |  |  |  |  |  |  | =item connection closed by peer | 
| 199 |  |  |  |  |  |  |  | 
| 200 |  |  |  |  |  |  | Connection has been closed while reading the request. | 
| 201 |  |  |  |  |  |  |  | 
| 202 |  |  |  |  |  |  | =item could not parse request | 
| 203 |  |  |  |  |  |  |  | 
| 204 |  |  |  |  |  |  | The client did not send a complete request. | 
| 205 |  |  |  |  |  |  |  | 
| 206 |  |  |  |  |  |  | =back | 
| 207 |  |  |  |  |  |  |  | 
| 208 |  |  |  |  |  |  | =head2 do_cached( $key, $sub ) | 
| 209 |  |  |  |  |  |  |  | 
| 210 |  |  |  |  |  |  | This method will execute the function reference give in $sub and store | 
| 211 |  |  |  |  |  |  | the return values in $key within the session. | 
| 212 |  |  |  |  |  |  | If there is already a cached result stored within $key of the session | 
| 213 |  |  |  |  |  |  | it will return the content instead of calling the reference again. | 
| 214 |  |  |  |  |  |  |  | 
| 215 |  |  |  |  |  |  | Returns an Array with the return values of the function call. | 
| 216 |  |  |  |  |  |  |  | 
| 217 |  |  |  |  |  |  | Example: | 
| 218 |  |  |  |  |  |  |  | 
| 219 |  |  |  |  |  |  | my ( $ip_result, $info ) = $r->do_cached('rbl-'.$self->name.'-result', | 
| 220 |  |  |  |  |  |  | sub { $self->_rbl->check( $ip ) } ); | 
| 221 |  |  |  |  |  |  |  | 
| 222 |  |  |  |  |  |  | =head2 is_already_done( $key ) | 
| 223 |  |  |  |  |  |  |  | 
| 224 |  |  |  |  |  |  | This function will raise an flag with name of $key within the session and return true if the | 
| 225 |  |  |  |  |  |  | flag is already set. False otherwise. | 
| 226 |  |  |  |  |  |  |  | 
| 227 |  |  |  |  |  |  | This could be used to prevent scores or headers from being applied a second time. | 
| 228 |  |  |  |  |  |  |  | 
| 229 |  |  |  |  |  |  | Example: | 
| 230 |  |  |  |  |  |  |  | 
| 231 |  |  |  |  |  |  | if( defined $self->score && ! $r->is_already_done('rbl-'.$self->name.'-score') ) { | 
| 232 |  |  |  |  |  |  | $self->add_score($r, $self->name => $self->score); | 
| 233 |  |  |  |  |  |  | } | 
| 234 |  |  |  |  |  |  |  | 
| 235 |  |  |  |  |  |  | =head2 is_attr_defined | 
| 236 |  |  |  |  |  |  |  | 
| 237 |  |  |  |  |  |  | Returns true if all given attribute names are defined and non-empty. | 
| 238 |  |  |  |  |  |  |  | 
| 239 |  |  |  |  |  |  | =head1 AUTHOR | 
| 240 |  |  |  |  |  |  |  | 
| 241 |  |  |  |  |  |  | Markus Benning <ich@markusbenning.de> | 
| 242 |  |  |  |  |  |  |  | 
| 243 |  |  |  |  |  |  | =head1 COPYRIGHT AND LICENSE | 
| 244 |  |  |  |  |  |  |  | 
| 245 |  |  |  |  |  |  | This software is Copyright (c) 2014 by Markus Benning <ich@markusbenning.de>. | 
| 246 |  |  |  |  |  |  |  | 
| 247 |  |  |  |  |  |  | This is free software, licensed under: | 
| 248 |  |  |  |  |  |  |  | 
| 249 |  |  |  |  |  |  | The GNU General Public License, Version 2, June 1991 | 
| 250 |  |  |  |  |  |  |  | 
| 251 |  |  |  |  |  |  | =cut |