summaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
authorFlorian Pritz <bluewind@xinu.at>2018-07-17 15:26:40 +0200
committerFlorian Pritz <bluewind@xinu.at>2018-07-17 15:26:40 +0200
commit50a37d8812c95c60203b0102db91f0c080d4d93b (patch)
tree86d1c9b2e5461e872fdfbcb207a4e07a9f37283e /lib
parent6e43e5e33b7d4fceaadb42e8264a7319002848cb (diff)
downloadApp-ImapNotify-50a37d8812c95c60203b0102db91f0c080d4d93b.tar.gz
App-ImapNotify-50a37d8812c95c60203b0102db91f0c080d4d93b.tar.xz
Initial port of single file script
Signed-off-by: Florian Pritz <bluewind@xinu.at>
Diffstat (limited to 'lib')
-rw-r--r--lib/App/ImapNotify.pm95
-rw-r--r--lib/App/ImapNotify/ImapClient.pm214
-rw-r--r--lib/App/ImapNotify/Notifier.pm48
-rw-r--r--lib/App/ImapNotify/Socket/SSL.pm34
4 files changed, 386 insertions, 5 deletions
diff --git a/lib/App/ImapNotify.pm b/lib/App/ImapNotify.pm
index 4cf5354..0b44f68 100644
--- a/lib/App/ImapNotify.pm
+++ b/lib/App/ImapNotify.pm
@@ -1,14 +1,16 @@
package App::ImapNotify;
-use 5.008001;
+use v5.24;
use strict;
use warnings;
our $VERSION = "0.01";
+use App::ImapNotify::ImapClient;
+use App::ImapNotify::Notifier;
-
-1;
-__END__
+use Carp;
+use Function::Parameters;
+use Log::Any qw($log);
=encoding utf-8
@@ -22,7 +24,9 @@ App::ImapNotify - It's new $module
=head1 DESCRIPTION
-App::ImapNotify is ...
+App::ImapNotify is a simple notification script using IMAP NOTIFY. Note that it is very simple and
+implements a custom IMAP client with very limited features. Mostly a proof of
+concept and personal script.
=head1 LICENSE
@@ -37,3 +41,84 @@ Florian Pritz E<lt>bluewind@xinu.atE<gt>
=cut
+method new($class: $config, $deps = {}) {
+ $deps->{imap_client} //= App::ImapNotify::ImapClient->new({$config->%{qw(host port log_id username password keepalive_timeout)}});
+ $deps->{notifier} //= App::ImapNotify::Notifier->new();
+ return $class->new_no_defaults($config, $deps);
+}
+
+method new_no_defaults($class: $config, $deps = {}) {
+ my $self = {};
+ bless $self, $class;
+ $self->{config} = $config;
+ $self->{deps} = $deps;
+ return $self;
+}
+
+method loop() {
+ #my $imap = $self->{deps}->{imap_client}->connect($self->{config}->@{qw(host port log_id)});
+ #$imap->login($self->{config}->@{qw(username password)});
+ my $imap = $self->{deps}->{imap_client};
+ $imap->select($self->{config}->{mailboxes}->@[0]);
+
+ $imap->send_command("notify set (selected (MessageExpunge MessageNew (uid body.peek[header.fields (from to subject)]))) (mailboxes (".join(' ', $self->{config}->{mailboxes}->@*).") (MessageNew MessageExpunge MailboxName))");
+
+ $log->info("Waiting for notify events");
+ while (my $line = $imap->readline_timeout()) {
+ $log->tracef("Got line: '%s'", $line);
+ if ($line =~ m/^\* .* FETCH /) {
+ my $message = $imap->handle_fetch($line);
+ $self->_notify($message);
+ next;
+ }
+ if ($line =~ m/^\* STATUS (?<mailbox>[^ ]+) \(MESSAGES \d+ UIDNEXT (?<uidnext>\d+) UNSEEN \d+\)/) {
+ $log->debugf("Got status change: '%s'", $line);
+ my $mailbox = $+{mailbox};
+ my $uid = $+{uidnext} - 1;
+ #$imap2->select($mailbox);
+ #my $message = $imap2->send_command("uid fetch $uid (body.peek[header.fields (from to subject)])");
+ $imap->select($mailbox);
+ my $message = $imap->send_command("uid fetch $uid (body.peek[header.fields (from to subject)])");
+ pop @{$message};
+ $self->_notify($message);
+ next;
+ }
+
+ next if $line =~ /\* \d+ RECENT/;
+ next if $line =~ /\* \d+ EXISTS/;
+ next if $line =~ /\* \d+ EXPUNGE/;
+
+ confess(sprintf("Got unexpected line: '%s'", $line));
+ }
+}
+
+method _notify($message) {
+ $log->debugf("Got data for notification: %s", $message);
+ my $fields = {};
+ my $current_field;
+
+ return if $message->@* == 0;
+
+ for my $line ($message->@*) {
+ if ($line =~ m/^(?<label>[^\s:]+): (?<value>.*)\r\n$/) {
+ $current_field = lc($+{label});
+ $fields->{$current_field} = $+{value};
+ next;
+ }
+
+ if ($line =~ m/^\s+(.*)$/) {
+ $fields->{$current_field} .= $1;
+ }
+ }
+
+ $log->debugf("Sending notification with data: %s", $fields);
+ my $notify_heading = sprintf("From: %s", $fields->%*->@{qw(from)});
+ my $notify_body = sprintf("Subject: %s", $fields->%*->@{qw(subject)});
+ $self->{deps}->{notifier}->notify($notify_heading, $notify_body);
+}
+
+
+
+1;
+__END__
+
diff --git a/lib/App/ImapNotify/ImapClient.pm b/lib/App/ImapNotify/ImapClient.pm
new file mode 100644
index 0000000..6e5e21b
--- /dev/null
+++ b/lib/App/ImapNotify/ImapClient.pm
@@ -0,0 +1,214 @@
+package App::ImapNotify::ImapClient;
+use v5.24;
+use strict;
+use warnings;
+
+use App::ImapNotify::Socket::SSL;
+
+use autodie;
+use Carp;
+use Data::Dumper;
+use Function::Parameters;
+use Log::Any qw($log);
+use Time::HiRes;
+use Time::Out qw(timeout);
+
+=head1 NAME
+
+App::ImapNotify::ImapClient - ShortDesc
+
+=head1 SYNOPSIS
+
+ use App::ImapNotify::ImapClient;
+
+ # synopsis...
+
+=head1 DESCRIPTION
+
+# longer description...
+
+
+=head1 INTERFACE
+
+
+=head1 DEPENDENCIES
+
+
+=head1 SEE ALSO
+
+L<App::ImapNotify>
+
+=cut
+
+method new($class: $config, $deps = {}) {
+ $deps->{sock} //= App::ImapNotify::Socket::SSL->new($config->@{qw(host port)});
+ $config->{keepalive_timeout} //= 300;
+ return $class->new_no_defaults($config, $deps);
+}
+
+method new_no_defaults($class: $config, $deps = {}) {
+ my $self = {};
+ bless $self, $class;
+ $self->{log_id} = $config->{log_id};
+ $self->{keepalive_timeout} = $config->{keepalive_timeout};
+ $self->{line_buffer} = [];
+ $self->{deps} = $deps;
+ $self->_connect();
+ $self->_login($config->@{qw(username password)});
+ return $self;
+}
+
+method _connect() {
+ # wait for server greeting
+ my $response = $self->readline_block();
+ if ($response !~ m/^\* OK (.*)/) {
+ confess "Invalid server greeting. Got reply: $response";
+ }
+
+ $self->{capabilities} = $1;
+}
+
+method _login($username, $password) {
+ if ($self->{capabilities} !~ m/\bAUTH=PLAIN\b/) {
+ croak "Server doesn't support AUTH=PLAIN";
+ }
+
+ my $response = $self->send_command("login $username $password");
+ confess "No capabilities found in response: '".$response->[0]."'" unless $response->[0] =~ m/^OK \[(.*)\].*$/;
+ $self->{capabilities} = $1;
+
+ if ($self->{capabilities} !~ m/\bNOTIFY\b/) {
+ croak "Server doesn't support NOTIFY";
+ }
+}
+
+method select($mailbox) {
+ # TODO: seems like select is needed to be able to access newly added UIDs. maybe find a better fix than removing this optimization or look in the standard what's going on here?
+ #if ($self->{current_mailbox} ne $mailbox) {
+ $self->send_command("select $mailbox");
+ # $self->{current_mailbox} = $mailbox;
+ #}
+}
+
+
+method send_command($command) {
+ state $counter = 0;
+
+ my $id = "CMD-".$counter++;
+
+ chomp($command);
+
+ #print "Sending $command\n";
+ #sleep (5) if $command eq "noop";
+
+ $self->writeline("$id $command\r\n");
+
+ my @lines;
+
+ while (my $line = $self->readline_block()) {
+ # TODO: this is probably not correct, but seems to be enough for now. a correct way should probably check that the fetch reply actually corresponds to the fetch command. probably best to check if the UID is the same.
+ if ($command =~ /^uid fetch /i and $line =~ /^(\* \d+ FETCH .*\r\n)/) {
+ push @lines, $self->handle_fetch($1)->@*;
+ next;
+ } elsif ($line =~/^(\* \d+ FETCH .*\r\n)/) {
+ push @lines, $line, $self->handle_fetch($1)->@*;
+ next;
+ }
+
+ if ($line =~ m/^$id (OK .*\r\n)$/) {
+ push @lines, $1;
+ return \@lines;
+ } elsif ($line =~ /^$id /) {
+ croak "Command '$command' failed. Got reply: $line";
+ }
+
+ if ($line =~ /^(.*\r\n)$/) {
+ push @lines, $1;
+ }
+
+ }
+}
+
+method get_uids($mailbox) {
+ $self->select($mailbox);
+ my $response = $self->send_command("UID FETCH 1:* (UID)");
+ pop @$response;
+
+ @$response = map {s/^.* FETCH \(UID ([0-9]+)\)$/$1/r} @$response;
+ return $response;
+}
+
+method handle_fetch($first_line) {
+ if ($first_line =~ m/^\* \d+ FETCH \(.* \{(?<bytes>\d+)\}\r\n$/) {
+ my $bytes = $+{bytes};
+ my $read = 0;
+ my @lines = ();
+ while ($read < $bytes) {
+ my $line = $self->readline_block();
+ $read += length($line);
+ push @lines, $line;
+
+ #print "Got total of $read bytes. data = --'$data'--";
+ }
+ my $line = $self->readline_block();
+ if ($line ne ")\r\n") {
+ confess "Expected closing brace after data. Got: '$line'";
+ }
+ push @lines, $line;
+ return \@lines;
+ } else {
+ confess "First line doesn't match FETCH pattern. Line is: '$first_line'";
+ }
+}
+
+method writeline($line) {
+ $log->tracef("%s >> %s", $self->{log_id}, $line =~ s/\r\n$//r);
+ return $self->{deps}->{sock}->writeline($line);
+}
+
+method readline_block() {
+ if ($self->{line_buffer}->@* > 0) {
+ return $self->_readline_buffer();
+ }
+
+ my $response = $self->{deps}->{sock}->readline();
+ if (defined $response) {
+ $log->tracef("%s << %s", $self->{log_id}, $response =~ s/\r\n$//r);
+ } else {
+ $log->tracef("%s input stream closed (read undef)", $self->{log_id});
+ }
+ return $response;
+}
+
+method readline_timeout() {
+ my $timeout = $self->{keepalive_timeout};
+
+ while (1) {
+ my $ret = timeout $timeout => sub {
+ return $self->readline_block();
+ };
+ if ($@) {
+ $log->debug("Keepalive timeout reached. Sending noop");
+ my @noop_reply = $self->send_command("noop")->@*;
+ #print Dumper(\@noop_reply);
+ if (@noop_reply > 1) {
+ # last line is the reply to NOOP (send_command checks for
+ # that). anything else is data that likely got in between the
+ # timeout expiring and noop reply. it should likely be passed
+ # back up to our caller
+ pop @noop_reply;
+ push $self->{line_buffer}->@*, @noop_reply;
+ return $self->_readline_buffer();
+ }
+ } else {
+ return $ret;
+ }
+ }
+}
+
+method _readline_buffer() {
+ return shift $self->{line_buffer}->@*;
+}
+1;
+
+__END__
diff --git a/lib/App/ImapNotify/Notifier.pm b/lib/App/ImapNotify/Notifier.pm
new file mode 100644
index 0000000..66e6fa6
--- /dev/null
+++ b/lib/App/ImapNotify/Notifier.pm
@@ -0,0 +1,48 @@
+package App::ImapNotify::Notifier;
+use v5.24;
+use strict;
+use warnings;
+
+use Function::Parameters;
+
+=head1 NAME
+
+App::ImapNotify::Notifier - Show notification to user
+
+=head1 SYNOPSIS
+
+ use App::ImapNotify::Notifier;
+
+ my $notifier = App::ImapNotify::Notifier->new();
+ $notifier->notify("subject", "body");
+
+=head1 DESCRIPTION
+
+Uses notify-send to show a notification to the user.
+
+=head1 SEE ALSO
+
+L<App::ImapNotify>
+
+=cut
+
+method new($class: $deps = {}) {
+ return $class->new_no_defaults($deps);
+}
+
+method new_no_defaults($class: $deps = {}) {
+ my $self = {};
+ bless $self, $class;
+ $self->{deps} = $deps;
+ return $self;
+}
+
+method notify($heading, $body) {
+ system(qw(notify-send -t 10000 --), $heading, $body);
+}
+
+
+
+1;
+
+__END__
diff --git a/lib/App/ImapNotify/Socket/SSL.pm b/lib/App/ImapNotify/Socket/SSL.pm
new file mode 100644
index 0000000..18d7ffa
--- /dev/null
+++ b/lib/App/ImapNotify/Socket/SSL.pm
@@ -0,0 +1,34 @@
+package App::ImapNotify::Socket::SSL;
+use v5.24;
+use strict;
+use warnings;
+
+use autodie;
+use Function::Parameters;
+use IO::Socket::SSL;
+use Log::Any qw($log);
+
+method new($class: $host, $port, $deps = {}) {
+ $deps->{sock} //= IO::Socket::SSL->new("$host:$port");
+ return $class->new_no_defaults($deps);
+}
+
+method new_no_defaults($class: $deps = {}) {
+ my $self = {};
+ bless $self, $class;
+ $self->{deps} = $deps;
+ return $self;
+}
+
+method readline() {
+ return CORE::readline $self->{deps}->{sock};
+}
+
+method writeline($line) {
+ print {$self->{deps}->{sock}} $line;
+}
+
+
+1;
+
+__END__