#!/usr/bin/env perl
#
# Accepteer een mail op stdin,
# schrijf die weg in een file genaamd <SUBJECT>-<teller>,
# en upload de file met sftp.
# 
# Casper Gielen, 2014, GPLv2+
#

# todo: 
# - geuploadete files na een tijdje weggooien uit $dir (cronjob?)
#


our $dir="/tmp/m2s";
our $host="localhost"; # empty string = don't upload
our $port="21";
our $user="";
our $password="";
our $path="";
our $countfile="/var/lib/mail2sftp/counter";

require '/etc/mail2sftp.conf';

use Email::MIME;
use File::CounterFile;
use Net::SFTP::Foreign;
use Switch;

# subject en eerste mime-part extraheren
my $email = Email::MIME->new(join('', <STDIN>));
my $subject = $email->header("Subject");
my $body = ($email->parts)[0]->body_str;

# tellertje bijhouden
my $counter = new File::CounterFile $countfile;
$counter->lock;
my $id = $counter->inc;
$counter->unlock;

# wegkrabbelen
my $filename="$subject-$id";
my $filepath=$dir."/".$filename;

open(F, ">:encoding(UTF-8)", $filepath) or die "Cannot open file $!";
print F $body;
close(F);

# uploaden
#
#
my $proto = substr($host, 0, 7); # ftps://
my $addr  = substr($host, 7);    # host.uvt.nl
switch ($proto) {
	case "ftps://" {
		system("lftp -c '" .
			"set ftps:initial-prot \"\";" .
			"set ftp:ssl-force true;" .
			"set ftp:ssl-protect-data true;" .
			"open \"ftp://$user:$password\@$addr/\"; " .
			"cd $path;" .
			"put $filepath;'") == 0
			or die "lftp returned $?"
	}
	case "sftp://" {
		my $ftp = Net::SFTP::Foreign->new($addr);
		$ftp->put($filepath, $filename);
		$ftp->quit();
	}
	case "" {
		print "No host specified, not uploading.\n";
	}
	else 	{
		print "Unknown protocol: ". $proto . "\n"; 
	}
}

__END__

=head1 NAME

mail2sftp - Upload de body van een MIME-encoded email naar sftp

=head1 DESCRIPTION

GX stuurt formulieren per e-mail. Die moeten via sftp worden geupload
naar een server van LIS Office Automation.

