| 1 | #!/usr/bin/perl -T |
|---|
| 2 | |
|---|
| 3 | # $Id$ |
|---|
| 4 | |
|---|
| 5 | ######################################################################## |
|---|
| 6 | # MAIA MAILGUARD LICENSE v.1.0 |
|---|
| 7 | # |
|---|
| 8 | # Copyright 2005 by Robert LeBlanc <rjl@renaissoft.com> |
|---|
| 9 | # and David Morton <mortonda@dgrmm.net> |
|---|
| 10 | # All rights reserved. |
|---|
| 11 | # |
|---|
| 12 | # PREAMBLE |
|---|
| 13 | # |
|---|
| 14 | # This License is designed for users of Maia Mailguard |
|---|
| 15 | # ("the Software") who wish to support the Maia Mailguard project by |
|---|
| 16 | # leaving "Maia Mailguard" branding information in the HTML output |
|---|
| 17 | # of the pages generated by the Software, and providing links back |
|---|
| 18 | # to the Maia Mailguard home page. Users who wish to remove this |
|---|
| 19 | # branding information should contact the copyright owner to obtain |
|---|
| 20 | # a Rebranding License. |
|---|
| 21 | # |
|---|
| 22 | # DEFINITION OF TERMS |
|---|
| 23 | # |
|---|
| 24 | # The "Software" refers to Maia Mailguard, including all of the |
|---|
| 25 | # associated PHP, Perl, and SQL scripts, documentation files, graphic |
|---|
| 26 | # icons and logo images. |
|---|
| 27 | # |
|---|
| 28 | # GRANT OF LICENSE |
|---|
| 29 | # |
|---|
| 30 | # Redistribution and use in source and binary forms, with or without |
|---|
| 31 | # modification, are permitted provided that the following conditions |
|---|
| 32 | # are met: |
|---|
| 33 | # |
|---|
| 34 | # 1. Redistributions of source code must retain the above copyright |
|---|
| 35 | # notice, this list of conditions and the following disclaimer. |
|---|
| 36 | # |
|---|
| 37 | # 2. Redistributions in binary form must reproduce the above copyright |
|---|
| 38 | # notice, this list of conditions and the following disclaimer in the |
|---|
| 39 | # documentation and/or other materials provided with the distribution. |
|---|
| 40 | # |
|---|
| 41 | # 3. The end-user documentation included with the redistribution, if |
|---|
| 42 | # any, must include the following acknowledgment: |
|---|
| 43 | # |
|---|
| 44 | # "This product includes software developed by Robert LeBlanc |
|---|
| 45 | # <rjl@renaissoft.com>." |
|---|
| 46 | # |
|---|
| 47 | # Alternately, this acknowledgment may appear in the software itself, |
|---|
| 48 | # if and wherever such third-party acknowledgments normally appear. |
|---|
| 49 | # |
|---|
| 50 | # 4. At least one of the following branding conventions must be used: |
|---|
| 51 | # |
|---|
| 52 | # a. The Maia Mailguard logo appears in the page-top banner of |
|---|
| 53 | # all HTML output pages in an unmodified form, and links |
|---|
| 54 | # directly to the Maia Mailguard home page; or |
|---|
| 55 | # |
|---|
| 56 | # b. The "Powered by Maia Mailguard" graphic appears in the HTML |
|---|
| 57 | # output of all gateway pages that lead to this software, |
|---|
| 58 | # linking directly to the Maia Mailguard home page; or |
|---|
| 59 | # |
|---|
| 60 | # c. A separate Rebranding License is obtained from the copyright |
|---|
| 61 | # owner, exempting the Licensee from 4(a) and 4(b), subject to |
|---|
| 62 | # the additional conditions laid out in that license document. |
|---|
| 63 | # |
|---|
| 64 | # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS |
|---|
| 65 | # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT |
|---|
| 66 | # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS |
|---|
| 67 | # FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE |
|---|
| 68 | # COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, |
|---|
| 69 | # INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, |
|---|
| 70 | # BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS |
|---|
| 71 | # OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND |
|---|
| 72 | # ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR |
|---|
| 73 | # TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE |
|---|
| 74 | # USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
|---|
| 75 | ######################################################################## |
|---|
| 76 | |
|---|
| 77 | use strict; |
|---|
| 78 | use DBI; |
|---|
| 79 | use POSIX; |
|---|
| 80 | use Net::SMTP; |
|---|
| 81 | use Template; |
|---|
| 82 | use Data::UUID; |
|---|
| 83 | |
|---|
| 84 | # CONFIGURE THIS: Location of your database.cfg file |
|---|
| 85 | my $cfg = "/var/amavisd/maia/scripts/database.cfg"; |
|---|
| 86 | |
|---|
| 87 | # CONFIGURE THIS: Base URL to maia scripts |
|---|
| 88 | my $base_url = "http://example.com/"; |
|---|
| 89 | |
|---|
| 90 | # CONFIGURE THIS: template directory |
|---|
| 91 | my $template_dir = "/var/amavisd/maia/templates/"; |
|---|
| 92 | |
|---|
| 93 | # CONFIGURE THIS: How you want the sorted (choose one per cache type) |
|---|
| 94 | # (note: non spam/ham caches don't have score to sort by) |
|---|
| 95 | # options are: |
|---|
| 96 | # *_sort = "score DIRECTION" |
|---|
| 97 | # = "received_date DIRECTION" |
|---|
| 98 | # = "recipient_id DIRECTION" |
|---|
| 99 | # Where DIRECTION is ASC or DESC |
|---|
| 100 | my %sort = ( |
|---|
| 101 | ham => "score DESC", # puts the high scores at the top |
|---|
| 102 | spam => "score ASC", # puts the low scroes at the top |
|---|
| 103 | virus => "received_date DESC", |
|---|
| 104 | banned_file => "received_date DESC", |
|---|
| 105 | bad_header => "received_date DESC", |
|---|
| 106 | ); |
|---|
| 107 | |
|---|
| 108 | my $titles = { 'spam' => "Spam Quarantine", |
|---|
| 109 | 'virus' => "Virus Quarantine", |
|---|
| 110 | 'banned_file' => "Banned File Attachments", |
|---|
| 111 | 'bad_header' => "Invalid Email Headers", |
|---|
| 112 | 'ham' => "Delivered Email" |
|---|
| 113 | }; |
|---|
| 114 | # The order of the sections of the digest report |
|---|
| 115 | # Valid elements are 'spam', 'ham', 'virus', banned_file', and 'bad_header' |
|---|
| 116 | # Omit any of these elements to leave them out of the report |
|---|
| 117 | |
|---|
| 118 | my @report_order = ('spam','ham','virus','banned_file','bad_header'); |
|---|
| 119 | |
|---|
| 120 | ######################################################################## |
|---|
| 121 | # End of user-configurable portion. There should be no need to modify # |
|---|
| 122 | # anything below this point. # |
|---|
| 123 | ######################################################################## |
|---|
| 124 | sub get_string_key($$); |
|---|
| 125 | sub get_config_value($$); |
|---|
| 126 | sub phrase_generate(); |
|---|
| 127 | sub generate_confirm_token($$); |
|---|
| 128 | |
|---|
| 129 | # Read the database configuration file into memory once |
|---|
| 130 | open DB_CFG, "<" . $cfg |
|---|
| 131 | or die ("Maia: [send-quarantine-reminders] Unable to open $cfg\n"); |
|---|
| 132 | my($db_cfg) = ""; |
|---|
| 133 | my $line; |
|---|
| 134 | while ($line = <DB_CFG>) { |
|---|
| 135 | $db_cfg .= $line; |
|---|
| 136 | } |
|---|
| 137 | close DB_CFG; |
|---|
| 138 | |
|---|
| 139 | # Connect to the database |
|---|
| 140 | my $dsn = get_string_key($db_cfg, "dsn"); |
|---|
| 141 | # The organization of this file makes this a bit obtuse |
|---|
| 142 | my $isPg = $dsn =~ /^dbi:Pg/; |
|---|
| 143 | my $username = get_string_key($db_cfg, "username"); |
|---|
| 144 | my $password = get_string_key($db_cfg, "password"); |
|---|
| 145 | my $dbh = DBI->connect($dsn, $username, $password) |
|---|
| 146 | or die("Can't connect to SQL database"); |
|---|
| 147 | |
|---|
| 148 | my($query, $sth, @row, %config_value_cache); |
|---|
| 149 | my($admin_email, $smtp_server, $smtp_port); |
|---|
| 150 | |
|---|
| 151 | $query = <<"endSQL;"; |
|---|
| 152 | SELECT admin_email, smtp_server, smtp_port |
|---|
| 153 | FROM maia_config |
|---|
| 154 | WHERE id = 0 |
|---|
| 155 | endSQL; |
|---|
| 156 | |
|---|
| 157 | $sth = $dbh->prepare($query) |
|---|
| 158 | or die (sprintf("Maia: [send-quarantine-digests] Couldn't prepare query: %s", $dbh->errstr)); |
|---|
| 159 | $sth->execute() |
|---|
| 160 | or die (sprintf("Maia: [send-quarantine-digests] Couldn't execute query: %s", $dbh->errstr)); |
|---|
| 161 | |
|---|
| 162 | if (@row = $sth->fetchrow_array()) { |
|---|
| 163 | $admin_email = $1 if $row[0] =~ /^(.+@.+\..+)$/si; # untaint |
|---|
| 164 | $smtp_server = $1 if $row[1] =~ /^(.+)$/si; # untaint |
|---|
| 165 | $smtp_port = $1 if $row[2] =~ /^([1-9]+[0-9]*)$/si; # untaint |
|---|
| 166 | } |
|---|
| 167 | $sth->finish(); |
|---|
| 168 | |
|---|
| 169 | my $bgcolor; |
|---|
| 170 | my $at_least_one = 0; |
|---|
| 171 | my $timestamp = time(); |
|---|
| 172 | my ($secs, $mins, $hours, $day, $mon, $year) = localtime($timestamp); |
|---|
| 173 | my $dbtimestamp = sprintf("%04d-%02d-%02d %02d:%02d:%02d", $year+1900, $mon+1, $day, $hours, $mins, $secs); |
|---|
| 174 | |
|---|
| 175 | my $unixTime = $isPg ? "( ROUND(DATE_PART('epoch', NOW())) - ROUND(DATE_PART('epoch', maia_users.last_digest_sent)))" |
|---|
| 176 | : "(UNIX_TIMESTAMP() - UNIX_TIMESTAMP(maia_users.last_digest_sent)"; |
|---|
| 177 | |
|---|
| 178 | $query = <<"endSQL;"; |
|---|
| 179 | SELECT maia_users.id, users.email |
|---|
| 180 | FROM maia_users, users |
|---|
| 181 | WHERE maia_users.primary_email_id = users.id |
|---|
| 182 | AND maia_users.quarantine_digest_interval > 0 |
|---|
| 183 | AND (maia_users.quarantine_digest_interval <= ($unixTime / 60) |
|---|
| 184 | OR maia_users.last_digest_sent IS NULL) |
|---|
| 185 | ORDER BY maia_users.id ASC |
|---|
| 186 | endSQL; |
|---|
| 187 | |
|---|
| 188 | my $users_sth = $dbh->prepare($query) |
|---|
| 189 | or die (sprintf("Maia: [send-quarantine-digests] Couldn't prepare query: %s", $dbh->errstr)); |
|---|
| 190 | $users_sth->execute() |
|---|
| 191 | or die (sprintf("Maia: [send-quarantine-digests] Couldn't execute query: %s", $dbh->errstr)); |
|---|
| 192 | |
|---|
| 193 | # Preparing the same statement over & over is wasteful. Granted, |
|---|
| 194 | # performance doesn't really matter in this application, but there is no |
|---|
| 195 | # sense in wasting db resources (which COULD be at a premium). |
|---|
| 196 | |
|---|
| 197 | my %report_statements; |
|---|
| 198 | while (my($element, $sort) = each(%sort)) { |
|---|
| 199 | next if exists $report_statements{$sort}; |
|---|
| 200 | |
|---|
| 201 | $query = <<"endSQL;"; |
|---|
| 202 | SELECT mmr.token, mm.received_date, mm.score, |
|---|
| 203 | mm.sender_email, mm.subject |
|---|
| 204 | FROM maia_mail AS mm, maia_mail_recipients AS mmr |
|---|
| 205 | WHERE mm.id = mmr.mail_id |
|---|
| 206 | AND mmr.type = ? |
|---|
| 207 | AND mmr.recipient_id = ? |
|---|
| 208 | ORDER BY mm.$sort |
|---|
| 209 | endSQL; |
|---|
| 210 | |
|---|
| 211 | $report_statements{$sort} = $dbh->prepare($query) |
|---|
| 212 | or die (sprintf("Maia: [send-quarantine-digests] Couldn't prepare query: %s", $dbh->errstr)); |
|---|
| 213 | } |
|---|
| 214 | |
|---|
| 215 | $query = <<"endSQL;"; |
|---|
| 216 | UPDATE maia_users SET last_digest_sent = ? WHERE id = ? |
|---|
| 217 | endSQL; |
|---|
| 218 | my $update_sth = $dbh->prepare($query) |
|---|
| 219 | or die (sprintf("Maia: [send-quarantine-digests] Couldn't prepare query: %s", $dbh->errstr)); |
|---|
| 220 | |
|---|
| 221 | my $date_add = $isPg ? "NOW() + INTERVAL ? DAY" |
|---|
| 222 | : "DATE_ADD(NOW(), INTERVAL ? DAY)"; |
|---|
| 223 | $query = <<"endSQL;"; |
|---|
| 224 | INSERT INTO maia_tokens (token_system, token, data, expires) |
|---|
| 225 | VALUES ('digest', ?, ?, $date_add) |
|---|
| 226 | endSQL; |
|---|
| 227 | |
|---|
| 228 | my $confirm_sth = $dbh->prepare($query); |
|---|
| 229 | |
|---|
| 230 | while (my @row3 = $users_sth->fetchrow_array()) { |
|---|
| 231 | my $user_id = $1 if $row3[0] =~ /^(\d+)$/si; # untaint |
|---|
| 232 | my $user_email = $1 if $row3[1] =~ /^(.+@.+\..+)$/si; # untaint |
|---|
| 233 | |
|---|
| 234 | #regenerate template vars for every user, to minimize memory usage |
|---|
| 235 | my %vars = ( |
|---|
| 236 | 'admin_email' => $admin_email, |
|---|
| 237 | 'date' => $dbtimestamp, |
|---|
| 238 | 'maia_user_id' => $user_id, |
|---|
| 239 | 'recipient' => $user_email, |
|---|
| 240 | 'titles' => $titles, |
|---|
| 241 | 'baseurl' => $base_url |
|---|
| 242 | ); |
|---|
| 243 | my %report_type = ( |
|---|
| 244 | ham => 'H', |
|---|
| 245 | spam => 'S', |
|---|
| 246 | virus => 'V', |
|---|
| 247 | banned_file => 'F', |
|---|
| 248 | bad_header => 'B', |
|---|
| 249 | ); |
|---|
| 250 | |
|---|
| 251 | # We need to use an array to Separate Report Elements, since hashes can't keep reliable ordering |
|---|
| 252 | my $report_count = 0; |
|---|
| 253 | $at_least_one = 0; |
|---|
| 254 | for my $report_element (@report_order) { |
|---|
| 255 | $sth = $report_statements{$sort{$report_element}}; |
|---|
| 256 | |
|---|
| 257 | $sth->execute($report_type{$report_element}, $user_id) |
|---|
| 258 | or die (sprintf("Maia: [send-quarantine-digests] Couldn't execute query: %s", $dbh->errstr)); |
|---|
| 259 | if ($sth->rows > 0) { |
|---|
| 260 | $at_least_one = 1; |
|---|
| 261 | my $rowcount = 0; |
|---|
| 262 | while (@row = $sth->fetchrow_array()) { |
|---|
| 263 | my $token = $1 if $row[0] =~ /^([a-zA-Z0-9]+)$/si; # untaint |
|---|
| 264 | my $received_date = $1 if $row[1] =~ /^(\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2})$/si; # untaint |
|---|
| 265 | my $score = $1 if $row[2] =~ /^(-?\d+\.\d+)$/si; # untaint |
|---|
| 266 | my $sender = $1 if $row[3] =~ /^(.+\@.+\..+)$/si; # untaint |
|---|
| 267 | my $subject = $1 if $row[4] =~ /^(.*)$/si; # untaint |
|---|
| 268 | if ($subject eq "") { |
|---|
| 269 | $subject = "(no subject)"; |
|---|
| 270 | } |
|---|
| 271 | |
|---|
| 272 | $vars{'list'}[$report_count]{$report_element}[$rowcount]{'token'} = $token; |
|---|
| 273 | $vars{'list'}[$report_count]{$report_element}[$rowcount]{'received_date'} = $received_date; |
|---|
| 274 | if ($report_element eq 'ham' || $report_element eq 'spam') { |
|---|
| 275 | $vars{'list'}[$report_count]{$report_element}[$rowcount]{'score'} = $score; |
|---|
| 276 | } |
|---|
| 277 | |
|---|
| 278 | $vars{'list'}[$report_count]{$report_element}[$rowcount]{'sender'} = $sender; |
|---|
| 279 | $vars{'list'}[$report_count]{$report_element}[$rowcount]{'subject'} = $subject; |
|---|
| 280 | |
|---|
| 281 | $rowcount++; |
|---|
| 282 | } |
|---|
| 283 | $report_count++ |
|---|
| 284 | } |
|---|
| 285 | $sth->finish(); |
|---|
| 286 | } |
|---|
| 287 | |
|---|
| 288 | # Send out the e-mail |
|---|
| 289 | if ($at_least_one) { |
|---|
| 290 | $vars{'confirm_token'} = generate_confirm_token($dbh, $user_id); |
|---|
| 291 | my $output = ''; |
|---|
| 292 | my $template = Template->new({INCLUDE_PATH => $template_dir, |
|---|
| 293 | OUTPUT => \$output }); |
|---|
| 294 | $template->process("digest.tpl", \%vars) |
|---|
| 295 | || die "Template process failed: ", $template->error(), "\n"; |
|---|
| 296 | |
|---|
| 297 | print "Sending quarantine digest to <" . $user_email . ">\n"; |
|---|
| 298 | |
|---|
| 299 | my($smtp) = Net::SMTP->new($smtp_server, Port => $smtp_port); |
|---|
| 300 | die "Couldn't connect to SMTP server" unless $smtp; |
|---|
| 301 | $smtp->mail($admin_email); |
|---|
| 302 | $smtp->to($user_email); |
|---|
| 303 | $smtp->data(); |
|---|
| 304 | $smtp->datasend($output); |
|---|
| 305 | $smtp->dataend(); |
|---|
| 306 | $smtp->quit(); |
|---|
| 307 | |
|---|
| 308 | $update_sth->execute($dbtimestamp, $user_id) |
|---|
| 309 | or die (sprintf("Maia: [send-quarantine-digests] Couldn't execute query: %s", $dbh->errstr)); |
|---|
| 310 | $update_sth->finish(); |
|---|
| 311 | |
|---|
| 312 | } |
|---|
| 313 | } |
|---|
| 314 | |
|---|
| 315 | # not strictly necessary, since we're about to disconnect, but good |
|---|
| 316 | # policy on the whole. |
|---|
| 317 | $users_sth->finish(); |
|---|
| 318 | |
|---|
| 319 | # Disconnect from the database |
|---|
| 320 | $dbh->disconnect; |
|---|
| 321 | |
|---|
| 322 | # We're done. |
|---|
| 323 | exit; |
|---|
| 324 | |
|---|
| 325 | # Retrieve the string value associated with a key in the database.cfg file. |
|---|
| 326 | sub get_string_key($$) { |
|---|
| 327 | my ($file, $key) = @_; |
|---|
| 328 | |
|---|
| 329 | if ($file =~ /\n[ \t]*$key[ \t]*=[ \t]*\"(.*)\"/) { |
|---|
| 330 | return ($1); |
|---|
| 331 | } else { |
|---|
| 332 | die ("Maia: [get_db_string_key] Unable to find $key value in $file\n"); |
|---|
| 333 | } |
|---|
| 334 | } |
|---|
| 335 | |
|---|
| 336 | # Read a single value from Maia's configuration table. |
|---|
| 337 | sub get_config_value($$) { |
|---|
| 338 | my($dbh, $key) = @_; |
|---|
| 339 | my($sth, @row, $select); |
|---|
| 340 | my $value = undef; |
|---|
| 341 | |
|---|
| 342 | return $config_value_cache{$key} if (exists $config_value_cache{$key}); |
|---|
| 343 | |
|---|
| 344 | $select = "SELECT " . $key . " FROM maia_config WHERE id = 0"; |
|---|
| 345 | $select = $1 if $select =~ /^(.*)$/si; # untaint |
|---|
| 346 | $sth = $dbh->prepare($select) |
|---|
| 347 | or die (sprintf("Maia: [get_config_value] Couldn't prepare query: %s", $dbh->errstr)); |
|---|
| 348 | $sth->execute() |
|---|
| 349 | or die (sprintf("Maia: [get_config_value] Couldn't execute query: %s", $dbh->errstr)); |
|---|
| 350 | if (@row = $sth->fetchrow_array()) { |
|---|
| 351 | $value = $row[0]; |
|---|
| 352 | } |
|---|
| 353 | $sth->finish; |
|---|
| 354 | $config_value_cache{$key} = $value; |
|---|
| 355 | return $value; |
|---|
| 356 | } |
|---|
| 357 | |
|---|
| 358 | #random phrase generated from password generator |
|---|
| 359 | #credit: http://web.uconn.edu/~cdavid/cgi-bin/book/make_password_html.pl |
|---|
| 360 | sub phrase_generate() { |
|---|
| 361 | my $ug = new Data::UUID; |
|---|
| 362 | my $uuid = $ug->create_hex(); |
|---|
| 363 | $uuid =~ s/0x(.*)/$1/; |
|---|
| 364 | |
|---|
| 365 | my (@passset,$rnd_passwd,$randum_num); |
|---|
| 366 | @passset = ('A'..'Z','0'..'9'); |
|---|
| 367 | $rnd_passwd = ""; |
|---|
| 368 | for (my $i = 0; $i<32;$i++) { |
|---|
| 369 | $randum_num = int(rand($#passset+1)); |
|---|
| 370 | $rnd_passwd .= $passset[$randum_num]; |
|---|
| 371 | } |
|---|
| 372 | |
|---|
| 373 | return $uuid . $rnd_passwd ; |
|---|
| 374 | } |
|---|
| 375 | |
|---|
| 376 | sub generate_confirm_token($$) { |
|---|
| 377 | my ($dbh, $maia_user_id) = @_; |
|---|
| 378 | my $spamexpiry = get_config_value($dbh, "expiry_period"); |
|---|
| 379 | my $hamexpiry = get_config_value($dbh, "ham_cache_expiry_period"); |
|---|
| 380 | my $days = $spamexpiry > $hamexpiry ? $spamexpiry : $hamexpiry; |
|---|
| 381 | |
|---|
| 382 | my $unique_string = phrase_generate(); |
|---|
| 383 | |
|---|
| 384 | $confirm_sth->execute($unique_string, $maia_user_id,$days) or die (sprintf("Maia: [send-quarantine-reminders] Couldn't execute query: %s", $dbh->errstr));; |
|---|
| 385 | $confirm_sth->finish(); |
|---|
| 386 | return $unique_string; |
|---|
| 387 | } |
|---|