14 use Unix::Syslog qw(:macros :subs); |
14 use Unix::Syslog qw(:macros :subs); |
15 use Text::Iconv; |
15 use Text::Iconv; |
16 use Time::HiRes qw(gettimeofday tv_interval); |
16 use Time::HiRes qw(gettimeofday tv_interval); |
17 use if $ENV{DEBUG} => "Data::Dumper"; |
17 use if $ENV{DEBUG} => "Data::Dumper"; |
18 |
18 |
19 my $T0 = [gettimeofday()]; |
19 my $T0 = [ gettimeofday() ]; |
20 |
20 |
21 my $OUTPUT_CHARSET = "UTF8"; |
21 my $OUTPUT_CHARSET = "UTF8"; |
22 my $DEFAULT_INPUT_CHARSET = "ASCII"; |
22 my $DEFAULT_INPUT_CHARSET = "ASCII"; |
23 |
23 |
24 my $opt_help = 0; |
24 my $opt_help = 0; |
34 # read the message into tmpfile (passed as arg) and return "Message" object |
34 # read the message into tmpfile (passed as arg) and return "Message" object |
35 sub get_message(); |
35 sub get_message(); |
36 sub get_headers($); |
36 sub get_headers($); |
37 sub decode_headers($$); |
37 sub decode_headers($$); |
38 |
38 |
39 |
|
40 |
|
41 MAIN: { |
39 MAIN: { |
42 openlog( "mail2db", LOG_PID | ( -t STDIN ? LOG_PERROR: 0 ), LOG_MAIL ); |
40 openlog( "mail2db", LOG_PID | ( -t STDIN ? LOG_PERROR: 0 ), LOG_MAIL ); |
43 $SIG{__DIE__} = sub { die $@ if $^S; syslog(LOG_ERR, "ERROR: %s", join "", @_); exit 2 }; |
41 $SIG{__DIE__} = |
44 $SIG{__WARN__} = sub { syslog(LOG_WARNING, "%s", join "", @_) }; |
42 sub { die $@ if $^S; syslog( LOG_ERR, "ERROR: %s", join "", @_ ); exit 2 }; |
|
43 $SIG{__WARN__} = sub { syslog( LOG_WARNING, "%s", join "", @_ ) }; |
45 |
44 |
46 if ( -f ( $_ = "/etc/mail2db.conf" ) ) { |
45 if ( -f ( $_ = "/etc/mail2db.conf" ) ) { |
47 open( X, $_ ) or die "Can't open $_: $!\n"; |
46 open( X, $_ ) or die "Can't open $_: $!\n"; |
48 unshift @ARGV, map { chomp; $_ } <X>; |
47 unshift @ARGV, map { chomp; $_ } <X>; |
49 } |
48 } |
52 "dbuser=s" => \$opt_dbuser, |
51 "dbuser=s" => \$opt_dbuser, |
53 "dbpass=s" => \$opt_dbpass, |
52 "dbpass=s" => \$opt_dbpass, |
54 "h|help" => \$opt_help, |
53 "h|help" => \$opt_help, |
55 "m|man" => \$opt_man, |
54 "m|man" => \$opt_man, |
56 "n|dry" => \$opt_dry, |
55 "n|dry" => \$opt_dry, |
57 "debug!" => \$opt_debug, |
56 "debug!" => \$opt_debug, |
58 ) or pod2usage(); |
57 ) or pod2usage(); |
59 |
58 |
60 pod2usage( -verbose => 1, -exitval => 0 ) if $opt_help; |
59 pod2usage( -verbose => 1, -exitval => 0 ) if $opt_help; |
61 pod2usage( -verbose => 2, -exitval => 0 ) if $opt_man; |
60 pod2usage( -verbose => 2, -exitval => 0 ) if $opt_man; |
62 |
61 |
63 $DBH = |
62 $DBH = |
64 DBI->connect( $opt_dsn, $opt_dbuser, $opt_dbpass, |
63 DBI->connect( $opt_dsn, $opt_dbuser, $opt_dbpass, |
65 { RaiseError => 1, FetchHashKeyName => "NAME_lc", AutoCommit => 0 } ) |
64 { RaiseError => 1, FetchHashKeyName => "NAME_lc", AutoCommit => 0 } ) |
66 or die; |
65 or die; |
67 |
66 |
68 # The $message contains the in-core representation, the MIME parser |
67 # The $message contains the in-core representation, the MIME parser |
69 # works on it. The $tmpfile (handle) will be used for access to the |
68 # works on it. The $tmpfile (handle) will be used for access to the |
70 # original unmodified message. |
69 # original unmodified message. |
71 my ( $tmpfile, $message ) = get_message(); |
70 my ( $tmpfile, $message ) = get_message(); |
72 decode_headers( $message, $OUTPUT_CHARSET ); |
71 decode_headers( $message, $OUTPUT_CHARSET ); |
73 |
72 |
74 # $message->print; |
73 # $message->print; |
75 |
74 |
100 |
99 |
101 # first insert the message and get the database message id |
100 # first insert the message and get the database message id |
102 my $msg_id; |
101 my $msg_id; |
103 { |
102 { |
104 local $/ = undef; |
103 local $/ = undef; |
105 seek($tmpfile, 0, 0); |
104 seek( $tmpfile, 0, 0 ); |
106 $insert_message->execute(<$tmpfile>); |
105 $insert_message->execute(<$tmpfile>); |
107 $msg_id = $DBH->last_insert_id( undef, undef, message => "id" ); |
106 $msg_id = $DBH->last_insert_id( undef, undef, message => "id" ); |
108 syslog( LOG_DEBUG, "message id: $msg_id" ) if $opt_debug; |
107 syslog( LOG_DEBUG, "message id: $msg_id" ) if $opt_debug; |
109 } |
108 } |
110 |
109 |
133 } |
132 } |
134 } |
133 } |
135 } |
134 } |
136 |
135 |
137 $DBH->commit if not $opt_dry; |
136 $DBH->commit if not $opt_dry; |
138 syslog(LOG_NOTICE, "inserted message $msg_id (%.1fs)", tv_interval($T0)); |
137 syslog( LOG_NOTICE, "inserted message $msg_id (%.1fs)", tv_interval($T0) ); |
139 |
138 |
140 } |
139 } |
141 |
140 |
142 sub get_message() { |
141 sub get_message() { |
143 |
142 |
144 # we'll create a tmp file containing the complete message |
143 # we'll create a tmp file containing the complete message |
145 # if speed matters we should use a ram disk. |
144 # if speed matters we should use a ram disk. |
146 # unfortunely the MIME::Parser may temporary files too |
145 # unfortunely the MIME::Parser may temporary files too |
147 my $tmpfile = new File::Temp( TEMPLATE => "/tmp/mail2db-XXXXXX" ); |
146 my $tmpfile = new File::Temp( TEMPLATE => "/tmp/mail2db-XXXXXX" ); |
148 local $_ = <>; |
147 local $_ = <>; |
149 die "No input" if not defined; |
148 die "No input" if not defined; |
150 |
149 |
151 if ( !/^From\s/ ) { |
150 if ( !/^From\s/ ) { |
152 my $nl = /\r?\n$/; |
151 my $nl = /\r?\n$/; |
153 print {$tmpfile} "From - @{[scalar localtime]}$nl", $_; |
152 print {$tmpfile} "From - @{[scalar localtime]}$nl", $_; |
154 } |
153 } |
155 |
154 |
156 { |
155 { |
157 local $/ = undef; |
156 local $/ = undef; |
158 print {$tmpfile} $_, <>; |
157 print {$tmpfile} $_, <>; |
159 } |
158 } |
160 $tmpfile->autoflush(1); |
159 $tmpfile->autoflush(1); |
161 seek( $tmpfile, 0, 0 ); |
160 seek( $tmpfile, 0, 0 ); |
162 |
161 |
163 my $parser = new MIME::Parser or die "internal error"; |
162 my $parser = new MIME::Parser or die "internal error"; |
164 $parser->output_to_core(1); |
163 $parser->output_to_core(1); |