#!/usr/bin/perl -w
# tiny IMAP server for cs161, fall 2005
# jj, cce
# usage: perl imaps.pl [port number]

use strict;
use Socket qw/:DEFAULT :crlf/;

# password database
my %pwdb = (
	    joe => "j0epasswd",
	    ted => "t3dpasswd",
	    ben => "b3npasswd",
	    );

sub logmsg { print "$0 $$: @_ at ", scalar localtime, "\n" }

my $proto = getprotobyname('tcp');
socket(S, PF_INET, SOCK_STREAM, $proto)        || die "socket: $!";
setsockopt(S, SOL_SOCKET, SO_REUSEADDR, pack("l",1)) || die "setsockopt: $!";

my $port = shift || 2345;
($port) = $port =~ /^(\d+)$/ or die "invalid port";
bind(S, sockaddr_in($port, INADDR_ANY)) || die "bind: $!";
listen(S,SOMAXCONN) || die "listen: $!";

logmsg "server started on port $port";

$SIG{CHLD} = 'IGNORE';

# various imap commands
sub ok { print "$_[0] OK ".uc($_[1])." completed".CRLF; } 
my $capabilities = "IMAP4REV1 STARTTLS IDLE BINARY UNSELECT SCAN SORT";
my %command = (
               login => sub { my ($u, $p) = split / /, $_[2], 2;
			      (exists($pwdb{$u}) && $pwdb{$u} eq $p) ? ok @_ : 
				  print "$_[0] NO authentication failed".CRLF; },
               logout => sub { print "* BYE logging out".CRLF; ok @_; exit; },
               capability => sub { print "* CAPABILITY $capabilities".CRLF; 
				   ok @_; },
               noop => sub { ok @_; },
              );


while (my $paddr = accept(C,S)) {
  my ($port,$iaddr) = sockaddr_in($paddr);
  my $name = gethostbyaddr($iaddr,AF_INET);
  logmsg "connection from $name [", inet_ntoa($iaddr), "] at port $port";

  my $pid;
  if (!defined($pid = fork)) {
    logmsg "cannot fork: $!";
    next;
  } elsif ($pid) {
    # I'm the parent
    logmsg "begat $pid";
    close C;                    # Parent closes, child
    next;
  }

  logmsg "child $$";

  # I'm the child, make stding/stdout go over the network
  open(STDIN, "<&C") || die "can't dup client to stdin";
  open(STDOUT, ">&C") || die "can't dup client to stdout";
  ## open(STDERR, ">&STDOUT") || die "can't dup stdout to stderr";
  $|=1;

  print "* OK Hello there, $name, it's now ", scalar localtime, CRLF;
  while (<>) {
    s/\s*$//;                   # Need to handle crlf, cannot just chomp
    my ($tag, $cmd, $line) = split / /, $_, 3;
#    warn "'$tag' '$cmd' '$line'".CRLF;
    $cmd = lc $cmd;
    if (!exists($command{$cmd})) {
      print "$tag BAD command not understood".CRLF;
      next;
    }
    &{$command{$cmd}}($tag, $cmd, $line);
  }
}