← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Sun Nov 5 02:36:06 2017
Reported on Sun Nov 5 02:56:23 2017

Filename/usr/local/lib/perl5/site_perl/Mail/SpamAssassin/BayesStore/DBM.pm
StatementsExecuted 434235 statements in 5.30s
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
234112.27s3.49sMail::SpamAssassin::BayesStore::DBM::::multi_tok_count_changeMail::SpamAssassin::BayesStore::DBM::multi_tok_count_change
74192311.04s1.04sMail::SpamAssassin::BayesStore::DBM::::defer_updateMail::SpamAssassin::BayesStore::DBM::defer_update
7372411186ms186msMail::SpamAssassin::BayesStore::DBM::::CORE:unpackMail::SpamAssassin::BayesStore::DBM::CORE:unpack (opcode)
1282211130ms130msMail::SpamAssassin::BayesStore::DBM::::get_magic_reMail::SpamAssassin::BayesStore::DBM::get_magic_re
23421111ms192msMail::SpamAssassin::BayesStore::DBM::::get_storage_variablesMail::SpamAssassin::BayesStore::DBM::get_storage_variables
2352178.6ms1.58sMail::SpamAssassin::BayesStore::DBM::::tie_db_readonlyMail::SpamAssassin::BayesStore::DBM::tie_db_readonly
2341140.3ms40.3msMail::SpamAssassin::BayesStore::DBM::::CORE:openMail::SpamAssassin::BayesStore::DBM::CORE:open (opcode)
2341127.3ms104msMail::SpamAssassin::BayesStore::DBM::::cleanupMail::SpamAssassin::BayesStore::DBM::cleanup
2341118.9ms18.9msMail::SpamAssassin::BayesStore::DBM::::CORE:syswriteMail::SpamAssassin::BayesStore::DBM::CORE:syswrite (opcode)
2392112.5ms12.5msMail::SpamAssassin::BayesStore::DBM::::CORE:ftfileMail::SpamAssassin::BayesStore::DBM::CORE:ftfile (opcode)
4581110.8ms31.2msMail::SpamAssassin::BayesStore::DBM::::seen_getMail::SpamAssassin::BayesStore::DBM::seen_get
234117.41ms11.2msMail::SpamAssassin::BayesStore::DBM::::seen_putMail::SpamAssassin::BayesStore::DBM::seen_put
234116.64ms9.65msMail::SpamAssassin::BayesStore::DBM::::nspam_nham_changeMail::SpamAssassin::BayesStore::DBM::nspam_nham_change
234116.50ms11.5msMail::SpamAssassin::BayesStore::DBM::::_get_journal_filenameMail::SpamAssassin::BayesStore::DBM::_get_journal_filename
1115.12ms5.48msMail::SpamAssassin::BayesStore::DBM::::BEGIN@38Mail::SpamAssassin::BayesStore::DBM::BEGIN@38
233115.01ms7.35msMail::SpamAssassin::BayesStore::DBM::::_check_db_versionMail::SpamAssassin::BayesStore::DBM::_check_db_version
1281214.12ms4.12msMail::SpamAssassin::BayesStore::DBM::::CORE:matchMail::SpamAssassin::BayesStore::DBM::CORE:match (opcode)
470313.75ms3.75msMail::SpamAssassin::BayesStore::DBM::::DBM_MODULEMail::SpamAssassin::BayesStore::DBM::DBM_MODULE
236213.38ms3.38msMail::SpamAssassin::BayesStore::DBM::::HAS_DBM_MODULEMail::SpamAssassin::BayesStore::DBM::HAS_DBM_MODULE
234113.17ms3.17msMail::SpamAssassin::BayesStore::DBM::::CORE:closeMail::SpamAssassin::BayesStore::DBM::CORE:close (opcode)
470411.65ms1.65msMail::SpamAssassin::BayesStore::DBM::::CORE:umaskMail::SpamAssassin::BayesStore::DBM::CORE:umask (opcode)
236211.58ms1.58msMail::SpamAssassin::BayesStore::DBM::::DB_EXTENSIONSMail::SpamAssassin::BayesStore::DBM::DB_EXTENSIONS
23411852µs852µsMail::SpamAssassin::BayesStore::DBM::::CORE:tellMail::SpamAssassin::BayesStore::DBM::CORE:tell (opcode)
111534µs4.45msMail::SpamAssassin::BayesStore::DBM::::tie_db_writableMail::SpamAssassin::BayesStore::DBM::tie_db_writable
111184µs1.24msMail::SpamAssassin::BayesStore::DBM::::untie_dbMail::SpamAssassin::BayesStore::DBM::untie_db
11155µs68µsMail::SpamAssassin::BayesStore::DBM::::BEGIN@20Mail::SpamAssassin::BayesStore::DBM::BEGIN@20
11154µs74µsMail::SpamAssassin::BayesStore::DBM::::newMail::SpamAssassin::BayesStore::DBM::new
11142µs221µsMail::SpamAssassin::BayesStore::DBM::::BEGIN@1450Mail::SpamAssassin::BayesStore::DBM::BEGIN@1450
11138µs240µsMail::SpamAssassin::BayesStore::DBM::::BEGIN@41Mail::SpamAssassin::BayesStore::DBM::BEGIN@41
11130µs113µsMail::SpamAssassin::BayesStore::DBM::::BEGIN@31Mail::SpamAssassin::BayesStore::DBM::BEGIN@31
11128µs226µsMail::SpamAssassin::BayesStore::DBM::::BEGIN@1895Mail::SpamAssassin::BayesStore::DBM::BEGIN@1895
11127µs151µsMail::SpamAssassin::BayesStore::DBM::::BEGIN@1899Mail::SpamAssassin::BayesStore::DBM::BEGIN@1899
11127µs1.50msMail::SpamAssassin::BayesStore::DBM::::BEGIN@25Mail::SpamAssassin::BayesStore::DBM::BEGIN@25
11126µs546µsMail::SpamAssassin::BayesStore::DBM::::BEGIN@43Mail::SpamAssassin::BayesStore::DBM::BEGIN@43
11126µs176µsMail::SpamAssassin::BayesStore::DBM::::BEGIN@27Mail::SpamAssassin::BayesStore::DBM::BEGIN@27
11125µs65µsMail::SpamAssassin::BayesStore::DBM::::BEGIN@21Mail::SpamAssassin::BayesStore::DBM::BEGIN@21
11125µs157µsMail::SpamAssassin::BayesStore::DBM::::BEGIN@39Mail::SpamAssassin::BayesStore::DBM::BEGIN@39
11124µs31µsMail::SpamAssassin::BayesStore::DBM::::BEGIN@22Mail::SpamAssassin::BayesStore::DBM::BEGIN@22
11124µs128µsMail::SpamAssassin::BayesStore::DBM::::BEGIN@29Mail::SpamAssassin::BayesStore::DBM::BEGIN@29
11123µs89µsMail::SpamAssassin::BayesStore::DBM::::BEGIN@23Mail::SpamAssassin::BayesStore::DBM::BEGIN@23
11123µs130µsMail::SpamAssassin::BayesStore::DBM::::BEGIN@37Mail::SpamAssassin::BayesStore::DBM::BEGIN@37
11122µs109µsMail::SpamAssassin::BayesStore::DBM::::BEGIN@26Mail::SpamAssassin::BayesStore::DBM::BEGIN@26
11119µs19µsMail::SpamAssassin::BayesStore::DBM::::CORE:ftdirMail::SpamAssassin::BayesStore::DBM::CORE:ftdir (opcode)
11119µs145µsMail::SpamAssassin::BayesStore::DBM::::BEGIN@1896Mail::SpamAssassin::BayesStore::DBM::BEGIN@1896
11119µs153µsMail::SpamAssassin::BayesStore::DBM::::BEGIN@1897Mail::SpamAssassin::BayesStore::DBM::BEGIN@1897
11118µs140µsMail::SpamAssassin::BayesStore::DBM::::BEGIN@1900Mail::SpamAssassin::BayesStore::DBM::BEGIN@1900
11117µs17µsMail::SpamAssassin::BayesStore::DBM::::BEGIN@28Mail::SpamAssassin::BayesStore::DBM::BEGIN@28
11115µs15µsMail::SpamAssassin::BayesStore::DBM::::BEGIN@36Mail::SpamAssassin::BayesStore::DBM::BEGIN@36
11113µs13µsMail::SpamAssassin::BayesStore::DBM::::db_readableMail::SpamAssassin::BayesStore::DBM::db_readable
1116µs6µsMail::SpamAssassin::BayesStore::DBM::::CORE:qrMail::SpamAssassin::BayesStore::DBM::CORE:qr (opcode)
0000s0sMail::SpamAssassin::BayesStore::DBM::::_rename_fileMail::SpamAssassin::BayesStore::DBM::_rename_file
0000s0sMail::SpamAssassin::BayesStore::DBM::::_seen_delete_directMail::SpamAssassin::BayesStore::DBM::_seen_delete_direct
0000s0sMail::SpamAssassin::BayesStore::DBM::::_seen_put_directMail::SpamAssassin::BayesStore::DBM::_seen_put_direct
0000s0sMail::SpamAssassin::BayesStore::DBM::::_sync_journalMail::SpamAssassin::BayesStore::DBM::_sync_journal
0000s0sMail::SpamAssassin::BayesStore::DBM::::_sync_journal_trappedMail::SpamAssassin::BayesStore::DBM::_sync_journal_trapped
0000s0sMail::SpamAssassin::BayesStore::DBM::::_unlink_fileMail::SpamAssassin::BayesStore::DBM::_unlink_file
0000s0sMail::SpamAssassin::BayesStore::DBM::::_upgrade_dbMail::SpamAssassin::BayesStore::DBM::_upgrade_db
0000s0sMail::SpamAssassin::BayesStore::DBM::::backup_databaseMail::SpamAssassin::BayesStore::DBM::backup_database
0000s0sMail::SpamAssassin::BayesStore::DBM::::calculate_expire_deltaMail::SpamAssassin::BayesStore::DBM::calculate_expire_delta
0000s0sMail::SpamAssassin::BayesStore::DBM::::clear_databaseMail::SpamAssassin::BayesStore::DBM::clear_database
0000s0sMail::SpamAssassin::BayesStore::DBM::::db_writableMail::SpamAssassin::BayesStore::DBM::db_writable
0000s0sMail::SpamAssassin::BayesStore::DBM::::dump_db_toksMail::SpamAssassin::BayesStore::DBM::dump_db_toks
0000s0sMail::SpamAssassin::BayesStore::DBM::::get_running_expire_tokMail::SpamAssassin::BayesStore::DBM::get_running_expire_tok
0000s0sMail::SpamAssassin::BayesStore::DBM::::nspam_nham_getMail::SpamAssassin::BayesStore::DBM::nspam_nham_get
0000s0sMail::SpamAssassin::BayesStore::DBM::::perform_upgradeMail::SpamAssassin::BayesStore::DBM::perform_upgrade
0000s0sMail::SpamAssassin::BayesStore::DBM::::remove_running_expire_tokMail::SpamAssassin::BayesStore::DBM::remove_running_expire_tok
0000s0sMail::SpamAssassin::BayesStore::DBM::::restore_databaseMail::SpamAssassin::BayesStore::DBM::restore_database
0000s0sMail::SpamAssassin::BayesStore::DBM::::sa_dieMail::SpamAssassin::BayesStore::DBM::sa_die
0000s0sMail::SpamAssassin::BayesStore::DBM::::seen_deleteMail::SpamAssassin::BayesStore::DBM::seen_delete
0000s0sMail::SpamAssassin::BayesStore::DBM::::set_last_expireMail::SpamAssassin::BayesStore::DBM::set_last_expire
0000s0sMail::SpamAssassin::BayesStore::DBM::::set_running_expire_tokMail::SpamAssassin::BayesStore::DBM::set_running_expire_tok
0000s0sMail::SpamAssassin::BayesStore::DBM::::syncMail::SpamAssassin::BayesStore::DBM::sync
0000s0sMail::SpamAssassin::BayesStore::DBM::::sync_dueMail::SpamAssassin::BayesStore::DBM::sync_due
0000s0sMail::SpamAssassin::BayesStore::DBM::::tok_count_changeMail::SpamAssassin::BayesStore::DBM::tok_count_change
0000s0sMail::SpamAssassin::BayesStore::DBM::::tok_getMail::SpamAssassin::BayesStore::DBM::tok_get
0000s0sMail::SpamAssassin::BayesStore::DBM::::tok_get_allMail::SpamAssassin::BayesStore::DBM::tok_get_all
0000s0sMail::SpamAssassin::BayesStore::DBM::::tok_packMail::SpamAssassin::BayesStore::DBM::tok_pack
0000s0sMail::SpamAssassin::BayesStore::DBM::::tok_putMail::SpamAssassin::BayesStore::DBM::tok_put
0000s0sMail::SpamAssassin::BayesStore::DBM::::tok_sync_countersMail::SpamAssassin::BayesStore::DBM::tok_sync_counters
0000s0sMail::SpamAssassin::BayesStore::DBM::::tok_sync_nspam_nhamMail::SpamAssassin::BayesStore::DBM::tok_sync_nspam_nham
0000s0sMail::SpamAssassin::BayesStore::DBM::::tok_touchMail::SpamAssassin::BayesStore::DBM::tok_touch
0000s0sMail::SpamAssassin::BayesStore::DBM::::tok_touch_allMail::SpamAssassin::BayesStore::DBM::tok_touch_all
0000s0sMail::SpamAssassin::BayesStore::DBM::::tok_touch_tokenMail::SpamAssassin::BayesStore::DBM::tok_touch_token
0000s0sMail::SpamAssassin::BayesStore::DBM::::tok_unpackMail::SpamAssassin::BayesStore::DBM::tok_unpack
0000s0sMail::SpamAssassin::BayesStore::DBM::::token_expirationMail::SpamAssassin::BayesStore::DBM::token_expiration
0000s0sMail::SpamAssassin::BayesStore::DBM::::upgrade_old_dbm_files_trappedMail::SpamAssassin::BayesStore::DBM::upgrade_old_dbm_files_trapped
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1# <@LICENSE>
2# Licensed to the Apache Software Foundation (ASF) under one or more
3# contributor license agreements. See the NOTICE file distributed with
4# this work for additional information regarding copyright ownership.
5# The ASF licenses this file to you under the Apache License, Version 2.0
6# (the "License"); you may not use this file except in compliance with
7# the License. You may obtain a copy of the License at:
8#
9# http://www.apache.org/licenses/LICENSE-2.0
10#
11# Unless required by applicable law or agreed to in writing, software
12# distributed under the License is distributed on an "AS IS" BASIS,
13# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
14# See the License for the specific language governing permissions and
15# limitations under the License.
16# </@LICENSE>
17
18package Mail::SpamAssassin::BayesStore::DBM;
19
20270µs281µs
# spent 68µs (55+13) within Mail::SpamAssassin::BayesStore::DBM::BEGIN@20 which was called: # once (55µs+13µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 20
use strict;
# spent 68µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@20 # spent 13µs making 1 call to strict::import
21262µs2106µs
# spent 65µs (25+41) within Mail::SpamAssassin::BayesStore::DBM::BEGIN@21 which was called: # once (25µs+41µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 21
use warnings;
# spent 65µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@21 # spent 41µs making 1 call to warnings::import
22265µs238µs
# spent 31µs (24+7) within Mail::SpamAssassin::BayesStore::DBM::BEGIN@22 which was called: # once (24µs+7µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 22
use bytes;
# spent 31µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@22 # spent 7µs making 1 call to bytes::import
23266µs2155µs
# spent 89µs (23+66) within Mail::SpamAssassin::BayesStore::DBM::BEGIN@23 which was called: # once (23µs+66µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 23
use re 'taint';
# spent 89µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@23 # spent 66µs making 1 call to re::import
24
25270µs22.98ms
# spent 1.50ms (27µs+1.48) within Mail::SpamAssassin::BayesStore::DBM::BEGIN@25 which was called: # once (27µs+1.48ms) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 25
use Fcntl;
# spent 1.50ms making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@25 # spent 1.48ms making 1 call to Exporter::import
26259µs2196µs
# spent 109µs (22+87) within Mail::SpamAssassin::BayesStore::DBM::BEGIN@26 which was called: # once (22µs+87µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 26
use Errno qw(EBADF);
# spent 109µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@26 # spent 87µs making 1 call to Exporter::import
27260µs2325µs
# spent 176µs (26+149) within Mail::SpamAssassin::BayesStore::DBM::BEGIN@27 which was called: # once (26µs+149µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 27
use File::Basename;
# spent 176µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@27 # spent 149µs making 1 call to Exporter::import
28260µs117µs
# spent 17µs within Mail::SpamAssassin::BayesStore::DBM::BEGIN@28 which was called: # once (17µs+0s) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 28
use File::Spec;
# spent 17µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@28
292140µs2232µs
# spent 128µs (24+104) within Mail::SpamAssassin::BayesStore::DBM::BEGIN@29 which was called: # once (24µs+104µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 29
use File::Path;
# spent 128µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@29 # spent 104µs making 1 call to Exporter::import
30
31
# spent 113µs (30+83) within Mail::SpamAssassin::BayesStore::DBM::BEGIN@31 which was called: # once (30µs+83µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 34
BEGIN {
32314µs183µs eval { require Digest::SHA; import Digest::SHA qw(sha1); 1 }
# spent 83µs making 1 call to Exporter::import
33110µs or do { require Digest::SHA1; import Digest::SHA1 qw(sha1) }
34144µs1113µs}
# spent 113µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@31
35
36260µs115µs
# spent 15µs within Mail::SpamAssassin::BayesStore::DBM::BEGIN@36 which was called: # once (15µs+0s) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 36
use Mail::SpamAssassin;
# spent 15µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@36
37256µs2238µs
# spent 130µs (23+107) within Mail::SpamAssassin::BayesStore::DBM::BEGIN@37 which was called: # once (23µs+107µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 37
use Mail::SpamAssassin::Util qw(untaint_var am_running_on_windows);
# spent 130µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@37 # spent 107µs making 1 call to Exporter::import
382340µs15.48ms
# spent 5.48ms (5.12+359µs) within Mail::SpamAssassin::BayesStore::DBM::BEGIN@38 which was called: # once (5.12ms+359µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 38
use Mail::SpamAssassin::BayesStore;
# spent 5.48ms making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@38
392116µs2289µs
# spent 157µs (25+132) within Mail::SpamAssassin::BayesStore::DBM::BEGIN@39 which was called: # once (25µs+132µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 39
use Mail::SpamAssassin::Logger;
# spent 157µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@39 # spent 132µs making 1 call to Exporter::import
40
412127µs3441µs
# spent 240µs (38+202) within Mail::SpamAssassin::BayesStore::DBM::BEGIN@41 which was called: # once (38µs+202µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 41
use constant MAGIC_RE => qr/^\015\001\007\011\003/;
# spent 240µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@41 # spent 196µs making 1 call to constant::import # spent 6µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::CORE:qr
42
4313µs
# spent 546µs (26+519) within Mail::SpamAssassin::BayesStore::DBM::BEGIN@43 which was called: # once (26µs+519µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 50
use vars qw{
44 @ISA
45 @DBNAMES
46 $NSPAM_MAGIC_TOKEN $NHAM_MAGIC_TOKEN $LAST_EXPIRE_MAGIC_TOKEN $LAST_JOURNAL_SYNC_MAGIC_TOKEN
47 $NTOKENS_MAGIC_TOKEN $OLDEST_TOKEN_AGE_MAGIC_TOKEN $LAST_EXPIRE_REDUCE_MAGIC_TOKEN
48 $RUNNING_EXPIRE_MAGIC_TOKEN $DB_VERSION_MAGIC_TOKEN $LAST_ATIME_DELTA_MAGIC_TOKEN
49 $NEWEST_TOKEN_AGE_MAGIC_TOKEN
50112.8ms21.07ms};
# spent 546µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@43 # spent 519µs making 1 call to vars::import
51
52124µs@ISA = qw( Mail::SpamAssassin::BayesStore );
53
54# db layout (quoting Matt):
55#
56# > need five db files though to make it real fast:
57# [probs] 1. ngood and nbad (two entries, so could be a flat file rather
58# than a db file). (now 2 entries in db_toks)
59# [toks] 2. good token -> number seen
60# [toks] 3. bad token -> number seen (both are packed into 1 entry in 1 db)
61# [probs] 4. Consolidated good token -> probability
62# [probs] 5. Consolidated bad token -> probability
63# > As you add new mails, you update the entry in 2 or 3, then regenerate
64# > the entry for that token in 4 or 5.
65# > Then as you test a new mail, you just need to pull the probability
66# > direct from 4 and 5, and generate the overall probability. A simple and
67# > very fast operation.
68#
69# jm: we use probs as overall probability. <0.5 = ham, >0.5 = spam
70#
71# update: probs is no longer maintained as a db, to keep on-disk and in-core
72# usage down.
73#
74# also, added a new one to support forgetting, auto-learning, and
75# auto-forgetting for refiled mails:
76# [seen] 6. a list of Message-IDs of messages already learnt from. values
77# are 's' for learnt-as-spam, 'h' for learnt-as-ham.
78#
79# and another, called [scancount] to model the scan-count for expiry.
80# This is not a database. Instead it increases by one byte for each
81# message scanned (note: scanned, not learned).
82
8312µs@DBNAMES = qw(toks seen);
84
85# These are the magic tokens we use to track stuff in the DB.
86# The format is '^M^A^G^I^C' followed by any string you want.
87# None of the control chars will be in a real token.
8812µs$DB_VERSION_MAGIC_TOKEN = "\015\001\007\011\003DBVERSION";
8912µs$LAST_ATIME_DELTA_MAGIC_TOKEN = "\015\001\007\011\003LASTATIMEDELTA";
9012µs$LAST_EXPIRE_MAGIC_TOKEN = "\015\001\007\011\003LASTEXPIRE";
9112µs$LAST_EXPIRE_REDUCE_MAGIC_TOKEN = "\015\001\007\011\003LASTEXPIREREDUCE";
9212µs$LAST_JOURNAL_SYNC_MAGIC_TOKEN = "\015\001\007\011\003LASTJOURNALSYNC";
9312µs$NEWEST_TOKEN_AGE_MAGIC_TOKEN = "\015\001\007\011\003NEWESTAGE";
9412µs$NHAM_MAGIC_TOKEN = "\015\001\007\011\003NHAM";
9512µs$NSPAM_MAGIC_TOKEN = "\015\001\007\011\003NSPAM";
9612µs$NTOKENS_MAGIC_TOKEN = "\015\001\007\011\003NTOKENS";
9712µs$OLDEST_TOKEN_AGE_MAGIC_TOKEN = "\015\001\007\011\003OLDESTAGE";
9812µs$RUNNING_EXPIRE_MAGIC_TOKEN = "\015\001\007\011\003RUNNINGEXPIRE";
99
100
# spent 3.38ms within Mail::SpamAssassin::BayesStore::DBM::HAS_DBM_MODULE which was called 236 times, avg 14µs/call: # 235 times (3.38ms+0s) by Mail::SpamAssassin::BayesStore::DBM::tie_db_readonly at line 141, avg 14µs/call # once (8µs+0s) by Mail::SpamAssassin::BayesStore::DBM::tie_db_writable at line 234
sub HAS_DBM_MODULE {
101236531µs my ($self) = @_;
102236826µs if (exists($self->{has_dbm_module})) {
1032352.66ms return $self->{has_dbm_module};
104 }
105219µs $self->{has_dbm_module} = eval { require DB_File; };
106}
107
108
# spent 3.75ms within Mail::SpamAssassin::BayesStore::DBM::DBM_MODULE which was called 470 times, avg 8µs/call: # 466 times (3.72ms+0s) by Mail::SpamAssassin::BayesStore::DBM::tie_db_readonly at line 182, avg 8µs/call # 2 times (16µs+0s) by Mail::SpamAssassin::BayesStore::DBM::tie_db_writable at line 295, avg 8µs/call # 2 times (10µs+0s) by Mail::SpamAssassin::BayesStore::DBM::tie_db_writable at line 301, avg 5µs/call
sub DBM_MODULE {
1094704.88ms return "DB_File";
110}
111
112# Possible file extensions used by the kinds of database files DB_File
113# might create. We need these so we can create a new file and rename
114# it into place.
115
# spent 1.58ms within Mail::SpamAssassin::BayesStore::DBM::DB_EXTENSIONS which was called 236 times, avg 7µs/call: # 235 times (1.57ms+0s) by Mail::SpamAssassin::BayesStore::DBM::tie_db_readonly at line 161, avg 7µs/call # once (4µs+0s) by Mail::SpamAssassin::BayesStore::DBM::tie_db_writable at line 259
sub DB_EXTENSIONS {
1162362.28ms return ('', '.db');
117}
118
119###########################################################################
120
121
# spent 74µs (54+21) within Mail::SpamAssassin::BayesStore::DBM::new which was called: # once (54µs+21µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 3 of (eval 1133)[Mail/SpamAssassin/Plugin/Bayes.pm:1661]
sub new {
12212µs my $class = shift;
12312µs $class = ref($class) || $class;
124
125115µs121µs my $self = $class->SUPER::new(@_);
# spent 21µs making 1 call to Mail::SpamAssassin::BayesStore::new
126
127111µs $self->{supported_db_version} = 3;
128
12913µs $self->{already_tied} = 0;
13013µs $self->{is_locked} = 0;
13113µs $self->{string_to_journal} = '';
132
133110µs $self;
134}
135
136###########################################################################
137
138
# spent 1.58s (78.6ms+1.51) within Mail::SpamAssassin::BayesStore::DBM::tie_db_readonly which was called 235 times, avg 6.74ms/call: # 234 times (78.5ms+1.51s) by Mail::SpamAssassin::Plugin::Bayes::learn_message at line 389 of Mail/SpamAssassin/Plugin/Bayes.pm, avg 6.77ms/call # once (117µs+363µs) by Mail::SpamAssassin::Plugin::Bayes::learner_is_scan_available at line 640 of Mail/SpamAssassin/Plugin/Bayes.pm
sub tie_db_readonly {
139235616µs my ($self) = @_;
140
1412352.21ms2353.38ms if (!$self->HAS_DBM_MODULE) {
# spent 3.38ms making 235 calls to Mail::SpamAssassin::BayesStore::DBM::HAS_DBM_MODULE, avg 14µs/call
142 dbg("bayes: %s module not installed, cannot use bayes", $self->DBM_MODULE);
143 return 0;
144 }
145
146 # return if we've already tied to the db's, using the same mode
147 # (locked/unlocked) as before.
1482351.14ms return 1 if ($self->{already_tied} && $self->{is_locked} == 0);
149
150235919µs my $main = $self->{bayes}->{main};
1512351.30ms if (!defined($main->{conf}->{bayes_path})) {
152 dbg("bayes: bayes_path not defined");
153 return 0;
154 }
155
1562352.41ms23512.1ms $self->read_db_configs();
# spent 12.1ms making 235 calls to Mail::SpamAssassin::BayesStore::read_db_configs, avg 51µs/call
157
1582352.64ms2355.24ms my $path = $main->sed_path($main->{conf}->{bayes_path});
# spent 5.24ms making 235 calls to Mail::SpamAssassin::sed_path, avg 22µs/call
159
160235588µs my $found = 0;
1612352.40ms2351.57ms for my $ext ($self->DB_EXTENSIONS) {
# spent 1.57ms making 235 calls to Mail::SpamAssassin::BayesStore::DBM::DB_EXTENSIONS, avg 7µs/call
16223715.1ms23712.4ms if (-f $path.'_toks'.$ext) {
# spent 12.4ms making 237 calls to Mail::SpamAssassin::BayesStore::DBM::CORE:ftfile, avg 52µs/call
163233509µs $found = 1;
164233783µs last;
165 }
166 }
167
168235475µs if (!$found) {
169219µs217µs dbg("bayes: no dbs present, cannot tie DB R/O: %s", $path.'_toks');
# spent 17µs making 2 calls to Mail::SpamAssassin::Logger::dbg, avg 8µs/call
170224µs return 0;
171 }
172
1732331.46ms foreach my $dbname (@DBNAMES) {
1744662.71ms my $name = $path.'_'.$dbname;
1754661.35ms my $db_var = 'db_'.$dbname;
1764664.57ms4664.37ms dbg("bayes: tie-ing to DB file R/O $name");
# spent 4.37ms making 466 calls to Mail::SpamAssassin::Logger::dbg, avg 9µs/call
177
178 # Bug 6901, [rt.cpan.org #83060]
179 # DB_File: Repeated tie to the same hash with no untie causes corruption
1809321.17s4661.16s untie %{$self->{$db_var}}; # has no effect if the variable is not tied
# spent 1.16s making 466 calls to DB_File::DESTROY, avg 2.48ms/call
181
18293217.7ms932108ms if (!tie %{$self->{$db_var}}, $self->DBM_MODULE, $name, O_RDONLY,
# spent 104ms making 466 calls to DB_File::TIEHASH, avg 224µs/call # spent 3.72ms making 466 calls to Mail::SpamAssassin::BayesStore::DBM::DBM_MODULE, avg 8µs/call
183 (oct($main->{conf}->{bayes_file_mode}) & 0666))
184 {
185 # bug 2975: it's acceptable for the db_seen to not be present,
186 # to allow it to be recycled. if that's the case, just create
187 # a new, empty one. we don't need to lock it, since we won't
188 # be writing to it; let the R/W api deal with that case.
189
190 if ($dbname eq 'seen') {
191 # Bug 6901, [rt.cpan.org #83060]
192 untie %{$self->{$db_var}}; # has no effect if the variable is not tied
193 tie %{$self->{$db_var}}, $self->DBM_MODULE, $name, O_RDWR|O_CREAT,
194 (oct($main->{conf}->{bayes_file_mode}) & 0666)
195 or goto failed_to_tie;
196 }
197 else {
198 goto failed_to_tie;
199 }
200 }
201 }
202
2032334.07ms233192ms $self->{db_version} = ($self->get_storage_variables())[6];
# spent 192ms making 233 calls to Mail::SpamAssassin::BayesStore::DBM::get_storage_variables, avg 823µs/call
2042332.05ms2331.81ms dbg("bayes: found bayes db version %s", $self->{db_version});
# spent 1.81ms making 233 calls to Mail::SpamAssassin::Logger::dbg, avg 8µs/call
205
206 # If the DB version is one we don't understand, abort!
2072332.51ms2337.35ms if ($self->_check_db_version() != 0) {
# spent 7.35ms making 233 calls to Mail::SpamAssassin::BayesStore::DBM::_check_db_version, avg 32µs/call
208 warn("bayes: bayes db version ".$self->{db_version}." is not able to be used, aborting!");
209 $self->untie_db();
210 return 0;
211 }
212
213233726µs $self->{already_tied} = 1;
2142332.57ms return 1;
215
216failed_to_tie:
217 warn "bayes: cannot open bayes databases ${path}_* R/O: tie failed: $!\n";
218 foreach my $dbname (@DBNAMES) {
219 my $db_var = 'db_'.$dbname;
220 next unless exists $self->{$db_var};
221 dbg("bayes: untie-ing DB file $dbname");
222 untie %{$self->{$db_var}};
223 }
224
225 return 0;
226}
227
228# tie() to the databases, read-write and locked. Any callers of
229# this should ensure they call untie_db() afterwards!
230#
231
# spent 4.45ms (534µs+3.92) within Mail::SpamAssassin::BayesStore::DBM::tie_db_writable which was called: # once (534µs+3.92ms) by Mail::SpamAssassin::Plugin::Bayes::learn_message at line 389 of Mail/SpamAssassin/Plugin/Bayes.pm
sub tie_db_writable {
23213µs my ($self) = @_;
233
23416µs18µs if (!$self->HAS_DBM_MODULE) {
# spent 8µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::HAS_DBM_MODULE
235 dbg("bayes: %s module not installed, cannot use bayes", $self->DBM_MODULE);
236 return 0;
237 }
238
239 # Useful shortcut ...
24014µs my $main = $self->{bayes}->{main};
241
242 # if we've already tied the db's using the same mode
243 # (locked/unlocked) as we want now, freshen the lock and return.
24412µs if ($self->{already_tied} && $self->{is_locked} == 1) {
245 $main->{locker}->refresh_lock($self->{locked_file});
246 return 1;
247 }
248
24913µs if (!defined($main->{conf}->{bayes_path})) {
250 dbg("bayes: bayes_path not defined");
251 return 0;
252 }
253
25417µs147µs $self->read_db_configs();
# spent 47µs making 1 call to Mail::SpamAssassin::BayesStore::read_db_configs
255
25618µs134µs my $path = $main->sed_path($main->{conf}->{bayes_path});
# spent 34µs making 1 call to Mail::SpamAssassin::sed_path
257
25812µs my $found = 0;
25919µs14µs for my $ext ($self->DB_EXTENSIONS) {
# spent 4µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::DB_EXTENSIONS
260252µs227µs if (-f $path.'_toks'.$ext) {
# spent 27µs making 2 calls to Mail::SpamAssassin::BayesStore::DBM::CORE:ftfile, avg 13µs/call
261 $found = 1;
262 last;
263 }
264 }
265
266111µs1259µs my $parentdir = dirname($path);
# spent 259µs making 1 call to File::Basename::dirname
267134µs119µs if (!-d $parentdir) {
# spent 19µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::CORE:ftdir
268 # run in an eval(); if mkpath has no perms, it calls die()
269 eval {
270 mkpath($parentdir, 0, (oct($main->{conf}->{bayes_file_mode}) & 0777));
271 };
272 }
273
27412µs my $tout;
27515µs if ($main->{learn_wait_for_lock}) {
27612µs $tout = 300; # TODO: Dan to write better lock code
277 } else {
278 $tout = 10;
279 }
280115µs1972µs if ($main->{locker}->safe_lock($path, $tout, $main->{conf}->{bayes_file_mode}))
# spent 972µs making 1 call to Mail::SpamAssassin::Locker::UnixNFSSafe::safe_lock
281 {
28214µs $self->{locked_file} = $path;
28312µs $self->{is_locked} = 1;
284 } else {
285 warn "bayes: cannot open bayes databases ${path}_* R/W: lock failed: $!\n";
286 return 0;
287 }
288
289116µs12µs my $umask = umask 0;
# spent 2µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::CORE:umask
290110µs foreach my $dbname (@DBNAMES) {
29129µs my $name = $path.'_'.$dbname;
29225µs my $db_var = 'db_'.$dbname;
293218µs215µs dbg("bayes: tie-ing to DB file R/W $name");
# spent 15µs making 2 calls to Mail::SpamAssassin::Logger::dbg, avg 8µs/call
294
295244µs41.64ms ($self->DBM_MODULE eq 'DB_File') and
# spent 1.62ms making 2 calls to Mail::SpamAssassin::Util::avoid_db_file_locking_bug, avg 812µs/call # spent 16µs making 2 calls to Mail::SpamAssassin::BayesStore::DBM::DBM_MODULE, avg 8µs/call
296 Mail::SpamAssassin::Util::avoid_db_file_locking_bug ($name);
297
298 # Bug 6901, [rt.cpan.org #83060]
299416µs untie %{$self->{$db_var}}; # has no effect if the variable is not tied
30024µs tie %{$self->{$db_var}}, $self->DBM_MODULE, $name, O_RDWR|O_CREAT,
301258µs4597µs (oct($main->{conf}->{bayes_file_mode}) & 0666)
# spent 587µs making 2 calls to DB_File::TIEHASH, avg 294µs/call # spent 10µs making 2 calls to Mail::SpamAssassin::BayesStore::DBM::DBM_MODULE, avg 5µs/call
302 or goto failed_to_tie;
303 }
304116µs12µs umask $umask;
# spent 2µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::CORE:umask
305
306 # set our cache to what version DB we're using
307113µs1258µs $self->{db_version} = ($self->get_storage_variables())[6];
# spent 258µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::get_storage_variables
308 # don't bother printing this unless found since it would be bogus anyway
30912µs dbg("bayes: found bayes db version %s", $self->{db_version}) if $found;
310
311 # figure out if we can read the current DB and if we need to do a
312 # DB version update and do it if necessary if either has a problem,
313 # fail immediately
314 #
31514µs if ($found && !$self->_upgrade_db()) {
316 $self->untie_db();
317 return 0;
318 }
319 elsif (!$found) { # new DB, make sure we know that ...
320162µs325µs $self->{db_version} = $self->{db_toks}->{$DB_VERSION_MAGIC_TOKEN} = $self->DB_VERSION;
# spent 11µs making 1 call to DB_File::STORE # spent 9µs making 1 call to Mail::SpamAssassin::BayesStore::DB_VERSION # spent 5µs making 1 call to DB_File::FETCH
321117µs14µs $self->{db_toks}->{$NTOKENS_MAGIC_TOKEN} = 0; # no tokens in the db ...
# spent 4µs making 1 call to DB_File::STORE
32218µs16µs dbg("bayes: new db, set db version %s and 0 tokens", $self->{db_version});
# spent 6µs making 1 call to Mail::SpamAssassin::Logger::dbg
323 }
324
32513µs $self->{already_tied} = 1;
326112µs return 1;
327
328failed_to_tie:
329 my $err = $!;
330 umask $umask;
331
332 foreach my $dbname (@DBNAMES) {
333 my $db_var = 'db_'.$dbname;
334 next unless exists $self->{$db_var};
335 dbg("bayes: untie-ing DB file $dbname");
336 untie %{$self->{$db_var}};
337 }
338
339 if ($self->{is_locked}) {
340 $self->{bayes}->{main}->{locker}->safe_unlock($self->{locked_file});
341 $self->{is_locked} = 0;
342 }
343 warn "bayes: cannot open bayes databases ${path}_* R/W: tie failed: $err\n";
344 return 0;
345}
346
347# Do we understand how to deal with this DB version?
348
# spent 7.35ms (5.01+2.33) within Mail::SpamAssassin::BayesStore::DBM::_check_db_version which was called 233 times, avg 32µs/call: # 233 times (5.01ms+2.33ms) by Mail::SpamAssassin::BayesStore::DBM::tie_db_readonly at line 207, avg 32µs/call
sub _check_db_version {
349233599µs my ($self) = @_;
350
351 # return -1 if older, 0 if current, 1 if newer
3522334.53ms2332.33ms return $self->{db_version} <=> $self->DB_VERSION;
# spent 2.33ms making 233 calls to Mail::SpamAssassin::BayesStore::DB_VERSION, avg 10µs/call
353}
354
355# Check to see if we need to upgrade the DB, and do so if necessary
356sub _upgrade_db {
357 my ($self) = @_;
358
359 my $verschk = $self->_check_db_version();
360 my $res = 0; # used later on for tie() checks
361 my $umask; # used later for umask modifications
362
363 # If the DB is the latest version, no problem.
364 return 1 if ($verschk == 0);
365
366 # If the DB is a newer version that we know what to do with ... abort!
367 if ($verschk == 1) {
368 warn("bayes: bayes db version ".$self->{db_version}." is newer than we understand, aborting!");
369 return 0;
370 }
371
372 # If the current DB version is lower than the new version, upgrade!
373 # Do conversions in order so we can go 1 -> 3, make sure to update
374 # $self->{db_version} along the way
375
376 dbg("bayes: detected bayes db format %s, upgrading", $self->{db_version});
377
378 # since DB_File will not shrink a database (!!), we need to *create*
379 # a new one instead.
380 my $main = $self->{bayes}->{main};
381 my $path = $main->sed_path($main->{conf}->{bayes_path});
382 my $name = $path.'_toks';
383
384 # older version's journal files are likely not in the same format as the new ones, so remove it.
385 my $jpath = $self->_get_journal_filename();
386 if (-f $jpath) {
387 dbg("bayes: old journal file found, removing");
388 warn "bayes: couldn't remove $jpath: $!" if (!unlink $jpath);
389 }
390
391 if ($self->{db_version} < 2) {
392 dbg("bayes: upgrading database format from v%s to v2", $self->{db_version});
393 $self->set_running_expire_tok();
394
395 my ($DB_NSPAM_MAGIC_TOKEN, $DB_NHAM_MAGIC_TOKEN, $DB_NTOKENS_MAGIC_TOKEN);
396 my ($DB_OLDEST_TOKEN_AGE_MAGIC_TOKEN, $DB_LAST_EXPIRE_MAGIC_TOKEN);
397
398 # Magic tokens for version 0, defined as '**[A-Z]+'
399 if ($self->{db_version} == 0) {
400 $DB_NSPAM_MAGIC_TOKEN = '**NSPAM';
401 $DB_NHAM_MAGIC_TOKEN = '**NHAM';
402 $DB_NTOKENS_MAGIC_TOKEN = '**NTOKENS';
403 #$DB_OLDEST_TOKEN_AGE_MAGIC_TOKEN = '**OLDESTAGE';
404 #$DB_LAST_EXPIRE_MAGIC_TOKEN = '**LASTEXPIRE';
405 #$DB_SCANCOUNT_BASE_MAGIC_TOKEN = '**SCANBASE';
406 #$DB_RUNNING_EXPIRE_MAGIC_TOKEN = '**RUNNINGEXPIRE';
407 }
408 else {
409 $DB_NSPAM_MAGIC_TOKEN = "\015\001\007\011\003NSPAM";
410 $DB_NHAM_MAGIC_TOKEN = "\015\001\007\011\003NHAM";
411 $DB_NTOKENS_MAGIC_TOKEN = "\015\001\007\011\003NTOKENS";
412 #$DB_OLDEST_TOKEN_AGE_MAGIC_TOKEN = "\015\001\007\011\003OLDESTAGE";
413 #$DB_LAST_EXPIRE_MAGIC_TOKEN = "\015\001\007\011\003LASTEXPIRE";
414 #$DB_SCANCOUNT_BASE_MAGIC_TOKEN = "\015\001\007\011\003SCANBASE";
415 #$DB_RUNNING_EXPIRE_MAGIC_TOKEN = "\015\001\007\011\003RUNNINGEXPIRE";
416 }
417
418 # remember when we started ...
419 my $started = time;
420 my $newatime = $started;
421
422 # use O_EXCL to avoid races (bonus paranoia, since we should be locked
423 # anyway)
424 my %new_toks;
425 $umask = umask 0;
426
427 $res = tie %new_toks, $self->DBM_MODULE, "${name}.new",
428 O_RDWR|O_CREAT|O_EXCL,
429 (oct($main->{conf}->{bayes_file_mode}) & 0666);
430 umask $umask;
431 return 0 unless $res;
432 undef $res;
433
434 # add the magic tokens to the new db.
435 $new_toks{$NSPAM_MAGIC_TOKEN} = $self->{db_toks}->{$DB_NSPAM_MAGIC_TOKEN};
436 $new_toks{$NHAM_MAGIC_TOKEN} = $self->{db_toks}->{$DB_NHAM_MAGIC_TOKEN};
437 $new_toks{$NTOKENS_MAGIC_TOKEN} = $self->{db_toks}->{$DB_NTOKENS_MAGIC_TOKEN};
438 $new_toks{$DB_VERSION_MAGIC_TOKEN} = 2; # we're now a DB version 2 file
439 $new_toks{$OLDEST_TOKEN_AGE_MAGIC_TOKEN} = $newatime;
440 $new_toks{$LAST_EXPIRE_MAGIC_TOKEN} = $newatime;
441 $new_toks{$NEWEST_TOKEN_AGE_MAGIC_TOKEN} = $newatime;
442 $new_toks{$LAST_JOURNAL_SYNC_MAGIC_TOKEN} = $newatime;
443 $new_toks{$LAST_ATIME_DELTA_MAGIC_TOKEN} = 0;
444 $new_toks{$LAST_EXPIRE_REDUCE_MAGIC_TOKEN} = 0;
445
446 # deal with the data tokens
447 my ($tok, $packed);
448 my $count = 0;
449 while (($tok, $packed) = each %{$self->{db_toks}}) {
450 next if ($tok =~ /^(?:\*\*[A-Z]+$|\015\001\007\011\003)/); # skip magic tokens
451
452 my ($ts, $th, $atime) = $self->tok_unpack($packed);
453 $new_toks{$tok} = $self->tok_pack($ts, $th, $newatime);
454
455 # Refresh the lock every so often...
456 if (($count++ % 1000) == 0) {
457 $self->set_running_expire_tok();
458 }
459 }
460
461
462 # now untie so we can do renames
463 untie %{$self->{db_toks}};
464 untie %new_toks;
465
466 # This is the critical phase (moving files around), so don't allow
467 # it to be interrupted.
468 local $SIG{'INT'} = 'IGNORE';
469 local $SIG{'TERM'} = 'IGNORE';
470 local $SIG{'HUP'} = 'IGNORE' if !am_running_on_windows();
471
472 # older versions used scancount, so kill the stupid little file ...
473 my $msgc = $path.'_msgcount';
474 if (-f $msgc) {
475 dbg("bayes: old msgcount file found, removing");
476 if (!unlink $msgc) {
477 warn "bayes: couldn't remove $msgc: $!";
478 }
479 }
480
481 # now rename in the new one. Try several extensions
482 for my $ext ($self->DB_EXTENSIONS) {
483 my $newf = $name.'.new'.$ext;
484 my $oldf = $name.$ext;
485 next unless (-f $newf);
486 if (!rename ($newf, $oldf)) {
487 warn "bayes: rename $newf to $oldf failed: $!\n";
488 return 0;
489 }
490 }
491
492 # re-tie to the new db in read-write mode ...
493 $umask = umask 0;
494 # Bug 6901, [rt.cpan.org #83060]
495 untie %{$self->{db_toks}}; # has no effect if the variable is not tied
496 $res = tie %{$self->{db_toks}}, $self->DBM_MODULE, $name, O_RDWR|O_CREAT,
497 (oct($main->{conf}->{bayes_file_mode}) & 0666);
498 umask $umask;
499 return 0 unless $res;
500 undef $res;
501
502 dbg("bayes: upgraded database format from v%s to v2 in %d seconds",
503 $self->{db_version}, time - $started);
504 $self->{db_version} = 2; # need this for other functions which check
505 }
506
507 # Version 3 of the database converts all existing tokens to SHA1 hashes
508 if ($self->{db_version} == 2) {
509 dbg("bayes: upgrading database format from v%s to v3", $self->{db_version});
510 $self->set_running_expire_tok();
511
512 my $DB_NSPAM_MAGIC_TOKEN = "\015\001\007\011\003NSPAM";
513 my $DB_NHAM_MAGIC_TOKEN = "\015\001\007\011\003NHAM";
514 my $DB_NTOKENS_MAGIC_TOKEN = "\015\001\007\011\003NTOKENS";
515 my $DB_OLDEST_TOKEN_AGE_MAGIC_TOKEN = "\015\001\007\011\003OLDESTAGE";
516 my $DB_LAST_EXPIRE_MAGIC_TOKEN = "\015\001\007\011\003LASTEXPIRE";
517 my $DB_NEWEST_TOKEN_AGE_MAGIC_TOKEN = "\015\001\007\011\003NEWESTAGE";
518 my $DB_LAST_JOURNAL_SYNC_MAGIC_TOKEN = "\015\001\007\011\003LASTJOURNALSYNC";
519 my $DB_LAST_ATIME_DELTA_MAGIC_TOKEN = "\015\001\007\011\003LASTATIMEDELTA";
520 my $DB_LAST_EXPIRE_REDUCE_MAGIC_TOKEN = "\015\001\007\011\003LASTEXPIREREDUCE";
521
522 # remember when we started ...
523 my $started = time;
524
525 # use O_EXCL to avoid races (bonus paranoia, since we should be locked
526 # anyway)
527 my %new_toks;
528 $umask = umask 0;
529 $res = tie %new_toks, $self->DBM_MODULE, "${name}.new", O_RDWR|O_CREAT|O_EXCL,
530 (oct($main->{conf}->{bayes_file_mode}) & 0666);
531 umask $umask;
532 return 0 unless $res;
533 undef $res;
534
535 # add the magic tokens to the new db.
536 $new_toks{$NSPAM_MAGIC_TOKEN} = $self->{db_toks}->{$DB_NSPAM_MAGIC_TOKEN};
537 $new_toks{$NHAM_MAGIC_TOKEN} = $self->{db_toks}->{$DB_NHAM_MAGIC_TOKEN};
538 $new_toks{$NTOKENS_MAGIC_TOKEN} = $self->{db_toks}->{$DB_NTOKENS_MAGIC_TOKEN};
539 $new_toks{$DB_VERSION_MAGIC_TOKEN} = 3; # we're now a DB version 3 file
540 $new_toks{$OLDEST_TOKEN_AGE_MAGIC_TOKEN} = $self->{db_toks}->{$DB_OLDEST_TOKEN_AGE_MAGIC_TOKEN};
541 $new_toks{$LAST_EXPIRE_MAGIC_TOKEN} = $self->{db_toks}->{$DB_LAST_EXPIRE_MAGIC_TOKEN};
542 $new_toks{$NEWEST_TOKEN_AGE_MAGIC_TOKEN} = $self->{db_toks}->{$DB_NEWEST_TOKEN_AGE_MAGIC_TOKEN};
543 $new_toks{$LAST_JOURNAL_SYNC_MAGIC_TOKEN} = $self->{db_toks}->{$DB_LAST_JOURNAL_SYNC_MAGIC_TOKEN};
544 $new_toks{$LAST_ATIME_DELTA_MAGIC_TOKEN} = $self->{db_toks}->{$DB_LAST_ATIME_DELTA_MAGIC_TOKEN};
545 $new_toks{$LAST_EXPIRE_REDUCE_MAGIC_TOKEN} =$self->{db_toks}->{$DB_LAST_EXPIRE_REDUCE_MAGIC_TOKEN};
546
547 # deal with the data tokens
548 my $count = 0;
549 while (my ($tok, $packed) = each %{$self->{db_toks}}) {
550 next if ($tok =~ /^\015\001\007\011\003/); # skip magic tokens
551 my $tok_hash = substr(sha1($tok), -5);
552 $new_toks{$tok_hash} = $packed;
553
554 # Refresh the lock every so often...
555 if (($count++ % 1000) == 0) {
556 $self->set_running_expire_tok();
557 }
558 }
559
560 # now untie so we can do renames
561 untie %{$self->{db_toks}};
562 untie %new_toks;
563
564 # This is the critical phase (moving files around), so don't allow
565 # it to be interrupted.
566 local $SIG{'INT'} = 'IGNORE';
567 local $SIG{'TERM'} = 'IGNORE';
568 local $SIG{'HUP'} = 'IGNORE' if !am_running_on_windows();
569
570 # now rename in the new one. Try several extensions
571 for my $ext ($self->DB_EXTENSIONS) {
572 my $newf = $name.'.new'.$ext;
573 my $oldf = $name.$ext;
574 next unless (-f $newf);
575 if (!rename($newf, $oldf)) {
576 warn "bayes: rename $newf to $oldf failed: $!\n";
577 return 0;
578 }
579 }
580
581 # re-tie to the new db in read-write mode ...
582 $umask = umask 0;
583 # Bug 6901, [rt.cpan.org #83060]
584 untie %{$self->{db_toks}}; # has no effect if the variable is not tied
585 $res = tie %{$self->{db_toks}}, $self->DBM_MODULE, $name, O_RDWR|O_CREAT,
586 (oct ($main->{conf}->{bayes_file_mode}) & 0666);
587 umask $umask;
588 return 0 unless $res;
589 undef $res;
590
591 dbg("bayes: upgraded database format from v%s to v3 in %d seconds",
592 $self->{db_version}, time - $started);
593
594 $self->{db_version} = 3; # need this for other functions which check
595 }
596
597 # if ($self->{db_version} == 3) {
598 # ...
599 # $self->{db_version} = 4; # need this for other functions which check
600 # }
601 # ... and so on.
602
603 return 1;
604}
605
606###########################################################################
607
608
# spent 1.24ms (184µs+1.06) within Mail::SpamAssassin::BayesStore::DBM::untie_db which was called: # once (184µs+1.06ms) by Mail::SpamAssassin::Plugin::Bayes::learner_close at line 332 of Mail/SpamAssassin/Plugin/Bayes.pm
sub untie_db {
60914µs my $self = shift;
610
61113µs return if (!$self->{already_tied});
612
61318µs18µs dbg("bayes: untie-ing");
# spent 8µs making 1 call to Mail::SpamAssassin::Logger::dbg
614
615112µs foreach my $dbname (@DBNAMES) {
616210µs my $db_var = 'db_'.$dbname;
617
618220µs if (exists $self->{$db_var}) {
619 # dbg("bayes: untie-ing $db_var");
6204247µs2195µs untie %{$self->{$db_var}};
# spent 195µs making 2 calls to DB_File::DESTROY, avg 97µs/call
62128µs delete $self->{$db_var};
622 }
623 }
624
62515µs if ($self->{is_locked}) {
62617µs17µs dbg("bayes: files locked, now unlocking lock");
# spent 7µs making 1 call to Mail::SpamAssassin::Logger::dbg
627116µs1849µs $self->{bayes}->{main}->{locker}->safe_unlock ($self->{locked_file});
# spent 849µs making 1 call to Mail::SpamAssassin::Locker::UnixNFSSafe::safe_unlock
62814µs $self->{is_locked} = 0;
629 }
630
63113µs $self->{already_tied} = 0;
632114µs $self->{db_version} = undef;
633}
634
635###########################################################################
636
637sub calculate_expire_delta {
638 my ($self, $newest_atime, $start, $max_expire_mult) = @_;
639
640 my %delta; # use a hash since an array is going to be very sparse
641
642 # do the first pass, figure out atime delta
643 my ($tok, $packed);
644 while (($tok, $packed) = each %{$self->{db_toks}}) {
645 next if ($tok =~ MAGIC_RE); # skip magic tokens
646
647 my ($ts, $th, $atime) = $self->tok_unpack ($packed);
648
649 # Go through from $start * 1 to $start * 512, mark how many tokens
650 # we would expire
651 my $token_age = $newest_atime - $atime;
652 for (my $i = 1; $i <= $max_expire_mult; $i<<=1) {
653 if ($token_age >= $start * $i) {
654 $delta{$i}++;
655 }
656 else {
657 # If the token age is less than the expire delta, it'll be
658 # less for all upcoming checks too, so abort early.
659 last;
660 }
661 }
662 }
663 return %delta;
664}
665
666###########################################################################
667
668sub token_expiration {
669 my ($self, $opts, $newdelta, @vars) = @_;
670
671 my $deleted = 0;
672 my $kept = 0;
673 my $num_hapaxes = 0;
674 my $num_lowfreq = 0;
675
676 # since DB_File will not shrink a database (!!), we need to *create*
677 # a new one instead.
678 my $main = $self->{bayes}->{main};
679 my $path = $main->sed_path($main->{conf}->{bayes_path});
680
681 # use a temporary PID-based suffix just in case another one was
682 # created previously by an interrupted expire
683 my $tmpsuffix = "expire$$";
684 my $tmpdbname = $path.'_toks.'.$tmpsuffix;
685
686 # clean out any leftover db copies from previous runs
687 for my $ext ($self->DB_EXTENSIONS) { unlink ($tmpdbname.$ext); }
688
689 # use O_EXCL to avoid races (bonus paranoia, since we should be locked
690 # anyway)
691 my %new_toks;
692 my $umask = umask 0;
693 tie %new_toks, $self->DBM_MODULE, $tmpdbname, O_RDWR|O_CREAT|O_EXCL,
694 (oct ($main->{conf}->{bayes_file_mode}) & 0666);
695 umask $umask;
696 my $oldest;
697
698 my $showdots = $opts->{showdots};
699 if ($showdots) { print STDERR "\n"; }
700
701 # We've chosen a new atime delta if we've gotten here, so record it
702 # for posterity.
703 $new_toks{$LAST_ATIME_DELTA_MAGIC_TOKEN} = $newdelta;
704
705 # Figure out how old is too old...
706 my $too_old = $vars[10] - $newdelta; # tooold = newest - delta
707
708 # Go ahead and do the move to new db/expire run now ...
709 my ($tok, $packed);
710 while (($tok, $packed) = each %{$self->{db_toks}}) {
711 next if ($tok =~ MAGIC_RE); # skip magic tokens
712
713 my ($ts, $th, $atime) = $self->tok_unpack ($packed);
714
715 if ($atime < $too_old) {
716 $deleted++;
717 }
718 else {
719 # if token atime > newest, reset to newest ...
720 if ($atime > $vars[10]) {
721 $atime = $vars[10];
722 }
723
724 $new_toks{$tok} = $self->tok_pack ($ts, $th, $atime); $kept++;
725 if (!defined($oldest) || $atime < $oldest) { $oldest = $atime; }
726 if ($ts + $th == 1) {
727 $num_hapaxes++;
728 } elsif ($ts < 8 && $th < 8) {
729 $num_lowfreq++;
730 }
731 }
732
733 if ((($kept + $deleted) % 1000) == 0) {
734 if ($showdots) { print STDERR "."; }
735 $self->set_running_expire_tok();
736 }
737 }
738
739 # and add the magic tokens. don't add the expire_running token.
740 $new_toks{$DB_VERSION_MAGIC_TOKEN} = $self->DB_VERSION;
741
742 # We haven't changed messages of each type seen, so just copy over.
743 $new_toks{$NSPAM_MAGIC_TOKEN} = $vars[1];
744 $new_toks{$NHAM_MAGIC_TOKEN} = $vars[2];
745
746 # We magically haven't removed the newest token, so just copy that value over.
747 $new_toks{$NEWEST_TOKEN_AGE_MAGIC_TOKEN} = $vars[10];
748
749 # The rest of these have been modified, so replace as necessary.
750 $new_toks{$NTOKENS_MAGIC_TOKEN} = $kept;
751 $new_toks{$LAST_EXPIRE_MAGIC_TOKEN} = time();
752 $new_toks{$OLDEST_TOKEN_AGE_MAGIC_TOKEN} = $oldest;
753 $new_toks{$LAST_EXPIRE_REDUCE_MAGIC_TOKEN} = $deleted;
754
755 # Sanity check: if we expired too many tokens, abort!
756 if ($kept < 100000) {
757 dbg("bayes: token expiration would expire too many tokens, aborting");
758 # set the magic tokens appropriately
759 # make sure the next expire run does a first pass
760 $self->{db_toks}->{$LAST_EXPIRE_MAGIC_TOKEN} = time();
761 $self->{db_toks}->{$LAST_EXPIRE_REDUCE_MAGIC_TOKEN} = 0;
762 $self->{db_toks}->{$LAST_ATIME_DELTA_MAGIC_TOKEN} = 0;
763
764 # remove the new DB
765 untie %new_toks;
766 for my $ext ($self->DB_EXTENSIONS) { unlink ($tmpdbname.$ext); }
767
768 # reset the results for the return
769 $kept = $vars[3];
770 $deleted = 0;
771 $num_hapaxes = 0;
772 $num_lowfreq = 0;
773 }
774 else {
775 # now untie so we can do renames
776 untie %{$self->{db_toks}};
777 untie %new_toks;
778
779 # This is the critical phase (moving files around), so don't allow
780 # it to be interrupted. Scope the signal changes.
781 {
782 local $SIG{'INT'} = 'IGNORE';
783 local $SIG{'TERM'} = 'IGNORE';
784 local $SIG{'HUP'} = 'IGNORE' if !am_running_on_windows();
785
786 # now rename in the new one. Try several extensions
787 for my $ext ($self->DB_EXTENSIONS) {
788 my $newf = $tmpdbname.$ext;
789 my $oldf = $path.'_toks'.$ext;
790 next unless (-f $newf);
791 if (!rename ($newf, $oldf)) {
792 warn "bayes: rename $newf to $oldf failed: $!\n";
793 }
794 }
795 }
796 }
797
798 # Call untie_db() so we unlock correctly.
799 $self->untie_db();
800
801 return ($kept, $deleted, $num_hapaxes, $num_lowfreq);
802}
803
804###########################################################################
805
806# Is a sync due?
807sub sync_due {
808 my ($self) = @_;
809
810 # don't bother doing old db versions
811 return 0 if ($self->{db_version} < $self->DB_VERSION);
812
813 my $conf = $self->{bayes}->{main}->{conf};
814 return 0 if ($conf->{bayes_journal_max_size} == 0);
815
816 my @vars = $self->get_storage_variables();
817 dbg("bayes: DB journal sync: last sync: %s", $vars[7]);
818
819 ## Ok, should we do a sync?
820
821 # Not if the journal file doesn't exist, it's not a file, or it's 0
822 # bytes long.
823 return 0 unless (stat($self->_get_journal_filename()) && -f _);
824
825 # Yes if the file size is larger than the specified maximum size.
826 return 1 if (-s _ > $conf->{bayes_journal_max_size});
827
828 # Yes there has been a sync before, and if it's been at least a day
829 # since that sync.
830 return 1 if (($vars[7] > 0) && (time - $vars[7] > 86400));
831
832 # No, I guess not.
833 return 0;
834}
835
836###########################################################################
837# db_seen reading APIs
838
839
# spent 31.2ms (10.8+20.5) within Mail::SpamAssassin::BayesStore::DBM::seen_get which was called 458 times, avg 68µs/call: # 458 times (10.8ms+20.5ms) by Mail::SpamAssassin::Plugin::Bayes::_learn_trapped at line 421 of Mail/SpamAssassin/Plugin/Bayes.pm, avg 68µs/call
sub seen_get {
8404582.16ms my ($self, $msgid) = @_;
84145830.1ms45820.5ms $self->{db_seen}->{$msgid};
# spent 20.5ms making 458 calls to DB_File::FETCH, avg 45µs/call
842}
843
844
# spent 11.2ms (7.41+3.78) within Mail::SpamAssassin::BayesStore::DBM::seen_put which was called 234 times, avg 48µs/call: # 234 times (7.41ms+3.78ms) by Mail::SpamAssassin::Plugin::Bayes::_learn_trapped at line 485 of Mail/SpamAssassin/Plugin/Bayes.pm, avg 48µs/call
sub seen_put {
8452341.21ms my ($self, $msgid, $seen) = @_;
846
8472342.65ms if ($self->{bayes}->{main}->{learn_to_journal}) {
8482342.53ms2343.78ms $self->defer_update ("m $seen $msgid");
# spent 3.78ms making 234 calls to Mail::SpamAssassin::BayesStore::DBM::defer_update, avg 16µs/call
849 }
850 else {
851 $self->_seen_put_direct($msgid, $seen);
852 }
853}
854sub _seen_put_direct {
855 my ($self, $msgid, $seen) = @_;
856 $self->{db_seen}->{$msgid} = $seen;
857}
858
859sub seen_delete {
860 my ($self, $msgid) = @_;
861
862 if ($self->{bayes}->{main}->{learn_to_journal}) {
863 $self->defer_update ("m f $msgid");
864 }
865 else {
866 $self->_seen_delete_direct($msgid);
867 }
868}
869sub _seen_delete_direct {
870 my ($self, $msgid) = @_;
871 delete $self->{db_seen}->{$msgid};
872}
873
874###########################################################################
875# db reading APIs
876
877sub tok_get {
878 my ($self, $tok) = @_;
879 $self->tok_unpack ($self->{db_toks}->{$tok});
880}
881
882sub tok_get_all {
883 my ($self, @tokens) = @_;
884
885 my @tokensdata;
886 foreach my $token (@tokens) {
887 my ($tok_spam, $tok_ham, $atime) = $self->tok_unpack($self->{db_toks}->{$token});
888 push(@tokensdata, [$token, $tok_spam, $tok_ham, $atime]);
889 }
890 return \@tokensdata;
891}
892
893# return the magic tokens in a specific order:
894# 0: scan count base
895# 1: number of spam
896# 2: number of ham
897# 3: number of tokens in db
898# 4: last expire atime
899# 5: oldest token in db atime
900# 6: db version value
901# 7: last journal sync
902# 8: last atime delta
903# 9: last expire reduction count
904# 10: newest token in db atime
905#
906
# spent 192ms (111+80.8) within Mail::SpamAssassin::BayesStore::DBM::get_storage_variables which was called 234 times, avg 821µs/call: # 233 times (111ms+80.8ms) by Mail::SpamAssassin::BayesStore::DBM::tie_db_readonly at line 203, avg 823µs/call # once (217µs+41µs) by Mail::SpamAssassin::BayesStore::DBM::tie_db_writable at line 307
sub get_storage_variables {
907234631µs my ($self) = @_;
908234544µs my @values;
909
91023418.3ms23412.9ms my $db_ver = $self->{db_toks}->{$DB_VERSION_MAGIC_TOKEN};
# spent 12.9ms making 234 calls to DB_File::FETCH, avg 55µs/call
911
9122353.45ms2331.11ms if (!$db_ver || $db_ver =~ /\D/) { $db_ver = 0; }
# spent 1.11ms making 233 calls to Mail::SpamAssassin::BayesStore::DBM::CORE:match, avg 5µs/call
913
9142343.81ms if ($db_ver >= 2) {
915233718µs my $DB2_LAST_ATIME_DELTA_MAGIC_TOKEN = "\015\001\007\011\003LASTATIMEDELTA";
916233663µs my $DB2_LAST_EXPIRE_MAGIC_TOKEN = "\015\001\007\011\003LASTEXPIRE";
917233611µs my $DB2_LAST_EXPIRE_REDUCE_MAGIC_TOKEN = "\015\001\007\011\003LASTEXPIREREDUCE";
918233583µs my $DB2_LAST_JOURNAL_SYNC_MAGIC_TOKEN = "\015\001\007\011\003LASTJOURNALSYNC";
919233561µs my $DB2_NEWEST_TOKEN_AGE_MAGIC_TOKEN = "\015\001\007\011\003NEWESTAGE";
920233555µs my $DB2_NHAM_MAGIC_TOKEN = "\015\001\007\011\003NHAM";
921233559µs my $DB2_NSPAM_MAGIC_TOKEN = "\015\001\007\011\003NSPAM";
922233575µs my $DB2_NTOKENS_MAGIC_TOKEN = "\015\001\007\011\003NTOKENS";
923233585µs my $DB2_OLDEST_TOKEN_AGE_MAGIC_TOKEN = "\015\001\007\011\003OLDESTAGE";
924233612µs my $DB2_RUNNING_EXPIRE_MAGIC_TOKEN = "\015\001\007\011\003RUNNINGEXPIRE";
925
926 @values = (
927 0,
928 $self->{db_toks}->{$DB2_NSPAM_MAGIC_TOKEN},
929 $self->{db_toks}->{$DB2_NHAM_MAGIC_TOKEN},
930 $self->{db_toks}->{$DB2_NTOKENS_MAGIC_TOKEN},
931 $self->{db_toks}->{$DB2_LAST_EXPIRE_MAGIC_TOKEN},
932 $self->{db_toks}->{$DB2_OLDEST_TOKEN_AGE_MAGIC_TOKEN},
933 $db_ver,
934 $self->{db_toks}->{$DB2_LAST_JOURNAL_SYNC_MAGIC_TOKEN},
935 $self->{db_toks}->{$DB2_LAST_ATIME_DELTA_MAGIC_TOKEN},
936 $self->{db_toks}->{$DB2_LAST_EXPIRE_REDUCE_MAGIC_TOKEN},
93723391.7ms209763.8ms $self->{db_toks}->{$DB2_NEWEST_TOKEN_AGE_MAGIC_TOKEN},
# spent 63.8ms making 2097 calls to DB_File::FETCH, avg 30µs/call
938 );
939 }
940 elsif ($db_ver == 0) {
94113µs my $DB0_NSPAM_MAGIC_TOKEN = '**NSPAM';
94212µs my $DB0_NHAM_MAGIC_TOKEN = '**NHAM';
94313µs my $DB0_OLDEST_TOKEN_AGE_MAGIC_TOKEN = '**OLDESTAGE';
94412µs my $DB0_LAST_EXPIRE_MAGIC_TOKEN = '**LASTEXPIRE';
94512µs my $DB0_NTOKENS_MAGIC_TOKEN = '**NTOKENS';
94612µs my $DB0_SCANCOUNT_BASE_MAGIC_TOKEN = '**SCANBASE';
947
948 @values = (
949 $self->{db_toks}->{$DB0_SCANCOUNT_BASE_MAGIC_TOKEN},
950 $self->{db_toks}->{$DB0_NSPAM_MAGIC_TOKEN},
951 $self->{db_toks}->{$DB0_NHAM_MAGIC_TOKEN},
952 $self->{db_toks}->{$DB0_NTOKENS_MAGIC_TOKEN},
953 $self->{db_toks}->{$DB0_LAST_EXPIRE_MAGIC_TOKEN},
954190µs627µs $self->{db_toks}->{$DB0_OLDEST_TOKEN_AGE_MAGIC_TOKEN},
# spent 27µs making 6 calls to DB_File::FETCH, avg 4µs/call
955 0,
956 0,
957 0,
958 0,
959 0,
960 );
961 }
962 elsif ($db_ver == 1) {
963 my $DB1_NSPAM_MAGIC_TOKEN = "\015\001\007\011\003NSPAM";
964 my $DB1_NHAM_MAGIC_TOKEN = "\015\001\007\011\003NHAM";
965 my $DB1_OLDEST_TOKEN_AGE_MAGIC_TOKEN = "\015\001\007\011\003OLDESTAGE";
966 my $DB1_LAST_EXPIRE_MAGIC_TOKEN = "\015\001\007\011\003LASTEXPIRE";
967 my $DB1_NTOKENS_MAGIC_TOKEN = "\015\001\007\011\003NTOKENS";
968 my $DB1_SCANCOUNT_BASE_MAGIC_TOKEN = "\015\001\007\011\003SCANBASE";
969
970 @values = (
971 $self->{db_toks}->{$DB1_SCANCOUNT_BASE_MAGIC_TOKEN},
972 $self->{db_toks}->{$DB1_NSPAM_MAGIC_TOKEN},
973 $self->{db_toks}->{$DB1_NHAM_MAGIC_TOKEN},
974 $self->{db_toks}->{$DB1_NTOKENS_MAGIC_TOKEN},
975 $self->{db_toks}->{$DB1_LAST_EXPIRE_MAGIC_TOKEN},
976 $self->{db_toks}->{$DB1_OLDEST_TOKEN_AGE_MAGIC_TOKEN},
977 1,
978 0,
979 0,
980 0,
981 0,
982 );
983 }
984
9852341.38ms foreach (@values) {
986257459.3ms10483.00ms if (!$_ || $_ =~ /\D/) {
# spent 3.00ms making 1048 calls to Mail::SpamAssassin::BayesStore::DBM::CORE:match, avg 3µs/call
98715263.04ms $_ = 0;
988 }
989 }
990
9912344.35ms return @values;
992}
993
994sub dump_db_toks {
995 my ($self, $template, $regex, @vars) = @_;
996
997 while (my ($tok, $tokvalue) = each %{$self->{db_toks}}) {
998 next if ($tok =~ MAGIC_RE); # skip magic tokens
999 next if (defined $regex && ($tok !~ /$regex/o));
1000
1001 # We have the value already, so just unpack it.
1002 my ($ts, $th, $atime) = $self->tok_unpack ($tokvalue);
1003
1004 my $prob = $self->{bayes}->_compute_prob_for_token($tok, $vars[1], $vars[2], $ts, $th);
1005 $prob ||= 0.5;
1006
1007 my $encoded_tok = unpack("H*",$tok);
1008 printf $template,$prob,$ts,$th,$atime,$encoded_tok;
1009 }
1010}
1011
1012sub set_last_expire {
1013 my ($self, $time) = @_;
1014 $self->{db_toks}->{$LAST_EXPIRE_MAGIC_TOKEN} = time();
1015}
1016
1017## Don't bother using get_magic_tokens here. This token should only
1018## ever exist when we're running expire, so we don't want to convert it if
1019## it's there and we're not expiring ...
1020sub get_running_expire_tok {
1021 my ($self) = @_;
1022 my $running = $self->{db_toks}->{$RUNNING_EXPIRE_MAGIC_TOKEN};
1023 if (!$running || $running =~ /\D/) { return; }
1024 return $running;
1025}
1026
1027sub set_running_expire_tok {
1028 my ($self) = @_;
1029
1030 # update the lock and running expire magic token
1031 $self->{bayes}->{main}->{locker}->refresh_lock ($self->{locked_file});
1032 $self->{db_toks}->{$RUNNING_EXPIRE_MAGIC_TOKEN} = time();
1033}
1034
1035sub remove_running_expire_tok {
1036 my ($self) = @_;
1037 delete $self->{db_toks}->{$RUNNING_EXPIRE_MAGIC_TOKEN};
1038}
1039
1040###########################################################################
1041
1042# db abstraction: allow deferred writes, since we will be frequently
1043# writing while checking.
1044
1045sub tok_count_change {
1046 my ($self, $ds, $dh, $tok, $atime) = @_;
1047
1048 $atime = 0 unless defined $atime;
1049
1050 if ($self->{bayes}->{main}->{learn_to_journal}) {
1051 # we can't store the SHA1 binary value in the journal, so convert it
1052 # to a printable value that can be converted back later
1053 my $encoded_tok = unpack("H*",$tok);
1054 $self->defer_update ("c $ds $dh $atime $encoded_tok");
1055 } else {
1056 $self->tok_sync_counters ($ds, $dh, $atime, $tok);
1057 }
1058}
1059
1060
# spent 3.49s (2.27+1.22) within Mail::SpamAssassin::BayesStore::DBM::multi_tok_count_change which was called 234 times, avg 14.9ms/call: # 234 times (2.27s+1.22s) by Mail::SpamAssassin::Plugin::Bayes::_learn_trapped at line 478 of Mail/SpamAssassin/Plugin/Bayes.pm, avg 14.9ms/call
sub multi_tok_count_change {
10612341.21ms my ($self, $ds, $dh, $tokens, $atime) = @_;
1062
1063234554µs $atime = 0 unless defined $atime;
1064
106546818.0ms foreach my $tok (keys %{$tokens}) {
106673724461ms if ($self->{bayes}->{main}->{learn_to_journal}) {
1067 # we can't store the SHA1 binary value in the journal, so convert it
1068 # to a printable value that can be converted back later
106973724816ms73724186ms my $encoded_tok = unpack("H*",$tok);
# spent 186ms making 73724 calls to Mail::SpamAssassin::BayesStore::DBM::CORE:unpack, avg 3µs/call
107073724850ms737241.03s $self->defer_update ("c $ds $dh $atime $encoded_tok");
# spent 1.03s making 73724 calls to Mail::SpamAssassin::BayesStore::DBM::defer_update, avg 14µs/call
1071 } else {
1072 $self->tok_sync_counters ($ds, $dh, $atime, $tok);
1073 }
1074 }
1075}
1076
1077sub nspam_nham_get {
1078 my ($self) = @_;
1079 my @vars = $self->get_storage_variables();
1080 ($vars[1], $vars[2]);
1081}
1082
1083
# spent 9.65ms (6.64+3.00) within Mail::SpamAssassin::BayesStore::DBM::nspam_nham_change which was called 234 times, avg 41µs/call: # 234 times (6.64ms+3.00ms) by Mail::SpamAssassin::Plugin::Bayes::_learn_trapped at line 477 of Mail/SpamAssassin/Plugin/Bayes.pm, avg 41µs/call
sub nspam_nham_change {
1084234710µs my ($self, $ds, $dh) = @_;
1085
10862342.89ms if ($self->{bayes}->{main}->{learn_to_journal}) {
10872342.90ms2343.00ms $self->defer_update ("n $ds $dh");
# spent 3.00ms making 234 calls to Mail::SpamAssassin::BayesStore::DBM::defer_update, avg 13µs/call
1088 } else {
1089 $self->tok_sync_nspam_nham ($ds, $dh);
1090 }
1091}
1092
1093sub tok_touch {
1094 my ($self, $tok, $atime) = @_;
1095 # we can't store the SHA1 binary value in the journal, so convert it
1096 # to a printable value that can be converted back later
1097 my $encoded_tok = unpack("H*", $tok);
1098 $self->defer_update ("t $atime $encoded_tok");
1099}
1100
1101sub tok_touch_all {
1102 my ($self, $tokens, $atime) = @_;
1103
1104 foreach my $token (@{$tokens}) {
1105 # we can't store the SHA1 binary value in the journal, so convert it
1106 # to a printable value that can be converted back later
1107 my $encoded_tok = unpack("H*", $token);
1108 $self->defer_update ("t $atime $encoded_tok");
1109 }
1110}
1111
1112
# spent 1.04s within Mail::SpamAssassin::BayesStore::DBM::defer_update which was called 74192 times, avg 14µs/call: # 73724 times (1.03s+0s) by Mail::SpamAssassin::BayesStore::DBM::multi_tok_count_change at line 1070, avg 14µs/call # 234 times (3.78ms+0s) by Mail::SpamAssassin::BayesStore::DBM::seen_put at line 848, avg 16µs/call # 234 times (3.00ms+0s) by Mail::SpamAssassin::BayesStore::DBM::nspam_nham_change at line 1087, avg 13µs/call
sub defer_update {
111374192218ms my ($self, $str) = @_;
1114741921.13s $self->{string_to_journal} .= "$str\n";
1115}
1116
1117###########################################################################
1118
1119
# spent 104ms (27.3+76.3) within Mail::SpamAssassin::BayesStore::DBM::cleanup which was called 234 times, avg 443µs/call: # 234 times (27.3ms+76.3ms) by Mail::SpamAssassin::Plugin::Bayes::_learn_trapped at line 486 of Mail/SpamAssassin/Plugin/Bayes.pm, avg 443µs/call
sub cleanup {
1120234557µs my ($self) = @_;
1121
11222341.04ms my $nbytes = length ($self->{string_to_journal});
1123234613µs return if ($nbytes == 0);
1124
11252342.26ms23411.5ms my $path = $self->_get_journal_filename();
# spent 11.5ms making 234 calls to Mail::SpamAssassin::BayesStore::DBM::_get_journal_filename, avg 49µs/call
1126
1127 # use append mode, write atomically, then close, so simultaneous updates are
1128 # not lost
1129234842µs my $conf = $self->{bayes}->{main}->{conf};
1130
1131 # set the umask to the inverse of what we want ...
11322343.86ms2341.07ms my $umask = umask(0777 - (oct ($conf->{bayes_file_mode}) & 0666));
# spent 1.07ms making 234 calls to Mail::SpamAssassin::BayesStore::DBM::CORE:umask, avg 5µs/call
1133
113423443.0ms23440.3ms if (!open (OUT, ">>".$path)) {
# spent 40.3ms making 234 calls to Mail::SpamAssassin::BayesStore::DBM::CORE:open, avg 172µs/call
1135 warn "bayes: cannot write to $path, bayes db update ignored: $!\n";
1136 umask $umask; # reset umask
1137 return;
1138 }
11392342.29ms234566µs umask $umask; # reset umask
# spent 566µs making 234 calls to Mail::SpamAssassin::BayesStore::DBM::CORE:umask, avg 2µs/call
1140
1141 # do not use print() here, it will break up the buffer if it's >8192 bytes,
1142 # which could result in two sets of tokens getting mixed up and their
1143 # touches missed.
1144234604µs my $write_failure = 0;
11452342.58ms234852µs my $original_point = tell OUT;
# spent 852µs making 234 calls to Mail::SpamAssassin::BayesStore::DBM::CORE:tell, avg 4µs/call
1146234592µs $original_point >= 0 or die "Can't obtain file position: $!";
1147234463µs my $len;
11482341.88ms do {
114923421.7ms23418.9ms $len = syswrite (OUT, $self->{string_to_journal}, $nbytes);
# spent 18.9ms making 234 calls to Mail::SpamAssassin::BayesStore::DBM::CORE:syswrite, avg 81µs/call
1150
1151 # argh, write failure, give up
1152234793µs if (!defined $len || $len < 0) {
1153 my $err = '';
1154 if (!defined $len) {
1155 $len = 0;
1156 $err = " ($!)";
1157 }
1158 warn "bayes: write failed to Bayes journal $path ($len of $nbytes)!$err\n";
1159 last;
1160 }
1161
1162 # This shouldn't happen, but could if the fs is full...
1163234674µs if ($len != $nbytes) {
1164 warn "bayes: partial write to bayes journal $path ($len of $nbytes), recovering\n";
1165
1166 # we want to be atomic, so revert the journal file back to where
1167 # we know it's "good". if we can't truncate the journal, or we've
1168 # tried 5 times to do the write, abort!
1169 if (!truncate(OUT, $original_point) || ($write_failure++ > 4)) {
1170 warn "bayes: cannot write to bayes journal $path, aborting!\n";
1171 last;
1172 }
1173
1174 # if the fs is full, let's give the system a break
1175 sleep 1;
1176 }
1177 } while ($len != $nbytes);
1178
11792345.67ms2343.17ms if (!close OUT) {
# spent 3.17ms making 234 calls to Mail::SpamAssassin::BayesStore::DBM::CORE:close, avg 14µs/call
1180 warn "bayes: cannot write to $path, bayes db update ignored\n";
1181 }
1182
11832342.84ms $self->{string_to_journal} = '';
1184}
1185
1186# Return a qr'd RE to match a token with the correct format's magic token
1187
# spent 130ms within Mail::SpamAssassin::BayesStore::DBM::get_magic_re which was called 12822 times, avg 10µs/call: # 12822 times (130ms+0s) by Mail::SpamAssassin::Plugin::Bayes::_tokenize_line at line 1168 of Mail/SpamAssassin/Plugin/Bayes.pm, avg 10µs/call
sub get_magic_re {
11881282224.5ms my ($self) = @_;
1189
11901282237.1ms if (!defined $self->{db_version} || $self->{db_version} >= 1) {
119112822130ms return MAGIC_RE;
1192 }
1193
1194 # When in doubt, assume v0
1195 return qr/^\*\*[A-Z]+$/;
1196}
1197
1198# provide a more generalized public interface into the journal sync
1199
1200sub sync {
1201 my ($self, $opts) = @_;
1202
1203 return $self->_sync_journal($opts);
1204}
1205
1206###########################################################################
1207# And this method reads the journal and applies the changes in one
1208# (locked) transaction.
1209
1210sub _sync_journal {
1211 my ($self, $opts) = @_;
1212 my $ret = 0;
1213
1214 my $path = $self->_get_journal_filename();
1215
1216 # if $path doesn't exist, or it's not a file, or is 0 bytes in length, return
1217 if (!stat($path) || !-f _ || -z _) {
1218 return 0;
1219 }
1220
1221 my $eval_stat;
1222 eval {
1223 local $SIG{'__DIE__'}; # do not run user die() traps in here
1224 if ($self->tie_db_writable()) {
1225 $ret = $self->_sync_journal_trapped($opts, $path);
1226 }
1227 1;
1228 } or do {
1229 $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
1230 };
1231
1232 # ok, untie from write-mode if we can
1233 if (!$self->{bayes}->{main}->{learn_caller_will_untie}) {
1234 $self->untie_db();
1235 }
1236
1237 # handle any errors that may have occurred
1238 if (defined $eval_stat) {
1239 warn "bayes: $eval_stat\n";
1240 return 0;
1241 }
1242
1243 $ret;
1244}
1245
1246sub _sync_journal_trapped {
1247 my ($self, $opts, $path) = @_;
1248
1249 # Flag that we're doing work
1250 $self->set_running_expire_tok();
1251
1252 my $started = time();
1253 my $count = 0;
1254 my $total_count = 0;
1255 my %tokens;
1256 my $showdots = $opts->{showdots};
1257 my $retirepath = $path.".old";
1258
1259 # if $path doesn't exist, or it's not a file, or is 0 bytes in length,
1260 # return we have to check again since the file may have been removed
1261 # by a recent bayes db upgrade ...
1262 if (!stat($path) || !-f _ || -z _) {
1263 return 0;
1264 }
1265
1266 if (!-r $path) { # will we be able to read the file?
1267 warn "bayes: bad permissions on journal, can't read: $path\n";
1268 return 0;
1269 }
1270
1271 # This is the critical phase (moving files around), so don't allow
1272 # it to be interrupted.
1273 {
1274 local $SIG{'INT'} = 'IGNORE';
1275 local $SIG{'TERM'} = 'IGNORE';
1276 local $SIG{'HUP'} = 'IGNORE' if !am_running_on_windows();
1277
1278 # retire the journal, so we can update the db files from it in peace.
1279 # TODO: use locking here
1280 if (!rename ($path, $retirepath)) {
1281 warn "bayes: failed rename $path to $retirepath\n";
1282 return 0;
1283 }
1284
1285 # now read the retired journal
1286 local *JOURNAL;
1287 if (!open (JOURNAL, "<$retirepath")) {
1288 warn "bayes: cannot open read $retirepath\n";
1289 return 0;
1290 }
1291
1292
1293 # Read the journal
1294 for ($!=0; defined($_=<JOURNAL>); $!=0) {
1295 $total_count++;
1296
1297 if (/^t (\d+) (.+)$/) { # Token timestamp update, cache resultant entries
1298 my $tok = pack("H*",$2);
1299 $tokens{$tok} = $1+0 if (!exists $tokens{$tok} || $1+0 > $tokens{$tok});
1300 } elsif (/^c (-?\d+) (-?\d+) (\d+) (.+)$/) { # Add/full token update
1301 my $tok = pack("H*",$4);
1302 $self->tok_sync_counters ($1+0, $2+0, $3+0, $tok);
1303 $count++;
1304 } elsif (/^n (-?\d+) (-?\d+)$/) { # update ham/spam count
1305 $self->tok_sync_nspam_nham ($1+0, $2+0);
1306 $count++;
1307 } elsif (/^m ([hsf]) (.+)$/) { # update msgid seen database
1308 if ($1 eq "f") {
1309 $self->_seen_delete_direct($2);
1310 }
1311 else {
1312 $self->_seen_put_direct($2,$1);
1313 }
1314 $count++;
1315 } else {
1316 warn "bayes: gibberish entry found in journal: $_";
1317 }
1318 }
1319 defined $_ || $!==0 or
1320 $!==EBADF ? dbg("bayes: error reading journal file: $!")
1321 : die "error reading journal file: $!";
1322 close(JOURNAL) or die "Can't close journal file: $!";
1323
1324 # Now that we've determined what tokens we need to update and their
1325 # final values, update the DB. Should be much smaller than the full
1326 # journal entries.
1327 while (my ($k,$v) = each %tokens) {
1328 $self->tok_touch_token ($v, $k);
1329
1330 if ((++$count % 1000) == 0) {
1331 if ($showdots) { print STDERR "."; }
1332 $self->set_running_expire_tok();
1333 }
1334 }
1335
1336 if ($showdots) { print STDERR "\n"; }
1337
1338 # we're all done, so unlink the old journal file
1339 unlink ($retirepath) || warn "bayes: can't unlink $retirepath: $!\n";
1340
1341 $self->{db_toks}->{$LAST_JOURNAL_SYNC_MAGIC_TOKEN} = $started;
1342
1343 my $done = time();
1344 my $msg = ("bayes: synced databases from journal in " .
1345 ($done - $started) .
1346 " seconds: $count unique entries ($total_count total entries)");
1347
1348 if ($opts->{verbose}) {
1349 print $msg,"\n";
1350 } else {
1351 dbg($msg);
1352 }
1353 }
1354
1355 # else, that's the lot, we're synced. return
1356 return 1;
1357}
1358
1359sub tok_touch_token {
1360 my ($self, $atime, $tok) = @_;
1361 my ($ts, $th, $oldatime) = $self->tok_get ($tok);
1362
1363 # If the new atime is < the old atime, ignore the update
1364 # We figure that we'll never want to lower a token atime, so abort if
1365 # we try. (journal out of sync, etc.)
1366 return if ($oldatime >= $atime);
1367
1368 $self->tok_put ($tok, $ts, $th, $atime);
1369}
1370
1371sub tok_sync_counters {
1372 my ($self, $ds, $dh, $atime, $tok) = @_;
1373 my ($ts, $th, $oldatime) = $self->tok_get ($tok);
1374 $ts += $ds; if ($ts < 0) { $ts = 0; }
1375 $th += $dh; if ($th < 0) { $th = 0; }
1376
1377 # Don't roll the atime of tokens backwards ...
1378 $atime = $oldatime if ($oldatime > $atime);
1379
1380 $self->tok_put ($tok, $ts, $th, $atime);
1381}
1382
1383sub tok_put {
1384 my ($self, $tok, $ts, $th, $atime) = @_;
1385 $ts ||= 0;
1386 $th ||= 0;
1387
1388 # Ignore magic tokens, the don't go in this way ...
1389 return if ($tok =~ MAGIC_RE);
1390
1391 # use defined() rather than exists(); the latter is not supported
1392 # by NDBM_File, believe it or not. Using defined() did not
1393 # indicate any noticeable speed hit in my testing. (Mar 31 2003 jm)
1394 my $exists_already = defined $self->{db_toks}->{$tok};
1395
1396 if ($ts == 0 && $th == 0) {
1397 return if (!$exists_already); # If the token doesn't exist, just return
1398 $self->{db_toks}->{$NTOKENS_MAGIC_TOKEN}--;
1399 delete $self->{db_toks}->{$tok};
1400 } else {
1401 if (!$exists_already) { # If the token doesn't exist, raise the token count
1402 $self->{db_toks}->{$NTOKENS_MAGIC_TOKEN}++;
1403 }
1404
1405 $self->{db_toks}->{$tok} = $self->tok_pack ($ts, $th, $atime);
1406
1407 my $newmagic = $self->{db_toks}->{$NEWEST_TOKEN_AGE_MAGIC_TOKEN};
1408 if (!defined ($newmagic) || $atime > $newmagic) {
1409 $self->{db_toks}->{$NEWEST_TOKEN_AGE_MAGIC_TOKEN} = $atime;
1410 }
1411
1412 # Make sure to check for either !defined or "" ... Apparently
1413 # sometimes the DB module doesn't return the value correctly. :(
1414 my $oldmagic = $self->{db_toks}->{$OLDEST_TOKEN_AGE_MAGIC_TOKEN};
1415 if (!defined ($oldmagic) || $oldmagic eq "" || $atime < $oldmagic) {
1416 $self->{db_toks}->{$OLDEST_TOKEN_AGE_MAGIC_TOKEN} = $atime;
1417 }
1418 }
1419}
1420
1421sub tok_sync_nspam_nham {
1422 my ($self, $ds, $dh) = @_;
1423 my ($ns, $nh) = ($self->get_storage_variables())[1,2];
1424 if ($ds) { $ns += $ds; } if ($ns < 0) { $ns = 0; }
1425 if ($dh) { $nh += $dh; } if ($nh < 0) { $nh = 0; }
1426 $self->{db_toks}->{$NSPAM_MAGIC_TOKEN} = $ns;
1427 $self->{db_toks}->{$NHAM_MAGIC_TOKEN} = $nh;
1428}
1429
1430###########################################################################
1431
1432
# spent 11.5ms (6.50+5.04) within Mail::SpamAssassin::BayesStore::DBM::_get_journal_filename which was called 234 times, avg 49µs/call: # 234 times (6.50ms+5.04ms) by Mail::SpamAssassin::BayesStore::DBM::cleanup at line 1125, avg 49µs/call
sub _get_journal_filename {
1433234561µs my ($self) = @_;
1434
1435234796µs my $main = $self->{bayes}->{main};
14362344.87ms2345.04ms return $main->sed_path($main->{conf}->{bayes_path}."_journal");
# spent 5.04ms making 234 calls to Mail::SpamAssassin::sed_path, avg 22µs/call
1437}
1438
1439###########################################################################
1440
1441# this is called directly from sa-learn(1).
1442sub perform_upgrade {
1443 my ($self, $opts) = @_;
1444 my $ret = 0;
1445
1446 my $eval_stat;
1447 eval {
1448 local $SIG{'__DIE__'}; # do not run user die() traps in here
1449
145024.33ms2401µs
# spent 221µs (42+179) within Mail::SpamAssassin::BayesStore::DBM::BEGIN@1450 which was called: # once (42µs+179µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 1450
use File::Basename;
# spent 221µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@1450 # spent 179µs making 1 call to Exporter::import
1451
1452 # bayes directory
1453 my $main = $self->{bayes}->{main};
1454 my $path = $main->sed_path($main->{conf}->{bayes_path});
1455
1456 # prevent dirname() from tainting the result, it assumes $1 is not tainted
1457 local($1,$2,$3); # Bug 6310; perl #67962 (fixed in perl 5.12/5.13)
1458 my $dir = dirname($path);
1459
1460 # make temporary copy since old dbm and new dbm may have same name
1461 opendir(DIR, $dir) or die "bayes: can't opendir $dir: $!";
1462 my @files = grep { /^bayes_(?:seen|toks)(?:\.\w+)?$/ } readdir(DIR);
1463 closedir(DIR) or die "bayes: can't close directory $dir: $!";
1464 if (@files < 2 || !grep(/bayes_seen/,@files) || !grep(/bayes_toks/,@files))
1465 {
1466 die "bayes: unable to find bayes_toks and bayes_seen, stopping\n";
1467 }
1468 # untaint @files (already safe after grep)
1469 untaint_var(\@files);
1470
1471 for (@files) {
1472 my $src = "$dir/$_";
1473 my $dst = "$dir/old_$_";
1474 eval q{
1475 use File::Copy;
1476 copy($src, $dst);
1477 } || die "bayes: can't copy $src to $dst: $!\n";
1478 }
1479
1480 # delete previous to make way for import
1481 for (@files) { unlink("$dir/$_"); }
1482
1483 # import
1484 if ($self->tie_db_writable()) {
1485 $ret += $self->upgrade_old_dbm_files_trapped("$dir/old_bayes_seen",
1486 $self->{db_seen});
1487 $ret += $self->upgrade_old_dbm_files_trapped("$dir/old_bayes_toks",
1488 $self->{db_toks});
1489 }
1490
1491 if ($ret == 2) {
1492 print "import successful, original files saved with \"old\" prefix\n";
1493 }
1494 else {
1495 print "import failed, original files saved with \"old\" prefix\n";
1496 }
1497 1;
1498 } or do {
1499 $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
1500 };
1501
1502 $self->untie_db();
1503
1504 # if we died, untie the dbm files
1505 if (defined $eval_stat) {
1506 warn "bayes: perform_upgrade: $eval_stat\n";
1507 return 0;
1508 }
1509 $ret;
1510}
1511
1512sub upgrade_old_dbm_files_trapped {
1513 my ($self, $filename, $output) = @_;
1514
1515 my $count;
1516 my %in;
1517
1518 print "upgrading to DB_File, please be patient: $filename\n";
1519
1520 # try each type of file until we find one with > 0 entries
1521 for my $dbm ('DB_File', 'GDBM_File', 'NDBM_File', 'SDBM_File') {
1522 $count = 0;
1523 # wrap in eval so it doesn't run in general use. This accesses db
1524 # modules directly.
1525 # Note: (bug 2390), the 'use' needs to be on the same line as the eval
1526 # for RPM dependency checks to work properly. It's lame, but...
1527 my $eval_stat;
1528 eval 'use ' . $dbm . ';
1529 tie %in, "' . $dbm . '", $filename, O_RDONLY, 0600;
1530 %{ $output } = %in;
1531 $count = scalar keys %{ $output };
1532 untie %in;
1533 1;
1534 ' or do {
1535 $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
1536 };
1537 if (defined $eval_stat) {
1538 print "$dbm: $dbm module not installed(?), nothing copied: $eval_stat\n";
1539 dbg("bayes: error was: $eval_stat");
1540 }
1541 elsif ($count == 0) {
1542 print "$dbm: no database of that kind found, nothing copied\n";
1543 }
1544 else {
1545 print "$dbm: copied $count entries\n";
1546 return 1;
1547 }
1548 }
1549
1550 return 0;
1551}
1552
1553sub clear_database {
1554 my ($self) = @_;
1555
1556 return 0 unless ($self->tie_db_writable());
1557
1558 dbg("bayes: untie-ing in preparation for removal.");
1559
1560 foreach my $dbname (@DBNAMES) {
1561 my $db_var = 'db_'.$dbname;
1562
1563 if (exists $self->{$db_var}) {
1564 # dbg("bayes: untie-ing $db_var");
1565 untie %{$self->{$db_var}};
1566 delete $self->{$db_var};
1567 }
1568 }
1569
1570 my $path = $self->{bayes}->{main}->sed_path($self->{bayes}->{main}->{conf}->{bayes_path});
1571
1572 foreach my $dbname (@DBNAMES, 'journal') {
1573 foreach my $ext ($self->DB_EXTENSIONS) {
1574 my $name = $path.'_'.$dbname.$ext;
1575 my $ret = unlink $name;
1576 dbg("bayes: clear_database: %s %s",
1577 $ret ? 'removed' : 'tried to remove', $name);
1578 }
1579 }
1580
1581 # the journal file needs to be done separately since it has no extension
1582 foreach my $dbname ('journal') {
1583 my $name = $path.'_'.$dbname;
1584 my $ret = unlink $name;
1585 dbg("bayes: clear_database: %s %s",
1586 $ret ? 'removed' : 'tried to remove', $name);
1587 }
1588
1589 $self->untie_db();
1590
1591 return 1;
1592}
1593
1594sub backup_database {
1595 my ($self) = @_;
1596
1597 # we tie writable because we want the upgrade code to kick in if needed
1598 return 0 unless ($self->tie_db_writable());
1599
1600 my @vars = $self->get_storage_variables();
1601
1602 print "v\t$vars[6]\tdb_version # this must be the first line!!!\n";
1603 print "v\t$vars[1]\tnum_spam\n";
1604 print "v\t$vars[2]\tnum_nonspam\n";
1605
1606 while (my ($tok, $packed) = each %{$self->{db_toks}}) {
1607 next if ($tok =~ MAGIC_RE); # skip magic tokens
1608
1609 my ($ts, $th, $atime) = $self->tok_unpack($packed);
1610 my $encoded_token = unpack("H*",$tok);
1611 print "t\t$ts\t$th\t$atime\t$encoded_token\n";
1612 }
1613
1614 while (my ($msgid, $flag) = each %{$self->{db_seen}}) {
1615 print "s\t$flag\t$msgid\n";
1616 }
1617
1618 $self->untie_db();
1619
1620 return 1;
1621}
1622
1623sub restore_database {
1624 my ($self, $filename, $showdots) = @_;
1625
1626 local *DUMPFILE;
1627 if (!open(DUMPFILE, '<', $filename)) {
1628 dbg("bayes: unable to open backup file $filename: $!");
1629 return 0;
1630 }
1631
1632 if (!$self->tie_db_writable()) {
1633 dbg("bayes: failed to tie db writable");
1634 return 0;
1635 }
1636
1637 my $main = $self->{bayes}->{main};
1638 my $path = $main->sed_path($main->{conf}->{bayes_path});
1639
1640 # use a temporary PID-based suffix just in case another one was
1641 # created previously by an interrupted expire
1642 my $tmpsuffix = "convert$$";
1643 my $tmptoksdbname = $path.'_toks.'.$tmpsuffix;
1644 my $tmpseendbname = $path.'_seen.'.$tmpsuffix;
1645 my $toksdbname = $path.'_toks';
1646 my $seendbname = $path.'_seen';
1647
1648 my %new_toks;
1649 my %new_seen;
1650 my $umask = umask 0;
1651 unless (tie %new_toks, $self->DBM_MODULE, $tmptoksdbname, O_RDWR|O_CREAT|O_EXCL,
1652 (oct ($main->{conf}->{bayes_file_mode}) & 0666)) {
1653 dbg("bayes: failed to tie temp toks db: $!");
1654 $self->untie_db();
1655 umask $umask;
1656 return 0;
1657 }
1658 unless (tie %new_seen, $self->DBM_MODULE, $tmpseendbname, O_RDWR|O_CREAT|O_EXCL,
1659 (oct ($main->{conf}->{bayes_file_mode}) & 0666)) {
1660 dbg("bayes: failed to tie temp seen db: $!");
1661 untie %new_toks;
1662 $self->_unlink_file($tmptoksdbname);
1663 $self->untie_db();
1664 umask $umask;
1665 return 0;
1666 }
1667 umask $umask;
1668
1669 my $line_count = 0;
1670 my $db_version;
1671 my $token_count = 0;
1672 my $num_spam;
1673 my $num_ham;
1674 my $error_p = 0;
1675 my $newest_token_age = 0;
1676 # Kinda wierd I know, but we need a nice big value and we know there will be
1677 # no tokens > time() since we reset atime if > time(), so use that with a
1678 # little buffer just in case.
1679 my $oldest_token_age = time() + 100000;
1680
1681 my $line = <DUMPFILE>;
1682 defined $line or die "Error reading dump file: $!";
1683 $line_count++;
1684
1685 # We require the database version line to be the first in the file so we can
1686 # figure out how to properly deal with the file. If it is not the first
1687 # line then fail
1688 if ($line =~ m/^v\s+(\d+)\s+db_version/) {
1689 $db_version = $1;
1690 }
1691 else {
1692 dbg("bayes: database version must be the first line in the backup file, correct and re-run");
1693 untie %new_toks;
1694 untie %new_seen;
1695 $self->_unlink_file($tmptoksdbname);
1696 $self->_unlink_file($tmpseendbname);
1697 $self->untie_db();
1698 return 0;
1699 }
1700
1701 unless ($db_version == 2 || $db_version == 3) {
1702 warn("bayes: database version $db_version is unsupported, must be version 2 or 3");
1703 untie %new_toks;
1704 untie %new_seen;
1705 $self->_unlink_file($tmptoksdbname);
1706 $self->_unlink_file($tmpseendbname);
1707 $self->untie_db();
1708 return 0;
1709 }
1710
1711 for ($!=0; defined($line=<DUMPFILE>); $!=0) {
1712 chomp($line);
1713 $line_count++;
1714
1715 if ($line_count % 1000 == 0) {
1716 print STDERR "." if ($showdots);
1717 }
1718
1719 if ($line =~ /^v\s+/) { # variable line
1720 my @parsed_line = split(/\s+/, $line, 3);
1721 my $value = $parsed_line[1] + 0;
1722 if ($parsed_line[2] eq 'num_spam') {
1723 $num_spam = $value;
1724 }
1725 elsif ($parsed_line[2] eq 'num_nonspam') {
1726 $num_ham = $value;
1727 }
1728 else {
1729 dbg("bayes: restore_database: skipping unknown line: $line");
1730 }
1731 }
1732 elsif ($line =~ /^t\s+/) { # token line
1733 my @parsed_line = split(/\s+/, $line, 5);
1734 my $spam_count = $parsed_line[1] + 0;
1735 my $ham_count = $parsed_line[2] + 0;
1736 my $atime = $parsed_line[3] + 0;
1737 my $token = $parsed_line[4];
1738
1739 my $token_warn_p = 0;
1740 my @warnings;
1741
1742 if ($spam_count < 0) {
1743 $spam_count = 0;
1744 push(@warnings, 'spam count < 0, resetting');
1745 $token_warn_p = 1;
1746 }
1747 if ($ham_count < 0) {
1748 $ham_count = 0;
1749 push(@warnings, 'ham count < 0, resetting');
1750 $token_warn_p = 1;
1751 }
1752
1753 if ($spam_count == 0 && $ham_count == 0) {
1754 dbg("bayes: token has zero spam and ham count, skipping");
1755 next;
1756 }
1757
1758 if ($atime > time()) {
1759 $atime = time();
1760 push(@warnings, 'atime > current time, resetting');
1761 $token_warn_p = 1;
1762 }
1763
1764 if ($token_warn_p) {
1765 dbg("bayes: token (%s) has the following warnings:\n%s",
1766 $token, join("\n",@warnings));
1767 }
1768
1769 # database versions < 3 did not encode their token values
1770 if ($db_version < 3) {
1771 $token = substr(sha1($token), -5);
1772 }
1773 else {
1774 # turn unpacked binary token back into binary value
1775 $token = pack("H*",$token);
1776 }
1777
1778 $new_toks{$token} = $self->tok_pack($spam_count, $ham_count, $atime);
1779 if ($atime < $oldest_token_age) {
1780 $oldest_token_age = $atime;
1781 }
1782 if ($atime > $newest_token_age) {
1783 $newest_token_age = $atime;
1784 }
1785 $token_count++;
1786 }
1787 elsif ($line =~ /^s\s+/) { # seen line
1788 my @parsed_line = split(/\s+/, $line, 3);
1789 my $flag = $parsed_line[1];
1790 my $msgid = $parsed_line[2];
1791
1792 unless ($flag eq 'h' || $flag eq 's') {
1793 dbg("bayes: unknown seen flag ($flag) for line: $line, skipping");
1794 next;
1795 }
1796
1797 unless ($msgid) {
1798 dbg("bayes: blank msgid for line: $line, skipping");
1799 next;
1800 }
1801
1802 $new_seen{$msgid} = $flag;
1803 }
1804 else {
1805 dbg("bayes: skipping unknown line: $line");
1806 next;
1807 }
1808 }
1809 defined $line || $!==0 or die "Error reading dump file: $!";
1810 close(DUMPFILE) or die "Can't close dump file: $!";
1811
1812 print STDERR "\n" if ($showdots);
1813
1814 unless (defined($num_spam)) {
1815 dbg("bayes: unable to find num spam, please check file");
1816 $error_p = 1;
1817 }
1818
1819 unless (defined($num_ham)) {
1820 dbg("bayes: unable to find num ham, please check file");
1821 $error_p = 1;
1822 }
1823
1824 if ($error_p) {
1825 dbg("bayes: error(s) while attempting to load $filename, correct and re-run");
1826
1827 untie %new_toks;
1828 untie %new_seen;
1829 $self->_unlink_file($tmptoksdbname);
1830 $self->_unlink_file($tmpseendbname);
1831 $self->untie_db();
1832 return 0;
1833 }
1834
1835 # set the calculated magic tokens
1836 $new_toks{$DB_VERSION_MAGIC_TOKEN} = $self->DB_VERSION();
1837 $new_toks{$NTOKENS_MAGIC_TOKEN} = $token_count;
1838 $new_toks{$NSPAM_MAGIC_TOKEN} = $num_spam;
1839 $new_toks{$NHAM_MAGIC_TOKEN} = $num_ham;
1840 $new_toks{$NEWEST_TOKEN_AGE_MAGIC_TOKEN} = $newest_token_age;
1841 $new_toks{$OLDEST_TOKEN_AGE_MAGIC_TOKEN} = $oldest_token_age;
1842
1843 # go ahead and zero out these, chances are good that they are bogus anyway.
1844 $new_toks{$LAST_EXPIRE_MAGIC_TOKEN} = 0;
1845 $new_toks{$LAST_JOURNAL_SYNC_MAGIC_TOKEN} = 0;
1846 $new_toks{$LAST_ATIME_DELTA_MAGIC_TOKEN} = 0;
1847 $new_toks{$LAST_EXPIRE_REDUCE_MAGIC_TOKEN} = 0;
1848
1849 local $SIG{'INT'} = 'IGNORE';
1850 local $SIG{'TERM'} = 'IGNORE';
1851 local $SIG{'HUP'} = 'IGNORE' if !am_running_on_windows();
1852
1853 untie %new_toks;
1854 untie %new_seen;
1855 $self->untie_db();
1856
1857 # Here is where something can go horribly wrong and screw up the bayes
1858 # database files. If we are able to copy one and not the other then it
1859 # will leave the database in an inconsistent state. Since this is an
1860 # edge case, and they're trying to replace the DB anyway we should be ok.
1861 unless ($self->_rename_file($tmptoksdbname, $toksdbname)) {
1862 dbg("bayes: error while renaming $tmptoksdbname to $toksdbname: $!");
1863 return 0;
1864 }
1865 unless ($self->_rename_file($tmpseendbname, $seendbname)) {
1866 dbg("bayes: error while renaming $tmpseendbname to $seendbname: $!");
1867 dbg("bayes: database now in inconsistent state");
1868 return 0;
1869 }
1870
1871 dbg("bayes: parsed $line_count lines");
1872 dbg("bayes: created database with $token_count tokens based on $num_spam spam messages and $num_ham ham messages");
1873
1874 return 1;
1875}
1876
1877###########################################################################
1878
1879# token marshalling format for db_toks.
1880
1881# Since we may have many entries with few hits, especially thousands of hapaxes
1882# (1-occurrence entries), use a flexible entry format, instead of simply "2
1883# packed ints", to keep the memory and disk space usage down. In my
1884# 18k-message test corpus, only 8.9% have >= 8 hits in either counter, so we
1885# can use a 1-byte representation for the other 91% of low-hitting entries
1886# and save masses of space.
1887
1888# This looks like: XXSSSHHH (XX = format bits, SSS = 3 spam-count bits, HHH = 3
1889# ham-count bits). If XX in the first byte is 11, it's packed as this 1-byte
1890# representation; otherwise, if XX in the first byte is 00, it's packed as
1891# "CLL", ie. 1 byte and 2 32-bit "longs" in perl pack format.
1892
1893# Savings: roughly halves size of toks db, at the cost of a ~10% slowdown.
1894
1895272µs2423µs
# spent 226µs (28+197) within Mail::SpamAssassin::BayesStore::DBM::BEGIN@1895 which was called: # once (28µs+197µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 1895
use constant FORMAT_FLAG => 0xc0; # 11000000
# spent 226µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@1895 # spent 197µs making 1 call to constant::import
1896259µs2270µs
# spent 145µs (19+125) within Mail::SpamAssassin::BayesStore::DBM::BEGIN@1896 which was called: # once (19µs+125µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 1896
use constant ONE_BYTE_FORMAT => 0xc0; # 11000000
# spent 145µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@1896 # spent 125µs making 1 call to constant::import
1897260µs2287µs
# spent 153µs (19+134) within Mail::SpamAssassin::BayesStore::DBM::BEGIN@1897 which was called: # once (19µs+134µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 1897
use constant TWO_LONGS_FORMAT => 0x00; # 00000000
# spent 153µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@1897 # spent 134µs making 1 call to constant::import
1898
1899259µs2275µs
# spent 151µs (27+124) within Mail::SpamAssassin::BayesStore::DBM::BEGIN@1899 which was called: # once (27µs+124µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 1899
use constant ONE_BYTE_SSS_BITS => 0x38; # 00111000
# spent 151µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@1899 # spent 124µs making 1 call to constant::import
19002862µs2262µs
# spent 140µs (18+122) within Mail::SpamAssassin::BayesStore::DBM::BEGIN@1900 which was called: # once (18µs+122µs) by Mail::SpamAssassin::Plugin::Bayes::learner_new at line 1900
use constant ONE_BYTE_HHH_BITS => 0x07; # 00000111
# spent 140µs making 1 call to Mail::SpamAssassin::BayesStore::DBM::BEGIN@1900 # spent 122µs making 1 call to constant::import
1901
1902sub tok_unpack {
1903 my ($self, $value) = @_;
1904 $value ||= 0;
1905
1906 my ($packed, $atime);
1907 if ($self->{db_version} >= 1) {
1908 ($packed, $atime) = unpack("CV", $value);
1909 }
1910 elsif ($self->{db_version} == 0) {
1911 ($packed, $atime) = unpack("CS", $value);
1912 }
1913
1914 if (($packed & FORMAT_FLAG) == ONE_BYTE_FORMAT) {
1915 return (($packed & ONE_BYTE_SSS_BITS) >> 3,
1916 $packed & ONE_BYTE_HHH_BITS,
1917 $atime || 0);
1918 }
1919 elsif (($packed & FORMAT_FLAG) == TWO_LONGS_FORMAT) {
1920 my ($packed, $ts, $th, $atime);
1921 if ($self->{db_version} >= 1) {
1922 ($packed, $ts, $th, $atime) = unpack("CVVV", $value);
1923 }
1924 elsif ($self->{db_version} == 0) {
1925 ($packed, $ts, $th, $atime) = unpack("CLLS", $value);
1926 }
1927 return ($ts || 0, $th || 0, $atime || 0);
1928 }
1929 # other formats would go here...
1930 else {
1931 warn "bayes: unknown packing format for bayes db, please re-learn: $packed";
1932 return (0, 0, 0);
1933 }
1934}
1935
1936sub tok_pack {
1937 my ($self, $ts, $th, $atime) = @_;
1938 $ts ||= 0; $th ||= 0; $atime ||= 0;
1939 if ($ts < 8 && $th < 8) {
1940 return pack ("CV", ONE_BYTE_FORMAT | ($ts << 3) | $th, $atime);
1941 } else {
1942 return pack ("CVVV", TWO_LONGS_FORMAT, $ts, $th, $atime);
1943 }
1944}
1945
1946###########################################################################
1947
1948
# spent 13µs within Mail::SpamAssassin::BayesStore::DBM::db_readable which was called: # once (13µs+0s) by Mail::SpamAssassin::Plugin::Bayes::learner_close at line 330 of Mail/SpamAssassin/Plugin/Bayes.pm
sub db_readable {
194913µs my ($self) = @_;
1950115µs return $self->{already_tied};
1951}
1952
1953sub db_writable {
1954 my ($self) = @_;
1955 return $self->{already_tied} && $self->{is_locked};
1956}
1957
1958###########################################################################
1959
1960sub _unlink_file {
1961 my ($self, $filename) = @_;
1962
1963 unlink $filename;
1964}
1965
1966sub _rename_file {
1967 my ($self, $sourcefilename, $targetfilename) = @_;
1968
1969 return 0 unless (rename($sourcefilename, $targetfilename));
1970
1971 return 1;
1972}
1973
1974sub sa_die { Mail::SpamAssassin::sa_die(@_); }
1975
1976119µs1;
 
