#!/bin/sh
exec ${PERL-perl} -wSx $0 ${1+"$@"}
#!perl

# $Id: imapcount,v 1.4 2003/12/25 18:32:14 friedman Exp $

package IMAP;

use Socket;
use Symbol;
use strict;

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

sub open_network_stream
{
  my $self = shift;

  my $rhostname = shift || $self->{host};
  my $port      = shift || $self->{port};

  my $proto = getprotobyname ("tcp");
  (undef, undef, $port) = getservbyname ($port, "tcp") if ($port !~ /^\d+$/o);

  my @rhostaddr;
  if ($rhostname =~ /^[\d.]+$/o)
    {
      push @rhostaddr, inet_aton ($rhostname);
    }
  else
    {
      @rhostaddr = gethostbyname ($rhostname);
      return undef unless (scalar @rhostaddr > 0);
      # try to get fully-qualified name.
      $rhostname = $rhostaddr[0]
        if (length ($rhostaddr[0]) > length ($rhostname));
      splice (@rhostaddr, 0, 4);
    }

  my $sock = gensym;
  my $connected = 0;
  while (!$connected && scalar @rhostaddr > 0)
    {
      close ($sock) if (defined fileno ($sock));
      return undef
        unless (socket ($sock, AF_INET, SOCK_STREAM, $proto));
      $connected = 1
        if connect ($sock, sockaddr_in ($port, shift @rhostaddr));
    }

  if ($connected)
    {
      $self->{sock} = $sock;
      return $sock;
    }
  close ($sock);  # free socket
  return undef;
}

# mode 1 = buffering, 0 = no buffering
sub set_buffering_mode
{
  my ($self, $mode) = @_;

  my $orig_handle = select ($self->{sock});
  $| = ($mode == 0);
  select ($orig_handle);
}

sub connect
{
  my $self = shift;

  $self->open_network_stream;
  $self->set_buffering_mode (0);
  $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/mo;
  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$//o;
  $response =~ s/.*\n//go;
  my @x = split (/[ \t]+/o, $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 client
{
  my $option = shift;
  my $file = $option->{countfile};

  exit (1) if (-z $file);
  my $fh = gensym;
  open ($fh, "<$file") || exit (1);
  print while (<$fh>);
  close ($fh);
}

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

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

  detach ();
  set_proctitle ("imapcountd");

  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 process_options
{
  my $ignore;
  my %option = ( daemon         => 0,
                 host           => "mailhost",
                 port           => 143,
                 user           => $ENV{USER},
                 countfile      => $ENV{HOME} . "/.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