40 # |
41 # |
41 # dbm file is relativ to $spool_directory/grey, EXCEPT its name |
42 # dbm file is relativ to $spool_directory/grey, EXCEPT its name |
42 # starts with "./" or "/". |
43 # starts with "./" or "/". |
43 # |
44 # |
44 sub unseen($;$$) { |
45 sub unseen($;$$) { |
45 my ($item, $delay, $db) = @_; |
46 my ($item, $delay, $db) = @_; |
46 $item .= "\0"; |
47 $item .= "\0"; |
47 $delay = $DEFAULT{delay} unless defined $delay; |
48 $delay = $DEFAULT{delay} unless defined $delay; |
48 $db = $DEFAULT{db} unless defined $db; |
49 $db = $DEFAULT{db} unless defined $db; |
49 |
50 |
50 my $now = time(); |
51 my $now = time(); |
51 my $rc; |
52 my $rc; |
52 |
53 |
53 my %h; |
54 my %h; |
54 $db = connectDB(\%h, $db); |
55 $db = connectDB(\%h, $db); |
55 |
56 |
56 if (not exists $h{$item}) { |
57 if (not exists $h{$item}) { |
57 $h{$item} = "$now $now 0\0"; |
58 $h{$item} = "$now $now 0\0"; |
58 $rc = "yes"; |
59 $rc = "yes"; |
59 } |
60 } |
60 else { |
61 else { |
61 ($_ = $h{$item}) =~ s/\0*$//; # we're \0 terminated |
62 ($_ = $h{$item}) =~ s/\0*$//; # we're \0 terminated |
62 my ($created, $used, $count) = split; |
63 my ($created, $used, $count) = split; |
63 if ($now - $created < $delay) { $rc = "yes" } |
64 if ($now - $created < $delay) { $rc = "yes" } |
64 else { |
65 else { |
65 $rc = "no"; |
66 $rc = "no"; |
66 ++$count; |
67 ++$count; |
67 $h{$item} = "$created $now $count\0"; |
68 $h{$item} = "$created $now $count\0"; |
68 } |
69 } |
69 } |
70 } |
70 untie %h; |
71 untie %h; |
71 disconnectDB(); |
72 disconnectDB(); |
72 return $rc; |
73 return $rc; |
73 } |
74 } |
74 |
75 |
75 sub white($;$) { |
76 sub white($;$) { |
76 unseen($_[0], 0, defined $_[1] ? $_[1] : $DEFAULT{white}); |
77 unseen($_[0], 0, defined $_[1] ? $_[1] : $DEFAULT{white}); |
77 return "yes"; |
78 return "yes"; |
78 } |
79 } |
79 |
80 |
80 # Get the directory where we could store the database file(s) |
81 # Get the directory where we could store the database file(s) |
81 # If we're running under exim it's easy, otherwise we've to find exim |
82 # If we're running under exim it's easy, otherwise we've to find exim |
82 # and then ask... |
83 # and then ask... |
83 sub getDBDir() { |
84 sub getDBDir() { |
84 my ($spooldir, $dbdir); |
85 my ($spooldir, $dbdir); |
85 eval { $spooldir = Exim::expand_string('$spool_directory') }; |
86 eval { $spooldir = Exim::expand_string('$spool_directory') }; |
86 if (not defined $spooldir) { |
87 if (not defined $spooldir) { |
87 my $exim = findExim(); |
88 my $exim = findExim(); |
88 chomp($spooldir = `$exim -be '\$spool_directory'`); |
89 chomp($spooldir = `$exim -be '\$spool_directory'`); |
89 die "Can't find spooldir" if not defined $spooldir; |
90 die "Can't find spooldir" if not defined $spooldir; |
90 } |
91 } |
91 -d ($dbdir = "$spooldir/grey") and return $dbdir; |
92 -d ($dbdir = "$spooldir/grey") and return $dbdir; |
92 |
93 |
93 my ($mode, $owner, $group) = (stat $spooldir)[ 2, 4, 5 ]; |
94 my ($mode, $owner, $group) = (stat $spooldir)[ 2, 4, 5 ]; |
94 { |
95 { |
95 local $) = $group; |
96 local $) = $group; |
96 local $> = $owner; |
97 local $> = $owner; |
97 $mode &= 0777; |
98 $mode &= 0777; |
98 mkdir $dbdir, $mode or die "Can't create $dbdir: $!"; |
99 mkdir $dbdir, $mode or die "Can't create $dbdir: $!"; |
99 } |
100 } |
100 return $dbdir; |
101 return $dbdir; |
101 } |
102 } |
102 |
103 |
103 sub findExim(;$) { |
104 sub findExim(;$) { |
104 my $path = shift || $ENV{PATH}; |
105 my $path = shift || $ENV{PATH}; |
105 my $exim; |
106 my $exim; |
106 foreach (split /:/, $ENV{PATH}) { |
107 foreach (split /:/, $ENV{PATH}) { |
107 -x ($exim = "$_/exim") and return $exim; |
108 -x ($exim = "$_/exim") and return $exim; |
108 -x ($exim = "$_/exim4") and return $exim; |
109 -x ($exim = "$_/exim4") and return $exim; |
109 } |
110 } |
110 die "Can't find exim binary (missing .../sbin dirs in PATH?"; |
111 die "Can't find exim binary (missing .../sbin dirs in PATH?"; |
111 } |
112 } |
112 |
113 |
113 { |
114 { |
114 my $fh; |
115 my $fh; |
115 |
116 |
116 sub connectDB($$) { |
117 sub connectDB($$) { |
117 my ($h, $db) = @_; |
118 my ($h, $db) = @_; |
118 $db = getDBDir() . "/$db" unless $db =~ m(^\.?/); |
119 $db = getDBDir() . "/$db" unless $db =~ m(^\.?/); |
119 |
120 |
120 # Creation of DB-File if it doesn't exist |
121 # Creation of DB-File if it doesn't exist |
121 # to avoid races we change our own uid/gid for creation of |
122 # to avoid races we change our own uid/gid for creation of |
122 # this file. |
123 # this file. |
123 if (!-f $db) { |
124 if (!-f $db) { |
124 (my $dir = $db) =~ s/^(.*)\/.*?$/$1/; |
125 (my $dir = $db) =~ s/^(.*)\/.*?$/$1/; |
125 |
126 |
126 # copy mode, uid, gid from the directory |
127 # copy mode, uid, gid from the directory |
127 my ($mode, $user, $group) = (stat $dir)[ 2, 4, 5 ] |
128 my ($mode, $user, $group) = (stat $dir)[ 2, 4, 5 ] |
128 or die "Can't stat $dir: $!"; |
129 or die "Can't stat $dir: $!"; |
129 my $umask = umask(($mode & 0777) ^ 0777); |
130 my $umask = umask(($mode & 0777) ^ 0777); |
130 local $) = $group; |
131 local $) = $group; |
131 local $> = $user; |
132 local $> = $user; |
132 open(X, ">>$db") or die "Can't create $db: $!"; |
133 open(X, ">>$db") or die "Can't create $db: $!"; |
133 close(X); |
134 close(X); |
134 umask $umask; |
135 umask $umask; |
135 } |
136 } |
136 |
137 |
137 # We try to open and lock the database file to avoid |
138 # We try to open and lock the database file to avoid |
138 # a race. |
139 # a race. |
139 open($fh, $db) or die "Can't open $db: $!"; |
140 open($fh, $db) or die "Can't open $db: $!"; |
140 flock($fh, LOCK_EX) or die "Can't lock $db: $!"; |
141 flock($fh, LOCK_EX) or die "Can't lock $db: $!"; |
141 |
142 |
142 # now test which of the DB-Modules has been loaded |
143 # now test which of the DB-Modules has been loaded |
143 |
144 |
144 if (exists &BerkeleyDB::Hash::TIEHASH) { |
145 if (exists &BerkeleyDB::Hash::TIEHASH) { |
145 no strict; |
146 no strict; |
146 my $umask = umask 077; |
147 my $umask = umask 077; |
147 tie %$h, "BerkeleyDB::Hash", -Filename => $db |
148 tie %$h, "BerkeleyDB::Hash", -Filename => $db |
148 or die "$0: $db: $!"; |
149 or die "$0: $db: $!"; |
149 return $db; |
150 return $db; |
150 } |
151 } |
151 |
152 |
152 if (exists &DB_File::TIEHASH) { |
153 if (exists &DB_File::TIEHASH) { |
153 tie %$h, "DB_File", $db |
154 tie %$h, "DB_File", $db |
154 or die "$0: $db: $!"; |
155 or die "$0: $db: $!"; |
155 return $db; |
156 return $db; |
156 } |
157 } |
157 |
158 |
158 die "Can't connect to database driver"; |
159 die "Can't connect to database driver"; |
159 } |
160 } |
160 |
161 |
161 sub disconnectDB() { |
162 sub disconnectDB() { |
162 close($fh); |
163 close($fh); |
163 } |
164 } |
164 } |
165 } |
165 0; |
166 0; |
166 |
167 |
167 # vim:aw: |
168 # vim:aw: |