#!/usr/bin/perl -w

#     Copyright 2006 Nickolay Kondrashov
# 
#    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 St, Fifth Floor, Boston, MA  02110-1301  USA

use strict;
use Sys::Hostname;
use File::Basename;
use Mail::Header;
use MIME::Lite;
use MIME::Words;

my $CONFIG_PATH = "/etc/cups/cups-pdf-dispatch.conf";

### CONFIGURATION ##############################

# set default configuration parameters
my $CHARSET = "utf-8";
my $FROM_MAILADDR = "root";
my $FROM_REALNAME = "PDF Printer";
my $SUBJECT_FORMAT = "Printout: \%s";
my $MAX_ATTACHMENT_SIZE = 5 * 1024 * 1024;	# 5Mb
my $BODY_MIME_TYPE = 'text/plain';

my $FILE_ATTACHED_MSG_FORMAT =
	"Your PDF file %s is attached.\n";
my $FILE_TOO_BIG_MSG_FORMAT =
	"Your PDF file size is \%s, which is greater than\n".
	"\%s attachment size limit set by administrator.\n\n".
	"The file has been left on the server to save e-mail traffic.\n";
my $FILE_STORED_MSG_FORMAT = 
	"It is stored until midnight at the following location:\n\%s\n";
my $FILE_REMOVED_MSG =
	"It has been removed from the server after sending.\n";

my @FILE_SIZE_DIMENSIONS = qw(bytes Kb Mb Gb);
my $TRY_STRIP_JOB_IDS = 1;
my @APP_PREFIXES = qw(
			Microsoft_Word_-_
			Microsoft_Excel_-_
			Microsoft_PowerPoint_-_
			Microsoft_Access_-_
			Microsoft_Outlook_-_
);
my $TRY_STRIP_APP_PREFIXES = 1;
my $REMOVE_SENT = 1;
my $LINK_FORMAT = "\\\\". uc( hostname() ). "\\printouts\$\\\%s\\\%s";
my $GET_USER_MAILADDR_SUB = sub{ $_[0]. '@'. hostname() };
my $GET_USER_REALNAME_SUB = sub{ (split( /,/, (getpwnam($_[0]))[6], 2 ))[0] };

# read config file contents
my $CONFIG_CONTENTS;
{
	local $/;
	open( CONFIG, $CONFIG_PATH ) or
		die "Failed to open config file $CONFIG_PATH: $!\n";
	$CONFIG_CONTENTS = <CONFIG>;
	close( CONFIG ) or
		die "Failed to close config file $CONFIG_PATH: $!\n";
}

# eval config file contents
eval $CONFIG_CONTENTS;
if( $@ ) {
	die "Failed to evaluate config file contents: $@\n"
}

# check parameters
unless( defined( $FROM_MAILADDR ) && length( $FROM_MAILADDR ) ) {
	die "From mail address is not set.";
}

### SUBS #######################################

# formats human-readable file size string
sub format_file_size
{
	my( $size ) = @_;
	my $dim = 0;
	while(
		$dim <= scalar( @FILE_SIZE_DIMENSIONS ) &&
		$size > 1024<<($dim*10)
	) { $dim++ }
	return ( $size>>($dim*10) ). " ".
		$FILE_SIZE_DIMENSIONS[$dim];
}

sub strip_job_ids
{
	my( $file_basename ) = @_;
	$file_basename =~ s/^job_[0-9]+-([^\.])/$1/;
	$file_basename =~ s/^smbprn_[0-9]{8}_([^\.])/$1/;
	return $file_basename;
}

sub strip_prefixes
{
	my( $file_basename, @prefixes ) = @_;
	foreach (@prefixes) {
		$file_basename =~ s/^\Q$_\E([^\.])/$1/;
	}
	return $file_basename;
}

# Taken this function from another project of mine.
# Can't remember exactly what it's purpose is, but
# it seems to correct some bug in underlying MIME::Words
# implementation.
sub hacked_encode_mimewords
{
	my ( $words ) = @_;
	my $encoded_words = MIME::Words::encode_mimeword( $words, 'Q', $CHARSET );
	$encoded_words =~ s/ /_/g;
	return $encoded_words;
}

