Initial port of single file script

Signed-off-by: Florian Pritz <bluewind@xinu.at>

3 files changed, 296 insertions, 0 deletions

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__