#!/usr/bin/perl -Tsw
#
# $Cambridge: hermes/src/2hermes/newsieve,v 1.4 2009/07/13 20:32:53 fanf2 Exp $

use strict;

use IO::Handle;
use NDBM_File;
use POSIX;
use Socket;
use Sys::Syslog;

use vars qw{ $d };

# taint control

%ENV = ();
$0 =~ /(.*)/;
my $PROG = $1;

# general settings

my $CDBGET = '/opt/cdb/bin/cdbget';
my $CYRUSMAP = '/opt/dist/users/cyrus.cdb';
my $SIEVEPORT = 2000;
my $STTY = '/bin/stty';

########################################################################

sub check ($$) {
	my $msg = shift;
	my $val = shift;
	if (defined $val) {
		return $val;
	} else {
		my $err = $!;
		die "$msg: $err\n";
	}
}

sub debug (@) {
	return unless $d;
	print STDERR map /\n$/ ? "$_" : "$_\n", @_;
}

########################################################################

# For SASL authentication

my $b64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/";

sub base64 ($) {
	my $string = shift;
	my $ret = "";

	while($string =~ m/(.)(.)?(.)?/g) {
		if(defined $3) {
			my ($o1,$o2,$o3) = (ord $1, ord $2, ord $3);
			$ret .= substr $b64, $o1 >> 2, 1;
			$ret .= substr $b64, ($o1 << 4 | $o2 >> 4) & 63, 1;
			$ret .= substr $b64, ($o2 << 2 | $o3 >> 6) & 63, 1;
			$ret .= substr $b64, $o3 & 63, 1;
		} elsif(defined $2) {
			my ($o1,$o2) = (ord $1, ord $2);
			$ret .= substr $b64, $o1 >> 2, 1;
			$ret .= substr $b64, ($o1 << 4 | $o2 >> 4) & 63, 1;
			$ret .= substr $b64, ($o2 << 2) & 63, 1;
			$ret .= '=';
		} else {
			my $o1 = ord $1;
			$ret .= substr $b64, $o1 >> 2, 1;
			$ret .= substr $b64, ($o1 << 4) & 63, 1;
			$ret .= '==';
		}
	}
	return $ret;
}

########################################################################

sub cdbget ($$) {
	my $file = shift;
	my $key = shift;

	my $pid = check "cdbget: pipe/fork",
	    open PIPE, "-|";
	if ($pid == 0) {
		# child
		check "cdbget: open $file",
		    open STDIN, $file;
		check "cdbget: exec $CDBGET $key",
		    exec $CDBGET, $key;
	} else {
		# parent
		my $result = join '', <PIPE>;
		return $result if close PIPE;
		# no data
		return undef if $? == 256;
		die "cdbget command failed: $! $? $result\n";
	}
}

########################################################################

# Sieve protocol utilities with shoddy parsing

sub sieve_resp (;\@) {
	my $resp = shift;

	for(;;) {
		my $line = <SIEVE>;
		debug "< $line";
	        if ($line =~ /^(OK|NO|BYE)\s+({(\d+)\+?}\s+$)?/) {
			return $line unless defined $2;
			my $length = $3 + length $line;
			while (length $line < $length) {
				my $extra = <SIEVE>;
				debug "< $extra";
				$line .= $extra;
			}
			return $line;
		}
		push @{$resp}, $line if ref $resp;
	}
}

sub sieve_cmd ($;\@) {
	my $cmd = shift;
	my $resp = shift;

	print SIEVE "$cmd\r\n";
	debug "> $cmd";
	return sieve_resp @{$resp};
}

sub sieve_put ($@) {
	my $script = shift;
	my @script = @_;
	my $length = 0;
	map { $length += length } @script;
	print SIEVE "PUTSCRIPT \"$script\" {$length+}\r\n", @script, "\r\n";
	debug map "> $_", "PUTSCRIPT \"$script\" {$length+}", @script;
	return sieve_resp;
}

sub sieve_ok ($) {
	my $resp = shift;
	return $resp =~ /^OK\s/;
}

sub sieve_check ($$) {
	my $cmd = shift;
	my $resp = shift;
	die "$cmd failed: $resp\n" unless sieve_ok $resp;
}

########################################################################

sub sieveupload ($$$) {
	my $user = shift;
	my $pass = shift;
	my $sieve = shift;

	# which machine is the user on?
	my $machine = cdbget $CYRUSMAP, $user;
	check "No machine for user $user\n", $machine;

	my ($name,$aliases,$addrtype,$length,@addr) =
	    gethostbyname $machine, AF_INET;
	die "Hostname lookup failed: $machine\n"
	    unless @addr and $addr[0] =~ /^(....)$/;
	my $addr = $1;

	check "socket", socket SIEVE, PF_INET, SOCK_STREAM, 0;
	check "connect", connect SIEVE, sockaddr_in $SIEVEPORT, $addr;
	SIEVE->autoflush;

	my @cap;
	my $resp = sieve_resp @cap;
	sieve_check "ManageSieve server", $resp;
	die "ManageSieve server does not support SASL PLAIN authentication\n"
	    unless grep /^"SASL" .*[" ]PLAIN[ "]/, @cap;
	sieve_check "AUTHENTICATE PLAIN",
	    sieve_cmd 'AUTHENTICATE "PLAIN" "' . base64("\0$user\0$pass") . '"';
	sieve_check "PUTSCRIPT sieve",
	    sieve_put "sieve", @{$sieve};
	sieve_check 'SETACTIVE sieve',
	    sieve_cmd 'SETACTIVE "sieve"';
	sieve_check 'LOGOUT',
	    sieve_cmd 'LOGOUT';
	return 1;
}

########################################################################

check "usage: $0 <username> <sievefile>\n", $ARGV[0];
check "usage: $0 <username> <sievefile>\n", $ARGV[1];

$ARGV[0] =~ /^([a-z]+[0-9]+)$/;
my $user = $1;
check "bad username $ARGV[0]", $user;

check "open $ARGV[1]",
    open SIEVE, "< $ARGV[1]";
my @sieve = <SIEVE>;
check "close $ARGV[1]",
    close SIEVE;

system $STTY, '-echo' and die "stty -echo failed\n";
print "Password: ";
my $pass = <STDIN>;
system $STTY, 'echo' and die "stty echo failed\n";
print "\n";

sieveupload $user, $pass, \@sieve;

print "OK\n";
exit 0;

# eof