#!/usr/bin/perl
#
# Abhijit Menon-Sen <ams@oryx.com>
#
# This is a quick hack to manage Sieve (RFC 3028) scripts on the Sieve
# server (draft-martin-managesieve-*) in Archiveopteryx 1.16 and later.
# There is no warranty, express or implied, not even of being able to
# speak to any other compliant managesieve server.

use IO::Socket;
use MIME::Base64;

$server = "imap.example.org:4190";

# TODO: no TLS?

$user = $ENV{USER} || (getpwuid($<))[0];
$name = "";
$script = "";

$get = 0;
$put = 0;
$list = 0;
$check = 0;
$delete = 0;
$activate = 0;
$explain = 0;


sub usage {
    print STDERR <<"HELP";
Syntax: $0 [-u username] <-l | -c | -[adgp] <name>> [file]

  -u specifies the username to authenticate as (the default is the name
     of the logged-in user).

  -l issues a LISTSCRIPT command and displays the results.

  -a <name> issues SETACTIVE on the named script. If a script file is
     also specified, the script is created with its contents first.

  -g <name> issues GETSCRIPT on the named script.

  -p <name> issues PUTSCRIPT on the named script. A script file must be
     specified with this option.

  -c issues a PUTSCRIPT command with an empty script name, to check the
     syntax of the contents of the script file.

  -d <name> issues DELETESCRIPT on the named script.

  -x <mailbox> <from> <to> <script> <message> issues an X-AOX-EXPLAIN
     command to explain the action of the specified script file on the
     specified message file with the given from and to addresses, and
     with an implicit keep to the named mailbox.
HELP
    exit;
}


sub slurp {
    my $file = shift;
    open( F, $file ) || die "$file: $!\n";
    chomp( my @lines = <F> );
    close( F );
    return join( "\r\n", @lines );
}


while ( @ARGV ) {
    $_ = shift @ARGV;

    if ( /^-h/ || /^-\?/ || /^--help/ ) {
        usage;
    }
    elsif ( /^-u/ ) {
        $user = shift( @ARGV ) || die "No username specified.";
    }
    elsif ( /^-l/ ) {
        $list = 1;
    }
    elsif ( /^-c/ ) {
        $check = 1;
    }
    elsif ( /^-g/ ) {
        $get = 1;
        $name = shift( @ARGV ) || die "No script name specified.";
    }
    elsif ( /^-p/ ) {
        $put = 1;
        $name = shift( @ARGV ) || die "No script name specified.";
    }
    elsif ( /^-d/ ) {
        $delete = 1;
        $name = shift( @ARGV ) || die "No script name specified.";
    }
    elsif ( /^-a/ ) {
        $activate = 1;
        unless ( defined( $name = shift @ARGV ) ) {
            die "No script name specified.";
        }
    }
    elsif ( /^-x/ ) {
        $explain = 1;
        $keep = shift( @ARGV ) || die "No keep mailbox specified.";
        $from = shift( @ARGV ) || die "No from address specified.";
        $to = shift( @ARGV ) || die "No to address specified.";
        $script = shift( @ARGV )|| die "No script file specified.";
        $message = shift( @ARGV )|| die "No message file specified.";
        $script = slurp( $script );
        if ( $script eq "" ) {
            die "Empty script file\n";
        }
        $message = slurp( $message );
        if ( $script eq "" ) {
            die "Empty message file\n";
        }
        last;
    }
    elsif ( /^-/ ) {
        die "Unknown option: $_\n";
    }
    else {
        $script = slurp( $_ );
        if ( $script eq "" ) {
            die "Empty script file\n";
        }
        last;
    }
}

unless ( $get || $check || $activate || $put || $delete ||
         $explain )
{
    $list = 1;
}

if ( ( $get && $name eq "" ) ||
     ( $delete && $name eq "" ) ||
     ( $put && ( $name eq "" || $script eq "" ) ) ||
     ( $check && ( $name ne "" || $script eq "" ) ) ||
     ( $explain && ( $name ne "" || $script eq "" || $from eq "" ||
                     $to eq "" || $keep eq "" || $message eq "" ) ) )
{
    usage;
}