### MAIN #######################################

my( $filename, $username ) = @ARGV;

my $file_basename = basename( $filename );
my $file_prettyname = $file_basename;

if( $TRY_STRIP_JOB_IDS ) {
	$file_prettyname = strip_job_ids( $file_prettyname );
}

if( $TRY_STRIP_APP_PREFIXES ) {
	$file_prettyname = strip_prefixes( $file_prettyname, @APP_PREFIXES );
}

my $file_size;
{
	my @file_stat = stat( $filename );
	unless( scalar( @file_stat ) ) {
		die "Failed to stat PDF file $filename: $!\n"
	}
	$file_size = $file_stat[7];
}
my $file_link = sprintf( $LINK_FORMAT, $username, $file_basename );

my $user_mailaddr = $GET_USER_MAILADDR_SUB->( $username );
unless( defined( $user_mailaddr ) ) {
	warn "User $username has no e-mail address.\n";
	exit 0
}
my $user_realname = $GET_USER_REALNAME_SUB->( $username );

my $from_header = defined $FROM_REALNAME ?
	hacked_encode_mimewords( $FROM_REALNAME ). '<'. $FROM_MAILADDR. '>' :
	$FROM_MAILADDR;
my $to_header = defined $user_realname ?
	hacked_encode_mimewords( $user_realname ). '<'. $user_mailaddr. '>' :
	$user_mailaddr;
my $subject_header = hacked_encode_mimewords(
	sprintf( $SUBJECT_FORMAT, $file_prettyname )
);

# prevent encoded headers from (incorrect) folding
Mail::Header->fold_length( 'From', 1023 );
Mail::Header->fold_length( 'To', 1023 );
Mail::Header->fold_length( 'Subject', 1023 );
Mail::Header->fold_length( 'Content-Type', 1023 );
Mail::Header->fold_length( 'Content-Disposition', 1023 );

my $msg;
my $remove_after_sending = 0;

if(
	!defined $MAX_ATTACHMENT_SIZE ||
	$file_size < $MAX_ATTACHMENT_SIZE
) {
	my $body_text = sprintf(
			$FILE_ATTACHED_MSG_FORMAT,
			$file_prettyname
	). "\n". ( $REMOVE_SENT ?
		$FILE_REMOVED_MSG :
		sprintf(
			$FILE_STORED_MSG_FORMAT,
			$file_link
		)
	);

	$msg = new MIME::Lite(
		From	=> $from_header,
		To	=> $to_header,
		Subject	=> $subject_header,
		Type	=> 'multipart/mixed'
	);
	$msg->attach(
		Encoding=> 'quoted-printable',
		Type	=> "$BODY_MIME_TYPE; charset=$CHARSET",
		Data	=> $body_text
	);
	$msg->attach(
		Encoding	=> 'base64',
		Type		=> 'application/pdf',
		Disposition	=> 'attachment',
		Path		=> $filename,
		Filename	=> hacked_encode_mimewords( $file_prettyname )
	);

	$remove_after_sending = $REMOVE_SENT;
} else {
	my $body_text = sprintf(
		$FILE_TOO_BIG_MSG_FORMAT,
		format_file_size( $file_size ),
		format_file_size( $MAX_ATTACHMENT_SIZE )
	). "\n". sprintf(
		$FILE_STORED_MSG_FORMAT,
		$file_link
	);
	$msg = new MIME::Lite(
		From	=> $from_header,
		To	=> $to_header,
		Subject	=> $subject_header,
		Encoding=> 'quoted-printable',
		Type	=> "$BODY_MIME_TYPE; charset=$CHARSET",
		Data	=> $body_text
	);
}

$msg->send();

if( $remove_after_sending ) {
	unlink $filename or
		die "Failed to remove PDF file $filename: $!\n";
}

exit 0