27 sub getDefault() { %DEFAULT }; |
27 sub getDefault() { %DEFAULT }; |
28 |
28 |
29 # Usage: |
29 # Usage: |
30 # ${perl{unseen}{$sender_host_address}} |
30 # ${perl{unseen}{$sender_host_address}} |
31 # ${perl{unseen}{$sender_host_address}{600}} |
31 # ${perl{unseen}{$sender_host_address}{600}} |
32 # ${perl{unseen}{$sender_host_address}{600}{seen.db}} |
32 # ${perl{unseen}{$sender_host_address}{600}{seen}} |
33 # ${perl{unseen}{$sender_host_address}{600}{/some/dir/seen.db}} |
33 # ${perl{unseen}{$sender_host_address}{600}{$spool_directory/grey/seen}} |
34 # |
34 # |
35 # record structure: key: item\0 |
35 # record structure: key: item\0 |
36 # value: timestamp(creation) timestamp(usage)\0 |
36 # value: timestamp(creation) timestamp(usage)\0 |
37 # (This way we're compatible with ${lookup{...}dbm{...}}) |
37 # (This way we're compatible with ${lookup{...}dbm{...}}) |
38 sub unseen($;$$) { |
38 sub unseen($;$$) { |
64 |
64 |
65 # Get the directory where we could store the database file(s) |
65 # Get the directory where we could store the database file(s) |
66 # If we're running under exim it's easy, otherwise we've to find exim |
66 # If we're running under exim it's easy, otherwise we've to find exim |
67 # and then ask... |
67 # and then ask... |
68 sub getDBDir() { |
68 sub getDBDir() { |
69 my $spooldir; |
69 my ($spooldir, $dbdir); |
70 eval { $spooldir = Exim::expand_string('$spool_directory') }; |
70 eval { $spooldir = Exim::expand_string('$spool_directory') }; |
71 if (not defined $spooldir) { |
71 if (not defined $spooldir) { |
72 my $exim = findExim(); |
72 my $exim = findExim(); |
73 chomp($spooldir = `$exim -be '\$spool_directory'`); |
73 chomp($spooldir = `$exim -be '\$spool_directory'`); |
74 die "Can't find spooldir" if not defined $spooldir; |
74 die "Can't find spooldir" if not defined $spooldir; |
75 } |
75 } |
76 return "$spooldir/db"; |
76 -d ($dbdir = "$spooldir/grey") and return $dbdir; |
|
77 |
|
78 my ($mode, $owner, $group) = (stat $spooldir)[2,4,5]; |
|
79 { |
|
80 local $) = $group; |
|
81 local $> = $owner; |
|
82 $mode &= 0777; |
|
83 mkdir $dbdir, $mode or die "Can't create $dbdir: $!"; |
|
84 } |
|
85 return $dbdir; |
77 } |
86 } |
78 |
87 |
79 sub findExim(;$) { |
88 sub findExim(;$) { |
80 my $path = shift || $ENV{PATH}; |
89 my $path = shift || $ENV{PATH}; |
81 my $exim; |
90 my $exim; |
88 |
97 |
89 sub connectDB($$) { |
98 sub connectDB($$) { |
90 my ($h, $db) = @_; |
99 my ($h, $db) = @_; |
91 $db = getDBDir() ."/$db" unless $db =~ /^\//; |
100 $db = getDBDir() ."/$db" unless $db =~ /^\//; |
92 |
101 |
|
102 # Creation of DB-File if it doesn't exist |
|
103 # to avoid races we change our own uid/gid for creation of |
|
104 # this file |
|
105 if (!-f $db) { |
|
106 (my $dir = $db) =~ s/^(.*)\/.*?$/$1/; |
|
107 local ($>, $)) = (stat $dir)[4,5] or die "Can't stat $dir: $!"; |
|
108 open(X, ">>$db") or die "Can't create $db: $!"; |
|
109 close(X); |
|
110 } |
|
111 |
|
112 # now test which of the DB-Modules has been loaded |
|
113 |
93 if (exists &BerkeleyDB::Hash::TIEHASH) { |
114 if (exists &BerkeleyDB::Hash::TIEHASH) { |
94 no strict; |
115 no strict; |
95 my $umask = umask 077; |
116 my $umask = umask 077; |
96 tie %$h, "BerkeleyDB::Hash", |
117 tie %$h, "BerkeleyDB::Hash", |
97 -Filename => $db, |
118 -Filename => $db |
98 -Flags => DB_CREATE |
|
99 or die "$0: $db: $!"; |
119 or die "$0: $db: $!"; |
100 return $db; |
120 return $db; |
101 } |
121 } |
102 |
122 |
103 if (exists &DB_File::TIEHASH) { |
123 if (exists &DB_File::TIEHASH) { |
104 tie %$h, "DB_File", $db, undef, 0600 |
124 tie %$h, "DB_File", $db |
105 or die "$0: $db: $!"; |
125 or die "$0: $db: $!"; |
106 return $db; |
126 return $db; |
107 } |
127 } |
108 |
128 |
109 die "Can't connect to database driver"; |
129 die "Can't connect to database driver"; |