mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-02-01 01:09:47 +00:00
585 lines
15 KiB
Perl
Executable File
585 lines
15 KiB
Perl
Executable File
|
|
# $Id$
|
|
|
|
# basic idea from https://github.com/justinribeiro/idlemailcheck
|
|
|
|
package main;
|
|
|
|
use strict;
|
|
use warnings;
|
|
|
|
use Mail::IMAPClient;
|
|
use IO::Socket::SSL;
|
|
use IO::Socket::INET;
|
|
use IO::File;
|
|
use IO::Handle;
|
|
use Data::Dumper;
|
|
|
|
my $mailcheck_hasGPG = 1;
|
|
my $mailcheck_hasMIME = 1;
|
|
|
|
sub
|
|
mailcheck_Initialize($)
|
|
{
|
|
my ($hash) = @_;
|
|
|
|
|
|
eval "use MIME::Parser";
|
|
$mailcheck_hasMIME = 0 if($@);
|
|
|
|
eval "use Mail::GnuPG";
|
|
$mailcheck_hasGPG = 0 if($@);
|
|
$hash->{ReadFn} = "mailcheck_Read";
|
|
|
|
$hash->{DefFn} = "mailcheck_Define";
|
|
$hash->{NotifyFn} = "mailcheck_Notify";
|
|
$hash->{UndefFn} = "mailcheck_Undefine";
|
|
$hash->{SetFn} = "mailcheck_Set";
|
|
$hash->{GetFn} = "mailcheck_Get";
|
|
$hash->{AttrFn} = "mailcheck_Attr";
|
|
$hash->{AttrList} = "debug:1 ".
|
|
"delete_message:1 ".
|
|
"disable:1 ".
|
|
"interval ".
|
|
"logfile ".
|
|
"nossl:1 ";
|
|
$hash->{AttrList} .= "accept_from " if( $mailcheck_hasMIME && $mailcheck_hasGPG );
|
|
$hash->{AttrList} .= $readingFnAttributes;
|
|
}
|
|
|
|
#####################################
|
|
|
|
sub
|
|
mailcheck_Define($$)
|
|
{
|
|
my ($hash, $def) = @_;
|
|
|
|
my @a = split("[ \t][ \t]*", $def);
|
|
|
|
return "Usage: define <name> mailcheck host user password [folder]" if(@a < 5);
|
|
|
|
my $name = $a[0];
|
|
|
|
my $host = $a[2];
|
|
my $user = $a[3];
|
|
my $password = $a[4];
|
|
my $folder = $a[5];
|
|
|
|
if( $user =~ m/^{.*}$/ ) {
|
|
my $NAME = $name;
|
|
my $HOST = $host;
|
|
my $u = eval $user;
|
|
if( $@ ) {
|
|
Log3 $name, 2, $name .": ". $user .": ". $@;
|
|
}
|
|
$user = $u if( $u );
|
|
}
|
|
|
|
if( $password =~ m/^{.*}$/ ) {
|
|
my $NAME = $name;
|
|
my $HOST = $host;
|
|
my $USER = $user;
|
|
my $p = eval $password;
|
|
if( $@ ) {
|
|
Log3 $name, 2, $name .": ". $password .": ". $@;
|
|
}
|
|
$password = $p if( $p );
|
|
}
|
|
|
|
$hash->{tag} = undef;
|
|
|
|
$hash->{NAME} = $name;
|
|
|
|
$hash->{Host} = $host;
|
|
$hash->{helper}{user} = $user;
|
|
$hash->{helper}{password} = $password;
|
|
|
|
$hash->{Folder} = "INBOX";
|
|
$hash->{Folder} = $folder if( $folder );
|
|
|
|
$hash->{HAS_GPG} = $mailcheck_hasGPG;
|
|
$hash->{HAS_MIME} = $mailcheck_hasMIME;
|
|
|
|
$hash->{NOTIFYDEV} = "global";
|
|
|
|
if( $init_done ) {
|
|
mailcheck_Disconnect($hash);
|
|
mailcheck_Connect($hash);
|
|
} elsif( $hash->{STATE} ne "???" ) {
|
|
$hash->{STATE} = "Initialized";
|
|
}
|
|
|
|
return undef;
|
|
}
|
|
|
|
sub
|
|
mailcheck_Notify($$)
|
|
{
|
|
my ($hash,$dev) = @_;
|
|
|
|
return if($dev->{NAME} ne "global");
|
|
return if(!grep(m/^INITIALIZED|REREADCFG$/, @{$dev->{CHANGED}}));
|
|
|
|
mailcheck_Connect($hash);
|
|
|
|
return undef;
|
|
}
|
|
|
|
sub
|
|
mailcheck_Connect($)
|
|
{
|
|
my ($hash) = @_;
|
|
my $name = $hash->{NAME};
|
|
|
|
return undef if( IsDisabled($name) > 0 );
|
|
|
|
my $socket;
|
|
if( AttrVal($name, "nossl", 0) ) {
|
|
$socket = IO::Socket::INET->new( PeerAddr => $hash->{Host},
|
|
PeerPort => 143, #AttrVal($name, "port", 143)
|
|
);
|
|
} else {
|
|
$socket = IO::Socket::SSL->new( PeerAddr => $hash->{Host},
|
|
PeerPort => 993, #AttrVal($name, "port", 993)
|
|
);
|
|
}
|
|
|
|
if($socket) {
|
|
$hash->{STATE} = "Connected";
|
|
$hash->{LAST_CONNECT} = FmtDateTime( gettimeofday() );
|
|
|
|
$hash->{FD} = $socket->fileno();
|
|
$hash->{CD} = $socket; # sysread / close won't work on fileno
|
|
$hash->{CONNECTS}++;
|
|
$selectlist{$name} = $hash;
|
|
Log3 $name, 3, "$name: connected to $hash->{Host}";
|
|
|
|
my $client = Mail::IMAPClient->new(
|
|
Socket => $socket,
|
|
KeepAlive => 'true',
|
|
User => $hash->{helper}{user},
|
|
Password => $hash->{helper}{password},
|
|
);
|
|
|
|
$client->Debug(AttrVal($name, "debug", 0)) if( $client );
|
|
$client->Debug_fh($hash->{FH}) if( $client && defined($hash->{FH}) );
|
|
|
|
if( $client && $client->IsConnected && $client->IsAuthenticated ) {
|
|
$hash->{STATE} = "Logged in";
|
|
$hash->{LAST_LOGIN} = FmtDateTime( gettimeofday() );
|
|
|
|
$hash->{CLIENT} = $client;
|
|
Log3 $name, 3, "$name: logged in to $hash->{helper}{user}";
|
|
|
|
$hash->{HAS_IDLE} = $client->has_capability("IDLE");
|
|
|
|
my $interval = AttrVal($name, "interval", 0);
|
|
$interval = $hash->{HAS_IDLE}?60*10:60*1 if( !$interval );
|
|
$hash->{INTERVAL} = $interval;
|
|
|
|
RemoveInternalTimer($hash);
|
|
InternalTimer(gettimeofday()+$hash->{INTERVAL}, "mailcheck_poll", $hash, 0);
|
|
|
|
#if( !$client->has_capability("IDLE") ) {
|
|
#mailcheck_Disconnect($hash);
|
|
#$hash->{STATE} = "IDLE not supported";
|
|
#return undef;
|
|
#}
|
|
|
|
$client->Uid(0);
|
|
$client->Timeout(8);
|
|
$client->select($hash->{Folder});
|
|
|
|
$hash->{tag} = $client->idle;
|
|
|
|
} else {
|
|
mailcheck_Disconnect($hash);
|
|
}
|
|
} else {
|
|
#$hash->{STATE} = "Connected";
|
|
Log3 $name, 3, "$name: failed to connect to $hash->{Host}";
|
|
}
|
|
}
|
|
sub
|
|
mailcheck_Disconnect($)
|
|
{
|
|
my ($hash) = @_;
|
|
my $name = $hash->{NAME};
|
|
|
|
RemoveInternalTimer($hash);
|
|
|
|
return if( !$hash->{CD} );
|
|
|
|
my $client = $hash->{CLIENT};
|
|
$client->done if($client && $client->IsAuthenticated );
|
|
$client->logout if($client && $client->IsConnected);
|
|
delete $hash->{CLIENT};
|
|
$hash->{tag} = undef;
|
|
Log3 $name, 3, "$name: logged out";
|
|
|
|
close($hash->{CD}) if($hash->{CD});
|
|
delete($hash->{FD});
|
|
delete($hash->{CD});
|
|
delete($selectlist{$name});
|
|
$hash->{STATE} = "Disconnected";
|
|
Log3 $name, 3, "$name: Disconnected";
|
|
$hash->{LAST_DISCONNECT} = FmtDateTime( gettimeofday() );
|
|
}
|
|
|
|
sub
|
|
mailcheck_Undefine($$)
|
|
{
|
|
my ($hash, $arg) = @_;
|
|
|
|
mailcheck_Disconnect($hash);
|
|
|
|
return undef;
|
|
}
|
|
|
|
sub
|
|
mailcheck_Set($$@)
|
|
{
|
|
my ($hash, $name, $cmd) = @_;
|
|
|
|
my $list = "active:noArg inactive:noArg";
|
|
|
|
if( $cmd eq 'active' ) {
|
|
mailcheck_Disconnect($hash);
|
|
$hash->{STATE} = "Initialized";
|
|
mailcheck_Connect($hash);
|
|
|
|
return undef;
|
|
|
|
} elsif( $cmd eq 'inactive' ) {
|
|
mailcheck_Disconnect($hash);
|
|
$hash->{STATE} = 'inactive';
|
|
|
|
return undef;
|
|
|
|
}
|
|
|
|
return "Unknown argument $cmd, choose one of $list";
|
|
}
|
|
|
|
sub
|
|
mailcheck_poll($)
|
|
{
|
|
my ($hash) = @_;
|
|
|
|
RemoveInternalTimer($hash);
|
|
InternalTimer(gettimeofday()+$hash->{INTERVAL}, "mailcheck_poll", $hash, 0);
|
|
|
|
my $client = $hash->{CLIENT};
|
|
if( $client && $client->IsConnected && $client->IsAuthenticated ) {
|
|
$client->done;
|
|
$client->select($hash->{Folder});
|
|
$hash->{tag} = $client->idle;
|
|
$hash->{LAST_POLL} = FmtDateTime( gettimeofday() );
|
|
}
|
|
}
|
|
|
|
|
|
sub
|
|
mailcheck_Get($$@)
|
|
{
|
|
my ($hash, $name, $cmd) = @_;
|
|
|
|
my $list = "folders:noArg update:noArg";
|
|
|
|
my $client = $hash->{CLIENT};
|
|
if( $cmd eq "folders" ) {
|
|
if( $client && $client->IsConnected && $client->IsAuthenticated ) {
|
|
$client->done;
|
|
my @folders = $client->folders;
|
|
$hash->{tag} = $client->idle;
|
|
return join( "\n", @folders );
|
|
}
|
|
return "not connected";
|
|
} elsif( $cmd eq "update" ) {
|
|
mailcheck_poll($hash);
|
|
return undef;
|
|
}
|
|
|
|
return "Unknown argument $cmd, choose one of $list";
|
|
}
|
|
|
|
sub
|
|
mailcheck_Attr($$$)
|
|
{
|
|
my ($cmd, $name, $attrName, $attrVal) = @_;
|
|
|
|
my $orig = $attrVal;
|
|
$attrVal = int($attrVal) if($attrName eq "interval");
|
|
$attrVal = 60 if($attrName eq "interval" && $attrVal < 60 && $attrVal != 0);
|
|
|
|
if( $attrName eq "debug" ) {
|
|
$attrVal = 1 if($attrVal);
|
|
|
|
my $hash = $defs{$name};
|
|
my $client = $hash->{CLIENT};
|
|
$client->Debug($attrVal) if( $client );
|
|
} elsif( $attrName eq "logfile" ) {
|
|
my $hash = $defs{$name};
|
|
|
|
close( $hash->{FH} ) if( defined($hash->{FH}) );
|
|
delete $hash->{FH};
|
|
delete $hash->{currentlogfile};
|
|
|
|
if( $cmd eq "set" ) {
|
|
my @t = localtime;
|
|
my $f = ResolveDateWildcards($attrVal, @t);
|
|
my $fh = new IO::File ">>$f";
|
|
if( defined($fh) ) {
|
|
Log3 $name, 3, "$name: logging to $f";
|
|
|
|
$fh->autoflush(1);
|
|
|
|
$hash->{FH} = $fh;
|
|
$hash->{currentlogfile} = $f;
|
|
|
|
my $client = $hash->{CLIENT};
|
|
$client->Debug_fh($fh) if( $client );
|
|
} else {
|
|
Log3 $name, 3, "$name: can't open log file $f";
|
|
|
|
my $client = $hash->{CLIENT};
|
|
$client->Debug_fh(*STDERR) if( $client );
|
|
}
|
|
}
|
|
} elsif( $attrName eq "disable" ) {
|
|
my $hash = $defs{$name};
|
|
if( $cmd eq "set" && $attrVal ne "0" ) {
|
|
mailcheck_Disconnect($hash);
|
|
} else {
|
|
$attr{$name}{$attrName} = 0;
|
|
mailcheck_Disconnect($hash);
|
|
mailcheck_Connect($hash);
|
|
}
|
|
}
|
|
|
|
if( $cmd eq "set" ) {
|
|
if( $orig ne $attrVal ) {
|
|
$attr{$name}{$attrName} = $attrVal;
|
|
return $attrName ." set to ". $attrVal;
|
|
}
|
|
}
|
|
|
|
return;
|
|
}
|
|
|
|
sub
|
|
mailcheck_Read($)
|
|
{
|
|
my ($hash) = @_;
|
|
my $name = $hash->{NAME};
|
|
|
|
my $client = $hash->{CLIENT};
|
|
|
|
my $ret = $client->idle_data();
|
|
|
|
if( !defined($ret) || !$ret ) {
|
|
$hash->{tag} = undef;
|
|
$ret = $client->done;
|
|
}
|
|
|
|
foreach my $resp (@$ret) {
|
|
$resp =~ s/\015?\012$//;
|
|
if ( $resp =~ /^\*\s+(\d+)\s+(EXISTS)\b/ ) {
|
|
$resp =~ s/\D//g;
|
|
|
|
$client->done;
|
|
|
|
my $msg_count = $client->unseen_count||0;
|
|
if ($msg_count > 0) {
|
|
my $from = $client->get_header($resp, "From");
|
|
Log3 $name, 4, "from: $from";
|
|
if( $from =~ m/<([^>]*)>/ ) {
|
|
$from = $1;
|
|
}
|
|
|
|
my $subject = $client->get_header($resp, "Subject");
|
|
Log3 $name, 4, "subject: $subject";
|
|
|
|
my $do_notify = 1;
|
|
if( $hash->{HAS_MIME} ) {
|
|
my $message = $client->message_string($resp);
|
|
Log3 $name, 5, "message: $message";
|
|
my $parser = new MIME::Parser;
|
|
$parser->tmp_to_core(1);
|
|
$parser->output_to_core(1);
|
|
my $entity = $parser->parse_data($message);
|
|
#Log3 $name, 5, "mime: $entity";
|
|
|
|
if( my $accept_from = AttrVal($name, "accept_from", "" ) ) {
|
|
$do_notify = 0;
|
|
if( $hash->{HAS_GPG} ) {
|
|
my $gpg = new Mail::GnuPG();
|
|
if( $gpg->is_signed($entity) ) {
|
|
my ($result,$keyid,$email) = $gpg->verify( $entity );
|
|
if( $result == 0 ) {
|
|
if( !$keyid && !$email) {
|
|
Log3 $name, 4, "signature valid";
|
|
my $result = join "", @{$gpg->{last_message}};
|
|
($keyid) = $result =~ /mittels \S+ ID (.+)$/m;
|
|
($email) = $result =~ /Korrekte Signatur von "(.+)"$/m;
|
|
#($email) = $result =~ /(Korrekte|FALSCHE) Signatur von "(.+)"$/m;
|
|
}
|
|
if( !$keyid || !$email ) {
|
|
Log3 $name, 3, "can't parse gpg result. please fix regex in module.";
|
|
Log3 $name, 3, Dumper $gpg->{last_message};
|
|
}
|
|
|
|
$do_notify = 1 if( ",$accept_from," =~/,$keyid,/i );
|
|
Log3 $name, 3, "sender $keyid not allowed" if( !$do_notify );
|
|
} else {
|
|
Log3 $name, 3, "invalid signature";
|
|
Log3 $name, 4, Dumper $gpg->{last_message};
|
|
}
|
|
} else {
|
|
Log3 $name, 3, "message not signed";
|
|
}
|
|
} elsif( $hash->{HAS_SMIME} ) {
|
|
} else {
|
|
Log3 $name, 2, "accept_from is set but Mail::GnuPG and/or S/MIME is not available";
|
|
}
|
|
}
|
|
|
|
$entity->head->decode();
|
|
|
|
if( $subject =~ /iso-8859-1/ ) {
|
|
$subject = $entity->head->get('Subject');
|
|
$subject = latin1ToUtf8( $subject );
|
|
} else {
|
|
$subject = $entity->head->get('Subject');
|
|
}
|
|
|
|
chomp( $subject );
|
|
Log3 $name, 4, "subject decoded: $subject";
|
|
|
|
} elsif( my $accept_from = AttrVal($name, "accept_from", "" ) ) {
|
|
Log3 $name, 2, "accept_from is set but MIME::Parser is not available";
|
|
}
|
|
|
|
if( $do_notify ) {
|
|
readingsBeginUpdate($hash);
|
|
readingsBulkUpdate($hash, "From", $from);
|
|
readingsBulkUpdate($hash, "Subject", $subject);
|
|
readingsEndUpdate($hash, 1);
|
|
}
|
|
|
|
$client->delete_message( $resp ) if( AttrVal($name, "delete_message", 0) == 1 );
|
|
}
|
|
|
|
$client->idle;
|
|
|
|
} elsif ( $resp =~ /^\*\s+(BYE)/ ) {
|
|
mailcheck_Disconnect($hash);
|
|
mailcheck_Connect($hash);
|
|
|
|
return undef;
|
|
}
|
|
}
|
|
|
|
$hash->{tag} ||= $client->idle;
|
|
|
|
unless ( $client->IsConnected ) {
|
|
mailcheck_Disconnect($hash);
|
|
mailcheck_Connect($hash);
|
|
}
|
|
}
|
|
|
|
|
|
1;
|
|
|
|
=pod
|
|
=item device
|
|
=item summary watches an mailbox
|
|
=item summary_DE überwacht eine Mailbox
|
|
=begin html
|
|
|
|
<a name="mailcheck"></a>
|
|
<h3>mailcheck</h3>
|
|
<ul>
|
|
Watches a mailbox with imap idle and for each new mail triggers an event with the subject of this mail.<br><br>
|
|
This can be used to send mails *to* FHEM and react to them from a notify. Application scenarios are for example
|
|
a geofencing apps on mobile phones, networked devices that inform about warning or failure conditions by e-mail or
|
|
(with a little logic in FHEM) the absence of regular status messages from such devices and so on.<br><br>
|
|
|
|
Notes:
|
|
<ul>
|
|
<li>Mail::IMAPClient and IO::Socket::SSL and IO::Socket::INET hast to be installed on the FHEM host.</li>
|
|
<li>Probably only works reliably if no other mail programm is marking messages as read at the same time.</li>
|
|
<li>If you experience a hanging system caused by regular forced disconnects of your internet provider you
|
|
can disable and enable the mailcheck instance with an <a href="#at">at</a>.</li>
|
|
<li>If MIME::Parser is installed non ascii subjects will be docoded to utf-8</li>
|
|
<li>If MIME::Parser and Mail::GnuPG are installed gpg signatures can be checked and mails from unknown senders can be ignored.</li>
|
|
</ul><br>
|
|
|
|
<a name="mailcheck_Define"></a>
|
|
<b>Define</b>
|
|
<ul>
|
|
<code>define <name> mailcheck <host> <user> <password> [<folder>]</code><br>
|
|
<br>
|
|
<user> and <password> can be of the form {perl-code}. no spaces are allowed. for both evals $NAME and $HOST is set to the name and host of the mailcheck device and $USER is set to the user in the password eval.
|
|
<br>
|
|
|
|
Defines a mailcheck device.<br><br>
|
|
|
|
Examples:
|
|
<ul>
|
|
<code>define mailcheck mailcheck imap.mail.me.com x.y@me.com myPassword</code><br>
|
|
<code>define mailcheck mailcheck imap.mail.me.com {"x.y@me.com"} {myPasswordOfAccount($USER)}</code><br>
|
|
</ul>
|
|
</ul><br>
|
|
|
|
<a name="mailcheck_Readings"></a>
|
|
<b>Readings</b>
|
|
<ul>
|
|
<li>Subject<br>
|
|
the subject of the last mail received</li>
|
|
<li>From<br>
|
|
the mail address of the last sender</li>
|
|
</ul><br>
|
|
|
|
<a name="mailcheck_Set"></a>
|
|
<b>Set</b>
|
|
<ul>
|
|
<li>inactive<br>
|
|
temporarily deactivates the device</li>
|
|
<li>active<br>
|
|
reenables the device</li>
|
|
</ul><br>
|
|
|
|
<a name="mailcheck_Get"></a>
|
|
<b>Get</b>
|
|
<ul>
|
|
<li>update<br>
|
|
trigger an update</li>
|
|
<li>folders<br>
|
|
list available folders</li>
|
|
</ul><br>
|
|
|
|
<a name="mailcheck_Attr"></a>
|
|
<b>Attributes</b>
|
|
<ul>
|
|
<li>delete_message<br>
|
|
1 -> delete message after Subject reading is created</li>
|
|
<li>interval<br>
|
|
the interval in seconds used to trigger an update on the connection.
|
|
if idle is supported the defailt is 600, without idle support the default is 60. the minimum is 60.</li>
|
|
<li>nossl<br>
|
|
1 -> don't use ssl.</li><br>
|
|
<li>disable<br>
|
|
1 -> disconnect and stop polling</li>
|
|
<li>debug<br>
|
|
1 -> enables debug output. default target is stdout.</li>
|
|
<li>logfile<br>
|
|
set the target for debug messages if debug is enabled.</li>
|
|
<li>accept_from<br>
|
|
comma separated list of gpg keys that will be accepted for signed messages. Mail::GnuPG and MIME::Parser have to be installed</li>
|
|
</ul>
|
|
</ul>
|
|
|
|
=end html
|
|
=cut
|