1 #! /usr/bin/perl

     2 # $Id$

     3 # $URL$

     4 my $USAGE = <<'#';

     5 {{ME}} [options] --user={USER} [mboxfile]

     6     --domain=s  default domain for mailbox id [{{$Cf->domain}}]

     7 

     8     Version: $Id$

     9 #

    10 

    11 use strict;

    12 use warnings;

    13 

    14 use Mail::IMAPClient;

    15 use File::Basename;

    16 use AppConfig;

    17 

    18 use constant CONFIG => (

    19     { CASE => 1 },

    20     domain => { ARGS => "=s", DEFAULT => "ddc-consult.de" },

    21     user => { ARGS => "=s", DEFAULT => undef },

    22     help => { ARGS => "!", DEFAULT => undef },

    23 );

    24 

    25 use constant ME => basename $0;

    26 

    27 use constant IMAP_SERVER => "localhost";

    28 use constant IMAP_ADMIN => "root";

    29 use constant IMAP_PASS => $ENV{IMAP_PASS};

    30 

    31 sub askPass($);

    32 

    33 my $Cf = new AppConfig CONFIG or die;

    34    $Cf->getopt(\@ARGV) or die;

    35 

    36 HELP: {

    37     last unless $Cf->help;

    38     $USAGE =~ s/{{(.*?)}}/eval $1/eg;

    39     print $USAGE;

    40     exit;

    41 }

    42 

    43 MAIN: {

    44     $Cf->user or die "Need user...";

    45     my $mbox = $Cf->user;

    46     $mbox .= "@" . $Cf->domain unless $mbox =~ /@/;

    47     $mbox = "user/$mbox";

    48 

    49 

    50     my $imap = new Mail::IMAPClient 

    51 	Server => IMAP_SERVER,

    52 	User => IMAP_ADMIN,

    53 	Password => IMAP_PASS || askPass("IMAP (". IMAP_ADMIN .") password: ")

    54     or die "Can't connect: $@";

    55 

    56     $imap->setacl($mbox, IMAP_ADMIN, "lrswipcda") or die "$@: $mbox";

    57     $imap->select($mbox) or die "$@: $mbox";

    58 

    59     {

    60 	my $message;

    61 	while (<>) {

    62 	    if (/^From / or eof) {

    63 		if ($message) {

    64 		    print "Appending message (" . length($message) . ") bytes\n";

    65 		    $imap->append($mbox, $message) or die "$@";

    66 		    $message = "";

    67 		}

    68 	    } else {

    69 		$message .= $_;

    70 	    }

    71 	}

    72     }

    73     

    74 }

    75 

    76 sub askPass($) {

    77     local $| = 1;

    78     return undef if not -t;

    79 

    80     print $_[0];

    81     system(stty => "-echo");

    82     my $ans = <STDIN>;

    83     system(stty => "echo");

    84     print "\n";

    85 

    86     chomp $ans;

    87     return $ans;

    88 }

    89 

    90 # vim:sts=4 sw=4 aw ai sm: