Server : Apache
System : Linux ks5.tuic.fr 6.1.0-18-amd64 #1 SMP PREEMPT_DYNAMIC Debian 6.1.76-1 (2024-02-01) x86_64
User : pragmatice ( 1003)
PHP Version : 8.2.24
Disable Function : NONE
Directory : /sbin/
|
Server : Apache System : Linux ks5.tuic.fr 6.1.0-18-amd64 #1 SMP PREEMPT_DYNAMIC Debian 6.1.76-1 (2024-02-01) x86_64 User : pragmatice ( 1003) PHP Version : 8.2.24 Disable Function : NONE Directory : /sbin/ |
#! /usr/bin/perl
# ---------------------------------------------------------------------------
# Copyright (C) 2008-2017 TJ Saunders <tj@castaglia.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA.
# ---------------------------------------------------------------------------
use strict;
use File::Basename qw(basename);
use Getopt::Long;
use Mail::Sendmail;
use MIME::Base64 qw(encode_base64);
use Time::HiRes qw(usleep);
my $program = basename($0);
my $opts = {};
GetOptions($opts, 'attach-file', 'fifo=s', 'from=s', 'help', 'ignore-users=s',
'log=s', 'recipient=s@', 'upload-recipient=s@', 'download-recipient=s@',
'sleep=s', 'smtp-server=s', 'subject=s', 'watch-users=s', 'auth=s');
if ($opts->{help}) {
usage();
exit 0;
}
unless ($opts->{fifo}) {
print STDERR "$program: missing required --fifo parameter\n";
exit 1;
}
my $fifo = $opts->{fifo};
unless ($opts->{from}) {
print STDERR "$program: missing required --from parameter\n";
exit 1;
}
my $from = $opts->{from};
unless ($opts->{recipient} ||
$opts->{'upload-recipient'}) {
print STDERR "$program: missing required --recipient (or --upload-recipient) parameter\n";
exit 1;
}
my $upload_recipients = $opts->{recipient};
# The --upload-recipient list takes precedence over the (deprecated)
# --recipient list.
if (defined($opts->{'upload-recipient'})) {
$upload_recipients = $opts->{'upload-recipient'};
}
my $download_recipients = undef;
if (defined($opts->{'download-recipient'})) {
$download_recipients = $opts->{'download-recipient'};
}
unless ($opts->{'smtp-server'}) {
print STDERR "$program: missing required --smtp-server parameter\n";
exit 1;
}
my $smtp_server = $opts->{'smtp-server'};
my $smtp_auth;
if ($opts->{'auth'}) {
eval { $smtp_auth = get_auth_info($opts->{'auth'}) };
if ($@) {
my $ex = $@;
print STDERR "$program: unable to obtain SMTP auth info: $ex\n";
exit 1;
}
}
my $delay = 0.5;
if ($opts->{sleep}) {
$delay = $opts->{sleep};
}
my $fifoh;
if (open($fifoh, "< $fifo")) {
while (1) {
my $line = <$fifoh>;
if ($line) {
chomp($line);
if ($line =~ /^(\S+\s+\S+\s+\d+\s+\d+:\d+:\d+\s+\d+)\s+(\d+)\s+(.*?)\s+(\d+)\s+(.*?)\s+(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s+(.*?)\s+.*?(\S+)$/o) {
my $curr_time = $1;
my $xfer_nsecs = $2;
my $client = $3;
my $nbytes = $4;
# Note that any spaces or control characters will be replaced in this
# path with underscores. This can make finding the actual file, as for
# attachments, rather difficult; we have to test to find the difference
# between a real underscore in the name, and a substituted underscore.
my $path = $5;
unless (-e $path) {
# Perform a quick-and-dirty check, on the assumption that all of the
# underscores in the given path are actually spaces. If a
# combination of underscores and spaces appears in the real file,
# we won't detect that here.
my $alt_path = $path;
$alt_path =~ s/_/ /g;
if (-e $alt_path) {
$path = $alt_path;
}
}
my $xfer_type = $6;
my $action_flag = $7;
my $xfer_direction = $8;
my $access_mode = $9;
my $user_name = $10;
my $completion_status = $11;
my $send_email = 0;
if ($xfer_direction eq 'i') {
$send_email = 1;
}
if (defined($download_recipients)) {
# If we have a list of download email recipients, it means we should
# send emails for downloads, too.
if ($xfer_direction eq 'o') {
$send_email = 1;
}
}
if ($send_email) {
# First, check for any specific --watch-users filter. If configured,
# and if the user name does NOT match the --watch-users filter, then
# don't send email. Otherwise, check for an --ignore-users filter,
# and see if the user matches that ignore filter.
if ($opts->{'watch-users'}) {
if ($user_name !~ /$opts->{'watch-users'}/) {
$send_email = 0;
}
} elsif ($opts->{'ignore-users'}) {
if ($user_name =~ /$opts->{'ignore-users'}/) {
$send_email = 0;
}
}
}
if ($send_email) {
send_email({
timestamp => $curr_time,
duration => $xfer_nsecs,
client => $client,
size => $nbytes,
file => $path,
transfer_type => $xfer_type,
auth_mode => $access_mode,
user => $user_name,
status => $completion_status,
direction => $xfer_direction,
});
}
}
if ($opts->{log}) {
# Note: since this opens, writes, then closes the log file for every
# write, it will interact with log rotation scripts MUCH better than
# proftpd by itself. Just one of the small benefits.
my $log_file = $opts->{log};
my $logfh;
if (open($logfh, ">> $log_file")) {
print $logfh "$line\n";
unless (close($logfh)) {
print STDERR "$program: error writing to log file '$log_file': $!\n";
}
} else {
print STDERR "$program: error opening log file '$log_file': $!\n";
}
}
} else {
# No input at this time. Sleep for half a second (or less) and check
# again.
usleep($delay * 1000000);
}
}
close($fifoh);
} else {
die "$program: unable to read FIFO '$fifo': $!\n";
}
sub get_auth_info {
my $path = shift;
my $info = {};
if (open(my $fh, "< $path")) {
while (my $line = <$fh>) {
chomp($line);
# Skip comments and blank lines
if ($line =~ /^(\s+)?#/) {
next;
}
if ($line =~ /^\s+$/) {
next;
}
if ($line =~ /^(\s+)?(\S+)(\s+)?=(\s+)?(.*)$/) {
my $key = $2;
my $val = $5;
# Trim off comments after the value, if any
$val =~ s/(\s*#.*)?$//;
# Ignore any keys other than 'user' and 'password'.
if (lc($key) eq 'user') {
$info->{'user'} = $val;
} elsif (lc($key) eq 'password' ||
lc($key) eq 'pass') {
$info->{'password'} = $val;
}
}
}
close($fh);
} else {
die("Can't read '$path': $!\n");
}
# Make sure that we have the required values
my $reqs = [qw(user password)];
foreach my $req (@$reqs) {
unless (exists($info->{$req})) {
die("Missing required '$req' value\n");
}
}
return $info;
}
sub send_email {
my $transfer_info = shift;
my $file = $transfer_info->{file};
my $file_str = basename($file);
my $transferred = 'uploaded';
if ($transfer_info->{direction} eq 'o') {
$transferred = 'downloaded';
}
my $subject = "User '$transfer_info->{user}' $transferred file '$file_str' via FTP";
if ($opts->{subject}) {
$subject = $opts->{subject};
}
my $bytes_str = "bytes";
if ($transfer_info->{size} == 1) {
$bytes_str = "byte";
}
my $status = "Completed";
if ($transfer_info->{status} eq 'i') {
$status = "Incomplete";
}
my $secs_str = "secs";
if ($transfer_info->{duration} == 1) {
$secs_str = "sec";
}
my $type_str = "Binary";
if ($transfer_info->{transfer_type} eq 'a') {
$type_str = "ASCII";
}
my $attached = "";
if ($opts->{'attach-file'} &&
-e $file) {
$attached = "(attached)";
}
my $text = <<EOT;
File just $transferred via FTP:
User: $transfer_info->{user}
Client: $transfer_info->{client}
File: $file $attached
Size: $transfer_info->{size} $bytes_str
At: $transfer_info->{timestamp}
Duration: $transfer_info->{duration} $secs_str
Status: $status
Transfer type: $type_str
Cheers,
--$program
EOT
my $email_info = {
smtp => $smtp_server,
From => $from,
Subject => $subject,
};
if ($transfer_info->{direction} eq 'i') {
$email_info->{To} = join(', ', @$upload_recipients);
} elsif ($transfer_info->{direction} eq 'o') {
$email_info->{To} = join(', ', @$download_recipients);
}
if ($opts->{'auth'}) {
$email_info->{'auth'} = $smtp_auth;
}
if ($opts->{'attach-file'}) {
if (-e $file) {
$email_info->{'MIME-Version'} = '1.0';
my $boundary = '====' . time() . '====';
$email_info->{'Content-Type'} = "multipart/mixed; boundary=\"$boundary\"";
$boundary = '--' . $boundary;
$email_info->{Body} .= "$boundary\n";
$email_info->{Body} .= "Content-Type: text/plain; charset=\"iso-8859-1\"\n";
$email_info->{Body} .= "Content-Transfer-Encoding: quoted-printable\n\n";
$email_info->{Body} .= "$text\n";
if (open(my $fh, "< $file")) {
binmode($fh);
# Note: this reads the entire file into memory, and can fail if
# the file is too big.
local $/;
my $attach;
while (my $data = <$fh>) {
$attach .= $data;
}
close($fh);
$email_info->{Body} .= "$boundary\n";
$email_info->{Body} .= "Content-Disposition: attachment; filename=\"$file\"\n";
if ($transfer_info->{transfer_type} eq 'a') {
$email_info->{Body} .= "Content-Type: text/plain; charset=\"iso-8859-1\"\n\n";
$email_info->{Body} .= $attach;
} else {
$email_info->{Body} .= "Content-Type: application/octet-stream\n";
$email_info->{Body} .= "Content-Transfer-Encoding: base64\n\n";
$email_info->{Body} .= encode_base64($attach);
}
$email_info->{Body} .= "\n";
} else {
my $timestamp = scalar(localtime());
print STDERR "$program: $timestamp: error reading file '$file' for attaching: $!\n";
}
} else {
# Couldn't find/access the uploaded file on the filesystem. This usually
# indicates either a permissions problem, or a munged filename.
#
# XXX Need to handle this better.
}
} else {
$email_info->{Body} = $text;
}
my $res = Mail::Sendmail::sendmail(%$email_info);
unless ($res) {
my $timestamp = scalar(localtime());
print STDERR "$program: $timestamp: error sending email: $Mail::Sendmail::error\n";
}
}
sub usage {
print <<EOH;
usage: $program [--help] [--fifo \$path] [--from \$addr] [--log \$path]
[--recipient \$addrs] [--upload-recipient \$addrs]
[--download-recipient \$addrs] [--subject \$string] [--smtp-server \$addr]
[--attach-file] [--ignore-users \$regex | --watch-users \$regex]
The purpose of this script is to monitor the TransferLog written by proftpd
for uploaded files. Whenever a file is uploaded by a user, an email will be
sent to the specified recipients. In the email there will be the timestamp,
the name of the user who uploaded the file, the path to the uploaded file, the
size of the uploaded file, and the time it took to upload.
Command-line options:
--attach-file If used, this will cause a copy of the uploaded file
to be included, as an attachment, in the generated
email.
--auth \$path Configures the path to a file containing SMTP
authentication information.
The configured file should look like this:
user = \$user
password = \$password
--fifo \$path Indicates the path to the FIFO to which proftpd is
writing its TransferLog. That is, this is the path
that you used for the TransferLog directive in your
proftpd.conf. This parameter is REQUIRED.
--from \$addr Specifies the email address to use in the From header.
This parameter is REQUIRED.
--help Displays this message.
--ignore-users \$regex
Specifies a Perl regular expression. If the uploading
user name matches this regular expression, then NO
email notification is sent; otherwise, an email is
sent.
--log \$path Since this script reads the TransferLog using FIFOs,
the actual TransferLog file is not written by default.
Use this option to write the normal TransferLog file,
in addition to watching for uploads.
--recipient \$addr Specifies an email address to which to send an email
notification of the upload. This option can be
used multiple times to specify multiple recipients.
AT LEAST ONE recipient is REQUIRED.
--upload-recipient Same as --recipient.
--download-recipient \$addr
Specifies an email address to which to send an email
notification of the B<download>. This option can be
used multiple times to specify multiple recipients.
If this option is specified, then C<ftpmail> will
watch for FTP downloads as well as uploads.
--smtp-server \$addr Specifies the SMTP server to which to send the email.
This parameter is REQUIRED.
--subject \$string Specify a custom Subject header for the email sent.
The default Subject is:
User '\$user' uploaded file '\$file' via FTP
--watch-users \$regex Specifies a Perl regular expression. If the uploading
user name matches this regular expression, then an
email notification is sent; otherwise, no email is
sent.
EOH
}