equal
deleted
inserted
replaced
53 # |
53 # |
54 # dbm file is relativ to $spool_directory/grey, EXCEPT its name |
54 # dbm file is relativ to $spool_directory/grey, EXCEPT its name |
55 # starts with "./" or "/". |
55 # starts with "./" or "/". |
56 |
56 |
57 sub unseen { |
57 sub unseen { |
58 my $item = shift; |
58 my $item = shift; |
59 my $delay = shift // $DEFAULT{delay}; |
59 my $delay = shift // $DEFAULT{delay}; |
60 my $db = shift // $DEFAULT{db}; |
60 my $db = shift // $DEFAULT{db}; |
61 my $now = time(); |
61 my $now = time(); |
62 my ($auto) = $item =~ /.*?\/(.+?)$/; |
62 my ($auto) = $item =~ /.*?\/(.+?)$/; |
63 my $rc; |
63 my $rc; |
64 |
64 |
65 connectDB(\my %h, $db); |
65 connectDB(\my %h, $db); |
66 |
66 |
67 return 'no' # not unseen, ergo known |
67 return 'no' # not unseen, ergo known |
68 if defined $auto and is_whitelisted($auto, \%h); |
68 if defined $auto and is_whitelisted($auto, \%h); |
69 |
69 |
70 my $key = "$item\0"; |
70 my $key = "$item\0"; |
71 |
71 |
72 # we do not know anything about the client -> unknown |
72 # we do not know anything about the client -> unknown |
73 if (not exists $h{$key}) { |
73 if (not exists $h{$key}) { |
76 } |
76 } |
77 |
77 |
78 my ($created, undef, $count) = split /[ \0]/, $h{$key}; |
78 my ($created, undef, $count) = split /[ \0]/, $h{$key}; |
79 |
79 |
80 # we know the client, but last contact was recently (too fast) |
80 # we know the client, but last contact was recently (too fast) |
81 if ($now - $created < $delay) { |
81 if ($now - $created < $delay) { |
82 return 'yes'; |
82 return 'yes'; |
83 } |
83 } |
84 |
84 |
85 # we know the client, was patiently enough |
85 # we know the client, was patiently enough |
86 ++$count; |
86 ++$count; |
88 whitelist($auto, \%h) if defined $auto; |
88 whitelist($auto, \%h) if defined $auto; |
89 return 'no'; |
89 return 'no'; |
90 } |
90 } |
91 |
91 |
92 # According to a thought from "David Woodhouse <dwmw2@infradead.org>" |
92 # According to a thought from "David Woodhouse <dwmw2@infradead.org>" |
93 # on exim-users@exim.org (Thu, 08 May 2008 13:10:21 +0100, |
93 # on exim-users@exim.org (Thu, 08 May 2008 13:10:21 +0100, |
94 # Message-Id: <1210248621.25560.1088.camel@pmac.infradead.org>) we |
94 # Message-Id: <1210248621.25560.1088.camel@pmac.infradead.org>) we |
95 # should have the ability to "auto whitelist" hosts which are known |
95 # should have the ability to "auto whitelist" hosts which are known |
96 # for retries, because there is no benefit in greylisting them. |
96 # for retries, because there is no benefit in greylisting them. |
97 # |
97 # |
98 # Most safe approach would be something based on message id. |
98 # Most safe approach would be something based on message id. |
114 sub is_whitelisted { |
114 sub is_whitelisted { |
115 my ($item, $h) = @_; |
115 my ($item, $h) = @_; |
116 my $key = "$item\0"; |
116 my $key = "$item\0"; |
117 |
117 |
118 return 0 if not exists $h->{$key}; |
118 return 0 if not exists $h->{$key}; |
119 |
119 |
120 my ($t0, undef, $cnt, $flag) = split /[ \0]/, $h->{$key}; |
120 my ($t0, undef, $cnt, $flag) = split /[ \0]/, $h->{$key}; |
121 $h->{$key} = join(' ' => $t0, time, ++$cnt, $flag ? $flag : ()) . "\0"; |
121 $h->{$key} = join(' ' => $t0, time, ++$cnt, $flag ? $flag : ()) . "\0"; |
122 |
122 |
123 return 1; |
123 return 1; |
124 } |
124 } |
134 chomp($spooldir = `$exim -be '\$spool_directory'`); |
134 chomp($spooldir = `$exim -be '\$spool_directory'`); |
135 die "Can't find spooldir" if not defined $spooldir; |
135 die "Can't find spooldir" if not defined $spooldir; |
136 } |
136 } |
137 -d ($dbdir = "$spooldir/grey") and return $dbdir; |
137 -d ($dbdir = "$spooldir/grey") and return $dbdir; |
138 |
138 |
139 my ($mode, $owner, $group) = (stat $spooldir)[ 2, 4, 5 ]; |
139 my ($mode, $owner, $group) = (stat $spooldir)[2, 4, 5]; |
140 { |
140 { |
141 local $) = $group; |
141 local $) = $group; |
142 local $> = $owner; |
142 local $> = $owner; |
143 $mode &= 0777; |
143 $mode &= 0777; |
144 mkdir $dbdir, $mode or die "Can't create $dbdir: $!"; |
144 mkdir $dbdir, $mode or die "Can't create $dbdir: $!"; |
165 # this file. |
165 # this file. |
166 if (!-f $db) { |
166 if (!-f $db) { |
167 (my $dir = $db) =~ s/^(.*)\/.*?$/$1/; |
167 (my $dir = $db) =~ s/^(.*)\/.*?$/$1/; |
168 |
168 |
169 # copy mode, uid, gid from the directory |
169 # copy mode, uid, gid from the directory |
170 my ($mode, $user, $group) = (stat $dir)[ 2, 4, 5 ] |
170 my ($mode, $user, $group) = (stat $dir)[2, 4, 5] |
171 or die "Can't stat $dir: $!"; |
171 or die "Can't stat $dir: $!"; |
172 my $umask = umask(($mode & 0777) ^ 0777); |
172 my $umask = umask(($mode & 0777) ^ 0777); |
173 local $) = $group; |
173 local $) = $group; |
174 local $> = $user; |
174 local $> = $user; |
175 open(X, ">>$db") or die "Can't create $db: $!"; |
175 open(X, ">>$db") or die "Can't create $db: $!"; |
186 or die "$0: $db: $!"; |
186 or die "$0: $db: $!"; |
187 return $db; |
187 return $db; |
188 } |
188 } |
189 |
189 |
190 if (exists &DB_File::Lock::TIEHASH) { |
190 if (exists &DB_File::Lock::TIEHASH) { |
191 tie %$h, 'DB_File::Lock', [ $db ], 'write' |
191 tie %$h, 'DB_File::Lock', [$db], 'write' |
192 or die "$0: $db: $!"; |
192 or die "$0: $db: $!"; |
193 return $db; |
193 return $db; |
194 } |
194 } |
195 |
195 |
196 if (exists &DB_File::TIEHASH) { |
196 if (exists &DB_File::TIEHASH) { |