#!/usr/bin/env perl
# $Id: imapcount,v 1.6 2018/07/23 17:29:41 friedman Exp $

(my $progname = $0) =~ s=.*/==;

package IMAP;

use strict;
use warnings qw(all);
use Socket;

my $socklib_def = q(IO::Socket);
my $socklib_ssl = q(IO::Socket::SSL);
my %socklib_map = (   143 => $socklib_def,     993 => $socklib_ssl,
                     imap => $socklib_def,   imaps => $socklib_ssl, );

our $SSL_ERROR    = ""; # Will be overridden by ssl class if loaded.
our $SSL_version_default = 'TLSv1_2'; # 2016-07-04

sub new
{
  my $class = shift;
  my $self = (scalar @_ == 1) ? { %{shift()} } : { @_ };
  bless ($self, (ref ($class) || $class));
  return $self;
}

sub _error
{
  my $msg = join (": ", $progname, "error", @_);
  $msg .= "\n" unless substr ($msg, -1, 1) eq "\n";
  die $msg;
}

sub connect
{
  my $self = shift;

  my $class = $socklib_map{$self->{port}} || $socklib_def;
  eval "use $class";
  _error ($@) if $@;

  my %p = (Type     => SOCK_STREAM,
           Domain   => AF_INET,
           PeerHost => $self->{host},
           PeerPort => $self->{port},
           @_);
  if ($class eq $socklib_ssl)
    {
      $p{SSL_version}     = $SSL_version_default;
      $p{SSL_verify_mode} = 0;
    }

  my $fh = $self->{sock} = $class->new (%p) or _error ($@ || $SSL_ERROR);
  $self->login;
}

sub login
{
  my $self = shift;

  my $cmd = sprintf ("AUTHENTICATE login %s %s", $self->{user}, $self->{pass});
  return 1
    if ($self->response_ok_p ()
        && $self->send_command_ok_p ($cmd, "AUTHENTICATE"));
  $self->disconnect;
  return 0;
}

sub message_count
{
  my $self = shift;
  $self->send_command ("EXAMINE examine inbox");
  my $result = $self->read_response ("EXAMINE");

  my $count = $1
    if $result =~ /^\* (\d+) EXISTS\r?\n/m;
  return $count;
}

sub send_command
{
  my $self = shift;
  my $sock = $self->{sock};
  print $sock $_[0], "\r\n";
}

sub response_ok_p
{
  my ($self, $tag) = @_;

  my $response = $self->read_response ($tag);

  $response =~ s/\r?\n$//;
  $response =~ s/.*\n//g;
  my @x = split (/[ \t]+/, $response, 3);

  return 1 if ($x[1] eq 'OK');
  return 0;
}

sub send_command_ok_p
{
  my ($self, $cmd, $tag) = @_;
  $self->send_command ($cmd);
  $self->response_ok_p ($tag);
}

sub read_response
{
  my ($self, $tag) = @_;
  my $sock = $self->{sock};

  unless ($tag)
    {
      my $line = <$sock>;
      return $line;
    }

  my $output;
  while (<$sock>)
    {
      $output .= $_;
      my ($firstword) = split (/\s+/, $_, 2);
      last if ($firstword eq $tag);
    }
  return $output;
}

sub disconnect
{
  my $self = shift;
  $self->send_command ("LOGOUT logout");
  $self->read_response ("LOGOUT");
  close ($self->{sock});
  delete $self->{sock};
}


package main;

use Getopt::Long;
use POSIX qw(setsid);
use Symbol;
use strict;

sub file_contents
{
  open (my $fh, $_[0]) || die "$_[0]: $!\n";
  local $/ = undef;
  scalar <$fh>;
}

sub client
{
  my $option = shift;
  my $file = $option->{countfile};
  exit (1) if (-z $file);
  print file_contents ($file);
}

sub daemon
{
  my $option = shift;
  my $file = $option->{countfile};

  my $imap = IMAP->new ($option);
  $imap->connect;

  detach ();
  set_proctitle ("imapcountd");

  umask (077);
  my $fh = gensym;
  while (1)
    {
      my $count = $imap->message_count;
      $count = 0 if ($count eq "");
      open ($fh, ">$file");
      print $fh $count, "\n";
      close ($fh);
      sleep ($option->{sleep});
    }
  $imap->disconnect;
}

sub set_proctitle
{
  my $title = shift;
  my $len = 2 * length ($0) + length ("@ARGV") + 2;

  for (my $i = 0; $i < $len; $i++)
    {
      substr ($0, $i, 1) = "\0";
    }
  substr ($0, 0, length ($title)) = $title;
}

sub detach
{
  close (STDIN);
  close (STDOUT);
  close (STDERR);
  open (STDIN,  "</dev/null");
  open (STDOUT, ">/dev/null");
  open (STDERR, ">/dev/null");

  exit (0) if (fork != 0);
  setsid ();
}

sub getpass
{
  my $prompt = shift;
  $prompt = "Password: " unless (defined $prompt);

  my $stty_preserve;
  if (-t 0)
    {
      $stty_preserve = `stty -g`;
      system ("stty -echo");
    }
  print $prompt;
  my $pass = <STDIN>;
  $pass =~ s/\r?\n$//;

  if (defined $stty_preserve)
    {
      print "\n";
      system ("stty " . $stty_preserve);
    }
  return $pass;
}

sub default_countfile_dir
{
  for my $dir ($ENV{XDG_RUNTIME_DIR},
               $ENV{XDG_DATA_HOME},
               $ENV{HOME},
               "/tmp")
    {
      return $dir if defined $dir && -d $dir && -w $dir;
    }
  return "";
}

sub process_options
{
  my $ignore;
  my %option = ( daemon         => 0,
                 host           => "mailhost",
                 port           => 143,
                 user           => $ENV{USER},
                 countfile      => default_countfile_dir() . "/.imapcount",
                 folder         => "INBOX",
                 pass           => $ENV{IMAPPASS},
                 sleep          => 60,
               );

  Getopt::Long::config ('bundling', 'autoabbrev');
  GetOptions ("d|daemon",         \$option{daemon},
              "h|host=s",         \$option{host},
              "p|port=s",         \$option{port},
              "u|user=s",         \$option{user},
              "f|imap-folder=s",  \$option{folder},
              "c|counter-file=s", \$option{countfile},
              "s|sleep=i",        \$option{sleep},
              # For compatibility with xbiffpop
              "C|count-only",     \$ignore,
              );

  return \%option;
}

sub main
{
  my $option = process_options ();

  if ($option->{daemon})
    {
      $option->{pass} = getpass ("Password: ")
        unless defined $option->{pass};
      daemon ($option);
    }

  client ($option);
  exit (0);
}

main ();


# local variables:
# mode: perl
# eval: (auto-fill-mode 1)
# end:

# imapcount ends here
