equal
deleted
inserted
replaced
3 # $URL$ |
3 # $URL$ |
4 |
4 |
5 use strict; |
5 use strict; |
6 use warnings; |
6 use warnings; |
7 use Carp; |
7 use Carp; |
|
8 use Fcntl qw(:flock); |
8 |
9 |
9 # You may choose, but DB_File's footprint is smaller. |
10 # You may choose, but DB_File's footprint is smaller. |
10 # perl -MDB_File -e 'tie %h, ...': real 0m0.063s |
11 # perl -MDB_File -e 'tie %h, ...': real 0m0.063s |
11 # perl -MBerkeleyDB -e 'tie %h, ...': real 0m0.112s |
12 # perl -MBerkeleyDB -e 'tie %h, ...': real 0m0.112s |
12 # And DB_File is part of the Perl core distribution (?) |
13 # And DB_File is part of the Perl core distribution (?) |
23 |
24 |
24 # some helper functions |
25 # some helper functions |
25 sub getDBDir(); |
26 sub getDBDir(); |
26 sub findExim(;$); |
27 sub findExim(;$); |
27 sub connectDB($$); |
28 sub connectDB($$); |
|
29 sub disconnectDB(); |
28 sub getDefault() { %DEFAULT }; |
30 sub getDefault() { %DEFAULT }; |
29 |
31 |
30 # Usage: |
32 # Usage: |
31 # ${perl{unseen}{$sender_host_address}} |
33 # ${perl{unseen}{$sender_host_address}} |
32 # ${perl{unseen}{$sender_host_address}{600}} |
34 # ${perl{unseen}{$sender_host_address}{600}} |
64 ++$count; |
66 ++$count; |
65 $h{$item} = "$created $now $count\0"; |
67 $h{$item} = "$created $now $count\0"; |
66 } |
68 } |
67 } |
69 } |
68 untie %h; |
70 untie %h; |
|
71 disconnectDB(); |
69 return $rc; |
72 return $rc; |
70 } |
73 } |
71 |
74 |
72 sub white($;$) { |
75 sub white($;$) { |
73 unseen($_[0], 0, defined $_[1] ? $_[1] : $DEFAULT{white}); |
76 unseen($_[0], 0, defined $_[1] ? $_[1] : $DEFAULT{white}); |
106 -x ($exim = "$_/exim4") and return $exim; |
109 -x ($exim = "$_/exim4") and return $exim; |
107 } |
110 } |
108 die "Can't find exim binary (missing .../sbin dirs in PATH?"; |
111 die "Can't find exim binary (missing .../sbin dirs in PATH?"; |
109 } |
112 } |
110 |
113 |
|
114 { |
|
115 my $fh; |
111 sub connectDB($$) { |
116 sub connectDB($$) { |
112 my ($h, $db) = @_; |
117 my ($h, $db) = @_; |
113 $db = getDBDir() ."/$db" unless $db =~ m(^\.?/); |
118 $db = getDBDir() ."/$db" unless $db =~ m(^\.?/); |
114 |
119 |
115 # Creation of DB-File if it doesn't exist |
120 # Creation of DB-File if it doesn't exist |
116 # to avoid races we change our own uid/gid for creation of |
121 # to avoid races we change our own uid/gid for creation of |
117 # this file |
122 # this file. |
118 if (!-f $db) { |
123 if (!-f $db) { |
119 (my $dir = $db) =~ s/^(.*)\/.*?$/$1/; |
124 (my $dir = $db) =~ s/^(.*)\/.*?$/$1/; |
120 |
125 |
121 # copy mode, uid, gid from the directory |
126 # copy mode, uid, gid from the directory |
122 my ($mode, $user, $group) = (stat $dir)[2,4,5] or die "Can't stat $dir: $!"; |
127 my ($mode, $user, $group) = (stat $dir)[2,4,5] or die "Can't stat $dir: $!"; |
125 local $> = $user; |
130 local $> = $user; |
126 open(X, ">>$db") or die "Can't create $db: $!"; |
131 open(X, ">>$db") or die "Can't create $db: $!"; |
127 close(X); |
132 close(X); |
128 umask $umask; |
133 umask $umask; |
129 } |
134 } |
|
135 |
|
136 # We try to open and lock the database file to avoid |
|
137 # a race. |
|
138 open($fh, $db) or die "Can't open $db: $!"; |
|
139 flock($fh, LOCK_EX) or die "Can't lock $db: $!"; |
130 |
140 |
131 # now test which of the DB-Modules has been loaded |
141 # now test which of the DB-Modules has been loaded |
132 |
142 |
133 if (exists &BerkeleyDB::Hash::TIEHASH) { |
143 if (exists &BerkeleyDB::Hash::TIEHASH) { |
134 no strict; |
144 no strict; |
145 return $db; |
155 return $db; |
146 } |
156 } |
147 |
157 |
148 die "Can't connect to database driver"; |
158 die "Can't connect to database driver"; |
149 } |
159 } |
|
160 |
|
161 sub disconnectDB() { |
|
162 close($fh); |
|
163 } } |
150 1; |
164 1; |
151 |
165 |
152 # vim:aw: |
166 # vim:aw: |