$s = IO::Socket::INET->new( $server ) || die "Can't connect to $server: $!\n";

$state = 0;

$/ = "\r\n";

while ( defined( $_ = <$s> ) ) {
    chomp;

    if ( s/^OK//i ) {
        if ( $state == 0 ) {
            {
                local $/ = "\n";
                print "Password: ";
                system( "stty -echo" );
                chomp( $pass = <STDIN> );
                system( "stty echo" );
                print "\n";
                chomp( $auth = encode_base64( chr(0).$user.chr(0).$pass ) );
            }
            print $s qq{authenticate "plain" "$auth"\r\n};
            $state = 1;
        }
        elsif ( $state == 1 ) {
            if ( $list ) {
                print "Listing scripts:\n";
                print $s qq[listscripts\r\n];
                $state = 2;
            }
            elsif ( $get ) {
                print "Fetching script $name:\n";
                print $s qq[getscript "$name"\r\n];
                $state = 3;
                $size = 0;
            }
            elsif ( $delete ) {
                print "Deleting script $name:\n";
                print $s qq[deletescript "$name"\r\n];
                $state = 5;
            }
            elsif ( ( $activate && $script ne "" ) || $put || $check ) {
                if ( $check ) {
                    print "Checking script:\n";
                }
                else {
                    print "Uploading script $name:\n";
                }
                my $size = length($script);
                print $s qq[putscript "$name" {$size+}\r\n];
                print $s $script, "\r\n";
                $state = $activate ? 4 : 5;
            }
            elsif ( $activate ) {
                if ( $name ne "" ) {
                    print "Activating script $name:\n";
                }
                else {
                    print "Deactivating all scripts:\n";
                }
                print $s qq[setactive "$name"\r\n];
                $state = 5;
            }
            elsif ( $explain ) {
                print "Explaining script action:\n";
                my $size = length($script);
                print $s qq[x-aox-explain "keep" "$keep" ].
                         qq["from" "$from" "to" "$to" ].
                         qq["script" {$size+}\r\n];
                my $size = length($message);
                print $s $script, qq[ "message" {$size+}\r\n];
                print $s $message, "\r\n";
                $state = 6;
            }
        }
        elsif ( $state == 4 ) {
            print "Activating script $name:\n";
            print $s qq[setactive "$name"\r\n];
            $state = 6;
        }
        elsif ( $state != 666 ) {
            print "OK\n";
            print $s qq{logout\r\n};
            $state = 666;
        }
        else {
            exit;
        }
    }
    elsif ( /^NO/i || $state == 42 ) {
        print "$_\n";

        if ( $state != 42 && /{(\d+)\+?}$/ ) {
            $size = $1;
            $state = 42;
        }

        if ( $state == 42 ) {
            $size -= length($_)+2;
            next if $size > 0;
        }

        print $s qq{logout\r\n};
        $state = 666;
    }
    elsif ( /^BYE/i ) {
        print ">>> $_\n";
        exit;
    }
    elsif ( /^"[^"]*?"/) {
        if ( $state == 0 ) {
            # We ignore capability responses. In theory, we should use
            # the SASL response to choose an authentication method.
        }
        elsif ( $state == 2 ) {
            # Just a script name in response to LISTSCRIPTS.
            print "$_\n";
        }
    }
    elsif ( $state == 3 || $state == 69 ) {
        # response to getscript.
        if ( $state == 3 ) {
            unless ( /^{(\d+)\+?}$/ ) {
                die "Unexpected response to getscript: $_\n";
            }
            $state = 69;
            $size = $1;
            next;
        }
        else {
            print "$_\n";
            $size -= (length($_)+2);
            next if $size > 0;
        }

        $state = 3;
    }
    elsif ( $state == 6 ) {
        # Response to x-aox-explain.
        print "$_\n";
    }
    else {
        die "Unrecognised server message: $_\n";
    }
}