# spent 3.17ms within Mail::SpamAssassin::BayesStore::DBM::CORE:close which was called 234 times, avg 14µs/call: # 234 times (3.17ms+0s) by Mail::SpamAssassin::BayesStore::DBM::cleanup at line 1179, avg 14µs/call
sub Mail::SpamAssassin::BayesStore::DBM::CORE:close; # opcode
# spent 19µs within Mail::SpamAssassin::BayesStore::DBM::CORE:ftdir which was called: # once (19µs+0s) by Mail::SpamAssassin::BayesStore::DBM::tie_db_writable at line 267
sub Mail::SpamAssassin::BayesStore::DBM::CORE:ftdir; # opcode
# spent 12.5ms within Mail::SpamAssassin::BayesStore::DBM::CORE:ftfile which was called 239 times, avg 52µs/call: # 237 times (12.4ms+0s) by Mail::SpamAssassin::BayesStore::DBM::tie_db_readonly at line 162, avg 52µs/call # 2 times (27µs+0s) by Mail::SpamAssassin::BayesStore::DBM::tie_db_writable at line 260, avg 13µs/call
sub Mail::SpamAssassin::BayesStore::DBM::CORE:ftfile; # opcode
# spent 4.12ms within Mail::SpamAssassin::BayesStore::DBM::CORE:match which was called 1281 times, avg 3µs/call: # 1048 times (3.00ms+0s) by Mail::SpamAssassin::BayesStore::DBM::get_storage_variables at line 986, avg 3µs/call # 233 times (1.11ms+0s) by Mail::SpamAssassin::BayesStore::DBM::get_storage_variables at line 912, avg 5µs/call
sub Mail::SpamAssassin::BayesStore::DBM::CORE:match; # opcode
# spent 40.3ms within Mail::SpamAssassin::BayesStore::DBM::CORE:open which was called 234 times, avg 172µs/call: # 234 times (40.3ms+0s) by Mail::SpamAssassin::BayesStore::DBM::cleanup at line 1134, avg 172µs/call
sub Mail::SpamAssassin::BayesStore::DBM::CORE:open; # opcode
# spent 6µs within Mail::SpamAssassin::BayesStore::DBM::CORE:qr which was called: # once (6µs+0s) by Mail::SpamAssassin::BayesStore::DBM::BEGIN@41 at line 41
sub Mail::SpamAssassin::BayesStore::DBM::CORE:qr; # opcode
# spent 18.9ms within Mail::SpamAssassin::BayesStore::DBM::CORE:syswrite which was called 234 times, avg 81µs/call: # 234 times (18.9ms+0s) by Mail::SpamAssassin::BayesStore::DBM::cleanup at line 1149, avg 81µs/call
sub Mail::SpamAssassin::BayesStore::DBM::CORE:syswrite; # opcode
# spent 852µs within Mail::SpamAssassin::BayesStore::DBM::CORE:tell which was called 234 times, avg 4µs/call: # 234 times (852µs+0s) by Mail::SpamAssassin::BayesStore::DBM::cleanup at line 1145, avg 4µs/call
sub Mail::SpamAssassin::BayesStore::DBM::CORE:tell; # opcode
# spent 1.65ms within Mail::SpamAssassin::BayesStore::DBM::CORE:umask which was called 470 times, avg 4µs/call: # 234 times (1.07ms+0s) by Mail::SpamAssassin::BayesStore::DBM::cleanup at line 1132, avg 5µs/call # 234 times (566µs+0s) by Mail::SpamAssassin::BayesStore::DBM::cleanup at line 1139, avg 2µs/call # once (2µs+0s) by Mail::SpamAssassin::BayesStore::DBM::tie_db_writable at line 304 # once (2µs+0s) by Mail::SpamAssassin::BayesStore::DBM::tie_db_writable at line 289
sub Mail::SpamAssassin::BayesStore::DBM::CORE:umask; # opcode
# spent 186ms within Mail::SpamAssassin::BayesStore::DBM::CORE:unpack which was called 73724 times, avg 3µs/call: # 73724 times (186ms+0s) by Mail::SpamAssassin::BayesStore::DBM::multi_tok_count_change at line 1069, avg 3µs/call
sub Mail::SpamAssassin::BayesStore::DBM::CORE:unpack; # opcode
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.